diff options
Diffstat (limited to 'theories/Reals')
54 files changed, 32995 insertions, 0 deletions
diff --git a/theories/Reals/Alembert.v b/theories/Reals/Alembert.v new file mode 100644 index 00000000..a691b189 --- /dev/null +++ b/theories/Reals/Alembert.v @@ -0,0 +1,726 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Alembert.v,v 1.14.2.1 2004/07/16 19:31:10 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rfunctions. +Require Import Rseries. +Require Import SeqProp. +Require Import PartSum. +Require Import Max. + +Open Local Scope R_scope. + +(***************************************************) +(* Various versions of the criterion of D'Alembert *) +(***************************************************) + +Lemma Alembert_C1 : + forall An:nat -> R, + (forall n:nat, 0 < An n) -> + Un_cv (fun n:nat => Rabs (An (S n) / An n)) 0 -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l). +intros An H H0. +cut + (sigT (fun l:R => is_lub (EUn (fun N:nat => sum_f_R0 An N)) l) -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l)). +intro; apply X. +apply completeness. +unfold Un_cv in H0; unfold bound in |- *; cut (0 < / 2); + [ intro | apply Rinv_0_lt_compat; prove_sup0 ]. +elim (H0 (/ 2) H1); intros. +exists (sum_f_R0 An x + 2 * An (S x)). +unfold is_upper_bound in |- *; intros; unfold EUn in H3; elim H3; intros. +rewrite H4; assert (H5 := lt_eq_lt_dec x1 x). +elim H5; intros. +elim a; intro. +replace (sum_f_R0 An x) with + (sum_f_R0 An x1 + sum_f_R0 (fun i:nat => An (S x1 + i)%nat) (x - S x1)). +pattern (sum_f_R0 An x1) at 1 in |- *; rewrite <- Rplus_0_r; + rewrite Rplus_assoc; apply Rplus_le_compat_l. +left; apply Rplus_lt_0_compat. +apply tech1; intros; apply H. +apply Rmult_lt_0_compat; [ prove_sup0 | apply H ]. +symmetry in |- *; apply tech2; assumption. +rewrite b; pattern (sum_f_R0 An x) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_le_compat_l. +left; apply Rmult_lt_0_compat; [ prove_sup0 | apply H ]. +replace (sum_f_R0 An x1) with + (sum_f_R0 An x + sum_f_R0 (fun i:nat => An (S x + i)%nat) (x1 - S x)). +apply Rplus_le_compat_l. +cut + (sum_f_R0 (fun i:nat => An (S x + i)%nat) (x1 - S x) <= + An (S x) * sum_f_R0 (fun i:nat => (/ 2) ^ i) (x1 - S x)). +intro; + apply Rle_trans with + (An (S x) * sum_f_R0 (fun i:nat => (/ 2) ^ i) (x1 - S x)). +assumption. +rewrite <- (Rmult_comm (An (S x))); apply Rmult_le_compat_l. +left; apply H. +rewrite tech3. +replace (1 - / 2) with (/ 2). +unfold Rdiv in |- *; rewrite Rinv_involutive. +pattern 2 at 3 in |- *; rewrite <- Rmult_1_r; rewrite <- (Rmult_comm 2); + apply Rmult_le_compat_l. +left; prove_sup0. +left; apply Rplus_lt_reg_r with ((/ 2) ^ S (x1 - S x)). +replace ((/ 2) ^ S (x1 - S x) + (1 - (/ 2) ^ S (x1 - S x))) with 1; + [ idtac | ring ]. +rewrite <- (Rplus_comm 1); pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_lt_compat_l. +apply pow_lt; apply Rinv_0_lt_compat; prove_sup0. +discrR. +apply Rmult_eq_reg_l with 2. +rewrite Rmult_minus_distr_l; rewrite <- Rinv_r_sym. +ring. +discrR. +discrR. +pattern 1 at 3 in |- *; replace 1 with (/ 1); + [ apply tech7; discrR | apply Rinv_1 ]. +replace (An (S x)) with (An (S x + 0)%nat). +apply (tech6 (fun i:nat => An (S x + i)%nat) (/ 2)). +left; apply Rinv_0_lt_compat; prove_sup0. +intro; cut (forall n:nat, (n >= x)%nat -> An (S n) < / 2 * An n). +intro; replace (S x + S i)%nat with (S (S x + i)). +apply H6; unfold ge in |- *; apply tech8. +apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; do 2 rewrite S_INR; ring. +intros; unfold R_dist in H2; apply Rmult_lt_reg_l with (/ An n). +apply Rinv_0_lt_compat; apply H. +do 2 rewrite (Rmult_comm (/ An n)); rewrite Rmult_assoc; + rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; + replace (An (S n) * / An n) with (Rabs (Rabs (An (S n) / An n) - 0)). +apply H2; assumption. +unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; + rewrite Rabs_Rabsolu; rewrite Rabs_right. +unfold Rdiv in |- *; reflexivity. +left; unfold Rdiv in |- *; change (0 < An (S n) * / An n) in |- *; + apply Rmult_lt_0_compat; [ apply H | apply Rinv_0_lt_compat; apply H ]. +red in |- *; intro; assert (H8 := H n); rewrite H7 in H8; + elim (Rlt_irrefl _ H8). +replace (S x + 0)%nat with (S x); [ reflexivity | ring ]. +symmetry in |- *; apply tech2; assumption. +exists (sum_f_R0 An 0); unfold EUn in |- *; exists 0%nat; reflexivity. +intro; elim X; intros. +apply existT with x; apply tech10; + [ unfold Un_growing in |- *; intro; rewrite tech5; + pattern (sum_f_R0 An n) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_le_compat_l; left; apply H + | apply p ]. +Qed. + +Lemma Alembert_C2 : + forall An:nat -> R, + (forall n:nat, An n <> 0) -> + Un_cv (fun n:nat => Rabs (An (S n) / An n)) 0 -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l). +intros. +set (Vn := fun i:nat => (2 * Rabs (An i) + An i) / 2). +set (Wn := fun i:nat => (2 * Rabs (An i) - An i) / 2). +cut (forall n:nat, 0 < Vn n). +intro; cut (forall n:nat, 0 < Wn n). +intro; cut (Un_cv (fun n:nat => Rabs (Vn (S n) / Vn n)) 0). +intro; cut (Un_cv (fun n:nat => Rabs (Wn (S n) / Wn n)) 0). +intro; assert (H5 := Alembert_C1 Vn H1 H3). +assert (H6 := Alembert_C1 Wn H2 H4). +elim H5; intros. +elim H6; intros. +apply existT with (x - x0); unfold Un_cv in |- *; unfold Un_cv in p; + unfold Un_cv in p0; intros; cut (0 < eps / 2). +intro; elim (p (eps / 2) H8); clear p; intros. +elim (p0 (eps / 2) H8); clear p0; intros. +set (N := max x1 x2). +exists N; intros; + replace (sum_f_R0 An n) with (sum_f_R0 Vn n - sum_f_R0 Wn n). +unfold R_dist in |- *; + replace (sum_f_R0 Vn n - sum_f_R0 Wn n - (x - x0)) with + (sum_f_R0 Vn n - x + - (sum_f_R0 Wn n - x0)); [ idtac | ring ]; + apply Rle_lt_trans with + (Rabs (sum_f_R0 Vn n - x) + Rabs (- (sum_f_R0 Wn n - x0))). +apply Rabs_triang. +rewrite Rabs_Ropp; apply Rlt_le_trans with (eps / 2 + eps / 2). +apply Rplus_lt_compat. +unfold R_dist in H9; apply H9; unfold ge in |- *; apply le_trans with N; + [ unfold N in |- *; apply le_max_l | assumption ]. +unfold R_dist in H10; apply H10; unfold ge in |- *; apply le_trans with N; + [ unfold N in |- *; apply le_max_r | assumption ]. +right; symmetry in |- *; apply double_var. +symmetry in |- *; apply tech11; intro; unfold Vn, Wn in |- *; + unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ 2)); + apply Rmult_eq_reg_l with 2. +rewrite Rmult_minus_distr_l; repeat rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym. +ring. +discrR. +discrR. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +cut (forall n:nat, / 2 * Rabs (An n) <= Wn n <= 3 * / 2 * Rabs (An n)). +intro; cut (forall n:nat, / Wn n <= 2 * / Rabs (An n)). +intro; cut (forall n:nat, Wn (S n) / Wn n <= 3 * Rabs (An (S n) / An n)). +intro; unfold Un_cv in |- *; intros; unfold Un_cv in H0; cut (0 < eps / 3). +intro; elim (H0 (eps / 3) H8); intros. +exists x; intros. +assert (H11 := H9 n H10). +unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; rewrite Rabs_Rabsolu; unfold R_dist in H11; + unfold Rminus in H11; rewrite Ropp_0 in H11; rewrite Rplus_0_r in H11; + rewrite Rabs_Rabsolu in H11; rewrite Rabs_right. +apply Rle_lt_trans with (3 * Rabs (An (S n) / An n)). +apply H6. +apply Rmult_lt_reg_l with (/ 3). +apply Rinv_0_lt_compat; prove_sup0. +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ]; + rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); unfold Rdiv in H11; + exact H11. +left; change (0 < Wn (S n) / Wn n) in |- *; unfold Rdiv in |- *; + apply Rmult_lt_0_compat. +apply H2. +apply Rinv_0_lt_compat; apply H2. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +intro; unfold Rdiv in |- *; rewrite Rabs_mult; rewrite <- Rmult_assoc; + replace 3 with (2 * (3 * / 2)); + [ idtac | rewrite <- Rmult_assoc; apply Rinv_r_simpl_m; discrR ]; + apply Rle_trans with (Wn (S n) * 2 * / Rabs (An n)). +rewrite Rmult_assoc; apply Rmult_le_compat_l. +left; apply H2. +apply H5. +rewrite Rabs_Rinv. +replace (Wn (S n) * 2 * / Rabs (An n)) with (2 * / Rabs (An n) * Wn (S n)); + [ idtac | ring ]; + replace (2 * (3 * / 2) * Rabs (An (S n)) * / Rabs (An n)) with + (2 * / Rabs (An n) * (3 * / 2 * Rabs (An (S n)))); + [ idtac | ring ]; apply Rmult_le_compat_l. +left; apply Rmult_lt_0_compat. +prove_sup0. +apply Rinv_0_lt_compat; apply Rabs_pos_lt; apply H. +elim (H4 (S n)); intros; assumption. +apply H. +intro; apply Rmult_le_reg_l with (Wn n). +apply H2. +rewrite <- Rinv_r_sym. +apply Rmult_le_reg_l with (Rabs (An n)). +apply Rabs_pos_lt; apply H. +rewrite Rmult_1_r; + replace (Rabs (An n) * (Wn n * (2 * / Rabs (An n)))) with + (2 * Wn n * (Rabs (An n) * / Rabs (An n))); [ idtac | ring ]; + rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; apply Rmult_le_reg_l with (/ 2). +apply Rinv_0_lt_compat; prove_sup0. +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; elim (H4 n); intros; assumption. +discrR. +apply Rabs_no_R0; apply H. +red in |- *; intro; assert (H6 := H2 n); rewrite H5 in H6; + elim (Rlt_irrefl _ H6). +intro; split. +unfold Wn in |- *; unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); + apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; prove_sup0. +pattern (Rabs (An n)) at 1 in |- *; rewrite <- Rplus_0_r; rewrite double; + unfold Rminus in |- *; rewrite Rplus_assoc; apply Rplus_le_compat_l. +apply Rplus_le_reg_l with (An n). +rewrite Rplus_0_r; rewrite (Rplus_comm (An n)); rewrite Rplus_assoc; + rewrite Rplus_opp_l; rewrite Rplus_0_r; apply RRle_abs. +unfold Wn in |- *; unfold Rdiv in |- *; repeat rewrite <- (Rmult_comm (/ 2)); + repeat rewrite Rmult_assoc; apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; prove_sup0. +unfold Rminus in |- *; rewrite double; + replace (3 * Rabs (An n)) with (Rabs (An n) + Rabs (An n) + Rabs (An n)); + [ idtac | ring ]; repeat rewrite Rplus_assoc; repeat apply Rplus_le_compat_l. +rewrite <- Rabs_Ropp; apply RRle_abs. +cut (forall n:nat, / 2 * Rabs (An n) <= Vn n <= 3 * / 2 * Rabs (An n)). +intro; cut (forall n:nat, / Vn n <= 2 * / Rabs (An n)). +intro; cut (forall n:nat, Vn (S n) / Vn n <= 3 * Rabs (An (S n) / An n)). +intro; unfold Un_cv in |- *; intros; unfold Un_cv in H1; cut (0 < eps / 3). +intro; elim (H0 (eps / 3) H7); intros. +exists x; intros. +assert (H10 := H8 n H9). +unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; rewrite Rabs_Rabsolu; unfold R_dist in H10; + unfold Rminus in H10; rewrite Ropp_0 in H10; rewrite Rplus_0_r in H10; + rewrite Rabs_Rabsolu in H10; rewrite Rabs_right. +apply Rle_lt_trans with (3 * Rabs (An (S n) / An n)). +apply H5. +apply Rmult_lt_reg_l with (/ 3). +apply Rinv_0_lt_compat; prove_sup0. +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ]; + rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); unfold Rdiv in H10; + exact H10. +left; change (0 < Vn (S n) / Vn n) in |- *; unfold Rdiv in |- *; + apply Rmult_lt_0_compat. +apply H1. +apply Rinv_0_lt_compat; apply H1. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +intro; unfold Rdiv in |- *; rewrite Rabs_mult; rewrite <- Rmult_assoc; + replace 3 with (2 * (3 * / 2)); + [ idtac | rewrite <- Rmult_assoc; apply Rinv_r_simpl_m; discrR ]; + apply Rle_trans with (Vn (S n) * 2 * / Rabs (An n)). +rewrite Rmult_assoc; apply Rmult_le_compat_l. +left; apply H1. +apply H4. +rewrite Rabs_Rinv. +replace (Vn (S n) * 2 * / Rabs (An n)) with (2 * / Rabs (An n) * Vn (S n)); + [ idtac | ring ]; + replace (2 * (3 * / 2) * Rabs (An (S n)) * / Rabs (An n)) with + (2 * / Rabs (An n) * (3 * / 2 * Rabs (An (S n)))); + [ idtac | ring ]; apply Rmult_le_compat_l. +left; apply Rmult_lt_0_compat. +prove_sup0. +apply Rinv_0_lt_compat; apply Rabs_pos_lt; apply H. +elim (H3 (S n)); intros; assumption. +apply H. +intro; apply Rmult_le_reg_l with (Vn n). +apply H1. +rewrite <- Rinv_r_sym. +apply Rmult_le_reg_l with (Rabs (An n)). +apply Rabs_pos_lt; apply H. +rewrite Rmult_1_r; + replace (Rabs (An n) * (Vn n * (2 * / Rabs (An n)))) with + (2 * Vn n * (Rabs (An n) * / Rabs (An n))); [ idtac | ring ]; + rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; apply Rmult_le_reg_l with (/ 2). +apply Rinv_0_lt_compat; prove_sup0. +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; elim (H3 n); intros; assumption. +discrR. +apply Rabs_no_R0; apply H. +red in |- *; intro; assert (H5 := H1 n); rewrite H4 in H5; + elim (Rlt_irrefl _ H5). +intro; split. +unfold Vn in |- *; unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); + apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; prove_sup0. +pattern (Rabs (An n)) at 1 in |- *; rewrite <- Rplus_0_r; rewrite double; + rewrite Rplus_assoc; apply Rplus_le_compat_l. +apply Rplus_le_reg_l with (- An n); rewrite Rplus_0_r; + rewrite <- (Rplus_comm (An n)); rewrite <- Rplus_assoc; + rewrite Rplus_opp_l; rewrite Rplus_0_l; rewrite <- Rabs_Ropp; + apply RRle_abs. +unfold Vn in |- *; unfold Rdiv in |- *; repeat rewrite <- (Rmult_comm (/ 2)); + repeat rewrite Rmult_assoc; apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; prove_sup0. +unfold Rminus in |- *; rewrite double; + replace (3 * Rabs (An n)) with (Rabs (An n) + Rabs (An n) + Rabs (An n)); + [ idtac | ring ]; repeat rewrite Rplus_assoc; repeat apply Rplus_le_compat_l; + apply RRle_abs. +intro; unfold Wn in |- *; unfold Rdiv in |- *; rewrite <- (Rmult_0_r (/ 2)); + rewrite <- (Rmult_comm (/ 2)); apply Rmult_lt_compat_l. +apply Rinv_0_lt_compat; prove_sup0. +apply Rplus_lt_reg_r with (An n); rewrite Rplus_0_r; unfold Rminus in |- *; + rewrite (Rplus_comm (An n)); rewrite Rplus_assoc; + rewrite Rplus_opp_l; rewrite Rplus_0_r; + apply Rle_lt_trans with (Rabs (An n)). +apply RRle_abs. +rewrite double; pattern (Rabs (An n)) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_lt_compat_l; apply Rabs_pos_lt; apply H. +intro; unfold Vn in |- *; unfold Rdiv in |- *; rewrite <- (Rmult_0_r (/ 2)); + rewrite <- (Rmult_comm (/ 2)); apply Rmult_lt_compat_l. +apply Rinv_0_lt_compat; prove_sup0. +apply Rplus_lt_reg_r with (- An n); rewrite Rplus_0_r; unfold Rminus in |- *; + rewrite (Rplus_comm (- An n)); rewrite Rplus_assoc; + rewrite Rplus_opp_r; rewrite Rplus_0_r; + apply Rle_lt_trans with (Rabs (An n)). +rewrite <- Rabs_Ropp; apply RRle_abs. +rewrite double; pattern (Rabs (An n)) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_lt_compat_l; apply Rabs_pos_lt; apply H. +Qed. + +Lemma AlembertC3_step1 : + forall (An:nat -> R) (x:R), + x <> 0 -> + (forall n:nat, An n <> 0) -> + Un_cv (fun n:nat => Rabs (An (S n) / An n)) 0 -> + sigT (fun l:R => Pser An x l). +intros; set (Bn := fun i:nat => An i * x ^ i). +cut (forall n:nat, Bn n <> 0). +intro; cut (Un_cv (fun n:nat => Rabs (Bn (S n) / Bn n)) 0). +intro; assert (H4 := Alembert_C2 Bn H2 H3). +elim H4; intros. +apply existT with x0; unfold Bn in p; apply tech12; assumption. +unfold Un_cv in |- *; intros; unfold Un_cv in H1; cut (0 < eps / Rabs x). +intro; elim (H1 (eps / Rabs x) H4); intros. +exists x0; intros; unfold R_dist in |- *; unfold Rminus in |- *; + rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; + unfold Bn in |- *; + replace (An (S n) * x ^ S n / (An n * x ^ n)) with (An (S n) / An n * x). +rewrite Rabs_mult; apply Rmult_lt_reg_l with (/ Rabs x). +apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. +rewrite <- (Rmult_comm (Rabs x)); rewrite <- Rmult_assoc; + rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); unfold Rdiv in H5; + replace (Rabs (An (S n) / An n)) with (R_dist (Rabs (An (S n) * / An n)) 0). +apply H5; assumption. +unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; rewrite Rabs_Rabsolu; unfold Rdiv in |- *; + reflexivity. +apply Rabs_no_R0; assumption. +replace (S n) with (n + 1)%nat; [ idtac | ring ]; rewrite pow_add; + unfold Rdiv in |- *; rewrite Rinv_mult_distr. +replace (An (n + 1)%nat * (x ^ n * x ^ 1) * (/ An n * / x ^ n)) with + (An (n + 1)%nat * x ^ 1 * / An n * (x ^ n * / x ^ n)); + [ idtac | ring ]; rewrite <- Rinv_r_sym. +simpl in |- *; ring. +apply pow_nonzero; assumption. +apply H0. +apply pow_nonzero; assumption. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption ]. +intro; unfold Bn in |- *; apply prod_neq_R0; + [ apply H0 | apply pow_nonzero; assumption ]. +Qed. + +Lemma AlembertC3_step2 : + forall (An:nat -> R) (x:R), x = 0 -> sigT (fun l:R => Pser An x l). +intros; apply existT with (An 0%nat). +unfold Pser in |- *; unfold infinit_sum in |- *; intros; exists 0%nat; intros; + replace (sum_f_R0 (fun n0:nat => An n0 * x ^ n0) n) with (An 0%nat). +unfold R_dist in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rabs_R0; assumption. +induction n as [| n Hrecn]. +simpl in |- *; ring. +rewrite tech5; rewrite Hrecn; + [ rewrite H; simpl in |- *; ring | unfold ge in |- *; apply le_O_n ]. +Qed. + +(* An useful criterion of convergence for power series *) +Theorem Alembert_C3 : + forall (An:nat -> R) (x:R), + (forall n:nat, An n <> 0) -> + Un_cv (fun n:nat => Rabs (An (S n) / An n)) 0 -> + sigT (fun l:R => Pser An x l). +intros; case (total_order_T x 0); intro. +elim s; intro. +cut (x <> 0). +intro; apply AlembertC3_step1; assumption. +red in |- *; intro; rewrite H1 in a; elim (Rlt_irrefl _ a). +apply AlembertC3_step2; assumption. +cut (x <> 0). +intro; apply AlembertC3_step1; assumption. +red in |- *; intro; rewrite H1 in r; elim (Rlt_irrefl _ r). +Qed. + +Lemma Alembert_C4 : + forall (An:nat -> R) (k:R), + 0 <= k < 1 -> + (forall n:nat, 0 < An n) -> + Un_cv (fun n:nat => Rabs (An (S n) / An n)) k -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l). +intros An k Hyp H H0. +cut + (sigT (fun l:R => is_lub (EUn (fun N:nat => sum_f_R0 An N)) l) -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l)). +intro; apply X. +apply completeness. +assert (H1 := tech13 _ _ Hyp H0). +elim H1; intros. +elim H2; intros. +elim H4; intros. +unfold bound in |- *; exists (sum_f_R0 An x0 + / (1 - x) * An (S x0)). +unfold is_upper_bound in |- *; intros; unfold EUn in H6. +elim H6; intros. +rewrite H7. +assert (H8 := lt_eq_lt_dec x2 x0). +elim H8; intros. +elim a; intro. +replace (sum_f_R0 An x0) with + (sum_f_R0 An x2 + sum_f_R0 (fun i:nat => An (S x2 + i)%nat) (x0 - S x2)). +pattern (sum_f_R0 An x2) at 1 in |- *; rewrite <- Rplus_0_r. +rewrite Rplus_assoc; apply Rplus_le_compat_l. +left; apply Rplus_lt_0_compat. +apply tech1. +intros; apply H. +apply Rmult_lt_0_compat. +apply Rinv_0_lt_compat; apply Rplus_lt_reg_r with x; rewrite Rplus_0_r; + replace (x + (1 - x)) with 1; [ elim H3; intros; assumption | ring ]. +apply H. +symmetry in |- *; apply tech2; assumption. +rewrite b; pattern (sum_f_R0 An x0) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_le_compat_l. +left; apply Rmult_lt_0_compat. +apply Rinv_0_lt_compat; apply Rplus_lt_reg_r with x; rewrite Rplus_0_r; + replace (x + (1 - x)) with 1; [ elim H3; intros; assumption | ring ]. +apply H. +replace (sum_f_R0 An x2) with + (sum_f_R0 An x0 + sum_f_R0 (fun i:nat => An (S x0 + i)%nat) (x2 - S x0)). +apply Rplus_le_compat_l. +cut + (sum_f_R0 (fun i:nat => An (S x0 + i)%nat) (x2 - S x0) <= + An (S x0) * sum_f_R0 (fun i:nat => x ^ i) (x2 - S x0)). +intro; + apply Rle_trans with (An (S x0) * sum_f_R0 (fun i:nat => x ^ i) (x2 - S x0)). +assumption. +rewrite <- (Rmult_comm (An (S x0))); apply Rmult_le_compat_l. +left; apply H. +rewrite tech3. +unfold Rdiv in |- *; apply Rmult_le_reg_l with (1 - x). +apply Rplus_lt_reg_r with x; rewrite Rplus_0_r. +replace (x + (1 - x)) with 1; [ elim H3; intros; assumption | ring ]. +do 2 rewrite (Rmult_comm (1 - x)). +rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; apply Rplus_le_reg_l with (x ^ S (x2 - S x0)). +replace (x ^ S (x2 - S x0) + (1 - x ^ S (x2 - S x0))) with 1; + [ idtac | ring ]. +rewrite <- (Rplus_comm 1); pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_le_compat_l. +left; apply pow_lt. +apply Rle_lt_trans with k. +elim Hyp; intros; assumption. +elim H3; intros; assumption. +apply Rminus_eq_contra. +red in |- *; intro. +elim H3; intros. +rewrite H10 in H12; elim (Rlt_irrefl _ H12). +red in |- *; intro. +elim H3; intros. +rewrite H10 in H12; elim (Rlt_irrefl _ H12). +replace (An (S x0)) with (An (S x0 + 0)%nat). +apply (tech6 (fun i:nat => An (S x0 + i)%nat) x). +left; apply Rle_lt_trans with k. +elim Hyp; intros; assumption. +elim H3; intros; assumption. +intro. +cut (forall n:nat, (n >= x0)%nat -> An (S n) < x * An n). +intro. +replace (S x0 + S i)%nat with (S (S x0 + i)). +apply H9. +unfold ge in |- *. +apply tech8. + apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; do 2 rewrite S_INR; + ring. +intros. +apply Rmult_lt_reg_l with (/ An n). +apply Rinv_0_lt_compat; apply H. +do 2 rewrite (Rmult_comm (/ An n)). +rewrite Rmult_assoc. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_r. +replace (An (S n) * / An n) with (Rabs (An (S n) / An n)). +apply H5; assumption. +rewrite Rabs_right. +unfold Rdiv in |- *; reflexivity. +left; unfold Rdiv in |- *; change (0 < An (S n) * / An n) in |- *; + apply Rmult_lt_0_compat. +apply H. +apply Rinv_0_lt_compat; apply H. +red in |- *; intro. +assert (H11 := H n). +rewrite H10 in H11; elim (Rlt_irrefl _ H11). +replace (S x0 + 0)%nat with (S x0); [ reflexivity | ring ]. +symmetry in |- *; apply tech2; assumption. +exists (sum_f_R0 An 0); unfold EUn in |- *; exists 0%nat; reflexivity. +intro; elim X; intros. +apply existT with x; apply tech10; + [ unfold Un_growing in |- *; intro; rewrite tech5; + pattern (sum_f_R0 An n) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_le_compat_l; left; apply H + | apply p ]. +Qed. + +Lemma Alembert_C5 : + forall (An:nat -> R) (k:R), + 0 <= k < 1 -> + (forall n:nat, An n <> 0) -> + Un_cv (fun n:nat => Rabs (An (S n) / An n)) k -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l). +intros. +cut + (sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l) -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l)). +intro Hyp0; apply Hyp0. +apply cv_cauchy_2. +apply cauchy_abs. +apply cv_cauchy_1. +cut + (sigT + (fun l:R => Un_cv (fun N:nat => sum_f_R0 (fun i:nat => Rabs (An i)) N) l) -> + sigT + (fun l:R => Un_cv (fun N:nat => sum_f_R0 (fun i:nat => Rabs (An i)) N) l)). +intro Hyp; apply Hyp. +apply (Alembert_C4 (fun i:nat => Rabs (An i)) k). +assumption. +intro; apply Rabs_pos_lt; apply H0. +unfold Un_cv in |- *. +unfold Un_cv in H1. +unfold Rdiv in |- *. +intros. +elim (H1 eps H2); intros. +exists x; intros. +rewrite <- Rabs_Rinv. +rewrite <- Rabs_mult. +rewrite Rabs_Rabsolu. +unfold Rdiv in H3; apply H3; assumption. +apply H0. +intro. +elim X; intros. +apply existT with x. +assumption. +intro. +elim X; intros. +apply existT with x. +assumption. +Qed. + +(* Convergence of power series in D(O,1/k) *) +(* k=0 is described in Alembert_C3 *) +Lemma Alembert_C6 : + forall (An:nat -> R) (x k:R), + 0 < k -> + (forall n:nat, An n <> 0) -> + Un_cv (fun n:nat => Rabs (An (S n) / An n)) k -> + Rabs x < / k -> sigT (fun l:R => Pser An x l). +intros. +cut + (sigT + (fun l:R => Un_cv (fun N:nat => sum_f_R0 (fun i:nat => An i * x ^ i) N) l)). +intro. +elim X; intros. +apply existT with x0. +apply tech12; assumption. +case (total_order_T x 0); intro. +elim s; intro. +eapply Alembert_C5 with (k * Rabs x). +split. +unfold Rdiv in |- *; apply Rmult_le_pos. +left; assumption. +left; apply Rabs_pos_lt. +red in |- *; intro; rewrite H3 in a; elim (Rlt_irrefl _ a). +apply Rmult_lt_reg_l with (/ k). +apply Rinv_0_lt_compat; assumption. +rewrite <- Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_l. +rewrite Rmult_1_r; assumption. +red in |- *; intro; rewrite H3 in H; elim (Rlt_irrefl _ H). +intro; apply prod_neq_R0. +apply H0. +apply pow_nonzero. +red in |- *; intro; rewrite H3 in a; elim (Rlt_irrefl _ a). +unfold Un_cv in |- *; unfold Un_cv in H1. +intros. +cut (0 < eps / Rabs x). +intro. +elim (H1 (eps / Rabs x) H4); intros. +exists x0. +intros. +replace (An (S n) * x ^ S n / (An n * x ^ n)) with (An (S n) / An n * x). +unfold R_dist in |- *. +rewrite Rabs_mult. +replace (Rabs (An (S n) / An n) * Rabs x - k * Rabs x) with + (Rabs x * (Rabs (An (S n) / An n) - k)); [ idtac | ring ]. +rewrite Rabs_mult. +rewrite Rabs_Rabsolu. +apply Rmult_lt_reg_l with (/ Rabs x). +apply Rinv_0_lt_compat; apply Rabs_pos_lt. +red in |- *; intro; rewrite H7 in a; elim (Rlt_irrefl _ a). +rewrite <- Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_l. +rewrite <- (Rmult_comm eps). +unfold R_dist in H5. +unfold Rdiv in |- *; unfold Rdiv in H5; apply H5; assumption. +apply Rabs_no_R0. +red in |- *; intro; rewrite H7 in a; elim (Rlt_irrefl _ a). +unfold Rdiv in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ]. +rewrite pow_add. +simpl in |- *. +rewrite Rmult_1_r. +rewrite Rinv_mult_distr. +replace (An (n + 1)%nat * (x ^ n * x) * (/ An n * / x ^ n)) with + (An (n + 1)%nat * / An n * x * (x ^ n * / x ^ n)); + [ idtac | ring ]. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; reflexivity. +apply pow_nonzero. +red in |- *; intro; rewrite H7 in a; elim (Rlt_irrefl _ a). +apply H0. +apply pow_nonzero. +red in |- *; intro; rewrite H7 in a; elim (Rlt_irrefl _ a). +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +assumption. +apply Rinv_0_lt_compat; apply Rabs_pos_lt. +red in |- *; intro H7; rewrite H7 in a; elim (Rlt_irrefl _ a). +apply existT with (An 0%nat). +unfold Un_cv in |- *. +intros. +exists 0%nat. +intros. +unfold R_dist in |- *. +replace (sum_f_R0 (fun i:nat => An i * x ^ i) n) with (An 0%nat). +unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. +induction n as [| n Hrecn]. +simpl in |- *; ring. +rewrite tech5. +rewrite <- Hrecn. +rewrite b; simpl in |- *; ring. +unfold ge in |- *; apply le_O_n. +eapply Alembert_C5 with (k * Rabs x). +split. +unfold Rdiv in |- *; apply Rmult_le_pos. +left; assumption. +left; apply Rabs_pos_lt. +red in |- *; intro; rewrite H3 in r; elim (Rlt_irrefl _ r). +apply Rmult_lt_reg_l with (/ k). +apply Rinv_0_lt_compat; assumption. +rewrite <- Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_l. +rewrite Rmult_1_r; assumption. +red in |- *; intro; rewrite H3 in H; elim (Rlt_irrefl _ H). +intro; apply prod_neq_R0. +apply H0. +apply pow_nonzero. +red in |- *; intro; rewrite H3 in r; elim (Rlt_irrefl _ r). +unfold Un_cv in |- *; unfold Un_cv in H1. +intros. +cut (0 < eps / Rabs x). +intro. +elim (H1 (eps / Rabs x) H4); intros. +exists x0. +intros. +replace (An (S n) * x ^ S n / (An n * x ^ n)) with (An (S n) / An n * x). +unfold R_dist in |- *. +rewrite Rabs_mult. +replace (Rabs (An (S n) / An n) * Rabs x - k * Rabs x) with + (Rabs x * (Rabs (An (S n) / An n) - k)); [ idtac | ring ]. +rewrite Rabs_mult. +rewrite Rabs_Rabsolu. +apply Rmult_lt_reg_l with (/ Rabs x). +apply Rinv_0_lt_compat; apply Rabs_pos_lt. +red in |- *; intro; rewrite H7 in r; elim (Rlt_irrefl _ r). +rewrite <- Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_l. +rewrite <- (Rmult_comm eps). +unfold R_dist in H5. +unfold Rdiv in |- *; unfold Rdiv in H5; apply H5; assumption. +apply Rabs_no_R0. +red in |- *; intro; rewrite H7 in r; elim (Rlt_irrefl _ r). +unfold Rdiv in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ]. +rewrite pow_add. +simpl in |- *. +rewrite Rmult_1_r. +rewrite Rinv_mult_distr. +replace (An (n + 1)%nat * (x ^ n * x) * (/ An n * / x ^ n)) with + (An (n + 1)%nat * / An n * x * (x ^ n * / x ^ n)); + [ idtac | ring ]. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; reflexivity. +apply pow_nonzero. +red in |- *; intro; rewrite H7 in r; elim (Rlt_irrefl _ r). +apply H0. +apply pow_nonzero. +red in |- *; intro; rewrite H7 in r; elim (Rlt_irrefl _ r). +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +assumption. +apply Rinv_0_lt_compat; apply Rabs_pos_lt. +red in |- *; intro H7; rewrite H7 in r; elim (Rlt_irrefl _ r). +Qed.
\ No newline at end of file diff --git a/theories/Reals/AltSeries.v b/theories/Reals/AltSeries.v new file mode 100644 index 00000000..166a8a46 --- /dev/null +++ b/theories/Reals/AltSeries.v @@ -0,0 +1,448 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: AltSeries.v,v 1.12.2.1 2004/07/16 19:31:10 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rfunctions. +Require Import Rseries. +Require Import SeqProp. +Require Import PartSum. +Require Import Max. +Open Local Scope R_scope. + +(**********) +Definition tg_alt (Un:nat -> R) (i:nat) : R := (-1) ^ i * Un i. +Definition positivity_seq (Un:nat -> R) : Prop := forall n:nat, 0 <= Un n. + +Lemma CV_ALT_step0 : + forall Un:nat -> R, + Un_decreasing Un -> + Un_growing (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N))). +intros; unfold Un_growing in |- *; intro. +cut ((2 * S n)%nat = S (S (2 * n))). +intro; rewrite H0. +do 4 rewrite tech5; repeat rewrite Rplus_assoc; apply Rplus_le_compat_l. +pattern (tg_alt Un (S (2 * n))) at 1 in |- *; rewrite <- Rplus_0_r. +apply Rplus_le_compat_l. +unfold tg_alt in |- *; rewrite <- H0; rewrite pow_1_odd; rewrite pow_1_even; + rewrite Rmult_1_l. +apply Rplus_le_reg_l with (Un (S (2 * S n))). +rewrite Rplus_0_r; + replace (Un (S (2 * S n)) + (Un (2 * S n)%nat + -1 * Un (S (2 * S n)))) with + (Un (2 * S n)%nat); [ idtac | ring ]. +apply H. +cut (forall n:nat, S n = (n + 1)%nat); [ intro | intro; ring ]. +rewrite (H0 n); rewrite (H0 (S (2 * n))); rewrite (H0 (2 * n)%nat); ring. +Qed. + +Lemma CV_ALT_step1 : + forall Un:nat -> R, + Un_decreasing Un -> + Un_decreasing (fun N:nat => sum_f_R0 (tg_alt Un) (2 * N)). +intros; unfold Un_decreasing in |- *; intro. +cut ((2 * S n)%nat = S (S (2 * n))). +intro; rewrite H0; do 2 rewrite tech5; repeat rewrite Rplus_assoc. +pattern (sum_f_R0 (tg_alt Un) (2 * n)) at 2 in |- *; rewrite <- Rplus_0_r. +apply Rplus_le_compat_l. +unfold tg_alt in |- *; rewrite <- H0; rewrite pow_1_odd; rewrite pow_1_even; + rewrite Rmult_1_l. +apply Rplus_le_reg_l with (Un (S (2 * n))). +rewrite Rplus_0_r; + replace (Un (S (2 * n)) + (-1 * Un (S (2 * n)) + Un (2 * S n)%nat)) with + (Un (2 * S n)%nat); [ idtac | ring ]. +rewrite H0; apply H. +cut (forall n:nat, S n = (n + 1)%nat); [ intro | intro; ring ]. +rewrite (H0 n); rewrite (H0 (S (2 * n))); rewrite (H0 (2 * n)%nat); ring. +Qed. + +(**********) +Lemma CV_ALT_step2 : + forall (Un:nat -> R) (N:nat), + Un_decreasing Un -> + positivity_seq Un -> + sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * N)) <= 0. +intros; induction N as [| N HrecN]. +simpl in |- *; unfold tg_alt in |- *; simpl in |- *; rewrite Rmult_1_r. +replace (-1 * -1 * Un 2%nat) with (Un 2%nat); [ idtac | ring ]. +apply Rplus_le_reg_l with (Un 1%nat); rewrite Rplus_0_r. +replace (Un 1%nat + (-1 * Un 1%nat + Un 2%nat)) with (Un 2%nat); + [ apply H | ring ]. +cut (S (2 * S N) = S (S (S (2 * N)))). +intro; rewrite H1; do 2 rewrite tech5. +apply Rle_trans with (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * N))). +pattern (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * N))) at 2 in |- *; + rewrite <- Rplus_0_r. +rewrite Rplus_assoc; apply Rplus_le_compat_l. +unfold tg_alt in |- *; rewrite <- H1. +rewrite pow_1_odd. +cut (S (S (2 * S N)) = (2 * S (S N))%nat). +intro; rewrite H2; rewrite pow_1_even; rewrite Rmult_1_l; rewrite <- H2. +apply Rplus_le_reg_l with (Un (S (2 * S N))). +rewrite Rplus_0_r; + replace (Un (S (2 * S N)) + (-1 * Un (S (2 * S N)) + Un (S (S (2 * S N))))) + with (Un (S (S (2 * S N)))); [ idtac | ring ]. +apply H. +apply INR_eq; rewrite mult_INR; repeat rewrite S_INR; rewrite mult_INR; + repeat rewrite S_INR; ring. +apply HrecN. +apply INR_eq; repeat rewrite S_INR; do 2 rewrite mult_INR; + repeat rewrite S_INR; ring. +Qed. + +(* A more general inequality *) +Lemma CV_ALT_step3 : + forall (Un:nat -> R) (N:nat), + Un_decreasing Un -> + positivity_seq Un -> sum_f_R0 (fun i:nat => tg_alt Un (S i)) N <= 0. +intros; induction N as [| N HrecN]. +simpl in |- *; unfold tg_alt in |- *; simpl in |- *; rewrite Rmult_1_r. +apply Rplus_le_reg_l with (Un 1%nat). +rewrite Rplus_0_r; replace (Un 1%nat + -1 * Un 1%nat) with 0; + [ apply H0 | ring ]. +assert (H1 := even_odd_cor N). +elim H1; intros. +elim H2; intro. +rewrite H3; apply CV_ALT_step2; assumption. +rewrite H3; rewrite tech5. +apply Rle_trans with (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * x))). +pattern (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * x))) at 2 in |- *; + rewrite <- Rplus_0_r. +apply Rplus_le_compat_l. +unfold tg_alt in |- *; simpl in |- *. +replace (x + (x + 0))%nat with (2 * x)%nat; [ idtac | ring ]. +rewrite pow_1_even. +replace (-1 * (-1 * (-1 * 1)) * Un (S (S (S (2 * x))))) with + (- Un (S (S (S (2 * x))))); [ idtac | ring ]. +apply Rplus_le_reg_l with (Un (S (S (S (2 * x))))). +rewrite Rplus_0_r; rewrite Rplus_opp_r. +apply H0. +apply CV_ALT_step2; assumption. +Qed. + +(**********) +Lemma CV_ALT_step4 : + forall Un:nat -> R, + Un_decreasing Un -> + positivity_seq Un -> + has_ub (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N))). +intros; unfold has_ub in |- *; unfold bound in |- *. +exists (Un 0%nat). +unfold is_upper_bound in |- *; intros; elim H1; intros. +rewrite H2; rewrite decomp_sum. +replace (tg_alt Un 0) with (Un 0%nat). +pattern (Un 0%nat) at 2 in |- *; rewrite <- Rplus_0_r. +apply Rplus_le_compat_l. +apply CV_ALT_step3; assumption. +unfold tg_alt in |- *; simpl in |- *; ring. +apply lt_O_Sn. +Qed. + +(* This lemma gives an interesting result about alternated series *) +Lemma CV_ALT : + forall Un:nat -> R, + Un_decreasing Un -> + positivity_seq Un -> + Un_cv Un 0 -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) N) l). +intros. +assert (H2 := CV_ALT_step0 _ H). +assert (H3 := CV_ALT_step4 _ H H0). +assert (X := growing_cv _ H2 H3). +elim X; intros. +apply existT with x. +unfold Un_cv in |- *; unfold R_dist in |- *; unfold Un_cv in H1; + unfold R_dist in H1; unfold Un_cv in p; unfold R_dist in p. +intros; cut (0 < eps / 2); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. +elim (H1 (eps / 2) H5); intros N2 H6. +elim (p (eps / 2) H5); intros N1 H7. +set (N := max (S (2 * N1)) N2). +exists N; intros. +assert (H9 := even_odd_cor n). +elim H9; intros P H10. +cut (N1 <= P)%nat. +intro; elim H10; intro. +replace (sum_f_R0 (tg_alt Un) n - x) with + (sum_f_R0 (tg_alt Un) (S n) - x + - tg_alt Un (S n)). +apply Rle_lt_trans with + (Rabs (sum_f_R0 (tg_alt Un) (S n) - x) + Rabs (- tg_alt Un (S n))). +apply Rabs_triang. +rewrite (double_var eps); apply Rplus_lt_compat. +rewrite H12; apply H7; assumption. +rewrite Rabs_Ropp; unfold tg_alt in |- *; rewrite Rabs_mult; + rewrite pow_1_abs; rewrite Rmult_1_l; unfold Rminus in H6; + rewrite Ropp_0 in H6; rewrite <- (Rplus_0_r (Un (S n))); + apply H6. +unfold ge in |- *; apply le_trans with n. +apply le_trans with N; [ unfold N in |- *; apply le_max_r | assumption ]. +apply le_n_Sn. +rewrite tech5; ring. +rewrite H12; apply Rlt_trans with (eps / 2). +apply H7; assumption. +unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2. +prove_sup0. +rewrite (Rmult_comm 2); rewrite Rmult_assoc; rewrite <- Rinv_l_sym; + [ rewrite Rmult_1_r | discrR ]. +rewrite double. +pattern eps at 1 in |- *; rewrite <- (Rplus_0_r eps); apply Rplus_lt_compat_l; + assumption. +elim H10; intro; apply le_double. +rewrite <- H11; apply le_trans with N. +unfold N in |- *; apply le_trans with (S (2 * N1)); + [ apply le_n_Sn | apply le_max_l ]. +assumption. +apply lt_n_Sm_le. +rewrite <- H11. +apply lt_le_trans with N. +unfold N in |- *; apply lt_le_trans with (S (2 * N1)). +apply lt_n_Sn. +apply le_max_l. +assumption. +Qed. + +(************************************************) +(* Convergence of alternated series *) +(* *) +(* Applications: PI, cos, sin *) +(************************************************) +Theorem alternated_series : + forall Un:nat -> R, + Un_decreasing Un -> + Un_cv Un 0 -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) N) l). +intros; apply CV_ALT. +assumption. +unfold positivity_seq in |- *; apply decreasing_ineq; assumption. +assumption. +Qed. + +Theorem alternated_series_ineq : + forall (Un:nat -> R) (l:R) (N:nat), + Un_decreasing Un -> + Un_cv Un 0 -> + Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) N) l -> + sum_f_R0 (tg_alt Un) (S (2 * N)) <= l <= sum_f_R0 (tg_alt Un) (2 * N). +intros. +cut (Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) (2 * N)) l). +cut (Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N))) l). +intros; split. +apply (growing_ineq (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N)))). +apply CV_ALT_step0; assumption. +assumption. +apply (decreasing_ineq (fun N:nat => sum_f_R0 (tg_alt Un) (2 * N))). +apply CV_ALT_step1; assumption. +assumption. +unfold Un_cv in |- *; unfold R_dist in |- *; unfold Un_cv in H1; + unfold R_dist in H1; intros. +elim (H1 eps H2); intros. +exists x; intros. +apply H3. +unfold ge in |- *; apply le_trans with (2 * n)%nat. +apply le_trans with n. +assumption. +assert (H5 := mult_O_le n 2). +elim H5; intro. +cut (0%nat <> 2%nat); + [ intro; elim H7; symmetry in |- *; assumption | discriminate ]. +assumption. +apply le_n_Sn. +unfold Un_cv in |- *; unfold R_dist in |- *; unfold Un_cv in H1; + unfold R_dist in H1; intros. +elim (H1 eps H2); intros. +exists x; intros. +apply H3. +unfold ge in |- *; apply le_trans with n. +assumption. +assert (H5 := mult_O_le n 2). +elim H5; intro. +cut (0%nat <> 2%nat); + [ intro; elim H7; symmetry in |- *; assumption | discriminate ]. +assumption. +Qed. + +(************************************) +(* Application : construction of PI *) +(************************************) + +Definition PI_tg (n:nat) := / INR (2 * n + 1). + +Lemma PI_tg_pos : forall n:nat, 0 <= PI_tg n. +intro; unfold PI_tg in |- *; left; apply Rinv_0_lt_compat; apply lt_INR_0; + replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_O_Sn | ring ]. +Qed. + +Lemma PI_tg_decreasing : Un_decreasing PI_tg. +unfold PI_tg, Un_decreasing in |- *; intro. +apply Rmult_le_reg_l with (INR (2 * n + 1)). +apply lt_INR_0. +replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_O_Sn | ring ]. +rewrite <- Rinv_r_sym. +apply Rmult_le_reg_l with (INR (2 * S n + 1)). +apply lt_INR_0. +replace (2 * S n + 1)%nat with (S (2 * S n)); [ apply lt_O_Sn | ring ]. +rewrite (Rmult_comm (INR (2 * S n + 1))); rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. +do 2 rewrite Rmult_1_r; apply le_INR. +replace (2 * S n + 1)%nat with (S (S (2 * n + 1))). +apply le_trans with (S (2 * n + 1)); apply le_n_Sn. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite plus_INR; + do 2 rewrite mult_INR; repeat rewrite S_INR; ring. +apply not_O_INR; discriminate. +apply not_O_INR; replace (2 * n + 1)%nat with (S (2 * n)); + [ discriminate | ring ]. +Qed. + +Lemma PI_tg_cv : Un_cv PI_tg 0. +unfold Un_cv in |- *; unfold R_dist in |- *; intros. +cut (0 < 2 * eps); + [ intro | apply Rmult_lt_0_compat; [ prove_sup0 | assumption ] ]. +assert (H1 := archimed (/ (2 * eps))). +cut (0 <= up (/ (2 * eps)))%Z. +intro; assert (H3 := IZN (up (/ (2 * eps))) H2). +elim H3; intros N H4. +cut (0 < N)%nat. +intro; exists N; intros. +cut (0 < n)%nat. +intro; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; + rewrite Rabs_right. +unfold PI_tg in |- *; apply Rlt_trans with (/ INR (2 * n)). +apply Rmult_lt_reg_l with (INR (2 * n)). +apply lt_INR_0. +replace (2 * n)%nat with (n + n)%nat; [ idtac | ring ]. +apply lt_le_trans with n. +assumption. +apply le_plus_l. +rewrite <- Rinv_r_sym. +apply Rmult_lt_reg_l with (INR (2 * n + 1)). +apply lt_INR_0. +replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_O_Sn | ring ]. +rewrite (Rmult_comm (INR (2 * n + 1))). +rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +do 2 rewrite Rmult_1_r; apply lt_INR. +replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_n_Sn | ring ]. +apply not_O_INR; replace (2 * n + 1)%nat with (S (2 * n)); + [ discriminate | ring ]. +replace n with (S (pred n)). +apply not_O_INR; discriminate. +symmetry in |- *; apply S_pred with 0%nat. +assumption. +apply Rle_lt_trans with (/ INR (2 * N)). +apply Rmult_le_reg_l with (INR (2 * N)). +rewrite mult_INR; apply Rmult_lt_0_compat; + [ simpl in |- *; prove_sup0 | apply lt_INR_0; assumption ]. +rewrite <- Rinv_r_sym. +apply Rmult_le_reg_l with (INR (2 * n)). +rewrite mult_INR; apply Rmult_lt_0_compat; + [ simpl in |- *; prove_sup0 | apply lt_INR_0; assumption ]. +rewrite (Rmult_comm (INR (2 * n))); rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. +do 2 rewrite Rmult_1_r; apply le_INR. +apply (fun m n p:nat => mult_le_compat_l p n m); assumption. +replace n with (S (pred n)). +apply not_O_INR; discriminate. +symmetry in |- *; apply S_pred with 0%nat. +assumption. +replace N with (S (pred N)). +apply not_O_INR; discriminate. +symmetry in |- *; apply S_pred with 0%nat. +assumption. +rewrite mult_INR. +rewrite Rinv_mult_distr. +replace (INR 2) with 2; [ idtac | reflexivity ]. +apply Rmult_lt_reg_l with 2. +prove_sup0. +rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; [ idtac | discrR ]. +rewrite Rmult_1_l; apply Rmult_lt_reg_l with (INR N). +apply lt_INR_0; assumption. +rewrite <- Rinv_r_sym. +apply Rmult_lt_reg_l with (/ (2 * eps)). +apply Rinv_0_lt_compat; assumption. +rewrite Rmult_1_r; + replace (/ (2 * eps) * (INR N * (2 * eps))) with + (INR N * (2 * eps * / (2 * eps))); [ idtac | ring ]. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; replace (INR N) with (IZR (Z_of_nat N)). +rewrite <- H4. +elim H1; intros; assumption. +symmetry in |- *; apply INR_IZR_INZ. +apply prod_neq_R0; + [ discrR | red in |- *; intro; rewrite H8 in H; elim (Rlt_irrefl _ H) ]. +apply not_O_INR. +red in |- *; intro; rewrite H8 in H5; elim (lt_irrefl _ H5). +replace (INR 2) with 2; [ discrR | reflexivity ]. +apply not_O_INR. +red in |- *; intro; rewrite H8 in H5; elim (lt_irrefl _ H5). +apply Rle_ge; apply PI_tg_pos. +apply lt_le_trans with N; assumption. +elim H1; intros H5 _. +assert (H6 := lt_eq_lt_dec 0 N). +elim H6; intro. +elim a; intro. +assumption. +rewrite <- b in H4. +rewrite H4 in H5. +simpl in H5. +cut (0 < / (2 * eps)); [ intro | apply Rinv_0_lt_compat; assumption ]. +elim (Rlt_irrefl _ (Rlt_trans _ _ _ H7 H5)). +elim (lt_n_O _ b). +apply le_IZR. +simpl in |- *. +left; apply Rlt_trans with (/ (2 * eps)). +apply Rinv_0_lt_compat; assumption. +elim H1; intros; assumption. +Qed. + +Lemma exist_PI : + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 (tg_alt PI_tg) N) l). +apply alternated_series. +apply PI_tg_decreasing. +apply PI_tg_cv. +Qed. + +(* Now, PI is defined *) +Definition PI : R := 4 * match exist_PI with + | existT a b => a + end. + +(* We can get an approximation of PI with the following inequality *) +Lemma PI_ineq : + forall N:nat, + sum_f_R0 (tg_alt PI_tg) (S (2 * N)) <= PI / 4 <= + sum_f_R0 (tg_alt PI_tg) (2 * N). +intro; apply alternated_series_ineq. +apply PI_tg_decreasing. +apply PI_tg_cv. +unfold PI in |- *; case exist_PI; intro. +replace (4 * x / 4) with x. +trivial. +unfold Rdiv in |- *; rewrite (Rmult_comm 4); rewrite Rmult_assoc; + rewrite <- Rinv_r_sym; [ rewrite Rmult_1_r; reflexivity | discrR ]. +Qed. + +Lemma PI_RGT_0 : 0 < PI. +assert (H := PI_ineq 0). +apply Rmult_lt_reg_l with (/ 4). +apply Rinv_0_lt_compat; prove_sup0. +rewrite Rmult_0_r; rewrite Rmult_comm. +elim H; clear H; intros H _. +unfold Rdiv in H; + apply Rlt_le_trans with (sum_f_R0 (tg_alt PI_tg) (S (2 * 0))). +simpl in |- *; unfold tg_alt in |- *; simpl in |- *; rewrite Rmult_1_l; + rewrite Rmult_1_r; apply Rplus_lt_reg_r with (PI_tg 1). +rewrite Rplus_0_r; + replace (PI_tg 1 + (PI_tg 0 + -1 * PI_tg 1)) with (PI_tg 0); + [ unfold PI_tg in |- * | ring ]. +simpl in |- *; apply Rinv_lt_contravar. +rewrite Rmult_1_l; replace (2 + 1) with 3; [ prove_sup0 | ring ]. +rewrite Rplus_comm; pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_lt_compat_l; prove_sup0. +assumption. +Qed.
\ No newline at end of file diff --git a/theories/Reals/ArithProp.v b/theories/Reals/ArithProp.v new file mode 100644 index 00000000..ad535a9d --- /dev/null +++ b/theories/Reals/ArithProp.v @@ -0,0 +1,178 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: ArithProp.v,v 1.11.2.1 2004/07/16 19:31:10 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rbasic_fun. +Require Import Even. +Require Import Div2. +Open Local Scope Z_scope. +Open Local Scope R_scope. + +Lemma minus_neq_O : forall n i:nat, (i < n)%nat -> (n - i)%nat <> 0%nat. +intros; red in |- *; intro. +cut (forall n m:nat, (m <= n)%nat -> (n - m)%nat = 0%nat -> n = m). +intro; assert (H2 := H1 _ _ (lt_le_weak _ _ H) H0); rewrite H2 in H; + elim (lt_irrefl _ H). +set (R := fun n m:nat => (m <= n)%nat -> (n - m)%nat = 0%nat -> n = m). +cut + ((forall n m:nat, R n m) -> + forall n0 m:nat, (m <= n0)%nat -> (n0 - m)%nat = 0%nat -> n0 = m). +intro; apply H1. +apply nat_double_ind. +unfold R in |- *; intros; inversion H2; reflexivity. +unfold R in |- *; intros; simpl in H3; assumption. +unfold R in |- *; intros; simpl in H4; assert (H5 := le_S_n _ _ H3); + assert (H6 := H2 H5 H4); rewrite H6; reflexivity. +unfold R in |- *; intros; apply H1; assumption. +Qed. + +Lemma le_minusni_n : forall n i:nat, (i <= n)%nat -> (n - i <= n)%nat. +set (R := fun m n:nat => (n <= m)%nat -> (m - n <= m)%nat). +cut + ((forall m n:nat, R m n) -> forall n i:nat, (i <= n)%nat -> (n - i <= n)%nat). +intro; apply H. +apply nat_double_ind. +unfold R in |- *; intros; simpl in |- *; apply le_n. +unfold R in |- *; intros; simpl in |- *; apply le_n. +unfold R in |- *; intros; simpl in |- *; apply le_trans with n. +apply H0; apply le_S_n; assumption. +apply le_n_Sn. +unfold R in |- *; intros; apply H; assumption. +Qed. + +Lemma lt_minus_O_lt : forall m n:nat, (m < n)%nat -> (0 < n - m)%nat. +intros n m; pattern n, m in |- *; apply nat_double_ind; + [ intros; rewrite <- minus_n_O; assumption + | intros; elim (lt_n_O _ H) + | intros; simpl in |- *; apply H; apply lt_S_n; assumption ]. +Qed. + +Lemma even_odd_cor : + forall n:nat, exists p : nat, n = (2 * p)%nat \/ n = S (2 * p). +intro. +assert (H := even_or_odd n). +exists (div2 n). +assert (H0 := even_odd_double n). +elim H0; intros. +elim H1; intros H3 _. +elim H2; intros H4 _. +replace (2 * div2 n)%nat with (double (div2 n)). +elim H; intro. +left. +apply H3; assumption. +right. +apply H4; assumption. +unfold double in |- *; ring. +Qed. + +(* 2m <= 2n => m<=n *) +Lemma le_double : forall m n:nat, (2 * m <= 2 * n)%nat -> (m <= n)%nat. +intros; apply INR_le. +assert (H1 := le_INR _ _ H). +do 2 rewrite mult_INR in H1. +apply Rmult_le_reg_l with (INR 2). +replace (INR 2) with 2; [ prove_sup0 | reflexivity ]. +assumption. +Qed. + +(* Here, we have the euclidian division *) +(* This lemma is used in the proof of sin_eq_0 : (sin x)=0<->x=kPI *) +Lemma euclidian_division : + forall x y:R, + y <> 0 -> + exists k : Z, (exists r : R, x = IZR k * y + r /\ 0 <= r < Rabs y). +intros. +set + (k0 := + match Rcase_abs y with + | left _ => (1 - up (x / - y))%Z + | right _ => (up (x / y) - 1)%Z + end). +exists k0. +exists (x - IZR k0 * y). +split. +ring. +unfold k0 in |- *; case (Rcase_abs y); intro. +assert (H0 := archimed (x / - y)); rewrite <- Z_R_minus; simpl in |- *; + unfold Rminus in |- *. +replace (- ((1 + - IZR (up (x / - y))) * y)) with + ((IZR (up (x / - y)) - 1) * y); [ idtac | ring ]. +split. +apply Rmult_le_reg_l with (/ - y). +apply Rinv_0_lt_compat; apply Ropp_0_gt_lt_contravar; exact r. +rewrite Rmult_0_r; rewrite (Rmult_comm (/ - y)); rewrite Rmult_plus_distr_r; + rewrite <- Ropp_inv_permute; [ idtac | assumption ]. +rewrite Rmult_assoc; repeat rewrite Ropp_mult_distr_r_reverse; + rewrite <- Rinv_r_sym; [ rewrite Rmult_1_r | assumption ]. +apply Rplus_le_reg_l with (IZR (up (x / - y)) - x / - y). +rewrite Rplus_0_r; unfold Rdiv in |- *; pattern (/ - y) at 4 in |- *; + rewrite <- Ropp_inv_permute; [ idtac | assumption ]. +replace + (IZR (up (x * / - y)) - x * - / y + + (- (x * / y) + - (IZR (up (x * / - y)) - 1))) with 1; + [ idtac | ring ]. +elim H0; intros _ H1; unfold Rdiv in H1; exact H1. +rewrite (Rabs_left _ r); apply Rmult_lt_reg_l with (/ - y). +apply Rinv_0_lt_compat; apply Ropp_0_gt_lt_contravar; exact r. +rewrite <- Rinv_l_sym. +rewrite (Rmult_comm (/ - y)); rewrite Rmult_plus_distr_r; + rewrite <- Ropp_inv_permute; [ idtac | assumption ]. +rewrite Rmult_assoc; repeat rewrite Ropp_mult_distr_r_reverse; + rewrite <- Rinv_r_sym; [ rewrite Rmult_1_r | assumption ]; + apply Rplus_lt_reg_r with (IZR (up (x / - y)) - 1). +replace (IZR (up (x / - y)) - 1 + 1) with (IZR (up (x / - y))); + [ idtac | ring ]. +replace (IZR (up (x / - y)) - 1 + (- (x * / y) + - (IZR (up (x / - y)) - 1))) + with (- (x * / y)); [ idtac | ring ]. +rewrite <- Ropp_mult_distr_r_reverse; rewrite (Ropp_inv_permute _ H); elim H0; + unfold Rdiv in |- *; intros H1 _; exact H1. +apply Ropp_neq_0_compat; assumption. +assert (H0 := archimed (x / y)); rewrite <- Z_R_minus; simpl in |- *; + cut (0 < y). +intro; unfold Rminus in |- *; + replace (- ((IZR (up (x / y)) + -1) * y)) with ((1 - IZR (up (x / y))) * y); + [ idtac | ring ]. +split. +apply Rmult_le_reg_l with (/ y). +apply Rinv_0_lt_compat; assumption. +rewrite Rmult_0_r; rewrite (Rmult_comm (/ y)); rewrite Rmult_plus_distr_r; + rewrite Rmult_assoc; rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_r | assumption ]; + apply Rplus_le_reg_l with (IZR (up (x / y)) - x / y); + rewrite Rplus_0_r; unfold Rdiv in |- *; + replace + (IZR (up (x * / y)) - x * / y + (x * / y + (1 - IZR (up (x * / y))))) with + 1; [ idtac | ring ]; elim H0; intros _ H2; unfold Rdiv in H2; + exact H2. +rewrite (Rabs_right _ r); apply Rmult_lt_reg_l with (/ y). +apply Rinv_0_lt_compat; assumption. +rewrite <- (Rinv_l_sym _ H); rewrite (Rmult_comm (/ y)); + rewrite Rmult_plus_distr_r; rewrite Rmult_assoc; rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_r | assumption ]; + apply Rplus_lt_reg_r with (IZR (up (x / y)) - 1); + replace (IZR (up (x / y)) - 1 + 1) with (IZR (up (x / y))); + [ idtac | ring ]; + replace (IZR (up (x / y)) - 1 + (x * / y + (1 - IZR (up (x / y))))) with + (x * / y); [ idtac | ring ]; elim H0; unfold Rdiv in |- *; + intros H2 _; exact H2. +case (total_order_T 0 y); intro. +elim s; intro. +assumption. +elim H; symmetry in |- *; exact b. +assert (H1 := Rge_le _ _ r); elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 r0)). +Qed. + +Lemma tech8 : forall n i:nat, (n <= S n + i)%nat. +intros; induction i as [| i Hreci]. +replace (S n + 0)%nat with (S n); [ apply le_n_Sn | ring ]. +replace (S n + S i)%nat with (S (S n + i)). +apply le_S; assumption. +apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; do 2 rewrite S_INR; ring. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Binomial.v b/theories/Reals/Binomial.v new file mode 100644 index 00000000..e31b623c --- /dev/null +++ b/theories/Reals/Binomial.v @@ -0,0 +1,204 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Binomial.v,v 1.9.2.1 2004/07/16 19:31:10 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rfunctions. +Require Import PartSum. +Open Local Scope R_scope. + +Definition C (n p:nat) : R := + INR (fact n) / (INR (fact p) * INR (fact (n - p))). + +Lemma pascal_step1 : forall n i:nat, (i <= n)%nat -> C n i = C n (n - i). +intros; unfold C in |- *; replace (n - (n - i))%nat with i. +rewrite Rmult_comm. +reflexivity. +apply plus_minus; rewrite plus_comm; apply le_plus_minus; assumption. +Qed. + +Lemma pascal_step2 : + forall n i:nat, + (i <= n)%nat -> C (S n) i = INR (S n) / INR (S n - i) * C n i. +intros; unfold C in |- *; replace (S n - i)%nat with (S (n - i)). +cut (forall n:nat, fact (S n) = (S n * fact n)%nat). +intro; repeat rewrite H0. +unfold Rdiv in |- *; repeat rewrite mult_INR; repeat rewrite Rinv_mult_distr. +ring. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply not_O_INR; discriminate. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply prod_neq_R0. +apply not_O_INR; discriminate. +apply INR_fact_neq_0. +intro; reflexivity. +apply minus_Sn_m; assumption. +Qed. + +Lemma pascal_step3 : + forall n i:nat, (i < n)%nat -> C n (S i) = INR (n - i) / INR (S i) * C n i. +intros; unfold C in |- *. +cut (forall n:nat, fact (S n) = (S n * fact n)%nat). +intro. +cut ((n - i)%nat = S (n - S i)). +intro. +pattern (n - i)%nat at 2 in |- *; rewrite H1. +repeat rewrite H0; unfold Rdiv in |- *; repeat rewrite mult_INR; + repeat rewrite Rinv_mult_distr. +rewrite <- H1; rewrite (Rmult_comm (/ INR (n - i))); + repeat rewrite Rmult_assoc; rewrite (Rmult_comm (INR (n - i))); + repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +ring. +apply not_O_INR; apply minus_neq_O; assumption. +apply not_O_INR; discriminate. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply prod_neq_R0; [ apply not_O_INR; discriminate | apply INR_fact_neq_0 ]. +apply not_O_INR; discriminate. +apply INR_fact_neq_0. +apply prod_neq_R0; [ apply not_O_INR; discriminate | apply INR_fact_neq_0 ]. +apply INR_fact_neq_0. +rewrite minus_Sn_m. +simpl in |- *; reflexivity. +apply lt_le_S; assumption. +intro; reflexivity. +Qed. + +(**********) +Lemma pascal : + forall n i:nat, (i < n)%nat -> C n i + C n (S i) = C (S n) (S i). +intros. +rewrite pascal_step3; [ idtac | assumption ]. +replace (C n i + INR (n - i) / INR (S i) * C n i) with + (C n i * (1 + INR (n - i) / INR (S i))); [ idtac | ring ]. +replace (1 + INR (n - i) / INR (S i)) with (INR (S n) / INR (S i)). +rewrite pascal_step1. +rewrite Rmult_comm; replace (S i) with (S n - (n - i))%nat. +rewrite <- pascal_step2. +apply pascal_step1. +apply le_trans with n. +apply le_minusni_n. +apply lt_le_weak; assumption. +apply le_n_Sn. +apply le_minusni_n. +apply lt_le_weak; assumption. +rewrite <- minus_Sn_m. +cut ((n - (n - i))%nat = i). +intro; rewrite H0; reflexivity. +symmetry in |- *; apply plus_minus. +rewrite plus_comm; rewrite le_plus_minus_r. +reflexivity. +apply lt_le_weak; assumption. +apply le_minusni_n; apply lt_le_weak; assumption. +apply lt_le_weak; assumption. +unfold Rdiv in |- *. +repeat rewrite S_INR. +rewrite minus_INR. +cut (INR i + 1 <> 0). +intro. +apply Rmult_eq_reg_l with (INR i + 1); [ idtac | assumption ]. +rewrite Rmult_plus_distr_l. +rewrite Rmult_1_r. +do 2 rewrite (Rmult_comm (INR i + 1)). +repeat rewrite Rmult_assoc. +rewrite <- Rinv_l_sym; [ idtac | assumption ]. +ring. +rewrite <- S_INR. +apply not_O_INR; discriminate. +apply lt_le_weak; assumption. +Qed. + +(*********************) +(*********************) +Lemma binomial : + forall (x y:R) (n:nat), + (x + y) ^ n = sum_f_R0 (fun i:nat => C n i * x ^ i * y ^ (n - i)) n. +intros; induction n as [| n Hrecn]. +unfold C in |- *; simpl in |- *; unfold Rdiv in |- *; + repeat rewrite Rmult_1_r; rewrite Rinv_1; ring. +pattern (S n) at 1 in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ]. +rewrite pow_add; rewrite Hrecn. +replace ((x + y) ^ 1) with (x + y); [ idtac | simpl in |- *; ring ]. +rewrite tech5. +cut (forall p:nat, C p p = 1). +cut (forall p:nat, C p 0 = 1). +intros; rewrite H0; rewrite <- minus_n_n; rewrite Rmult_1_l. +replace (y ^ 0) with 1; [ rewrite Rmult_1_r | simpl in |- *; reflexivity ]. +induction n as [| n Hrecn0]. +simpl in |- *; do 2 rewrite H; ring. +(* N >= 1 *) +set (N := S n). +rewrite Rmult_plus_distr_l. +replace (sum_f_R0 (fun i:nat => C N i * x ^ i * y ^ (N - i)) N * x) with + (sum_f_R0 (fun i:nat => C N i * x ^ S i * y ^ (N - i)) N). +replace (sum_f_R0 (fun i:nat => C N i * x ^ i * y ^ (N - i)) N * y) with + (sum_f_R0 (fun i:nat => C N i * x ^ i * y ^ (S N - i)) N). +rewrite (decomp_sum (fun i:nat => C (S N) i * x ^ i * y ^ (S N - i)) N). +rewrite H; replace (x ^ 0) with 1; [ idtac | reflexivity ]. +do 2 rewrite Rmult_1_l. +replace (S N - 0)%nat with (S N); [ idtac | reflexivity ]. +set (An := fun i:nat => C N i * x ^ S i * y ^ (N - i)). +set (Bn := fun i:nat => C N (S i) * x ^ S i * y ^ (N - i)). +replace (pred N) with n. +replace (sum_f_R0 (fun i:nat => C (S N) (S i) * x ^ S i * y ^ (S N - S i)) n) + with (sum_f_R0 (fun i:nat => An i + Bn i) n). +rewrite plus_sum. +replace (x ^ S N) with (An (S n)). +rewrite (Rplus_comm (sum_f_R0 An n)). +repeat rewrite Rplus_assoc. +rewrite <- tech5. +fold N in |- *. +set (Cn := fun i:nat => C N i * x ^ i * y ^ (S N - i)). +cut (forall i:nat, (i < N)%nat -> Cn (S i) = Bn i). +intro; replace (sum_f_R0 Bn n) with (sum_f_R0 (fun i:nat => Cn (S i)) n). +replace (y ^ S N) with (Cn 0%nat). +rewrite <- Rplus_assoc; rewrite (decomp_sum Cn N). +replace (pred N) with n. +ring. +unfold N in |- *; simpl in |- *; reflexivity. +unfold N in |- *; apply lt_O_Sn. +unfold Cn in |- *; rewrite H; simpl in |- *; ring. +apply sum_eq. +intros; apply H1. +unfold N in |- *; apply le_lt_trans with n; [ assumption | apply lt_n_Sn ]. +intros; unfold Bn, Cn in |- *. +replace (S N - S i)%nat with (N - i)%nat; reflexivity. +unfold An in |- *; fold N in |- *; rewrite <- minus_n_n; rewrite H0; + simpl in |- *; ring. +apply sum_eq. +intros; unfold An, Bn in |- *; replace (S N - S i)%nat with (N - i)%nat; + [ idtac | reflexivity ]. +rewrite <- pascal; + [ ring + | apply le_lt_trans with n; [ assumption | unfold N in |- *; apply lt_n_Sn ] ]. +unfold N in |- *; reflexivity. +unfold N in |- *; apply lt_O_Sn. +rewrite <- (Rmult_comm y); rewrite scal_sum; apply sum_eq. +intros; replace (S N - i)%nat with (S (N - i)). +replace (S (N - i)) with (N - i + 1)%nat; [ idtac | ring ]. +rewrite pow_add; replace (y ^ 1) with y; [ idtac | simpl in |- *; ring ]; + ring. +apply minus_Sn_m; assumption. +rewrite <- (Rmult_comm x); rewrite scal_sum; apply sum_eq. +intros; replace (S i) with (i + 1)%nat; [ idtac | ring ]; rewrite pow_add; + replace (x ^ 1) with x; [ idtac | simpl in |- *; ring ]; + ring. +intro; unfold C in |- *. +replace (INR (fact 0)) with 1; [ idtac | reflexivity ]. +replace (p - 0)%nat with p; [ idtac | apply minus_n_O ]. +rewrite Rmult_1_l; unfold Rdiv in |- *; rewrite <- Rinv_r_sym; + [ reflexivity | apply INR_fact_neq_0 ]. +intro; unfold C in |- *. +replace (p - p)%nat with 0%nat; [ idtac | apply minus_n_n ]. +replace (INR (fact 0)) with 1; [ idtac | reflexivity ]. +rewrite Rmult_1_r; unfold Rdiv in |- *; rewrite <- Rinv_r_sym; + [ reflexivity | apply INR_fact_neq_0 ]. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Cauchy_prod.v b/theories/Reals/Cauchy_prod.v new file mode 100644 index 00000000..41a6284f --- /dev/null +++ b/theories/Reals/Cauchy_prod.v @@ -0,0 +1,458 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Cauchy_prod.v,v 1.10.2.1 2004/07/16 19:31:10 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rfunctions. +Require Import Rseries. +Require Import PartSum. +Open Local Scope R_scope. + +(**********) +Lemma sum_N_predN : + forall (An:nat -> R) (N:nat), + (0 < N)%nat -> sum_f_R0 An N = sum_f_R0 An (pred N) + An N. +intros. +replace N with (S (pred N)). +rewrite tech5. +reflexivity. +symmetry in |- *; apply S_pred with 0%nat; assumption. +Qed. + +(**********) +Lemma sum_plus : + forall (An Bn:nat -> R) (N:nat), + sum_f_R0 (fun l:nat => An l + Bn l) N = sum_f_R0 An N + sum_f_R0 Bn N. +intros. +induction N as [| N HrecN]. +reflexivity. +do 3 rewrite tech5. +rewrite HrecN; ring. +Qed. + +(* The main result *) +Theorem cauchy_finite : + forall (An Bn:nat -> R) (N:nat), + (0 < N)%nat -> + sum_f_R0 An N * sum_f_R0 Bn N = + sum_f_R0 (fun k:nat => sum_f_R0 (fun p:nat => An p * Bn (k - p)%nat) k) N + + sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (N - l)%nat) + (pred (N - k))) (pred N). +intros; induction N as [| N HrecN]. +elim (lt_irrefl _ H). +cut (N = 0%nat \/ (0 < N)%nat). +intro; elim H0; intro. +rewrite H1; simpl in |- *; ring. +replace (pred (S N)) with (S (pred N)). +do 5 rewrite tech5. +rewrite Rmult_plus_distr_r; rewrite Rmult_plus_distr_l; rewrite (HrecN H1). +repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l. +replace (pred (S N - S (pred N))) with 0%nat. +rewrite Rmult_plus_distr_l; + replace + (sum_f_R0 (fun l:nat => An (S (l + S (pred N))) * Bn (S N - l)%nat) 0) with + (An (S N) * Bn (S N)). +repeat rewrite <- Rplus_assoc; + do 2 rewrite <- (Rplus_comm (An (S N) * Bn (S N))); + repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l. +rewrite <- minus_n_n; cut (N = 1%nat \/ (2 <= N)%nat). +intro; elim H2; intro. +rewrite H3; simpl in |- *; ring. +replace + (sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (N - l)%nat) (pred (N - k))) + (pred N)) with + (sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) + (pred (pred (N - k)))) (pred (pred N)) + + sum_f_R0 (fun l:nat => An (S l) * Bn (N - l)%nat) (pred N)). +replace (sum_f_R0 (fun p:nat => An p * Bn (S N - p)%nat) N) with + (sum_f_R0 (fun l:nat => An (S l) * Bn (N - l)%nat) (pred N) + + An 0%nat * Bn (S N)). +repeat rewrite <- Rplus_assoc; + rewrite <- + (Rplus_comm (sum_f_R0 (fun l:nat => An (S l) * Bn (N - l)%nat) (pred N))) + ; repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l. +replace + (sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (S N - l)%nat) + (pred (S N - k))) (pred N)) with + (sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) + (pred (N - k))) (pred N) + + Bn (S N) * sum_f_R0 (fun l:nat => An (S l)) (pred N)). +rewrite (decomp_sum An N H1); rewrite Rmult_plus_distr_r; + repeat rewrite <- Rplus_assoc; rewrite <- (Rplus_comm (An 0%nat * Bn (S N))); + repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l. +repeat rewrite <- Rplus_assoc; + rewrite <- + (Rplus_comm (sum_f_R0 (fun i:nat => An (S i)) (pred N) * Bn (S N))) + ; + rewrite <- + (Rplus_comm (Bn (S N) * sum_f_R0 (fun i:nat => An (S i)) (pred N))) + ; rewrite (Rmult_comm (Bn (S N))); repeat rewrite Rplus_assoc; + apply Rplus_eq_compat_l. +replace + (sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) + (pred (N - k))) (pred N)) with + (sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) + (pred (pred (N - k)))) (pred (pred N)) + + An (S N) * sum_f_R0 (fun l:nat => Bn (S l)) (pred N)). +rewrite (decomp_sum Bn N H1); rewrite Rmult_plus_distr_l. +set + (Z := + sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) + (pred (pred (N - k)))) (pred (pred N))); + set (Z2 := sum_f_R0 (fun i:nat => Bn (S i)) (pred N)); + ring. +rewrite + (sum_N_predN + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) + (pred (N - k))) (pred N)). +replace + (sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) + (pred (N - k))) (pred (pred N))) with + (sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) + (pred (pred (N - k))) + An (S N) * Bn (S k)) ( + pred (pred N))). +rewrite + (sum_plus + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) + (pred (pred (N - k)))) (fun k:nat => An (S N) * Bn (S k)) + (pred (pred N))). +repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l. +replace (pred (N - pred N)) with 0%nat. +simpl in |- *; rewrite <- minus_n_O. +replace (S (pred N)) with N. +replace (sum_f_R0 (fun k:nat => An (S N) * Bn (S k)) (pred (pred N))) with + (sum_f_R0 (fun k:nat => Bn (S k) * An (S N)) (pred (pred N))). +rewrite <- (scal_sum (fun l:nat => Bn (S l)) (pred (pred N)) (An (S N))); + rewrite (sum_N_predN (fun l:nat => Bn (S l)) (pred N)). +replace (S (pred N)) with N. +ring. +apply S_pred with 0%nat; assumption. +apply lt_pred; apply lt_le_trans with 2%nat; [ apply lt_n_Sn | assumption ]. +apply sum_eq; intros; apply Rmult_comm. +apply S_pred with 0%nat; assumption. +replace (N - pred N)%nat with 1%nat. +reflexivity. +pattern N at 1 in |- *; replace N with (S (pred N)). +rewrite <- minus_Sn_m. +rewrite <- minus_n_n; reflexivity. +apply le_n. +symmetry in |- *; apply S_pred with 0%nat; assumption. +apply sum_eq; intros; + rewrite + (sum_N_predN (fun l:nat => An (S (S (l + i))) * Bn (N - l)%nat) + (pred (N - i))). +replace (S (S (pred (N - i) + i))) with (S N). +replace (N - pred (N - i))%nat with (S i). +ring. +rewrite pred_of_minus; apply INR_eq; repeat rewrite minus_INR. +rewrite S_INR; ring. +apply le_trans with (pred (pred N)). +assumption. +apply le_trans with (pred N); apply le_pred_n. +apply INR_le; rewrite minus_INR. +apply Rplus_le_reg_l with (INR i - 1). +replace (INR i - 1 + INR 1) with (INR i); [ idtac | ring ]. +replace (INR i - 1 + (INR N - INR i)) with (INR N - INR 1); [ idtac | ring ]. +rewrite <- minus_INR. +apply le_INR; apply le_trans with (pred (pred N)). +assumption. +rewrite <- pred_of_minus; apply le_pred_n. +apply le_trans with 2%nat. +apply le_n_Sn. +assumption. +apply le_trans with (pred (pred N)). +assumption. +apply le_trans with (pred N); apply le_pred_n. +rewrite <- pred_of_minus. +apply le_trans with (pred N). +apply le_S_n. +replace (S (pred N)) with N. +replace (S (pred (N - i))) with (N - i)%nat. +apply (fun p n m:nat => plus_le_reg_l n m p) with i; rewrite le_plus_minus_r. +apply le_plus_r. +apply le_trans with (pred (pred N)); + [ assumption | apply le_trans with (pred N); apply le_pred_n ]. +apply S_pred with 0%nat. +apply plus_lt_reg_l with i; rewrite le_plus_minus_r. +replace (i + 0)%nat with i; [ idtac | ring ]. +apply le_lt_trans with (pred (pred N)); + [ assumption | apply lt_trans with (pred N); apply lt_pred_n_n ]. +apply lt_S_n. +replace (S (pred N)) with N. +apply lt_le_trans with 2%nat. +apply lt_n_Sn. +assumption. +apply S_pred with 0%nat; assumption. +assumption. +apply le_trans with (pred (pred N)). +assumption. +apply le_trans with (pred N); apply le_pred_n. +apply S_pred with 0%nat; assumption. +apply le_pred_n. +apply INR_eq; rewrite pred_of_minus; do 3 rewrite S_INR; rewrite plus_INR; + repeat rewrite minus_INR. +ring. +apply le_trans with (pred (pred N)). +assumption. +apply le_trans with (pred N); apply le_pred_n. +apply INR_le. +rewrite minus_INR. +apply Rplus_le_reg_l with (INR i - 1). +replace (INR i - 1 + INR 1) with (INR i); [ idtac | ring ]. +replace (INR i - 1 + (INR N - INR i)) with (INR N - INR 1); [ idtac | ring ]. +rewrite <- minus_INR. +apply le_INR. +apply le_trans with (pred (pred N)). +assumption. +rewrite <- pred_of_minus. +apply le_pred_n. +apply le_trans with 2%nat. +apply le_n_Sn. +assumption. +apply le_trans with (pred (pred N)). +assumption. +apply le_trans with (pred N); apply le_pred_n. +apply lt_le_trans with 1%nat. +apply lt_O_Sn. +apply INR_le. +rewrite pred_of_minus. +repeat rewrite minus_INR. +apply Rplus_le_reg_l with (INR i - 1). +replace (INR i - 1 + INR 1) with (INR i); [ idtac | ring ]. +replace (INR i - 1 + (INR N - INR i - INR 1)) with (INR N - INR 1 - INR 1). +repeat rewrite <- minus_INR. +apply le_INR. +apply le_trans with (pred (pred N)). +assumption. +do 2 rewrite <- pred_of_minus. +apply le_n. +apply (fun p n m:nat => plus_le_reg_l n m p) with 1%nat. +rewrite le_plus_minus_r. +simpl in |- *; assumption. +apply le_trans with 2%nat; [ apply le_n_Sn | assumption ]. +apply le_trans with 2%nat; [ apply le_n_Sn | assumption ]. +ring. +apply le_trans with (pred (pred N)). +assumption. +apply le_trans with (pred N); apply le_pred_n. +apply (fun p n m:nat => plus_le_reg_l n m p) with i. +rewrite le_plus_minus_r. +replace (i + 1)%nat with (S i). +replace N with (S (pred N)). +apply le_n_S. +apply le_trans with (pred (pred N)). +assumption. +apply le_pred_n. +symmetry in |- *; apply S_pred with 0%nat; assumption. +apply INR_eq; rewrite S_INR; rewrite plus_INR; reflexivity. +apply le_trans with (pred (pred N)). +assumption. +apply le_trans with (pred N); apply le_pred_n. +apply lt_le_trans with 1%nat. +apply lt_O_Sn. +apply le_S_n. +replace (S (pred N)) with N. +assumption. +apply S_pred with 0%nat; assumption. +replace + (sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (S N - l)%nat) + (pred (S N - k))) (pred N)) with + (sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) + (pred (N - k)) + An (S k) * Bn (S N)) (pred N)). +rewrite + (sum_plus + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) + (pred (N - k))) (fun k:nat => An (S k) * Bn (S N))) + . +apply Rplus_eq_compat_l. +rewrite scal_sum; reflexivity. +apply sum_eq; intros; rewrite Rplus_comm; + rewrite + (decomp_sum (fun l:nat => An (S (l + i)) * Bn (S N - l)%nat) + (pred (S N - i))). +replace (0 + i)%nat with i; [ idtac | ring ]. +rewrite <- minus_n_O; apply Rplus_eq_compat_l. +replace (pred (pred (S N - i))) with (pred (N - i)). +apply sum_eq; intros. +replace (S N - S i0)%nat with (N - i0)%nat; [ idtac | reflexivity ]. +replace (S i0 + i)%nat with (S (i0 + i)). +reflexivity. +apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; rewrite S_INR; ring. +cut ((N - i)%nat = pred (S N - i)). +intro; rewrite H5; reflexivity. +rewrite pred_of_minus. +apply INR_eq; repeat rewrite minus_INR. +rewrite S_INR; ring. +apply le_trans with N. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply le_n_Sn. +apply (fun p n m:nat => plus_le_reg_l n m p) with i. +rewrite le_plus_minus_r. +replace (i + 1)%nat with (S i). +apply le_n_S. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply INR_eq; rewrite S_INR; rewrite plus_INR; ring. +apply le_trans with N. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply le_n_Sn. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +replace (pred (S N - i)) with (S N - S i)%nat. +replace (S N - S i)%nat with (N - i)%nat; [ idtac | reflexivity ]. +apply plus_lt_reg_l with i. +rewrite le_plus_minus_r. +replace (i + 0)%nat with i; [ idtac | ring ]. +apply le_lt_trans with (pred N). +assumption. +apply lt_pred_n_n. +assumption. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +rewrite pred_of_minus. +apply INR_eq; repeat rewrite minus_INR. +repeat rewrite S_INR; ring. +apply le_trans with N. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply le_n_Sn. +apply (fun p n m:nat => plus_le_reg_l n m p) with i. +rewrite le_plus_minus_r. +replace (i + 1)%nat with (S i). +apply le_n_S. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply INR_eq; rewrite S_INR; rewrite plus_INR; ring. +apply le_trans with N. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply le_n_Sn. +apply le_n_S. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +rewrite Rplus_comm. +rewrite (decomp_sum (fun p:nat => An p * Bn (S N - p)%nat) N). +rewrite <- minus_n_O. +apply Rplus_eq_compat_l. +apply sum_eq; intros. +reflexivity. +assumption. +rewrite Rplus_comm. +rewrite + (decomp_sum + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (N - l)%nat) (pred (N - k))) + (pred N)). +rewrite <- minus_n_O. +replace (sum_f_R0 (fun l:nat => An (S (l + 0)) * Bn (N - l)%nat) (pred N)) + with (sum_f_R0 (fun l:nat => An (S l) * Bn (N - l)%nat) (pred N)). +apply Rplus_eq_compat_l. +apply sum_eq; intros. +replace (pred (N - S i)) with (pred (pred (N - i))). +apply sum_eq; intros. +replace (i0 + S i)%nat with (S (i0 + i)). +reflexivity. +apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; rewrite S_INR; ring. +cut (pred (N - i) = (N - S i)%nat). +intro; rewrite H5; reflexivity. +rewrite pred_of_minus. +apply INR_eq. +repeat rewrite minus_INR. +repeat rewrite S_INR; ring. +apply le_trans with (S (pred (pred N))). +apply le_n_S; assumption. +replace (S (pred (pred N))) with (pred N). +apply le_pred_n. +apply S_pred with 0%nat. +apply lt_S_n. +replace (S (pred N)) with N. +apply lt_le_trans with 2%nat. +apply lt_n_Sn. +assumption. +apply S_pred with 0%nat; assumption. +apply le_trans with (pred (pred N)). +assumption. +apply le_trans with (pred N); apply le_pred_n. +apply (fun p n m:nat => plus_le_reg_l n m p) with i. +rewrite le_plus_minus_r. +replace (i + 1)%nat with (S i). +replace N with (S (pred N)). +apply le_n_S. +apply le_trans with (pred (pred N)). +assumption. +apply le_pred_n. +symmetry in |- *; apply S_pred with 0%nat; assumption. +apply INR_eq; rewrite S_INR; rewrite plus_INR; ring. +apply le_trans with (pred (pred N)). +assumption. +apply le_trans with (pred N); apply le_pred_n. +apply sum_eq; intros. +replace (i + 0)%nat with i; [ reflexivity | trivial ]. +apply lt_S_n. +replace (S (pred N)) with N. +apply lt_le_trans with 2%nat; [ apply lt_n_Sn | assumption ]. +apply S_pred with 0%nat; assumption. +inversion H1. +left; reflexivity. +right; apply le_n_S; assumption. +simpl in |- *. +replace (S (pred N)) with N. +reflexivity. +apply S_pred with 0%nat; assumption. +simpl in |- *. +cut ((N - pred N)%nat = 1%nat). +intro; rewrite H2; reflexivity. +rewrite pred_of_minus. +apply INR_eq; repeat rewrite minus_INR. +ring. +apply lt_le_S; assumption. +rewrite <- pred_of_minus; apply le_pred_n. +simpl in |- *; symmetry in |- *; apply S_pred with 0%nat; assumption. +inversion H. +left; reflexivity. +right; apply lt_le_trans with 1%nat; [ apply lt_n_Sn | exact H1 ]. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Cos_plus.v b/theories/Reals/Cos_plus.v new file mode 100644 index 00000000..422eb4a4 --- /dev/null +++ b/theories/Reals/Cos_plus.v @@ -0,0 +1,1061 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Cos_plus.v,v 1.11.2.1 2004/07/16 19:31:10 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rfunctions. +Require Import SeqSeries. +Require Import Rtrigo_def. +Require Import Cos_rel. +Require Import Max. Open Local Scope nat_scope. Open Local Scope R_scope. + +Definition Majxy (x y:R) (n:nat) : R := + Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S n) / INR (fact n). + +Lemma Majxy_cv_R0 : forall x y:R, Un_cv (Majxy x y) 0. +intros. +set (C := Rmax 1 (Rmax (Rabs x) (Rabs y))). +set (C0 := C ^ 4). +cut (0 < C). +intro. +cut (0 < C0). +intro. +assert (H1 := cv_speed_pow_fact C0). +unfold Un_cv in H1; unfold R_dist in H1. +unfold Un_cv in |- *; unfold R_dist in |- *; intros. +cut (0 < eps / C0); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; assumption ] ]. +elim (H1 (eps / C0) H3); intros N0 H4. +exists N0; intros. +replace (Majxy x y n) with (C0 ^ S n / INR (fact n)). +simpl in |- *. +apply Rmult_lt_reg_l with (Rabs (/ C0)). +apply Rabs_pos_lt. +apply Rinv_neq_0_compat. +red in |- *; intro; rewrite H6 in H0; elim (Rlt_irrefl _ H0). +rewrite <- Rabs_mult. +unfold Rminus in |- *; rewrite Rmult_plus_distr_l. +rewrite Ropp_0; rewrite Rmult_0_r. +unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_l. +rewrite (Rabs_right (/ C0)). +rewrite <- (Rmult_comm eps). +replace (C0 ^ n * / INR (fact n) + 0) with (C0 ^ n * / INR (fact n) - 0); + [ idtac | ring ]. +unfold Rdiv in H4; apply H4; assumption. +apply Rle_ge; left; apply Rinv_0_lt_compat; assumption. +red in |- *; intro; rewrite H6 in H0; elim (Rlt_irrefl _ H0). +unfold Majxy in |- *. +unfold C0 in |- *. +rewrite pow_mult. +unfold C in |- *; reflexivity. +unfold C0 in |- *; apply pow_lt; assumption. +apply Rlt_le_trans with 1. +apply Rlt_0_1. +unfold C in |- *. +apply RmaxLess1. +Qed. + +Lemma reste1_maj : + forall (x y:R) (N:nat), + (0 < N)%nat -> Rabs (Reste1 x y N) <= Majxy x y (pred N). +intros. +set (C := Rmax 1 (Rmax (Rabs x) (Rabs y))). +unfold Reste1 in |- *. +apply Rle_trans with + (sum_f_R0 + (fun k:nat => + Rabs + (sum_f_R0 + (fun l:nat => + (-1) ^ S (l + k) / INR (fact (2 * S (l + k))) * + x ^ (2 * S (l + k)) * + ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) * + y ^ (2 * (N - l))) (pred (N - k)))) ( + pred N)). +apply + (Rsum_abs + (fun k:nat => + sum_f_R0 + (fun l:nat => + (-1) ^ S (l + k) / INR (fact (2 * S (l + k))) * + x ^ (2 * S (l + k)) * ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) * + y ^ (2 * (N - l))) (pred (N - k))) (pred N)). +apply Rle_trans with + (sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + Rabs + ((-1) ^ S (l + k) / INR (fact (2 * S (l + k))) * + x ^ (2 * S (l + k)) * + ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) * + y ^ (2 * (N - l)))) (pred (N - k))) ( + pred N)). +apply sum_Rle. +intros. +apply + (Rsum_abs + (fun l:nat => + (-1) ^ S (l + n) / INR (fact (2 * S (l + n))) * x ^ (2 * S (l + n)) * + ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) * + y ^ (2 * (N - l))) (pred (N - n))). +apply Rle_trans with + (sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + / INR (fact (2 * S (l + k)) * fact (2 * (N - l))) * + C ^ (2 * S (N + k))) (pred (N - k))) (pred N)). +apply sum_Rle; intros. +apply sum_Rle; intros. +unfold Rdiv in |- *; repeat rewrite Rabs_mult. +do 2 rewrite pow_1_abs. +do 2 rewrite Rmult_1_l. +rewrite (Rabs_right (/ INR (fact (2 * S (n0 + n))))). +rewrite (Rabs_right (/ INR (fact (2 * (N - n0))))). +rewrite mult_INR. +rewrite Rinv_mult_distr. +repeat rewrite Rmult_assoc. +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +rewrite <- Rmult_assoc. +rewrite <- (Rmult_comm (/ INR (fact (2 * (N - n0))))). +rewrite Rmult_assoc. +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +do 2 rewrite <- RPow_abs. +apply Rle_trans with (Rabs x ^ (2 * S (n0 + n)) * C ^ (2 * (N - n0))). +apply Rmult_le_compat_l. +apply pow_le; apply Rabs_pos. +apply pow_incr. +split. +apply Rabs_pos. +unfold C in |- *. +apply Rle_trans with (Rmax (Rabs x) (Rabs y)); apply RmaxLess2. +apply Rle_trans with (C ^ (2 * S (n0 + n)) * C ^ (2 * (N - n0))). +do 2 rewrite <- (Rmult_comm (C ^ (2 * (N - n0)))). +apply Rmult_le_compat_l. +apply pow_le. +apply Rle_trans with 1. +left; apply Rlt_0_1. +unfold C in |- *; apply RmaxLess1. +apply pow_incr. +split. +apply Rabs_pos. +unfold C in |- *; apply Rle_trans with (Rmax (Rabs x) (Rabs y)). +apply RmaxLess1. +apply RmaxLess2. +right. +replace (2 * S (N + n))%nat with (2 * (N - n0) + 2 * S (n0 + n))%nat. +rewrite pow_add. +apply Rmult_comm. +apply INR_eq; rewrite plus_INR; do 3 rewrite mult_INR. +rewrite minus_INR. +repeat rewrite S_INR; do 2 rewrite plus_INR; ring. +apply le_trans with (pred (N - n)). +exact H1. +apply le_S_n. +replace (S (pred (N - n))) with (N - n)%nat. +apply le_trans with N. +apply (fun p n m:nat => plus_le_reg_l n m p) with n. +rewrite <- le_plus_minus. +apply le_plus_r. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply le_n_Sn. +apply S_pred with 0%nat. +apply plus_lt_reg_l with n. +rewrite <- le_plus_minus. +replace (n + 0)%nat with n; [ idtac | ring ]. +apply le_lt_trans with (pred N). +assumption. +apply lt_pred_n_n; assumption. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply Rle_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +apply Rle_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +apply Rle_trans with + (sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + / INR (fact (2 * S (l + k)) * fact (2 * (N - l))) * C ^ (4 * N)) + (pred (N - k))) (pred N)). +apply sum_Rle; intros. +apply sum_Rle; intros. +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat. +rewrite mult_INR; apply Rmult_lt_0_compat; apply INR_fact_lt_0. +apply Rle_pow. +unfold C in |- *; apply RmaxLess1. +replace (4 * N)%nat with (2 * (2 * N))%nat; [ idtac | ring ]. +apply (fun m n p:nat => mult_le_compat_l p n m). +replace (2 * N)%nat with (S (N + pred N)). +apply le_n_S. +apply plus_le_compat_l; assumption. +rewrite pred_of_minus. +apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR; + rewrite minus_INR. +repeat rewrite S_INR; ring. +apply lt_le_S; assumption. +apply Rle_trans with + (sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => C ^ (4 * N) * Rsqr (/ INR (fact (S (N + k))))) + (pred (N - k))) (pred N)). +apply sum_Rle; intros. +apply sum_Rle; intros. +rewrite <- (Rmult_comm (C ^ (4 * N))). +apply Rmult_le_compat_l. +apply pow_le. +left; apply Rlt_le_trans with 1. +apply Rlt_0_1. +unfold C in |- *; apply RmaxLess1. +replace (/ INR (fact (2 * S (n0 + n)) * fact (2 * (N - n0)))) with + (Binomial.C (2 * S (N + n)) (2 * S (n0 + n)) / INR (fact (2 * S (N + n)))). +apply Rle_trans with + (Binomial.C (2 * S (N + n)) (S (N + n)) / INR (fact (2 * S (N + n)))). +unfold Rdiv in |- *; + do 2 rewrite <- (Rmult_comm (/ INR (fact (2 * S (N + n))))). +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +apply C_maj. +apply (fun m n p:nat => mult_le_compat_l p n m). +apply le_n_S. +apply plus_le_compat_r. +apply le_trans with (pred (N - n)). +assumption. +apply le_S_n. +replace (S (pred (N - n))) with (N - n)%nat. +apply le_trans with N. +apply (fun p n m:nat => plus_le_reg_l n m p) with n. +rewrite <- le_plus_minus. +apply le_plus_r. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply le_n_Sn. +apply S_pred with 0%nat. +apply plus_lt_reg_l with n. +rewrite <- le_plus_minus. +replace (n + 0)%nat with n; [ idtac | ring ]. +apply le_lt_trans with (pred N). +assumption. +apply lt_pred_n_n; assumption. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +right. +unfold Rdiv in |- *; rewrite Rmult_comm. +unfold Binomial.C in |- *. +unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_l. +replace (2 * S (N + n) - S (N + n))%nat with (S (N + n)). +rewrite Rinv_mult_distr. +unfold Rsqr in |- *; reflexivity. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply INR_eq; rewrite S_INR; rewrite minus_INR. +rewrite mult_INR; repeat rewrite S_INR; rewrite plus_INR; ring. +apply le_n_2n. +apply INR_fact_neq_0. +unfold Rdiv in |- *; rewrite Rmult_comm. +unfold Binomial.C in |- *. +unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_l. +replace (2 * S (N + n) - 2 * S (n0 + n))%nat with (2 * (N - n0))%nat. +rewrite mult_INR. +reflexivity. +apply INR_eq; rewrite minus_INR. +do 3 rewrite mult_INR; repeat rewrite S_INR; do 2 rewrite plus_INR; + rewrite minus_INR. +ring. +apply le_trans with (pred (N - n)). +assumption. +apply le_S_n. +replace (S (pred (N - n))) with (N - n)%nat. +apply le_trans with N. +apply (fun p n m:nat => plus_le_reg_l n m p) with n. +rewrite <- le_plus_minus. +apply le_plus_r. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply le_n_Sn. +apply S_pred with 0%nat. +apply plus_lt_reg_l with n. +rewrite <- le_plus_minus. +replace (n + 0)%nat with n; [ idtac | ring ]. +apply le_lt_trans with (pred N). +assumption. +apply lt_pred_n_n; assumption. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply (fun m n p:nat => mult_le_compat_l p n m). +apply le_n_S. +apply plus_le_compat_r. +apply le_trans with (pred (N - n)). +assumption. +apply le_S_n. +replace (S (pred (N - n))) with (N - n)%nat. +apply le_trans with N. +apply (fun p n m:nat => plus_le_reg_l n m p) with n. +rewrite <- le_plus_minus. +apply le_plus_r. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply le_n_Sn. +apply S_pred with 0%nat. +apply plus_lt_reg_l with n. +rewrite <- le_plus_minus. +replace (n + 0)%nat with n; [ idtac | ring ]. +apply le_lt_trans with (pred N). +assumption. +apply lt_pred_n_n; assumption. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply INR_fact_neq_0. +apply Rle_trans with + (sum_f_R0 (fun k:nat => INR N / INR (fact (S N)) * C ^ (4 * N)) (pred N)). +apply sum_Rle; intros. +rewrite <- + (scal_sum (fun _:nat => C ^ (4 * N)) (pred (N - n)) + (Rsqr (/ INR (fact (S (N + n)))))). +rewrite sum_cte. +rewrite <- Rmult_assoc. +do 2 rewrite <- (Rmult_comm (C ^ (4 * N))). +rewrite Rmult_assoc. +apply Rmult_le_compat_l. +apply pow_le. +left; apply Rlt_le_trans with 1. +apply Rlt_0_1. +unfold C in |- *; apply RmaxLess1. +apply Rle_trans with (Rsqr (/ INR (fact (S (N + n)))) * INR N). +apply Rmult_le_compat_l. +apply Rle_0_sqr. +replace (S (pred (N - n))) with (N - n)%nat. +apply le_INR. +apply (fun p n m:nat => plus_le_reg_l n m p) with n. +rewrite <- le_plus_minus. +apply le_plus_r. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply S_pred with 0%nat. +apply plus_lt_reg_l with n. +rewrite <- le_plus_minus. +replace (n + 0)%nat with n; [ idtac | ring ]. +apply le_lt_trans with (pred N). +assumption. +apply lt_pred_n_n; assumption. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +rewrite Rmult_comm; unfold Rdiv in |- *; apply Rmult_le_compat_l. +apply pos_INR. +apply Rle_trans with (/ INR (fact (S (N + n)))). +pattern (/ INR (fact (S (N + n)))) at 2 in |- *; rewrite <- Rmult_1_r. +unfold Rsqr in |- *. +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +apply Rmult_le_reg_l with (INR (fact (S (N + n)))). +apply INR_fact_lt_0. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_r. +replace 1 with (INR 1). +apply le_INR. +apply lt_le_S. +apply INR_lt; apply INR_fact_lt_0. +reflexivity. +apply INR_fact_neq_0. +apply Rmult_le_reg_l with (INR (fact (S (N + n)))). +apply INR_fact_lt_0. +rewrite <- Rinv_r_sym. +apply Rmult_le_reg_l with (INR (fact (S N))). +apply INR_fact_lt_0. +rewrite Rmult_1_r. +rewrite (Rmult_comm (INR (fact (S N)))). +rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +apply le_INR. +apply fact_le. +apply le_n_S. +apply le_plus_l. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +rewrite sum_cte. +apply Rle_trans with (C ^ (4 * N) / INR (fact (pred N))). +rewrite <- (Rmult_comm (C ^ (4 * N))). +unfold Rdiv in |- *; rewrite Rmult_assoc; apply Rmult_le_compat_l. +apply pow_le. +left; apply Rlt_le_trans with 1. +apply Rlt_0_1. +unfold C in |- *; apply RmaxLess1. +cut (S (pred N) = N). +intro; rewrite H0. +pattern N at 2 in |- *; rewrite <- H0. +do 2 rewrite fact_simpl. +rewrite H0. +repeat rewrite mult_INR. +repeat rewrite Rinv_mult_distr. +rewrite (Rmult_comm (/ INR (S N))). +repeat rewrite <- Rmult_assoc. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_l. +pattern (/ INR (fact (pred N))) at 2 in |- *; rewrite <- Rmult_1_r. +rewrite Rmult_assoc. +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +apply Rmult_le_reg_l with (INR (S N)). +apply lt_INR_0; apply lt_O_Sn. +rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; rewrite Rmult_1_l. +apply le_INR; apply le_n_Sn. +apply not_O_INR; discriminate. +apply not_O_INR. +red in |- *; intro; rewrite H1 in H; elim (lt_irrefl _ H). +apply not_O_INR. +red in |- *; intro; rewrite H1 in H; elim (lt_irrefl _ H). +apply INR_fact_neq_0. +apply not_O_INR; discriminate. +apply prod_neq_R0. +apply not_O_INR. +red in |- *; intro; rewrite H1 in H; elim (lt_irrefl _ H). +apply INR_fact_neq_0. +symmetry in |- *; apply S_pred with 0%nat; assumption. +right. +unfold Majxy in |- *. +unfold C in |- *. +replace (S (pred N)) with N. +reflexivity. +apply S_pred with 0%nat; assumption. +Qed. + +Lemma reste2_maj : + forall (x y:R) (N:nat), (0 < N)%nat -> Rabs (Reste2 x y N) <= Majxy x y N. +intros. +set (C := Rmax 1 (Rmax (Rabs x) (Rabs y))). +unfold Reste2 in |- *. +apply Rle_trans with + (sum_f_R0 + (fun k:nat => + Rabs + (sum_f_R0 + (fun l:nat => + (-1) ^ S (l + k) / INR (fact (2 * S (l + k) + 1)) * + x ^ (2 * S (l + k) + 1) * + ((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) * + y ^ (2 * (N - l) + 1)) (pred (N - k)))) ( + pred N)). +apply + (Rsum_abs + (fun k:nat => + sum_f_R0 + (fun l:nat => + (-1) ^ S (l + k) / INR (fact (2 * S (l + k) + 1)) * + x ^ (2 * S (l + k) + 1) * + ((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) * + y ^ (2 * (N - l) + 1)) (pred (N - k))) ( + pred N)). +apply Rle_trans with + (sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + Rabs + ((-1) ^ S (l + k) / INR (fact (2 * S (l + k) + 1)) * + x ^ (2 * S (l + k) + 1) * + ((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) * + y ^ (2 * (N - l) + 1))) (pred (N - k))) ( + pred N)). +apply sum_Rle. +intros. +apply + (Rsum_abs + (fun l:nat => + (-1) ^ S (l + n) / INR (fact (2 * S (l + n) + 1)) * + x ^ (2 * S (l + n) + 1) * + ((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) * + y ^ (2 * (N - l) + 1)) (pred (N - n))). +apply Rle_trans with + (sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + / INR (fact (2 * S (l + k) + 1) * fact (2 * (N - l) + 1)) * + C ^ (2 * S (S (N + k)))) (pred (N - k))) ( + pred N)). +apply sum_Rle; intros. +apply sum_Rle; intros. +unfold Rdiv in |- *; repeat rewrite Rabs_mult. +do 2 rewrite pow_1_abs. +do 2 rewrite Rmult_1_l. +rewrite (Rabs_right (/ INR (fact (2 * S (n0 + n) + 1)))). +rewrite (Rabs_right (/ INR (fact (2 * (N - n0) + 1)))). +rewrite mult_INR. +rewrite Rinv_mult_distr. +repeat rewrite Rmult_assoc. +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +rewrite <- Rmult_assoc. +rewrite <- (Rmult_comm (/ INR (fact (2 * (N - n0) + 1)))). +rewrite Rmult_assoc. +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +do 2 rewrite <- RPow_abs. +apply Rle_trans with (Rabs x ^ (2 * S (n0 + n) + 1) * C ^ (2 * (N - n0) + 1)). +apply Rmult_le_compat_l. +apply pow_le; apply Rabs_pos. +apply pow_incr. +split. +apply Rabs_pos. +unfold C in |- *. +apply Rle_trans with (Rmax (Rabs x) (Rabs y)); apply RmaxLess2. +apply Rle_trans with (C ^ (2 * S (n0 + n) + 1) * C ^ (2 * (N - n0) + 1)). +do 2 rewrite <- (Rmult_comm (C ^ (2 * (N - n0) + 1))). +apply Rmult_le_compat_l. +apply pow_le. +apply Rle_trans with 1. +left; apply Rlt_0_1. +unfold C in |- *; apply RmaxLess1. +apply pow_incr. +split. +apply Rabs_pos. +unfold C in |- *; apply Rle_trans with (Rmax (Rabs x) (Rabs y)). +apply RmaxLess1. +apply RmaxLess2. +right. +replace (2 * S (S (N + n)))%nat with + (2 * (N - n0) + 1 + (2 * S (n0 + n) + 1))%nat. +repeat rewrite pow_add. +ring. +apply INR_eq; repeat rewrite plus_INR; do 3 rewrite mult_INR. +rewrite minus_INR. +repeat rewrite S_INR; do 2 rewrite plus_INR; ring. +apply le_trans with (pred (N - n)). +exact H1. +apply le_S_n. +replace (S (pred (N - n))) with (N - n)%nat. +apply le_trans with N. +apply (fun p n m:nat => plus_le_reg_l n m p) with n. +rewrite <- le_plus_minus. +apply le_plus_r. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply le_n_Sn. +apply S_pred with 0%nat. +apply plus_lt_reg_l with n. +rewrite <- le_plus_minus. +replace (n + 0)%nat with n; [ idtac | ring ]. +apply le_lt_trans with (pred N). +assumption. +apply lt_pred_n_n; assumption. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply Rle_ge; left; apply Rinv_0_lt_compat. +apply INR_fact_lt_0. +apply Rle_ge; left; apply Rinv_0_lt_compat. +apply INR_fact_lt_0. +apply Rle_trans with + (sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + / INR (fact (2 * S (l + k) + 1) * fact (2 * (N - l) + 1)) * + C ^ (4 * S N)) (pred (N - k))) (pred N)). +apply sum_Rle; intros. +apply sum_Rle; intros. +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat. +rewrite mult_INR; apply Rmult_lt_0_compat; apply INR_fact_lt_0. +apply Rle_pow. +unfold C in |- *; apply RmaxLess1. +replace (4 * S N)%nat with (2 * (2 * S N))%nat; [ idtac | ring ]. +apply (fun m n p:nat => mult_le_compat_l p n m). +replace (2 * S N)%nat with (S (S (N + N))). +repeat apply le_n_S. +apply plus_le_compat_l. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply INR_eq; do 2 rewrite S_INR; rewrite plus_INR; rewrite mult_INR. +repeat rewrite S_INR; ring. +apply Rle_trans with + (sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => C ^ (4 * S N) * Rsqr (/ INR (fact (S (S (N + k)))))) + (pred (N - k))) (pred N)). +apply sum_Rle; intros. +apply sum_Rle; intros. +rewrite <- (Rmult_comm (C ^ (4 * S N))). +apply Rmult_le_compat_l. +apply pow_le. +left; apply Rlt_le_trans with 1. +apply Rlt_0_1. +unfold C in |- *; apply RmaxLess1. +replace (/ INR (fact (2 * S (n0 + n) + 1) * fact (2 * (N - n0) + 1))) with + (Binomial.C (2 * S (S (N + n))) (2 * S (n0 + n) + 1) / + INR (fact (2 * S (S (N + n))))). +apply Rle_trans with + (Binomial.C (2 * S (S (N + n))) (S (S (N + n))) / + INR (fact (2 * S (S (N + n))))). +unfold Rdiv in |- *; + do 2 rewrite <- (Rmult_comm (/ INR (fact (2 * S (S (N + n)))))). +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +apply C_maj. +apply le_trans with (2 * S (S (n0 + n)))%nat. +replace (2 * S (S (n0 + n)))%nat with (S (2 * S (n0 + n) + 1)). +apply le_n_Sn. +apply INR_eq; rewrite S_INR; rewrite plus_INR; do 2 rewrite mult_INR; + repeat rewrite S_INR; rewrite plus_INR; ring. +apply (fun m n p:nat => mult_le_compat_l p n m). +repeat apply le_n_S. +apply plus_le_compat_r. +apply le_trans with (pred (N - n)). +assumption. +apply le_S_n. +replace (S (pred (N - n))) with (N - n)%nat. +apply le_trans with N. +apply (fun p n m:nat => plus_le_reg_l n m p) with n. +rewrite <- le_plus_minus. +apply le_plus_r. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply le_n_Sn. +apply S_pred with 0%nat. +apply plus_lt_reg_l with n. +rewrite <- le_plus_minus. +replace (n + 0)%nat with n; [ idtac | ring ]. +apply le_lt_trans with (pred N). +assumption. +apply lt_pred_n_n; assumption. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +right. +unfold Rdiv in |- *; rewrite Rmult_comm. +unfold Binomial.C in |- *. +unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_l. +replace (2 * S (S (N + n)) - S (S (N + n)))%nat with (S (S (N + n))). +rewrite Rinv_mult_distr. +unfold Rsqr in |- *; reflexivity. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply INR_eq; do 2 rewrite S_INR; rewrite minus_INR. +rewrite mult_INR; repeat rewrite S_INR; rewrite plus_INR; ring. +apply le_n_2n. +apply INR_fact_neq_0. +unfold Rdiv in |- *; rewrite Rmult_comm. +unfold Binomial.C in |- *. +unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_l. +replace (2 * S (S (N + n)) - (2 * S (n0 + n) + 1))%nat with + (2 * (N - n0) + 1)%nat. +rewrite mult_INR. +reflexivity. +apply INR_eq; rewrite minus_INR. +do 2 rewrite plus_INR; do 3 rewrite mult_INR; repeat rewrite S_INR; + do 2 rewrite plus_INR; rewrite minus_INR. +ring. +apply le_trans with (pred (N - n)). +assumption. +apply le_S_n. +replace (S (pred (N - n))) with (N - n)%nat. +apply le_trans with N. +apply (fun p n m:nat => plus_le_reg_l n m p) with n. +rewrite <- le_plus_minus. +apply le_plus_r. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply le_n_Sn. +apply S_pred with 0%nat. +apply plus_lt_reg_l with n. +rewrite <- le_plus_minus. +replace (n + 0)%nat with n; [ idtac | ring ]. +apply le_lt_trans with (pred N). +assumption. +apply lt_pred_n_n; assumption. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply le_trans with (2 * S (S (n0 + n)))%nat. +replace (2 * S (S (n0 + n)))%nat with (S (2 * S (n0 + n) + 1)). +apply le_n_Sn. +apply INR_eq; rewrite S_INR; rewrite plus_INR; do 2 rewrite mult_INR; + repeat rewrite S_INR; rewrite plus_INR; ring. +apply (fun m n p:nat => mult_le_compat_l p n m). +repeat apply le_n_S. +apply plus_le_compat_r. +apply le_trans with (pred (N - n)). +assumption. +apply le_S_n. +replace (S (pred (N - n))) with (N - n)%nat. +apply le_trans with N. +apply (fun p n m:nat => plus_le_reg_l n m p) with n. +rewrite <- le_plus_minus. +apply le_plus_r. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply le_n_Sn. +apply S_pred with 0%nat. +apply plus_lt_reg_l with n. +rewrite <- le_plus_minus. +replace (n + 0)%nat with n; [ idtac | ring ]. +apply le_lt_trans with (pred N). +assumption. +apply lt_pred_n_n; assumption. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply INR_fact_neq_0. +apply Rle_trans with + (sum_f_R0 (fun k:nat => INR N / INR (fact (S (S N))) * C ^ (4 * S N)) + (pred N)). +apply sum_Rle; intros. +rewrite <- + (scal_sum (fun _:nat => C ^ (4 * S N)) (pred (N - n)) + (Rsqr (/ INR (fact (S (S (N + n))))))). +rewrite sum_cte. +rewrite <- Rmult_assoc. +do 2 rewrite <- (Rmult_comm (C ^ (4 * S N))). +rewrite Rmult_assoc. +apply Rmult_le_compat_l. +apply pow_le. +left; apply Rlt_le_trans with 1. +apply Rlt_0_1. +unfold C in |- *; apply RmaxLess1. +apply Rle_trans with (Rsqr (/ INR (fact (S (S (N + n))))) * INR N). +apply Rmult_le_compat_l. +apply Rle_0_sqr. +replace (S (pred (N - n))) with (N - n)%nat. +apply le_INR. +apply (fun p n m:nat => plus_le_reg_l n m p) with n. +rewrite <- le_plus_minus. +apply le_plus_r. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply S_pred with 0%nat. +apply plus_lt_reg_l with n. +rewrite <- le_plus_minus. +replace (n + 0)%nat with n; [ idtac | ring ]. +apply le_lt_trans with (pred N). +assumption. +apply lt_pred_n_n; assumption. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +rewrite Rmult_comm; unfold Rdiv in |- *; apply Rmult_le_compat_l. +apply pos_INR. +apply Rle_trans with (/ INR (fact (S (S (N + n))))). +pattern (/ INR (fact (S (S (N + n))))) at 2 in |- *; rewrite <- Rmult_1_r. +unfold Rsqr in |- *. +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +apply Rmult_le_reg_l with (INR (fact (S (S (N + n))))). +apply INR_fact_lt_0. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_r. +replace 1 with (INR 1). +apply le_INR. +apply lt_le_S. +apply INR_lt; apply INR_fact_lt_0. +reflexivity. +apply INR_fact_neq_0. +apply Rmult_le_reg_l with (INR (fact (S (S (N + n))))). +apply INR_fact_lt_0. +rewrite <- Rinv_r_sym. +apply Rmult_le_reg_l with (INR (fact (S (S N)))). +apply INR_fact_lt_0. +rewrite Rmult_1_r. +rewrite (Rmult_comm (INR (fact (S (S N))))). +rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +apply le_INR. +apply fact_le. +repeat apply le_n_S. +apply le_plus_l. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +rewrite sum_cte. +apply Rle_trans with (C ^ (4 * S N) / INR (fact N)). +rewrite <- (Rmult_comm (C ^ (4 * S N))). +unfold Rdiv in |- *; rewrite Rmult_assoc; apply Rmult_le_compat_l. +apply pow_le. +left; apply Rlt_le_trans with 1. +apply Rlt_0_1. +unfold C in |- *; apply RmaxLess1. +cut (S (pred N) = N). +intro; rewrite H0. +do 2 rewrite fact_simpl. +repeat rewrite mult_INR. +repeat rewrite Rinv_mult_distr. +apply Rle_trans with + (INR (S (S N)) * (/ INR (S (S N)) * (/ INR (S N) * / INR (fact N))) * INR N). +repeat rewrite Rmult_assoc. +rewrite (Rmult_comm (INR N)). +rewrite (Rmult_comm (INR (S (S N)))). +apply Rmult_le_compat_l. +repeat apply Rmult_le_pos. +left; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn. +left; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn. +left; apply Rinv_0_lt_compat. +apply INR_fact_lt_0. +apply pos_INR. +apply le_INR. +apply le_trans with (S N); apply le_n_Sn. +repeat rewrite <- Rmult_assoc. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_l. +apply Rle_trans with (/ INR (S N) * / INR (fact N) * INR (S N)). +repeat rewrite Rmult_assoc. +repeat apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +apply le_INR; apply le_n_Sn. +rewrite (Rmult_comm (/ INR (S N))). +rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; right; reflexivity. +apply not_O_INR; discriminate. +apply not_O_INR; discriminate. +apply not_O_INR; discriminate. +apply INR_fact_neq_0. +apply not_O_INR; discriminate. +apply prod_neq_R0; [ apply not_O_INR; discriminate | apply INR_fact_neq_0 ]. +symmetry in |- *; apply S_pred with 0%nat; assumption. +right. +unfold Majxy in |- *. +unfold C in |- *. +reflexivity. +Qed. + +Lemma reste1_cv_R0 : forall x y:R, Un_cv (Reste1 x y) 0. +intros. +assert (H := Majxy_cv_R0 x y). +unfold Un_cv in H; unfold R_dist in H. +unfold Un_cv in |- *; unfold R_dist in |- *; intros. +elim (H eps H0); intros N0 H1. +exists (S N0); intros. +unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r. +apply Rle_lt_trans with (Rabs (Majxy x y (pred n))). +rewrite (Rabs_right (Majxy x y (pred n))). +apply reste1_maj. +apply lt_le_trans with (S N0). +apply lt_O_Sn. +assumption. +apply Rle_ge. +unfold Majxy in |- *. +unfold Rdiv in |- *; apply Rmult_le_pos. +apply pow_le. +apply Rle_trans with 1. +left; apply Rlt_0_1. +apply RmaxLess1. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +replace (Majxy x y (pred n)) with (Majxy x y (pred n) - 0); [ idtac | ring ]. +apply H1. +unfold ge in |- *; apply le_S_n. +replace (S (pred n)) with n. +assumption. +apply S_pred with 0%nat. +apply lt_le_trans with (S N0); [ apply lt_O_Sn | assumption ]. +Qed. + +Lemma reste2_cv_R0 : forall x y:R, Un_cv (Reste2 x y) 0. +intros. +assert (H := Majxy_cv_R0 x y). +unfold Un_cv in H; unfold R_dist in H. +unfold Un_cv in |- *; unfold R_dist in |- *; intros. +elim (H eps H0); intros N0 H1. +exists (S N0); intros. +unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r. +apply Rle_lt_trans with (Rabs (Majxy x y n)). +rewrite (Rabs_right (Majxy x y n)). +apply reste2_maj. +apply lt_le_trans with (S N0). +apply lt_O_Sn. +assumption. +apply Rle_ge. +unfold Majxy in |- *. +unfold Rdiv in |- *; apply Rmult_le_pos. +apply pow_le. +apply Rle_trans with 1. +left; apply Rlt_0_1. +apply RmaxLess1. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +replace (Majxy x y n) with (Majxy x y n - 0); [ idtac | ring ]. +apply H1. +unfold ge in |- *; apply le_trans with (S N0). +apply le_n_Sn. +exact H2. +Qed. + +Lemma reste_cv_R0 : forall x y:R, Un_cv (Reste x y) 0. +intros. +unfold Reste in |- *. +set (An := fun n:nat => Reste2 x y n). +set (Bn := fun n:nat => Reste1 x y (S n)). +cut + (Un_cv (fun n:nat => An n - Bn n) (0 - 0) -> + Un_cv (fun N:nat => Reste2 x y N - Reste1 x y (S N)) 0). +intro. +apply H. +apply CV_minus. +unfold An in |- *. +replace (fun n:nat => Reste2 x y n) with (Reste2 x y). +apply reste2_cv_R0. +reflexivity. +unfold Bn in |- *. +assert (H0 := reste1_cv_R0 x y). +unfold Un_cv in H0; unfold R_dist in H0. +unfold Un_cv in |- *; unfold R_dist in |- *; intros. +elim (H0 eps H1); intros N0 H2. +exists N0; intros. +apply H2. +unfold ge in |- *; apply le_trans with (S N0). +apply le_n_Sn. +apply le_n_S; assumption. +unfold An, Bn in |- *. +intro. +replace 0 with (0 - 0); [ idtac | ring ]. +exact H. +Qed. + +Theorem cos_plus : forall x y:R, cos (x + y) = cos x * cos y - sin x * sin y. +intros. +cut (Un_cv (C1 x y) (cos x * cos y - sin x * sin y)). +cut (Un_cv (C1 x y) (cos (x + y))). +intros. +apply UL_sequence with (C1 x y); assumption. +apply C1_cvg. +unfold Un_cv in |- *; unfold R_dist in |- *. +intros. +assert (H0 := A1_cvg x). +assert (H1 := A1_cvg y). +assert (H2 := B1_cvg x). +assert (H3 := B1_cvg y). +assert (H4 := CV_mult _ _ _ _ H0 H1). +assert (H5 := CV_mult _ _ _ _ H2 H3). +assert (H6 := reste_cv_R0 x y). +unfold Un_cv in H4; unfold Un_cv in H5; unfold Un_cv in H6. +unfold R_dist in H4; unfold R_dist in H5; unfold R_dist in H6. +cut (0 < eps / 3); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. +elim (H4 (eps / 3) H7); intros N1 H8. +elim (H5 (eps / 3) H7); intros N2 H9. +elim (H6 (eps / 3) H7); intros N3 H10. +set (N := S (S (max (max N1 N2) N3))). +exists N. +intros. +cut (n = S (pred n)). +intro; rewrite H12. +rewrite <- cos_plus_form. +rewrite <- H12. +apply Rle_lt_trans with + (Rabs (A1 x n * A1 y n - cos x * cos y) + + Rabs (sin x * sin y - B1 x (pred n) * B1 y (pred n) + Reste x y (pred n))). +replace + (A1 x n * A1 y n - B1 x (pred n) * B1 y (pred n) + Reste x y (pred n) - + (cos x * cos y - sin x * sin y)) with + (A1 x n * A1 y n - cos x * cos y + + (sin x * sin y - B1 x (pred n) * B1 y (pred n) + Reste x y (pred n))); + [ apply Rabs_triang | ring ]. +replace eps with (eps / 3 + (eps / 3 + eps / 3)). +apply Rplus_lt_compat. +apply H8. +unfold ge in |- *; apply le_trans with N. +unfold N in |- *. +apply le_trans with (max N1 N2). +apply le_max_l. +apply le_trans with (max (max N1 N2) N3). +apply le_max_l. +apply le_trans with (S (max (max N1 N2) N3)); apply le_n_Sn. +assumption. +apply Rle_lt_trans with + (Rabs (sin x * sin y - B1 x (pred n) * B1 y (pred n)) + + Rabs (Reste x y (pred n))). +apply Rabs_triang. +apply Rplus_lt_compat. +rewrite <- Rabs_Ropp. +rewrite Ropp_minus_distr. +apply H9. +unfold ge in |- *; apply le_trans with (max N1 N2). +apply le_max_r. +apply le_S_n. +rewrite <- H12. +apply le_trans with N. +unfold N in |- *. +apply le_n_S. +apply le_trans with (max (max N1 N2) N3). +apply le_max_l. +apply le_n_Sn. +assumption. +replace (Reste x y (pred n)) with (Reste x y (pred n) - 0). +apply H10. +unfold ge in |- *. +apply le_S_n. +rewrite <- H12. +apply le_trans with N. +unfold N in |- *. +apply le_n_S. +apply le_trans with (max (max N1 N2) N3). +apply le_max_r. +apply le_n_Sn. +assumption. +ring. +pattern eps at 4 in |- *; replace eps with (3 * (eps / 3)). +ring. +unfold Rdiv in |- *. +rewrite <- Rmult_assoc. +apply Rinv_r_simpl_m. +discrR. +apply lt_le_trans with (pred N). +unfold N in |- *; simpl in |- *; apply lt_O_Sn. +apply le_S_n. +rewrite <- H12. +replace (S (pred N)) with N. +assumption. +unfold N in |- *; simpl in |- *; reflexivity. +cut (0 < N)%nat. +intro. +cut (0 < n)%nat. +intro. +apply S_pred with 0%nat; assumption. +apply lt_le_trans with N; assumption. +unfold N in |- *; apply lt_O_Sn. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Cos_rel.v b/theories/Reals/Cos_rel.v new file mode 100644 index 00000000..9f76a5ad --- /dev/null +++ b/theories/Reals/Cos_rel.v @@ -0,0 +1,420 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Cos_rel.v,v 1.12.2.1 2004/07/16 19:31:10 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rfunctions. +Require Import SeqSeries. +Require Import Rtrigo_def. +Open Local Scope R_scope. + +Definition A1 (x:R) (N:nat) : R := + sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * x ^ (2 * k)) N. + +Definition B1 (x:R) (N:nat) : R := + sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * x ^ (2 * k + 1)) + N. + +Definition C1 (x y:R) (N:nat) : R := + sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * (x + y) ^ (2 * k)) N. + +Definition Reste1 (x y:R) (N:nat) : R := + sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + (-1) ^ S (l + k) / INR (fact (2 * S (l + k))) * + x ^ (2 * S (l + k)) * ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) * + y ^ (2 * (N - l))) (pred (N - k))) (pred N). + +Definition Reste2 (x y:R) (N:nat) : R := + sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + (-1) ^ S (l + k) / INR (fact (2 * S (l + k) + 1)) * + x ^ (2 * S (l + k) + 1) * + ((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) * + y ^ (2 * (N - l) + 1)) (pred (N - k))) ( + pred N). + +Definition Reste (x y:R) (N:nat) : R := Reste2 x y N - Reste1 x y (S N). + +(* Here is the main result that will be used to prove that (cos (x+y))=(cos x)(cos y)-(sin x)(sin y) *) +Theorem cos_plus_form : + forall (x y:R) (n:nat), + (0 < n)%nat -> + A1 x (S n) * A1 y (S n) - B1 x n * B1 y n + Reste x y n = C1 x y (S n). +intros. +unfold A1, B1 in |- *. +rewrite + (cauchy_finite (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * x ^ (2 * k)) + (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * y ^ (2 * k)) ( + S n)). +rewrite + (cauchy_finite + (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * x ^ (2 * k + 1)) + (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * y ^ (2 * k + 1)) n H) + . +unfold Reste in |- *. +replace + (sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + (-1) ^ S (l + k) / INR (fact (2 * S (l + k))) * + x ^ (2 * S (l + k)) * + ((-1) ^ (S n - l) / INR (fact (2 * (S n - l))) * + y ^ (2 * (S n - l)))) (pred (S n - k))) ( + pred (S n))) with (Reste1 x y (S n)). +replace + (sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + (-1) ^ S (l + k) / INR (fact (2 * S (l + k) + 1)) * + x ^ (2 * S (l + k) + 1) * + ((-1) ^ (n - l) / INR (fact (2 * (n - l) + 1)) * + y ^ (2 * (n - l) + 1))) (pred (n - k))) ( + pred n)) with (Reste2 x y n). +ring. +replace + (sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun p:nat => + (-1) ^ p / INR (fact (2 * p)) * x ^ (2 * p) * + ((-1) ^ (k - p) / INR (fact (2 * (k - p))) * y ^ (2 * (k - p)))) + k) (S n)) with + (sum_f_R0 + (fun k:nat => + (-1) ^ k / INR (fact (2 * k)) * + sum_f_R0 + (fun l:nat => C (2 * k) (2 * l) * x ^ (2 * l) * y ^ (2 * (k - l))) k) + (S n)). +set + (sin_nnn := + fun n:nat => + match n with + | O => 0 + | S p => + (-1) ^ S p / INR (fact (2 * S p)) * + sum_f_R0 + (fun l:nat => + C (2 * S p) (S (2 * l)) * x ^ S (2 * l) * y ^ S (2 * (p - l))) p + end). +replace + (- + sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun p:nat => + (-1) ^ p / INR (fact (2 * p + 1)) * x ^ (2 * p + 1) * + ((-1) ^ (k - p) / INR (fact (2 * (k - p) + 1)) * + y ^ (2 * (k - p) + 1))) k) n) with (sum_f_R0 sin_nnn (S n)). +rewrite <- sum_plus. +unfold C1 in |- *. +apply sum_eq; intros. +induction i as [| i Hreci]. +simpl in |- *. +rewrite Rplus_0_l. +replace (C 0 0) with 1. +unfold Rdiv in |- *; rewrite Rinv_1. +ring. +unfold C in |- *. +rewrite <- minus_n_n. +simpl in |- *. +unfold Rdiv in |- *; rewrite Rmult_1_r; rewrite Rinv_1; ring. +unfold sin_nnn in |- *. +rewrite <- Rmult_plus_distr_l. +apply Rmult_eq_compat_l. +rewrite binomial. +set (Wn := fun i0:nat => C (2 * S i) i0 * x ^ i0 * y ^ (2 * S i - i0)). +replace + (sum_f_R0 + (fun l:nat => C (2 * S i) (2 * l) * x ^ (2 * l) * y ^ (2 * (S i - l))) + (S i)) with (sum_f_R0 (fun l:nat => Wn (2 * l)%nat) (S i)). +replace + (sum_f_R0 + (fun l:nat => + C (2 * S i) (S (2 * l)) * x ^ S (2 * l) * y ^ S (2 * (i - l))) i) with + (sum_f_R0 (fun l:nat => Wn (S (2 * l))) i). +rewrite Rplus_comm. +apply sum_decomposition. +apply sum_eq; intros. +unfold Wn in |- *. +apply Rmult_eq_compat_l. +replace (2 * S i - S (2 * i0))%nat with (S (2 * (i - i0))). +reflexivity. +apply INR_eq. +rewrite S_INR; rewrite mult_INR. +repeat rewrite minus_INR. +rewrite mult_INR; repeat rewrite S_INR. +rewrite mult_INR; repeat rewrite S_INR; ring. +replace (2 * S i)%nat with (S (S (2 * i))). +apply le_n_S. +apply le_trans with (2 * i)%nat. +apply (fun m n p:nat => mult_le_compat_l p n m); assumption. +apply le_n_Sn. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; + ring. +assumption. +apply sum_eq; intros. +unfold Wn in |- *. +apply Rmult_eq_compat_l. +replace (2 * S i - 2 * i0)%nat with (2 * (S i - i0))%nat. +reflexivity. +apply INR_eq. +rewrite mult_INR. +repeat rewrite minus_INR. +rewrite mult_INR; repeat rewrite S_INR. +rewrite mult_INR; repeat rewrite S_INR; ring. +apply (fun m n p:nat => mult_le_compat_l p n m); assumption. +assumption. +rewrite <- (Ropp_involutive (sum_f_R0 sin_nnn (S n))). +apply Ropp_eq_compat. +replace (- sum_f_R0 sin_nnn (S n)) with (-1 * sum_f_R0 sin_nnn (S n)); + [ idtac | ring ]. +rewrite scal_sum. +rewrite decomp_sum. +replace (sin_nnn 0%nat) with 0. +rewrite Rmult_0_l; rewrite Rplus_0_l. +replace (pred (S n)) with n; [ idtac | reflexivity ]. +apply sum_eq; intros. +rewrite Rmult_comm. +unfold sin_nnn in |- *. +rewrite scal_sum. +rewrite scal_sum. +apply sum_eq; intros. +unfold Rdiv in |- *. +repeat rewrite Rmult_assoc. +rewrite (Rmult_comm (/ INR (fact (2 * S i)))). +repeat rewrite <- Rmult_assoc. +rewrite <- (Rmult_comm (/ INR (fact (2 * S i)))). +repeat rewrite <- Rmult_assoc. +replace (/ INR (fact (2 * S i)) * C (2 * S i) (S (2 * i0))) with + (/ INR (fact (2 * i0 + 1)) * / INR (fact (2 * (i - i0) + 1))). +replace (S (2 * i0)) with (2 * i0 + 1)%nat; [ idtac | ring ]. +replace (S (2 * (i - i0))) with (2 * (i - i0) + 1)%nat; [ idtac | ring ]. +replace ((-1) ^ S i) with (-1 * (-1) ^ i0 * (-1) ^ (i - i0)). +ring. +simpl in |- *. +pattern i at 2 in |- *; replace i with (i0 + (i - i0))%nat. +rewrite pow_add. +ring. +symmetry in |- *; apply le_plus_minus; assumption. +unfold C in |- *. +unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_l. +rewrite Rinv_mult_distr. +replace (S (2 * i0)) with (2 * i0 + 1)%nat; + [ apply Rmult_eq_compat_l | ring ]. +replace (2 * S i - (2 * i0 + 1))%nat with (2 * (i - i0) + 1)%nat. +reflexivity. +apply INR_eq. +rewrite plus_INR; rewrite mult_INR; repeat rewrite minus_INR. +rewrite plus_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; ring. +replace (2 * i0 + 1)%nat with (S (2 * i0)). +replace (2 * S i)%nat with (S (S (2 * i))). +apply le_n_S. +apply le_trans with (2 * i)%nat. +apply (fun m n p:nat => mult_le_compat_l p n m); assumption. +apply le_n_Sn. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; + ring. +apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR; + repeat rewrite S_INR; ring. +assumption. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +reflexivity. +apply lt_O_Sn. +apply sum_eq; intros. +rewrite scal_sum. +apply sum_eq; intros. +unfold Rdiv in |- *. +repeat rewrite <- Rmult_assoc. +rewrite <- (Rmult_comm (/ INR (fact (2 * i)))). +repeat rewrite <- Rmult_assoc. +replace (/ INR (fact (2 * i)) * C (2 * i) (2 * i0)) with + (/ INR (fact (2 * i0)) * / INR (fact (2 * (i - i0)))). +replace ((-1) ^ i) with ((-1) ^ i0 * (-1) ^ (i - i0)). +ring. +pattern i at 2 in |- *; replace i with (i0 + (i - i0))%nat. +rewrite pow_add. +ring. +symmetry in |- *; apply le_plus_minus; assumption. +unfold C in |- *. +unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_l. +rewrite Rinv_mult_distr. +replace (2 * i - 2 * i0)%nat with (2 * (i - i0))%nat. +reflexivity. +apply INR_eq. +rewrite mult_INR; repeat rewrite minus_INR. +do 2 rewrite mult_INR; repeat rewrite S_INR; ring. +apply (fun m n p:nat => mult_le_compat_l p n m); assumption. +assumption. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +unfold Reste2 in |- *; apply sum_eq; intros. +apply sum_eq; intros. +unfold Rdiv in |- *; ring. +unfold Reste1 in |- *; apply sum_eq; intros. +apply sum_eq; intros. +unfold Rdiv in |- *; ring. +apply lt_O_Sn. +Qed. + +Lemma pow_sqr : forall (x:R) (i:nat), x ^ (2 * i) = (x * x) ^ i. +intros. +assert (H := pow_Rsqr x i). +unfold Rsqr in H; exact H. +Qed. + +Lemma A1_cvg : forall x:R, Un_cv (A1 x) (cos x). +intro. +assert (H := exist_cos (x * x)). +elim H; intros. +assert (p_i := p). +unfold cos_in in p. +unfold cos_n, infinit_sum in p. +unfold R_dist in p. +cut (cos x = x0). +intro. +rewrite H0. +unfold Un_cv in |- *; unfold R_dist in |- *; intros. +elim (p eps H1); intros. +exists x1; intros. +unfold A1 in |- *. +replace + (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * x ^ (2 * k)) n) with + (sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i)) * (x * x) ^ i) n). +apply H2; assumption. +apply sum_eq. +intros. +replace ((x * x) ^ i) with (x ^ (2 * i)). +reflexivity. +apply pow_sqr. +unfold cos in |- *. +case (exist_cos (Rsqr x)). +unfold Rsqr in |- *; intros. +unfold cos_in in p_i. +unfold cos_in in c. +apply uniqueness_sum with (fun i:nat => cos_n i * (x * x) ^ i); assumption. +Qed. + +Lemma C1_cvg : forall x y:R, Un_cv (C1 x y) (cos (x + y)). +intros. +assert (H := exist_cos ((x + y) * (x + y))). +elim H; intros. +assert (p_i := p). +unfold cos_in in p. +unfold cos_n, infinit_sum in p. +unfold R_dist in p. +cut (cos (x + y) = x0). +intro. +rewrite H0. +unfold Un_cv in |- *; unfold R_dist in |- *; intros. +elim (p eps H1); intros. +exists x1; intros. +unfold C1 in |- *. +replace + (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * (x + y) ^ (2 * k)) n) + with + (sum_f_R0 + (fun i:nat => (-1) ^ i / INR (fact (2 * i)) * ((x + y) * (x + y)) ^ i) n). +apply H2; assumption. +apply sum_eq. +intros. +replace (((x + y) * (x + y)) ^ i) with ((x + y) ^ (2 * i)). +reflexivity. +apply pow_sqr. +unfold cos in |- *. +case (exist_cos (Rsqr (x + y))). +unfold Rsqr in |- *; intros. +unfold cos_in in p_i. +unfold cos_in in c. +apply uniqueness_sum with (fun i:nat => cos_n i * ((x + y) * (x + y)) ^ i); + assumption. +Qed. + +Lemma B1_cvg : forall x:R, Un_cv (B1 x) (sin x). +intro. +case (Req_dec x 0); intro. +rewrite H. +rewrite sin_0. +unfold B1 in |- *. +unfold Un_cv in |- *; unfold R_dist in |- *; intros; exists 0%nat; intros. +replace + (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * 0 ^ (2 * k + 1)) + n) with 0. +unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. +induction n as [| n Hrecn]. +simpl in |- *; ring. +rewrite tech5; rewrite <- Hrecn. +simpl in |- *; ring. +unfold ge in |- *; apply le_O_n. +assert (H0 := exist_sin (x * x)). +elim H0; intros. +assert (p_i := p). +unfold sin_in in p. +unfold sin_n, infinit_sum in p. +unfold R_dist in p. +cut (sin x = x * x0). +intro. +rewrite H1. +unfold Un_cv in |- *; unfold R_dist in |- *; intros. +cut (0 < eps / Rabs x); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption ] ]. +elim (p (eps / Rabs x) H3); intros. +exists x1; intros. +unfold B1 in |- *. +replace + (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * x ^ (2 * k + 1)) + n) with + (x * + sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i + 1)) * (x * x) ^ i) n). +replace + (x * + sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i + 1)) * (x * x) ^ i) n - + x * x0) with + (x * + (sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i + 1)) * (x * x) ^ i) n - + x0)); [ idtac | ring ]. +rewrite Rabs_mult. +apply Rmult_lt_reg_l with (/ Rabs x). +apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. +rewrite <- Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); unfold Rdiv in H4; apply H4; + assumption. +apply Rabs_no_R0; assumption. +rewrite scal_sum. +apply sum_eq. +intros. +rewrite pow_add. +rewrite pow_sqr. +simpl in |- *. +ring. +unfold sin in |- *. +case (exist_sin (Rsqr x)). +unfold Rsqr in |- *; intros. +unfold sin_in in p_i. +unfold sin_in in s. +assert + (H1 := uniqueness_sum (fun i:nat => sin_n i * (x * x) ^ i) x0 x1 p_i s). +rewrite H1; reflexivity. +Qed.
\ No newline at end of file diff --git a/theories/Reals/DiscrR.v b/theories/Reals/DiscrR.v new file mode 100644 index 00000000..f897e258 --- /dev/null +++ b/theories/Reals/DiscrR.v @@ -0,0 +1,97 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: DiscrR.v,v 1.21.2.1 2004/07/16 19:31:10 herbelin Exp $ i*) + +Require Import RIneq. +Require Import Omega. Open Local Scope R_scope. + +Lemma Rlt_R0_R2 : 0 < 2. +replace 2 with (INR 2); [ apply lt_INR_0; apply lt_O_Sn | reflexivity ]. +Qed. + +Lemma Rplus_lt_pos : forall x y:R, 0 < x -> 0 < y -> 0 < x + y. +intros. +apply Rlt_trans with x. +assumption. +pattern x at 1 in |- *; rewrite <- Rplus_0_r. +apply Rplus_lt_compat_l. +assumption. +Qed. + +Lemma IZR_eq : forall z1 z2:Z, z1 = z2 -> IZR z1 = IZR z2. +intros; rewrite H; reflexivity. +Qed. + +Lemma IZR_neq : forall z1 z2:Z, z1 <> z2 -> IZR z1 <> IZR z2. +intros; red in |- *; intro; elim H; apply eq_IZR; assumption. +Qed. + +Ltac discrR := + try + match goal with + | |- (?X1 <> ?X2) => + replace 2 with (IZR 2); + [ replace 1 with (IZR 1); + [ replace 0 with (IZR 0); + [ repeat + rewrite <- plus_IZR || + rewrite <- mult_IZR || + rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus; + apply IZR_neq; try discriminate + | reflexivity ] + | reflexivity ] + | reflexivity ] + end. + +Ltac prove_sup0 := + match goal with + | |- (0 < 1) => apply Rlt_0_1 + | |- (0 < ?X1) => + repeat + (apply Rmult_lt_0_compat || apply Rplus_lt_pos; + try apply Rlt_0_1 || apply Rlt_R0_R2) + | |- (?X1 > 0) => change (0 < X1) in |- *; prove_sup0 + end. + +Ltac omega_sup := + replace 2 with (IZR 2); + [ replace 1 with (IZR 1); + [ replace 0 with (IZR 0); + [ repeat + rewrite <- plus_IZR || + rewrite <- mult_IZR || + rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus; + apply IZR_lt; omega + | reflexivity ] + | reflexivity ] + | reflexivity ]. + +Ltac prove_sup := + match goal with + | |- (?X1 > ?X2) => change (X2 < X1) in |- *; prove_sup + | |- (0 < ?X1) => prove_sup0 + | |- (- ?X1 < 0) => rewrite <- Ropp_0; prove_sup + | |- (- ?X1 < - ?X2) => apply Ropp_lt_gt_contravar; prove_sup + | |- (- ?X1 < ?X2) => apply Rlt_trans with 0; prove_sup + | |- (?X1 < ?X2) => omega_sup + | _ => idtac + end. + +Ltac Rcompute := + replace 2 with (IZR 2); + [ replace 1 with (IZR 1); + [ replace 0 with (IZR 0); + [ repeat + rewrite <- plus_IZR || + rewrite <- mult_IZR || + rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus; + apply IZR_eq; try reflexivity + | reflexivity ] + | reflexivity ] + | reflexivity ].
\ No newline at end of file diff --git a/theories/Reals/Exp_prop.v b/theories/Reals/Exp_prop.v new file mode 100644 index 00000000..fcaeb11e --- /dev/null +++ b/theories/Reals/Exp_prop.v @@ -0,0 +1,1011 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Exp_prop.v,v 1.16.2.1 2004/07/16 19:31:10 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rfunctions. +Require Import SeqSeries. +Require Import Rtrigo. +Require Import Ranalysis1. +Require Import PSeries_reg. +Require Import Div2. +Require Import Even. +Require Import Max. +Open Local Scope nat_scope. +Open Local Scope R_scope. + +Definition E1 (x:R) (N:nat) : R := + sum_f_R0 (fun k:nat => / INR (fact k) * x ^ k) N. + +Lemma E1_cvg : forall x:R, Un_cv (E1 x) (exp x). +intro; unfold exp in |- *; unfold projT1 in |- *. +case (exist_exp x); intro. +unfold exp_in, Un_cv in |- *; unfold infinit_sum, E1 in |- *; trivial. +Qed. + +Definition Reste_E (x y:R) (N:nat) : R := + sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + / INR (fact (S (l + k))) * x ^ S (l + k) * + (/ INR (fact (N - l)) * y ^ (N - l))) ( + pred (N - k))) (pred N). + +Lemma exp_form : + forall (x y:R) (n:nat), + (0 < n)%nat -> E1 x n * E1 y n - Reste_E x y n = E1 (x + y) n. +intros; unfold E1 in |- *. +rewrite cauchy_finite. +unfold Reste_E in |- *; unfold Rminus in |- *; rewrite Rplus_assoc; + rewrite Rplus_opp_r; rewrite Rplus_0_r; apply sum_eq; + intros. +rewrite binomial. +rewrite scal_sum; apply sum_eq; intros. +unfold C in |- *; unfold Rdiv in |- *; repeat rewrite Rmult_assoc; + rewrite (Rmult_comm (INR (fact i))); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; rewrite Rinv_mult_distr. +ring. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply H. +Qed. + +Definition maj_Reste_E (x y:R) (N:nat) : R := + 4 * + (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * N) / + Rsqr (INR (fact (div2 (pred N))))). + +Lemma Rle_Rinv : forall x y:R, 0 < x -> 0 < y -> x <= y -> / y <= / x. +intros; apply Rmult_le_reg_l with x. +apply H. +rewrite <- Rinv_r_sym. +apply Rmult_le_reg_l with y. +apply H0. +rewrite Rmult_1_r; rewrite Rmult_comm; rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; apply H1. +red in |- *; intro; rewrite H2 in H0; elim (Rlt_irrefl _ H0). +red in |- *; intro; rewrite H2 in H; elim (Rlt_irrefl _ H). +Qed. + +(**********) +Lemma div2_double : forall N:nat, div2 (2 * N) = N. +intro; induction N as [| N HrecN]. +reflexivity. +replace (2 * S N)%nat with (S (S (2 * N))). +simpl in |- *; simpl in HrecN; rewrite HrecN; reflexivity. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; + ring. +Qed. + +Lemma div2_S_double : forall N:nat, div2 (S (2 * N)) = N. +intro; induction N as [| N HrecN]. +reflexivity. +replace (2 * S N)%nat with (S (S (2 * N))). +simpl in |- *; simpl in HrecN; rewrite HrecN; reflexivity. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; + ring. +Qed. + +Lemma div2_not_R0 : forall N:nat, (1 < N)%nat -> (0 < div2 N)%nat. +intros; induction N as [| N HrecN]. +elim (lt_n_O _ H). +cut ((1 < N)%nat \/ N = 1%nat). +intro; elim H0; intro. +assert (H2 := even_odd_dec N). +elim H2; intro. +rewrite <- (even_div2 _ a); apply HrecN; assumption. +rewrite <- (odd_div2 _ b); apply lt_O_Sn. +rewrite H1; simpl in |- *; apply lt_O_Sn. +inversion H. +right; reflexivity. +left; apply lt_le_trans with 2%nat; [ apply lt_n_Sn | apply H1 ]. +Qed. + +Lemma Reste_E_maj : + forall (x y:R) (N:nat), + (0 < N)%nat -> Rabs (Reste_E x y N) <= maj_Reste_E x y N. +intros; set (M := Rmax 1 (Rmax (Rabs x) (Rabs y))). +apply Rle_trans with + (M ^ (2 * N) * + sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => / Rsqr (INR (fact (div2 (S N))))) + (pred (N - k))) (pred N)). +unfold Reste_E in |- *. +apply Rle_trans with + (sum_f_R0 + (fun k:nat => + Rabs + (sum_f_R0 + (fun l:nat => + / INR (fact (S (l + k))) * x ^ S (l + k) * + (/ INR (fact (N - l)) * y ^ (N - l))) ( + pred (N - k)))) (pred N)). +apply + (Rsum_abs + (fun k:nat => + sum_f_R0 + (fun l:nat => + / INR (fact (S (l + k))) * x ^ S (l + k) * + (/ INR (fact (N - l)) * y ^ (N - l))) ( + pred (N - k))) (pred N)). +apply Rle_trans with + (sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + Rabs + (/ INR (fact (S (l + k))) * x ^ S (l + k) * + (/ INR (fact (N - l)) * y ^ (N - l)))) ( + pred (N - k))) (pred N)). +apply sum_Rle; intros. +apply + (Rsum_abs + (fun l:nat => + / INR (fact (S (l + n))) * x ^ S (l + n) * + (/ INR (fact (N - l)) * y ^ (N - l)))). +apply Rle_trans with + (sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + M ^ (2 * N) * / INR (fact (S l)) * / INR (fact (N - l))) + (pred (N - k))) (pred N)). +apply sum_Rle; intros. +apply sum_Rle; intros. +repeat rewrite Rabs_mult. +do 2 rewrite <- RPow_abs. +rewrite (Rabs_right (/ INR (fact (S (n0 + n))))). +rewrite (Rabs_right (/ INR (fact (N - n0)))). +replace + (/ INR (fact (S (n0 + n))) * Rabs x ^ S (n0 + n) * + (/ INR (fact (N - n0)) * Rabs y ^ (N - n0))) with + (/ INR (fact (N - n0)) * / INR (fact (S (n0 + n))) * Rabs x ^ S (n0 + n) * + Rabs y ^ (N - n0)); [ idtac | ring ]. +rewrite <- (Rmult_comm (/ INR (fact (N - n0)))). +repeat rewrite Rmult_assoc. +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +apply Rle_trans with + (/ INR (fact (S n0)) * Rabs x ^ S (n0 + n) * Rabs y ^ (N - n0)). +rewrite (Rmult_comm (/ INR (fact (S (n0 + n))))); + rewrite (Rmult_comm (/ INR (fact (S n0)))); repeat rewrite Rmult_assoc; + apply Rmult_le_compat_l. +apply pow_le; apply Rabs_pos. +rewrite (Rmult_comm (/ INR (fact (S n0)))); apply Rmult_le_compat_l. +apply pow_le; apply Rabs_pos. +apply Rle_Rinv. +apply INR_fact_lt_0. +apply INR_fact_lt_0. +apply le_INR; apply fact_le; apply le_n_S. +apply le_plus_l. +rewrite (Rmult_comm (M ^ (2 * N))); rewrite Rmult_assoc; + apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +apply Rle_trans with (M ^ S (n0 + n) * Rabs y ^ (N - n0)). +do 2 rewrite <- (Rmult_comm (Rabs y ^ (N - n0))). +apply Rmult_le_compat_l. +apply pow_le; apply Rabs_pos. +apply pow_incr; split. +apply Rabs_pos. +apply Rle_trans with (Rmax (Rabs x) (Rabs y)). +apply RmaxLess1. +unfold M in |- *; apply RmaxLess2. +apply Rle_trans with (M ^ S (n0 + n) * M ^ (N - n0)). +apply Rmult_le_compat_l. +apply pow_le; apply Rle_trans with 1. +left; apply Rlt_0_1. +unfold M in |- *; apply RmaxLess1. +apply pow_incr; split. +apply Rabs_pos. +apply Rle_trans with (Rmax (Rabs x) (Rabs y)). +apply RmaxLess2. +unfold M in |- *; apply RmaxLess2. +rewrite <- pow_add; replace (S (n0 + n) + (N - n0))%nat with (N + S n)%nat. +apply Rle_pow. +unfold M in |- *; apply RmaxLess1. +replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ]. +apply plus_le_compat_l. +replace N with (S (pred N)). +apply le_n_S; apply H0. +symmetry in |- *; apply S_pred with 0%nat; apply H. +apply INR_eq; do 2 rewrite plus_INR; do 2 rewrite S_INR; rewrite plus_INR; + rewrite minus_INR. +ring. +apply le_trans with (pred (N - n)). +apply H1. +apply le_S_n. +replace (S (pred (N - n))) with (N - n)%nat. +apply le_trans with N. +apply (fun p n m:nat => plus_le_reg_l n m p) with n. +rewrite <- le_plus_minus. +apply le_plus_r. +apply le_trans with (pred N). +apply H0. +apply le_pred_n. +apply le_n_Sn. +apply S_pred with 0%nat. +apply plus_lt_reg_l with n. +rewrite <- le_plus_minus. +replace (n + 0)%nat with n; [ idtac | ring ]. +apply le_lt_trans with (pred N). +apply H0. +apply lt_pred_n_n. +apply H. +apply le_trans with (pred N). +apply H0. +apply le_pred_n. +apply Rle_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +apply Rle_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +rewrite scal_sum. +apply sum_Rle; intros. +rewrite <- Rmult_comm. +rewrite scal_sum. +apply sum_Rle; intros. +rewrite (Rmult_comm (/ Rsqr (INR (fact (div2 (S N)))))). +rewrite Rmult_assoc; apply Rmult_le_compat_l. +apply pow_le. +apply Rle_trans with 1. +left; apply Rlt_0_1. +unfold M in |- *; apply RmaxLess1. +assert (H2 := even_odd_cor N). +elim H2; intros N0 H3. +elim H3; intro. +apply Rle_trans with (/ INR (fact n0) * / INR (fact (N - n0))). +do 2 rewrite <- (Rmult_comm (/ INR (fact (N - n0)))). +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +apply Rle_Rinv. +apply INR_fact_lt_0. +apply INR_fact_lt_0. +apply le_INR. +apply fact_le. +apply le_n_Sn. +replace (/ INR (fact n0) * / INR (fact (N - n0))) with + (C N n0 / INR (fact N)). +pattern N at 1 in |- *; rewrite H4. +apply Rle_trans with (C N N0 / INR (fact N)). +unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ INR (fact N))). +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +rewrite H4. +apply C_maj. +rewrite <- H4; apply le_trans with (pred (N - n)). +apply H1. +apply le_S_n. +replace (S (pred (N - n))) with (N - n)%nat. +apply le_trans with N. +apply (fun p n m:nat => plus_le_reg_l n m p) with n. +rewrite <- le_plus_minus. +apply le_plus_r. +apply le_trans with (pred N). +apply H0. +apply le_pred_n. +apply le_n_Sn. +apply S_pred with 0%nat. +apply plus_lt_reg_l with n. +rewrite <- le_plus_minus. +replace (n + 0)%nat with n; [ idtac | ring ]. +apply le_lt_trans with (pred N). +apply H0. +apply lt_pred_n_n. +apply H. +apply le_trans with (pred N). +apply H0. +apply le_pred_n. +replace (C N N0 / INR (fact N)) with (/ Rsqr (INR (fact N0))). +rewrite H4; rewrite div2_S_double; right; reflexivity. +unfold Rsqr, C, Rdiv in |- *. +repeat rewrite Rinv_mult_distr. +rewrite (Rmult_comm (INR (fact N))). +repeat rewrite Rmult_assoc. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; replace (N - N0)%nat with N0. +ring. +replace N with (N0 + N0)%nat. +symmetry in |- *; apply minus_plus. +rewrite H4. +apply INR_eq; rewrite plus_INR; rewrite mult_INR; do 2 rewrite S_INR; ring. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +unfold C, Rdiv in |- *. +rewrite (Rmult_comm (INR (fact N))). +repeat rewrite Rmult_assoc. +rewrite <- Rinv_r_sym. +rewrite Rinv_mult_distr. +rewrite Rmult_1_r; ring. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +replace (/ INR (fact (S n0)) * / INR (fact (N - n0))) with + (C (S N) (S n0) / INR (fact (S N))). +apply Rle_trans with (C (S N) (S N0) / INR (fact (S N))). +unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ INR (fact (S N)))). +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +cut (S N = (2 * S N0)%nat). +intro; rewrite H5; apply C_maj. +rewrite <- H5; apply le_n_S. +apply le_trans with (pred (N - n)). +apply H1. +apply le_S_n. +replace (S (pred (N - n))) with (N - n)%nat. +apply le_trans with N. +apply (fun p n m:nat => plus_le_reg_l n m p) with n. +rewrite <- le_plus_minus. +apply le_plus_r. +apply le_trans with (pred N). +apply H0. +apply le_pred_n. +apply le_n_Sn. +apply S_pred with 0%nat. +apply plus_lt_reg_l with n. +rewrite <- le_plus_minus. +replace (n + 0)%nat with n; [ idtac | ring ]. +apply le_lt_trans with (pred N). +apply H0. +apply lt_pred_n_n. +apply H. +apply le_trans with (pred N). +apply H0. +apply le_pred_n. +apply INR_eq; rewrite H4. +do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; ring. +cut (S N = (2 * S N0)%nat). +intro. +replace (C (S N) (S N0) / INR (fact (S N))) with (/ Rsqr (INR (fact (S N0)))). +rewrite H5; rewrite div2_double. +right; reflexivity. +unfold Rsqr, C, Rdiv in |- *. +repeat rewrite Rinv_mult_distr. +replace (S N - S N0)%nat with (S N0). +rewrite (Rmult_comm (INR (fact (S N)))). +repeat rewrite Rmult_assoc. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; reflexivity. +apply INR_fact_neq_0. +replace (S N) with (S N0 + S N0)%nat. +symmetry in |- *; apply minus_plus. +rewrite H5; ring. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply INR_eq; rewrite H4; do 2 rewrite S_INR; do 2 rewrite mult_INR; + repeat rewrite S_INR; ring. +unfold C, Rdiv in |- *. +rewrite (Rmult_comm (INR (fact (S N)))). +rewrite Rmult_assoc; rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; rewrite Rinv_mult_distr. +reflexivity. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +unfold maj_Reste_E in |- *. +unfold Rdiv in |- *; rewrite (Rmult_comm 4). +rewrite Rmult_assoc. +apply Rmult_le_compat_l. +apply pow_le. +apply Rle_trans with 1. +left; apply Rlt_0_1. +apply RmaxLess1. +apply Rle_trans with + (sum_f_R0 (fun k:nat => INR (N - k) * / Rsqr (INR (fact (div2 (S N))))) + (pred N)). +apply sum_Rle; intros. +rewrite sum_cte. +replace (S (pred (N - n))) with (N - n)%nat. +right; apply Rmult_comm. +apply S_pred with 0%nat. +apply plus_lt_reg_l with n. +rewrite <- le_plus_minus. +replace (n + 0)%nat with n; [ idtac | ring ]. +apply le_lt_trans with (pred N). +apply H0. +apply lt_pred_n_n. +apply H. +apply le_trans with (pred N). +apply H0. +apply le_pred_n. +apply Rle_trans with + (sum_f_R0 (fun k:nat => INR N * / Rsqr (INR (fact (div2 (S N))))) (pred N)). +apply sum_Rle; intros. +do 2 rewrite <- (Rmult_comm (/ Rsqr (INR (fact (div2 (S N)))))). +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt. +apply INR_fact_neq_0. +apply le_INR. +apply (fun p n m:nat => plus_le_reg_l n m p) with n. +rewrite <- le_plus_minus. +apply le_plus_r. +apply le_trans with (pred N). +apply H0. +apply le_pred_n. +rewrite sum_cte; replace (S (pred N)) with N. +cut (div2 (S N) = S (div2 (pred N))). +intro; rewrite H0. +rewrite fact_simpl; rewrite mult_comm; rewrite mult_INR; rewrite Rsqr_mult. +rewrite Rinv_mult_distr. +rewrite (Rmult_comm (INR N)); repeat rewrite Rmult_assoc; + apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt; apply INR_fact_neq_0. +rewrite <- H0. +cut (INR N <= INR (2 * div2 (S N))). +intro; apply Rmult_le_reg_l with (Rsqr (INR (div2 (S N)))). +apply Rsqr_pos_lt. +apply not_O_INR; red in |- *; intro. +cut (1 < S N)%nat. +intro; assert (H4 := div2_not_R0 _ H3). +rewrite H2 in H4; elim (lt_n_O _ H4). +apply lt_n_S; apply H. +repeat rewrite <- Rmult_assoc. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_l. +replace (INR N * INR N) with (Rsqr (INR N)); [ idtac | reflexivity ]. +rewrite Rmult_assoc. +rewrite Rmult_comm. +replace 4 with (Rsqr 2); [ idtac | ring_Rsqr ]. +rewrite <- Rsqr_mult. +apply Rsqr_incr_1. +replace 2 with (INR 2). +rewrite <- mult_INR; apply H1. +reflexivity. +left; apply lt_INR_0; apply H. +left; apply Rmult_lt_0_compat. +prove_sup0. +apply lt_INR_0; apply div2_not_R0. +apply lt_n_S; apply H. +cut (1 < S N)%nat. +intro; unfold Rsqr in |- *; apply prod_neq_R0; apply not_O_INR; intro; + assert (H4 := div2_not_R0 _ H2); rewrite H3 in H4; + elim (lt_n_O _ H4). +apply lt_n_S; apply H. +assert (H1 := even_odd_cor N). +elim H1; intros N0 H2. +elim H2; intro. +pattern N at 2 in |- *; rewrite H3. +rewrite div2_S_double. +right; rewrite H3; reflexivity. +pattern N at 2 in |- *; rewrite H3. +replace (S (S (2 * N0))) with (2 * S N0)%nat. +rewrite div2_double. +rewrite H3. +rewrite S_INR; do 2 rewrite mult_INR. +rewrite (S_INR N0). +rewrite Rmult_plus_distr_l. +apply Rplus_le_compat_l. +rewrite Rmult_1_r. +simpl in |- *. +pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; + apply Rlt_0_1. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; + ring. +unfold Rsqr in |- *; apply prod_neq_R0; apply INR_fact_neq_0. +unfold Rsqr in |- *; apply prod_neq_R0; apply not_O_INR; discriminate. +assert (H0 := even_odd_cor N). +elim H0; intros N0 H1. +elim H1; intro. +cut (0 < N0)%nat. +intro; rewrite H2. +rewrite div2_S_double. +replace (2 * N0)%nat with (S (S (2 * pred N0))). +replace (pred (S (S (2 * pred N0)))) with (S (2 * pred N0)). +rewrite div2_S_double. +apply S_pred with 0%nat; apply H3. +reflexivity. +replace N0 with (S (pred N0)). +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; + ring. +symmetry in |- *; apply S_pred with 0%nat; apply H3. +rewrite H2 in H. +apply neq_O_lt. +red in |- *; intro. +rewrite <- H3 in H. +simpl in H. +elim (lt_n_O _ H). +rewrite H2. +replace (pred (S (2 * N0))) with (2 * N0)%nat; [ idtac | reflexivity ]. +replace (S (S (2 * N0))) with (2 * S N0)%nat. +do 2 rewrite div2_double. +reflexivity. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; + ring. +apply S_pred with 0%nat; apply H. +Qed. + +Lemma maj_Reste_cv_R0 : forall x y:R, Un_cv (maj_Reste_E x y) 0. +intros; assert (H := Majxy_cv_R0 x y). +unfold Un_cv in H; unfold Un_cv in |- *; intros. +cut (0 < eps / 4); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. +elim (H _ H1); intros N0 H2. +exists (max (2 * S N0) 2); intros. +unfold R_dist in H2; unfold R_dist in |- *; rewrite Rminus_0_r; + unfold Majxy in H2; unfold maj_Reste_E in |- *. +rewrite Rabs_right. +apply Rle_lt_trans with + (4 * + (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S (div2 (pred n))) / + INR (fact (div2 (pred n))))). +apply Rmult_le_compat_l. +left; prove_sup0. +unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr. +rewrite (Rmult_comm (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * n))); + rewrite + (Rmult_comm (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S (div2 (pred n))))) + ; rewrite Rmult_assoc; apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +apply Rle_trans with (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * n)). +rewrite Rmult_comm; + pattern (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * n)) at 2 in |- *; + rewrite <- Rmult_1_r; apply Rmult_le_compat_l. +apply pow_le; apply Rle_trans with 1. +left; apply Rlt_0_1. +apply RmaxLess1. +apply Rmult_le_reg_l with (INR (fact (div2 (pred n)))). +apply INR_fact_lt_0. +rewrite Rmult_1_r; rewrite <- Rinv_r_sym. +replace 1 with (INR 1); [ apply le_INR | reflexivity ]. +apply lt_le_S. +apply INR_lt. +apply INR_fact_lt_0. +apply INR_fact_neq_0. +apply Rle_pow. +apply RmaxLess1. +assert (H4 := even_odd_cor n). +elim H4; intros N1 H5. +elim H5; intro. +cut (0 < N1)%nat. +intro. +rewrite H6. +replace (pred (2 * N1)) with (S (2 * pred N1)). +rewrite div2_S_double. +replace (S (pred N1)) with N1. +apply INR_le. +right. +do 3 rewrite mult_INR; repeat rewrite S_INR; ring. +apply S_pred with 0%nat; apply H7. +replace (2 * N1)%nat with (S (S (2 * pred N1))). +reflexivity. +pattern N1 at 2 in |- *; replace N1 with (S (pred N1)). +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; + ring. +symmetry in |- *; apply S_pred with 0%nat; apply H7. +apply INR_lt. +apply Rmult_lt_reg_l with (INR 2). +simpl in |- *; prove_sup0. +rewrite Rmult_0_r; rewrite <- mult_INR. +apply lt_INR_0. +rewrite <- H6. +apply lt_le_trans with 2%nat. +apply lt_O_Sn. +apply le_trans with (max (2 * S N0) 2). +apply le_max_r. +apply H3. +rewrite H6. +replace (pred (S (2 * N1))) with (2 * N1)%nat. +rewrite div2_double. +replace (4 * S N1)%nat with (2 * (2 * S N1))%nat. +apply (fun m n p:nat => mult_le_compat_l p n m). +replace (2 * S N1)%nat with (S (S (2 * N1))). +apply le_n_Sn. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; + ring. +ring. +reflexivity. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply Rmult_lt_reg_l with (/ 4). +apply Rinv_0_lt_compat; prove_sup0. +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; rewrite Rmult_comm. +replace + (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S (div2 (pred n))) / + INR (fact (div2 (pred n)))) with + (Rabs + (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S (div2 (pred n))) / + INR (fact (div2 (pred n))) - 0)). +apply H2; unfold ge in |- *. +cut (2 * S N0 <= n)%nat. +intro; apply le_S_n. +apply INR_le; apply Rmult_le_reg_l with (INR 2). +simpl in |- *; prove_sup0. +do 2 rewrite <- mult_INR; apply le_INR. +apply le_trans with n. +apply H4. +assert (H5 := even_odd_cor n). +elim H5; intros N1 H6. +elim H6; intro. +cut (0 < N1)%nat. +intro. +rewrite H7. +apply (fun m n p:nat => mult_le_compat_l p n m). +replace (pred (2 * N1)) with (S (2 * pred N1)). +rewrite div2_S_double. +replace (S (pred N1)) with N1. +apply le_n. +apply S_pred with 0%nat; apply H8. +replace (2 * N1)%nat with (S (S (2 * pred N1))). +reflexivity. +pattern N1 at 2 in |- *; replace N1 with (S (pred N1)). +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; + ring. +symmetry in |- *; apply S_pred with 0%nat; apply H8. +apply INR_lt. +apply Rmult_lt_reg_l with (INR 2). +simpl in |- *; prove_sup0. +rewrite Rmult_0_r; rewrite <- mult_INR. +apply lt_INR_0. +rewrite <- H7. +apply lt_le_trans with 2%nat. +apply lt_O_Sn. +apply le_trans with (max (2 * S N0) 2). +apply le_max_r. +apply H3. +rewrite H7. +replace (pred (S (2 * N1))) with (2 * N1)%nat. +rewrite div2_double. +replace (2 * S N1)%nat with (S (S (2 * N1))). +apply le_n_Sn. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; + ring. +reflexivity. +apply le_trans with (max (2 * S N0) 2). +apply le_max_l. +apply H3. +rewrite Rminus_0_r; apply Rabs_right. +apply Rle_ge. +unfold Rdiv in |- *; repeat apply Rmult_le_pos. +apply pow_le. +apply Rle_trans with 1. +left; apply Rlt_0_1. +apply RmaxLess1. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +discrR. +apply Rle_ge. +unfold Rdiv in |- *; apply Rmult_le_pos. +left; prove_sup0. +apply Rmult_le_pos. +apply pow_le. +apply Rle_trans with 1. +left; apply Rlt_0_1. +apply RmaxLess1. +left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt; apply INR_fact_neq_0. +Qed. + +(**********) +Lemma Reste_E_cv : forall x y:R, Un_cv (Reste_E x y) 0. +intros; assert (H := maj_Reste_cv_R0 x y). +unfold Un_cv in H; unfold Un_cv in |- *; intros; elim (H _ H0); intros. +exists (max x0 1); intros. +unfold R_dist in |- *; rewrite Rminus_0_r. +apply Rle_lt_trans with (maj_Reste_E x y n). +apply Reste_E_maj. +apply lt_le_trans with 1%nat. +apply lt_O_Sn. +apply le_trans with (max x0 1). +apply le_max_r. +apply H2. +replace (maj_Reste_E x y n) with (R_dist (maj_Reste_E x y n) 0). +apply H1. +unfold ge in |- *; apply le_trans with (max x0 1). +apply le_max_l. +apply H2. +unfold R_dist in |- *; rewrite Rminus_0_r; apply Rabs_right. +apply Rle_ge; apply Rle_trans with (Rabs (Reste_E x y n)). +apply Rabs_pos. +apply Reste_E_maj. +apply lt_le_trans with 1%nat. +apply lt_O_Sn. +apply le_trans with (max x0 1). +apply le_max_r. +apply H2. +Qed. + +(**********) +Lemma exp_plus : forall x y:R, exp (x + y) = exp x * exp y. +intros; assert (H0 := E1_cvg x). +assert (H := E1_cvg y). +assert (H1 := E1_cvg (x + y)). +eapply UL_sequence. +apply H1. +assert (H2 := CV_mult _ _ _ _ H0 H). +assert (H3 := CV_minus _ _ _ _ H2 (Reste_E_cv x y)). +unfold Un_cv in |- *; unfold Un_cv in H3; intros. +elim (H3 _ H4); intros. +exists (S x0); intros. +rewrite <- (exp_form x y n). +rewrite Rminus_0_r in H5. +apply H5. +unfold ge in |- *; apply le_trans with (S x0). +apply le_n_Sn. +apply H6. +apply lt_le_trans with (S x0). +apply lt_O_Sn. +apply H6. +Qed. + +(**********) +Lemma exp_pos_pos : forall x:R, 0 < x -> 0 < exp x. +intros; set (An := fun N:nat => / INR (fact N) * x ^ N). +cut (Un_cv (fun n:nat => sum_f_R0 An n) (exp x)). +intro; apply Rlt_le_trans with (sum_f_R0 An 0). +unfold An in |- *; simpl in |- *; rewrite Rinv_1; rewrite Rmult_1_r; + apply Rlt_0_1. +apply sum_incr. +assumption. +intro; unfold An in |- *; left; apply Rmult_lt_0_compat. +apply Rinv_0_lt_compat; apply INR_fact_lt_0. +apply (pow_lt _ n H). +unfold exp in |- *; unfold projT1 in |- *; case (exist_exp x); intro. +unfold exp_in in |- *; unfold infinit_sum, Un_cv in |- *; trivial. +Qed. + +(**********) +Lemma exp_pos : forall x:R, 0 < exp x. +intro; case (total_order_T 0 x); intro. +elim s; intro. +apply (exp_pos_pos _ a). +rewrite <- b; rewrite exp_0; apply Rlt_0_1. +replace (exp x) with (1 / exp (- x)). +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +apply Rlt_0_1. +apply Rinv_0_lt_compat; apply exp_pos_pos. +apply (Ropp_0_gt_lt_contravar _ r). +cut (exp (- x) <> 0). +intro; unfold Rdiv in |- *; apply Rmult_eq_reg_l with (exp (- x)). +rewrite Rmult_1_l; rewrite <- Rinv_r_sym. +rewrite <- exp_plus. +rewrite Rplus_opp_l; rewrite exp_0; reflexivity. +apply H. +apply H. +assert (H := exp_plus x (- x)). +rewrite Rplus_opp_r in H; rewrite exp_0 in H. +red in |- *; intro; rewrite H0 in H. +rewrite Rmult_0_r in H. +elim R1_neq_R0; assumption. +Qed. + +(* ((exp h)-1)/h -> 0 quand h->0 *) +Lemma derivable_pt_lim_exp_0 : derivable_pt_lim exp 0 1. +unfold derivable_pt_lim in |- *; intros. +set (fn := fun (N:nat) (x:R) => x ^ N / INR (fact (S N))). +cut (CVN_R fn). +intro; cut (forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)). +intro cv; cut (forall n:nat, continuity (fn n)). +intro; cut (continuity (SFL fn cv)). +intro; unfold continuity in H1. +assert (H2 := H1 0). +unfold continuity_pt in H2; unfold continue_in in H2; unfold limit1_in in H2; + unfold limit_in in H2; simpl in H2; unfold R_dist in H2. +elim (H2 _ H); intros alp H3. +elim H3; intros. +exists (mkposreal _ H4); intros. +rewrite Rplus_0_l; rewrite exp_0. +replace ((exp h - 1) / h) with (SFL fn cv h). +replace 1 with (SFL fn cv 0). +apply H5. +split. +unfold D_x, no_cond in |- *; split. +trivial. +apply (sym_not_eq H6). +rewrite Rminus_0_r; apply H7. +unfold SFL in |- *. +case (cv 0); intros. +eapply UL_sequence. +apply u. +unfold Un_cv, SP in |- *. +intros; exists 1%nat; intros. +unfold R_dist in |- *; rewrite decomp_sum. +rewrite (Rplus_comm (fn 0%nat 0)). +replace (fn 0%nat 0) with 1. +unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_r; + rewrite Rplus_0_r. +replace (sum_f_R0 (fun i:nat => fn (S i) 0) (pred n)) with 0. +rewrite Rabs_R0; apply H8. +symmetry in |- *; apply sum_eq_R0; intros. +unfold fn in |- *. +simpl in |- *. +unfold Rdiv in |- *; do 2 rewrite Rmult_0_l; reflexivity. +unfold fn in |- *; simpl in |- *. +unfold Rdiv in |- *; rewrite Rinv_1; rewrite Rmult_1_r; reflexivity. +apply lt_le_trans with 1%nat; [ apply lt_n_Sn | apply H9 ]. +unfold SFL, exp in |- *. +unfold projT1 in |- *. +case (cv h); case (exist_exp h); intros. +eapply UL_sequence. +apply u. +unfold Un_cv in |- *; intros. +unfold exp_in in e. +unfold infinit_sum in e. +cut (0 < eps0 * Rabs h). +intro; elim (e _ H9); intros N0 H10. +exists N0; intros. +unfold R_dist in |- *. +apply Rmult_lt_reg_l with (Rabs h). +apply Rabs_pos_lt; assumption. +rewrite <- Rabs_mult. +rewrite Rmult_minus_distr_l. +replace (h * ((x - 1) / h)) with (x - 1). +unfold R_dist in H10. +replace (h * SP fn n h - (x - 1)) with + (sum_f_R0 (fun i:nat => / INR (fact i) * h ^ i) (S n) - x). +rewrite (Rmult_comm (Rabs h)). +apply H10. +unfold ge in |- *. +apply le_trans with (S N0). +apply le_n_Sn. +apply le_n_S; apply H11. +rewrite decomp_sum. +replace (/ INR (fact 0) * h ^ 0) with 1. +unfold Rminus in |- *. +rewrite Ropp_plus_distr. +rewrite Ropp_involutive. +rewrite <- (Rplus_comm (- x)). +rewrite <- (Rplus_comm (- x + 1)). +rewrite Rplus_assoc; repeat apply Rplus_eq_compat_l. +replace (pred (S n)) with n; [ idtac | reflexivity ]. +unfold SP in |- *. +rewrite scal_sum. +apply sum_eq; intros. +unfold fn in |- *. +replace (h ^ S i) with (h * h ^ i). +unfold Rdiv in |- *; ring. +simpl in |- *; ring. +simpl in |- *; rewrite Rinv_1; rewrite Rmult_1_r; reflexivity. +apply lt_O_Sn. +unfold Rdiv in |- *. +rewrite <- Rmult_assoc. +symmetry in |- *; apply Rinv_r_simpl_m. +assumption. +apply Rmult_lt_0_compat. +apply H8. +apply Rabs_pos_lt; assumption. +apply SFL_continuity; assumption. +intro; unfold fn in |- *. +replace (fun x:R => x ^ n / INR (fact (S n))) with + (pow_fct n / fct_cte (INR (fact (S n))))%F; [ idtac | reflexivity ]. +apply continuity_div. +apply derivable_continuous; apply (derivable_pow n). +apply derivable_continuous; apply derivable_const. +intro; unfold fct_cte in |- *; apply INR_fact_neq_0. +apply (CVN_R_CVS _ X). +assert (H0 := Alembert_exp). +unfold CVN_R in |- *. +intro; unfold CVN_r in |- *. +apply existT with (fun N:nat => r ^ N / INR (fact (S N))). +cut + (sigT + (fun l:R => + Un_cv + (fun n:nat => + sum_f_R0 (fun k:nat => Rabs (r ^ k / INR (fact (S k)))) n) l)). +intro. +elim X; intros. +exists x; intros. +split. +apply p. +unfold Boule in |- *; intros. +rewrite Rminus_0_r in H1. +unfold fn in |- *. +unfold Rdiv in |- *; rewrite Rabs_mult. +cut (0 < INR (fact (S n))). +intro. +rewrite (Rabs_right (/ INR (fact (S n)))). +do 2 rewrite <- (Rmult_comm (/ INR (fact (S n)))). +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply H2. +rewrite <- RPow_abs. +apply pow_maj_Rabs. +rewrite Rabs_Rabsolu; left; apply H1. +apply Rle_ge; left; apply Rinv_0_lt_compat; apply H2. +apply INR_fact_lt_0. +cut ((r:R) <> 0). +intro; apply Alembert_C2. +intro; apply Rabs_no_R0. +unfold Rdiv in |- *; apply prod_neq_R0. +apply pow_nonzero; assumption. +apply Rinv_neq_0_compat; apply INR_fact_neq_0. +unfold Un_cv in H0. +unfold Un_cv in |- *; intros. +cut (0 < eps0 / r); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; apply (cond_pos r) ] ]. +elim (H0 _ H3); intros N0 H4. +exists N0; intros. +cut (S n >= N0)%nat. +intro hyp_sn. +assert (H6 := H4 _ hyp_sn). +unfold R_dist in H6; rewrite Rminus_0_r in H6. +rewrite Rabs_Rabsolu in H6. +unfold R_dist in |- *; rewrite Rminus_0_r. +rewrite Rabs_Rabsolu. +replace + (Rabs (r ^ S n / INR (fact (S (S n)))) / Rabs (r ^ n / INR (fact (S n)))) + with (r * / INR (fact (S (S n))) * / / INR (fact (S n))). +rewrite Rmult_assoc; rewrite Rabs_mult. +rewrite (Rabs_right r). +apply Rmult_lt_reg_l with (/ r). +apply Rinv_0_lt_compat; apply (cond_pos r). +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; rewrite <- (Rmult_comm eps0). +apply H6. +assumption. +apply Rle_ge; left; apply (cond_pos r). +unfold Rdiv in |- *. +repeat rewrite Rabs_mult. +repeat rewrite Rabs_Rinv. +rewrite Rinv_mult_distr. +repeat rewrite Rabs_right. +rewrite Rinv_involutive. +rewrite (Rmult_comm r). +rewrite (Rmult_comm (r ^ S n)). +repeat rewrite Rmult_assoc. +apply Rmult_eq_compat_l. +rewrite (Rmult_comm r). +rewrite <- Rmult_assoc; rewrite <- (Rmult_comm (INR (fact (S n)))). +apply Rmult_eq_compat_l. +simpl in |- *. +rewrite Rmult_assoc; rewrite <- Rinv_r_sym. +ring. +apply pow_nonzero; assumption. +apply INR_fact_neq_0. +apply Rle_ge; left; apply INR_fact_lt_0. +apply Rle_ge; left; apply pow_lt; apply (cond_pos r). +apply Rle_ge; left; apply INR_fact_lt_0. +apply Rle_ge; left; apply pow_lt; apply (cond_pos r). +apply Rabs_no_R0; apply pow_nonzero; assumption. +apply Rinv_neq_0_compat; apply Rabs_no_R0; apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +unfold ge in |- *; apply le_trans with n. +apply H5. +apply le_n_Sn. +assert (H1 := cond_pos r); red in |- *; intro; rewrite H2 in H1; + elim (Rlt_irrefl _ H1). +Qed. + +(**********) +Lemma derivable_pt_lim_exp : forall x:R, derivable_pt_lim exp x (exp x). +intro; assert (H0 := derivable_pt_lim_exp_0). +unfold derivable_pt_lim in H0; unfold derivable_pt_lim in |- *; intros. +cut (0 < eps / exp x); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply H | apply Rinv_0_lt_compat; apply exp_pos ] ]. +elim (H0 _ H1); intros del H2. +exists del; intros. +assert (H5 := H2 _ H3 H4). +rewrite Rplus_0_l in H5; rewrite exp_0 in H5. +replace ((exp (x + h) - exp x) / h - exp x) with + (exp x * ((exp h - 1) / h - 1)). +rewrite Rabs_mult; rewrite (Rabs_right (exp x)). +apply Rmult_lt_reg_l with (/ exp x). +apply Rinv_0_lt_compat; apply exp_pos. +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; rewrite <- (Rmult_comm eps). +apply H5. +assert (H6 := exp_pos x); red in |- *; intro; rewrite H7 in H6; + elim (Rlt_irrefl _ H6). +apply Rle_ge; left; apply exp_pos. +rewrite Rmult_minus_distr_l. +rewrite Rmult_1_r; unfold Rdiv in |- *; rewrite <- Rmult_assoc; + rewrite Rmult_minus_distr_l. +rewrite Rmult_1_r; rewrite exp_plus; reflexivity. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Integration.v b/theories/Reals/Integration.v new file mode 100644 index 00000000..c3c3d9bb --- /dev/null +++ b/theories/Reals/Integration.v @@ -0,0 +1,13 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Integration.v,v 1.1.6.1 2004/07/16 19:31:10 herbelin Exp $ i*) + +Require Export NewtonInt. +Require Export RiemannInt_SF. +Require Export RiemannInt.
\ No newline at end of file diff --git a/theories/Reals/MVT.v b/theories/Reals/MVT.v new file mode 100644 index 00000000..baa61304 --- /dev/null +++ b/theories/Reals/MVT.v @@ -0,0 +1,699 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: MVT.v,v 1.10.2.1 2004/07/16 19:31:10 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rfunctions. +Require Import Ranalysis1. +Require Import Rtopology. Open Local Scope R_scope. + +(* The Mean Value Theorem *) +Theorem MVT : + forall (f g:R -> R) (a b:R) (pr1:forall c:R, a < c < b -> derivable_pt f c) + (pr2:forall c:R, a < c < b -> derivable_pt g c), + a < b -> + (forall c:R, a <= c <= b -> continuity_pt f c) -> + (forall c:R, a <= c <= b -> continuity_pt g c) -> + exists c : R, + (exists P : a < c < b, + (g b - g a) * derive_pt f c (pr1 c P) = + (f b - f a) * derive_pt g c (pr2 c P)). +intros; assert (H2 := Rlt_le _ _ H). +set (h := fun y:R => (g b - g a) * f y - (f b - f a) * g y). +cut (forall c:R, a < c < b -> derivable_pt h c). +intro; cut (forall c:R, a <= c <= b -> continuity_pt h c). +intro; assert (H4 := continuity_ab_maj h a b H2 H3). +assert (H5 := continuity_ab_min h a b H2 H3). +elim H4; intros Mx H6. +elim H5; intros mx H7. +cut (h a = h b). +intro; set (M := h Mx); set (m := h mx). +cut + (forall (c:R) (P:a < c < b), + derive_pt h c (X c P) = + (g b - g a) * derive_pt f c (pr1 c P) - + (f b - f a) * derive_pt g c (pr2 c P)). +intro; case (Req_dec (h a) M); intro. +case (Req_dec (h a) m); intro. +cut (forall c:R, a <= c <= b -> h c = M). +intro; cut (a < (a + b) / 2 < b). +(*** h constant ***) +intro; exists ((a + b) / 2). +exists H13. +apply Rminus_diag_uniq; rewrite <- H9; apply deriv_constant2 with a b. +elim H13; intros; assumption. +elim H13; intros; assumption. +intros; rewrite (H12 ((a + b) / 2)). +apply H12; split; left; assumption. +elim H13; intros; split; left; assumption. +split. +apply Rmult_lt_reg_l with 2. +prove_sup0. +unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym. +rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; apply H. +discrR. +apply Rmult_lt_reg_l with 2. +prove_sup0. +unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym. +rewrite Rmult_1_l; rewrite Rplus_comm; rewrite double; + apply Rplus_lt_compat_l; apply H. +discrR. +intros; elim H6; intros H13 _. +elim H7; intros H14 _. +apply Rle_antisym. +apply H13; apply H12. +rewrite H10 in H11; rewrite H11; apply H14; apply H12. +cut (a < mx < b). +(*** h admet un minimum global sur [a,b] ***) +intro; exists mx. +exists H12. +apply Rminus_diag_uniq; rewrite <- H9; apply deriv_minimum with a b. +elim H12; intros; assumption. +elim H12; intros; assumption. +intros; elim H7; intros. +apply H15; split; left; assumption. +elim H7; intros _ H12; elim H12; intros; split. +inversion H13. +apply H15. +rewrite H15 in H11; elim H11; reflexivity. +inversion H14. +apply H15. +rewrite H8 in H11; rewrite <- H15 in H11; elim H11; reflexivity. +cut (a < Mx < b). +(*** h admet un maximum global sur [a,b] ***) +intro; exists Mx. +exists H11. +apply Rminus_diag_uniq; rewrite <- H9; apply deriv_maximum with a b. +elim H11; intros; assumption. +elim H11; intros; assumption. +intros; elim H6; intros; apply H14. +split; left; assumption. +elim H6; intros _ H11; elim H11; intros; split. +inversion H12. +apply H14. +rewrite H14 in H10; elim H10; reflexivity. +inversion H13. +apply H14. +rewrite H8 in H10; rewrite <- H14 in H10; elim H10; reflexivity. +intros; unfold h in |- *; + replace + (derive_pt (fun y:R => (g b - g a) * f y - (f b - f a) * g y) c (X c P)) + with + (derive_pt ((fct_cte (g b - g a) * f)%F - (fct_cte (f b - f a) * g)%F) c + (derivable_pt_minus _ _ _ + (derivable_pt_mult _ _ _ (derivable_pt_const (g b - g a) c) (pr1 c P)) + (derivable_pt_mult _ _ _ (derivable_pt_const (f b - f a) c) (pr2 c P)))); + [ idtac | apply pr_nu ]. +rewrite derive_pt_minus; do 2 rewrite derive_pt_mult; + do 2 rewrite derive_pt_const; do 2 rewrite Rmult_0_l; + do 2 rewrite Rplus_0_l; reflexivity. +unfold h in |- *; ring. +intros; unfold h in |- *; + change + (continuity_pt ((fct_cte (g b - g a) * f)%F - (fct_cte (f b - f a) * g)%F) + c) in |- *. +apply continuity_pt_minus; apply continuity_pt_mult. +apply derivable_continuous_pt; apply derivable_const. +apply H0; apply H3. +apply derivable_continuous_pt; apply derivable_const. +apply H1; apply H3. +intros; + change + (derivable_pt ((fct_cte (g b - g a) * f)%F - (fct_cte (f b - f a) * g)%F) + c) in |- *. +apply derivable_pt_minus; apply derivable_pt_mult. +apply derivable_pt_const. +apply (pr1 _ H3). +apply derivable_pt_const. +apply (pr2 _ H3). +Qed. + +(* Corollaries ... *) +Lemma MVT_cor1 : + forall (f:R -> R) (a b:R) (pr:derivable f), + a < b -> + exists c : R, f b - f a = derive_pt f c (pr c) * (b - a) /\ a < c < b. +intros f a b pr H; cut (forall c:R, a < c < b -> derivable_pt f c); + [ intro | intros; apply pr ]. +cut (forall c:R, a < c < b -> derivable_pt id c); + [ intro | intros; apply derivable_pt_id ]. +cut (forall c:R, a <= c <= b -> continuity_pt f c); + [ intro | intros; apply derivable_continuous_pt; apply pr ]. +cut (forall c:R, a <= c <= b -> continuity_pt id c); + [ intro | intros; apply derivable_continuous_pt; apply derivable_id ]. +assert (H2 := MVT f id a b X X0 H H0 H1). +elim H2; intros c H3; elim H3; intros. +exists c; split. +cut (derive_pt id c (X0 c x) = derive_pt id c (derivable_pt_id c)); + [ intro | apply pr_nu ]. +rewrite H5 in H4; rewrite (derive_pt_id c) in H4; rewrite Rmult_1_r in H4; + rewrite <- H4; replace (derive_pt f c (X c x)) with (derive_pt f c (pr c)); + [ idtac | apply pr_nu ]; apply Rmult_comm. +apply x. +Qed. + +Theorem MVT_cor2 : + forall (f f':R -> R) (a b:R), + a < b -> + (forall c:R, a <= c <= b -> derivable_pt_lim f c (f' c)) -> + exists c : R, f b - f a = f' c * (b - a) /\ a < c < b. +intros f f' a b H H0; cut (forall c:R, a <= c <= b -> derivable_pt f c). +intro; cut (forall c:R, a < c < b -> derivable_pt f c). +intro; cut (forall c:R, a <= c <= b -> continuity_pt f c). +intro; cut (forall c:R, a <= c <= b -> derivable_pt id c). +intro; cut (forall c:R, a < c < b -> derivable_pt id c). +intro; cut (forall c:R, a <= c <= b -> continuity_pt id c). +intro; elim (MVT f id a b X0 X2 H H1 H2); intros; elim H3; clear H3; intros; + exists x; split. +cut (derive_pt id x (X2 x x0) = 1). +cut (derive_pt f x (X0 x x0) = f' x). +intros; rewrite H4 in H3; rewrite H5 in H3; unfold id in H3; + rewrite Rmult_1_r in H3; rewrite Rmult_comm; symmetry in |- *; + assumption. +apply derive_pt_eq_0; apply H0; elim x0; intros; split; left; assumption. +apply derive_pt_eq_0; apply derivable_pt_lim_id. +assumption. +intros; apply derivable_continuous_pt; apply X1; assumption. +intros; apply derivable_pt_id. +intros; apply derivable_pt_id. +intros; apply derivable_continuous_pt; apply X; assumption. +intros; elim H1; intros; apply X; split; left; assumption. +intros; unfold derivable_pt in |- *; apply existT with (f' c); apply H0; + apply H1. +Qed. + +Lemma MVT_cor3 : + forall (f f':R -> R) (a b:R), + a < b -> + (forall x:R, a <= x -> x <= b -> derivable_pt_lim f x (f' x)) -> + exists c : R, a <= c /\ c <= b /\ f b = f a + f' c * (b - a). +intros f f' a b H H0; + assert (H1 : exists c : R, f b - f a = f' c * (b - a) /\ a < c < b); + [ apply MVT_cor2; [ apply H | intros; elim H1; intros; apply (H0 _ H2 H3) ] + | elim H1; intros; exists x; elim H2; intros; elim H4; intros; split; + [ left; assumption | split; [ left; assumption | rewrite <- H3; ring ] ] ]. +Qed. + +Lemma Rolle : + forall (f:R -> R) (a b:R) (pr:forall x:R, a < x < b -> derivable_pt f x), + (forall x:R, a <= x <= b -> continuity_pt f x) -> + a < b -> + f a = f b -> + exists c : R, (exists P : a < c < b, derive_pt f c (pr c P) = 0). +intros; assert (H2 : forall x:R, a < x < b -> derivable_pt id x). +intros; apply derivable_pt_id. +assert (H3 := MVT f id a b pr H2 H0 H); + assert (H4 : forall x:R, a <= x <= b -> continuity_pt id x). +intros; apply derivable_continuous; apply derivable_id. +elim (H3 H4); intros; elim H5; intros; exists x; exists x0; rewrite H1 in H6; + unfold id in H6; unfold Rminus in H6; rewrite Rplus_opp_r in H6; + rewrite Rmult_0_l in H6; apply Rmult_eq_reg_l with (b - a); + [ rewrite Rmult_0_r; apply H6 + | apply Rminus_eq_contra; red in |- *; intro; rewrite H7 in H0; + elim (Rlt_irrefl _ H0) ]. +Qed. + +(**********) +Lemma nonneg_derivative_1 : + forall (f:R -> R) (pr:derivable f), + (forall x:R, 0 <= derive_pt f x (pr x)) -> increasing f. +intros. +unfold increasing in |- *. +intros. +case (total_order_T x y); intro. +elim s; intro. +apply Rplus_le_reg_l with (- f x). +rewrite Rplus_opp_l; rewrite Rplus_comm. +assert (H1 := MVT_cor1 f _ _ pr a). +elim H1; intros. +elim H2; intros. +unfold Rminus in H3. +rewrite H3. +apply Rmult_le_pos. +apply H. +apply Rplus_le_reg_l with x. +rewrite Rplus_0_r; replace (x + (y + - x)) with y; [ assumption | ring ]. +rewrite b; right; reflexivity. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 r)). +Qed. + +(**********) +Lemma nonpos_derivative_0 : + forall (f:R -> R) (pr:derivable f), + decreasing f -> forall x:R, derive_pt f x (pr x) <= 0. +intros f pr H x; assert (H0 := H); unfold decreasing in H0; + generalize (derivable_derive f x (pr x)); intro; elim H1; + intros l H2. +rewrite H2; case (Rtotal_order l 0); intro. +left; assumption. +elim H3; intro. +right; assumption. +generalize (derive_pt_eq_1 f x l (pr x) H2); intros; cut (0 < l / 2). +intro; elim (H5 (l / 2) H6); intros delta H7; + cut (delta / 2 <> 0 /\ 0 < delta / 2 /\ Rabs (delta / 2) < delta). +intro; decompose [and] H8; intros; generalize (H7 (delta / 2) H9 H12); + cut ((f (x + delta / 2) - f x) / (delta / 2) <= 0). +intro; cut (0 < - ((f (x + delta / 2) - f x) / (delta / 2) - l)). +intro; unfold Rabs in |- *; + case (Rcase_abs ((f (x + delta / 2) - f x) / (delta / 2) - l)). +intros; + generalize + (Rplus_lt_compat_r (- l) (- ((f (x + delta / 2) - f x) / (delta / 2) - l)) + (l / 2) H14); unfold Rminus in |- *. +replace (l / 2 + - l) with (- (l / 2)). +replace (- ((f (x + delta / 2) + - f x) / (delta / 2) + - l) + - l) with + (- ((f (x + delta / 2) + - f x) / (delta / 2))). +intro. +generalize + (Ropp_lt_gt_contravar (- ((f (x + delta / 2) + - f x) / (delta / 2))) + (- (l / 2)) H15). +repeat rewrite Ropp_involutive. +intro. +generalize + (Rlt_trans 0 (l / 2) ((f (x + delta / 2) - f x) / (delta / 2)) H6 H16); + intro. +elim + (Rlt_irrefl 0 + (Rlt_le_trans 0 ((f (x + delta / 2) - f x) / (delta / 2)) 0 H17 H10)). +ring. +pattern l at 3 in |- *; rewrite double_var. +ring. +intros. +generalize + (Ropp_ge_le_contravar ((f (x + delta / 2) - f x) / (delta / 2) - l) 0 r). +rewrite Ropp_0. +intro. +elim + (Rlt_irrefl 0 + (Rlt_le_trans 0 (- ((f (x + delta / 2) - f x) / (delta / 2) - l)) 0 H13 + H15)). +replace (- ((f (x + delta / 2) - f x) / (delta / 2) - l)) with + ((f x - f (x + delta / 2)) / (delta / 2) + l). +unfold Rminus in |- *. +apply Rplus_le_lt_0_compat. +unfold Rdiv in |- *; apply Rmult_le_pos. +cut (x <= x + delta * / 2). +intro; generalize (H0 x (x + delta * / 2) H13); intro; + generalize + (Rplus_le_compat_l (- f (x + delta / 2)) (f (x + delta / 2)) (f x) H14); + rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption. +pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l; + left; assumption. +left; apply Rinv_0_lt_compat; assumption. +assumption. +rewrite Ropp_minus_distr. +unfold Rminus in |- *. +rewrite (Rplus_comm l). +unfold Rdiv in |- *. +rewrite <- Ropp_mult_distr_l_reverse. +rewrite Ropp_plus_distr. +rewrite Ropp_involutive. +rewrite (Rplus_comm (f x)). +reflexivity. +replace ((f (x + delta / 2) - f x) / (delta / 2)) with + (- ((f x - f (x + delta / 2)) / (delta / 2))). +rewrite <- Ropp_0. +apply Ropp_ge_le_contravar. +apply Rle_ge. +unfold Rdiv in |- *; apply Rmult_le_pos. +cut (x <= x + delta * / 2). +intro; generalize (H0 x (x + delta * / 2) H10); intro. +generalize + (Rplus_le_compat_l (- f (x + delta / 2)) (f (x + delta / 2)) (f x) H13); + rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption. +pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l; + left; assumption. +left; apply Rinv_0_lt_compat; assumption. +unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse. +rewrite Ropp_minus_distr. +reflexivity. +split. +unfold Rdiv in |- *; apply prod_neq_R0. +generalize (cond_pos delta); intro; red in |- *; intro H9; rewrite H9 in H8; + elim (Rlt_irrefl 0 H8). +apply Rinv_neq_0_compat; discrR. +split. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ]. +rewrite Rabs_right. +unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2. +prove_sup0. +rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. +rewrite Rmult_1_l; rewrite double; pattern (pos delta) at 1 in |- *; + rewrite <- Rplus_0_r. +apply Rplus_lt_compat_l; apply (cond_pos delta). +discrR. +apply Rle_ge; unfold Rdiv in |- *; left; apply Rmult_lt_0_compat. +apply (cond_pos delta). +apply Rinv_0_lt_compat; prove_sup0. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply H4 | apply Rinv_0_lt_compat; prove_sup0 ]. +Qed. + +(**********) +Lemma increasing_decreasing_opp : + forall f:R -> R, increasing f -> decreasing (- f)%F. +unfold increasing, decreasing, opp_fct in |- *; intros; generalize (H x y H0); + intro; apply Ropp_ge_le_contravar; apply Rle_ge; assumption. +Qed. + +(**********) +Lemma nonpos_derivative_1 : + forall (f:R -> R) (pr:derivable f), + (forall x:R, derive_pt f x (pr x) <= 0) -> decreasing f. +intros. +cut (forall h:R, - - f h = f h). +intro. +generalize (increasing_decreasing_opp (- f)%F). +unfold decreasing in |- *. +unfold opp_fct in |- *. +intros. +rewrite <- (H0 x); rewrite <- (H0 y). +apply H1. +cut (forall x:R, 0 <= derive_pt (- f) x (derivable_opp f pr x)). +intros. +replace (fun x:R => - f x) with (- f)%F; [ idtac | reflexivity ]. +apply (nonneg_derivative_1 (- f)%F (derivable_opp f pr) H3). +intro. +assert (H3 := derive_pt_opp f x0 (pr x0)). +cut + (derive_pt (- f) x0 (derivable_pt_opp f x0 (pr x0)) = + derive_pt (- f) x0 (derivable_opp f pr x0)). +intro. +rewrite <- H4. +rewrite H3. +rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; apply (H x0). +apply pr_nu. +assumption. +intro; ring. +Qed. + +(**********) +Lemma positive_derivative : + forall (f:R -> R) (pr:derivable f), + (forall x:R, 0 < derive_pt f x (pr x)) -> strict_increasing f. +intros. +unfold strict_increasing in |- *. +intros. +apply Rplus_lt_reg_r with (- f x). +rewrite Rplus_opp_l; rewrite Rplus_comm. +assert (H1 := MVT_cor1 f _ _ pr H0). +elim H1; intros. +elim H2; intros. +unfold Rminus in H3. +rewrite H3. +apply Rmult_lt_0_compat. +apply H. +apply Rplus_lt_reg_r with x. +rewrite Rplus_0_r; replace (x + (y + - x)) with y; [ assumption | ring ]. +Qed. + +(**********) +Lemma strictincreasing_strictdecreasing_opp : + forall f:R -> R, strict_increasing f -> strict_decreasing (- f)%F. +unfold strict_increasing, strict_decreasing, opp_fct in |- *; intros; + generalize (H x y H0); intro; apply Ropp_lt_gt_contravar; + assumption. +Qed. + +(**********) +Lemma negative_derivative : + forall (f:R -> R) (pr:derivable f), + (forall x:R, derive_pt f x (pr x) < 0) -> strict_decreasing f. +intros. +cut (forall h:R, - - f h = f h). +intros. +generalize (strictincreasing_strictdecreasing_opp (- f)%F). +unfold strict_decreasing, opp_fct in |- *. +intros. +rewrite <- (H0 x). +rewrite <- (H0 y). +apply H1; [ idtac | assumption ]. +cut (forall x:R, 0 < derive_pt (- f) x (derivable_opp f pr x)). +intros; eapply positive_derivative; apply H3. +intro. +assert (H3 := derive_pt_opp f x0 (pr x0)). +cut + (derive_pt (- f) x0 (derivable_pt_opp f x0 (pr x0)) = + derive_pt (- f) x0 (derivable_opp f pr x0)). +intro. +rewrite <- H4; rewrite H3. +rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; apply (H x0). +apply pr_nu. +intro; ring. +Qed. + +(**********) +Lemma null_derivative_0 : + forall (f:R -> R) (pr:derivable f), + constant f -> forall x:R, derive_pt f x (pr x) = 0. +intros. +unfold constant in H. +apply derive_pt_eq_0. +intros; exists (mkposreal 1 Rlt_0_1); simpl in |- *; intros. +rewrite (H x (x + h)); unfold Rminus in |- *; unfold Rdiv in |- *; + rewrite Rplus_opp_r; rewrite Rmult_0_l; rewrite Rplus_opp_r; + rewrite Rabs_R0; assumption. +Qed. + +(**********) +Lemma increasing_decreasing : + forall f:R -> R, increasing f -> decreasing f -> constant f. +unfold increasing, decreasing, constant in |- *; intros; + case (Rtotal_order x y); intro. +generalize (Rlt_le x y H1); intro; + apply (Rle_antisym (f x) (f y) (H x y H2) (H0 x y H2)). +elim H1; intro. +rewrite H2; reflexivity. +generalize (Rlt_le y x H2); intro; symmetry in |- *; + apply (Rle_antisym (f y) (f x) (H y x H3) (H0 y x H3)). +Qed. + +(**********) +Lemma null_derivative_1 : + forall (f:R -> R) (pr:derivable f), + (forall x:R, derive_pt f x (pr x) = 0) -> constant f. +intros. +cut (forall x:R, derive_pt f x (pr x) <= 0). +cut (forall x:R, 0 <= derive_pt f x (pr x)). +intros. +assert (H2 := nonneg_derivative_1 f pr H0). +assert (H3 := nonpos_derivative_1 f pr H1). +apply increasing_decreasing; assumption. +intro; right; symmetry in |- *; apply (H x). +intro; right; apply (H x). +Qed. + +(**********) +Lemma derive_increasing_interv_ax : + forall (a b:R) (f:R -> R) (pr:derivable f), + a < b -> + ((forall t:R, a < t < b -> 0 < derive_pt f t (pr t)) -> + forall x y:R, a <= x <= b -> a <= y <= b -> x < y -> f x < f y) /\ + ((forall t:R, a < t < b -> 0 <= derive_pt f t (pr t)) -> + forall x y:R, a <= x <= b -> a <= y <= b -> x < y -> f x <= f y). +intros. +split; intros. +apply Rplus_lt_reg_r with (- f x). +rewrite Rplus_opp_l; rewrite Rplus_comm. +assert (H4 := MVT_cor1 f _ _ pr H3). +elim H4; intros. +elim H5; intros. +unfold Rminus in H6. +rewrite H6. +apply Rmult_lt_0_compat. +apply H0. +elim H7; intros. +split. +elim H1; intros. +apply Rle_lt_trans with x; assumption. +elim H2; intros. +apply Rlt_le_trans with y; assumption. +apply Rplus_lt_reg_r with x. +rewrite Rplus_0_r; replace (x + (y + - x)) with y; [ assumption | ring ]. +apply Rplus_le_reg_l with (- f x). +rewrite Rplus_opp_l; rewrite Rplus_comm. +assert (H4 := MVT_cor1 f _ _ pr H3). +elim H4; intros. +elim H5; intros. +unfold Rminus in H6. +rewrite H6. +apply Rmult_le_pos. +apply H0. +elim H7; intros. +split. +elim H1; intros. +apply Rle_lt_trans with x; assumption. +elim H2; intros. +apply Rlt_le_trans with y; assumption. +apply Rplus_le_reg_l with x. +rewrite Rplus_0_r; replace (x + (y + - x)) with y; + [ left; assumption | ring ]. +Qed. + +(**********) +Lemma derive_increasing_interv : + forall (a b:R) (f:R -> R) (pr:derivable f), + a < b -> + (forall t:R, a < t < b -> 0 < derive_pt f t (pr t)) -> + forall x y:R, a <= x <= b -> a <= y <= b -> x < y -> f x < f y. +intros. +generalize (derive_increasing_interv_ax a b f pr H); intro. +elim H4; intros H5 _; apply (H5 H0 x y H1 H2 H3). +Qed. + +(**********) +Lemma derive_increasing_interv_var : + forall (a b:R) (f:R -> R) (pr:derivable f), + a < b -> + (forall t:R, a < t < b -> 0 <= derive_pt f t (pr t)) -> + forall x y:R, a <= x <= b -> a <= y <= b -> x < y -> f x <= f y. +intros a b f pr H H0 x y H1 H2 H3; + generalize (derive_increasing_interv_ax a b f pr H); + intro; elim H4; intros _ H5; apply (H5 H0 x y H1 H2 H3). +Qed. + +(**********) +(**********) +Theorem IAF : + forall (f:R -> R) (a b k:R) (pr:derivable f), + a <= b -> + (forall c:R, a <= c <= b -> derive_pt f c (pr c) <= k) -> + f b - f a <= k * (b - a). +intros. +case (total_order_T a b); intro. +elim s; intro. +assert (H1 := MVT_cor1 f _ _ pr a0). +elim H1; intros. +elim H2; intros. +rewrite H3. +do 2 rewrite <- (Rmult_comm (b - a)). +apply Rmult_le_compat_l. +apply Rplus_le_reg_l with a; rewrite Rplus_0_r. +replace (a + (b - a)) with b; [ assumption | ring ]. +apply H0. +elim H4; intros. +split; left; assumption. +rewrite b0. +unfold Rminus in |- *; do 2 rewrite Rplus_opp_r. +rewrite Rmult_0_r; right; reflexivity. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). +Qed. + +Lemma IAF_var : + forall (f g:R -> R) (a b:R) (pr1:derivable f) (pr2:derivable g), + a <= b -> + (forall c:R, a <= c <= b -> derive_pt g c (pr2 c) <= derive_pt f c (pr1 c)) -> + g b - g a <= f b - f a. +intros. +cut (derivable (g - f)). +intro. +cut (forall c:R, a <= c <= b -> derive_pt (g - f) c (X c) <= 0). +intro. +assert (H2 := IAF (g - f)%F a b 0 X H H1). +rewrite Rmult_0_l in H2; unfold minus_fct in H2. +apply Rplus_le_reg_l with (- f b + f a). +replace (- f b + f a + (f b - f a)) with 0; [ idtac | ring ]. +replace (- f b + f a + (g b - g a)) with (g b - f b - (g a - f a)); + [ apply H2 | ring ]. +intros. +cut + (derive_pt (g - f) c (X c) = + derive_pt (g - f) c (derivable_pt_minus _ _ _ (pr2 c) (pr1 c))). +intro. +rewrite H2. +rewrite derive_pt_minus. +apply Rplus_le_reg_l with (derive_pt f c (pr1 c)). +rewrite Rplus_0_r. +replace + (derive_pt f c (pr1 c) + (derive_pt g c (pr2 c) - derive_pt f c (pr1 c))) + with (derive_pt g c (pr2 c)); [ idtac | ring ]. +apply H0; assumption. +apply pr_nu. +apply derivable_minus; assumption. +Qed. + +(* If f has a null derivative in ]a,b[ and is continue in [a,b], *) +(* then f is constant on [a,b] *) +Lemma null_derivative_loc : + forall (f:R -> R) (a b:R) (pr:forall x:R, a < x < b -> derivable_pt f x), + (forall x:R, a <= x <= b -> continuity_pt f x) -> + (forall (x:R) (P:a < x < b), derive_pt f x (pr x P) = 0) -> + constant_D_eq f (fun x:R => a <= x <= b) (f a). +intros; unfold constant_D_eq in |- *; intros; case (total_order_T a b); intro. +elim s; intro. +assert (H2 : forall y:R, a < y < x -> derivable_pt id y). +intros; apply derivable_pt_id. +assert (H3 : forall y:R, a <= y <= x -> continuity_pt id y). +intros; apply derivable_continuous; apply derivable_id. +assert (H4 : forall y:R, a < y < x -> derivable_pt f y). +intros; apply pr; elim H4; intros; split. +assumption. +elim H1; intros; apply Rlt_le_trans with x; assumption. +assert (H5 : forall y:R, a <= y <= x -> continuity_pt f y). +intros; apply H; elim H5; intros; split. +assumption. +elim H1; intros; apply Rle_trans with x; assumption. +elim H1; clear H1; intros; elim H1; clear H1; intro. +assert (H7 := MVT f id a x H4 H2 H1 H5 H3). +elim H7; intros; elim H8; intros; assert (H10 : a < x0 < b). +elim x1; intros; split. +assumption. +apply Rlt_le_trans with x; assumption. +assert (H11 : derive_pt f x0 (H4 x0 x1) = 0). +replace (derive_pt f x0 (H4 x0 x1)) with (derive_pt f x0 (pr x0 H10)); + [ apply H0 | apply pr_nu ]. +assert (H12 : derive_pt id x0 (H2 x0 x1) = 1). +apply derive_pt_eq_0; apply derivable_pt_lim_id. +rewrite H11 in H9; rewrite H12 in H9; rewrite Rmult_0_r in H9; + rewrite Rmult_1_r in H9; apply Rminus_diag_uniq; symmetry in |- *; + assumption. +rewrite H1; reflexivity. +assert (H2 : x = a). +rewrite <- b0 in H1; elim H1; intros; apply Rle_antisym; assumption. +rewrite H2; reflexivity. +elim H1; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (Rle_trans _ _ _ H2 H3) r)). +Qed. + +(* Unicity of the antiderivative *) +Lemma antiderivative_Ucte : + forall (f g1 g2:R -> R) (a b:R), + antiderivative f g1 a b -> + antiderivative f g2 a b -> + exists c : R, (forall x:R, a <= x <= b -> g1 x = g2 x + c). +unfold antiderivative in |- *; intros; elim H; clear H; intros; elim H0; + clear H0; intros H0 _; exists (g1 a - g2 a); intros; + assert (H3 : forall x:R, a <= x <= b -> derivable_pt g1 x). +intros; unfold derivable_pt in |- *; apply existT with (f x0); elim (H x0 H3); + intros; eapply derive_pt_eq_1; symmetry in |- *; + apply H4. +assert (H4 : forall x:R, a <= x <= b -> derivable_pt g2 x). +intros; unfold derivable_pt in |- *; apply existT with (f x0); + elim (H0 x0 H4); intros; eapply derive_pt_eq_1; symmetry in |- *; + apply H5. +assert (H5 : forall x:R, a < x < b -> derivable_pt (g1 - g2) x). +intros; elim H5; intros; apply derivable_pt_minus; + [ apply H3; split; left; assumption | apply H4; split; left; assumption ]. +assert (H6 : forall x:R, a <= x <= b -> continuity_pt (g1 - g2) x). +intros; apply derivable_continuous_pt; apply derivable_pt_minus; + [ apply H3 | apply H4 ]; assumption. +assert (H7 : forall (x:R) (P:a < x < b), derive_pt (g1 - g2) x (H5 x P) = 0). +intros; elim P; intros; apply derive_pt_eq_0; replace 0 with (f x0 - f x0); + [ idtac | ring ]. +assert (H9 : a <= x0 <= b). +split; left; assumption. +apply derivable_pt_lim_minus; [ elim (H _ H9) | elim (H0 _ H9) ]; intros; + eapply derive_pt_eq_1; symmetry in |- *; apply H10. +assert (H8 := null_derivative_loc (g1 - g2)%F a b H5 H6 H7); + unfold constant_D_eq in H8; assert (H9 := H8 _ H2); + unfold minus_fct in H9; rewrite <- H9; ring. +Qed. diff --git a/theories/Reals/NewtonInt.v b/theories/Reals/NewtonInt.v new file mode 100644 index 00000000..97cd4b94 --- /dev/null +++ b/theories/Reals/NewtonInt.v @@ -0,0 +1,788 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: NewtonInt.v,v 1.11.2.1 2004/07/16 19:31:10 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rfunctions. +Require Import SeqSeries. +Require Import Rtrigo. +Require Import Ranalysis. Open Local Scope R_scope. + +(*******************************************) +(* Newton's Integral *) +(*******************************************) + +Definition Newton_integrable (f:R -> R) (a b:R) : Type := + sigT (fun g:R -> R => antiderivative f g a b \/ antiderivative f g b a). + +Definition NewtonInt (f:R -> R) (a b:R) (pr:Newton_integrable f a b) : R := + let g := match pr with + | existT a b => a + end in g b - g a. + +(* If f is differentiable, then f' is Newton integrable (Tautology ?) *) +Lemma FTCN_step1 : + forall (f:Differential) (a b:R), + Newton_integrable (fun x:R => derive_pt f x (cond_diff f x)) a b. +intros f a b; unfold Newton_integrable in |- *; apply existT with (d1 f); + unfold antiderivative in |- *; intros; case (Rle_dec a b); + intro; + [ left; split; [ intros; exists (cond_diff f x); reflexivity | assumption ] + | right; split; + [ intros; exists (cond_diff f x); reflexivity | auto with real ] ]. +Defined. + +(* By definition, we have the Fondamental Theorem of Calculus *) +Lemma FTC_Newton : + forall (f:Differential) (a b:R), + NewtonInt (fun x:R => derive_pt f x (cond_diff f x)) a b + (FTCN_step1 f a b) = f b - f a. +intros; unfold NewtonInt in |- *; reflexivity. +Qed. + +(* $\int_a^a f$ exists forall a:R and f:R->R *) +Lemma NewtonInt_P1 : forall (f:R -> R) (a:R), Newton_integrable f a a. +intros f a; unfold Newton_integrable in |- *; + apply existT with (fct_cte (f a) * id)%F; left; + unfold antiderivative in |- *; split. +intros; assert (H1 : derivable_pt (fct_cte (f a) * id) x). +apply derivable_pt_mult. +apply derivable_pt_const. +apply derivable_pt_id. +exists H1; assert (H2 : x = a). +elim H; intros; apply Rle_antisym; assumption. +symmetry in |- *; apply derive_pt_eq_0; + replace (f x) with (0 * id x + fct_cte (f a) x * 1); + [ apply (derivable_pt_lim_mult (fct_cte (f a)) id x); + [ apply derivable_pt_lim_const | apply derivable_pt_lim_id ] + | unfold id, fct_cte in |- *; rewrite H2; ring ]. +right; reflexivity. +Defined. + +(* $\int_a^a f = 0$ *) +Lemma NewtonInt_P2 : + forall (f:R -> R) (a:R), NewtonInt f a a (NewtonInt_P1 f a) = 0. +intros; unfold NewtonInt in |- *; simpl in |- *; + unfold mult_fct, fct_cte, id in |- *; ring. +Qed. + +(* If $\int_a^b f$ exists, then $\int_b^a f$ exists too *) +Lemma NewtonInt_P3 : + forall (f:R -> R) (a b:R) (X:Newton_integrable f a b), + Newton_integrable f b a. +unfold Newton_integrable in |- *; intros; elim X; intros g H; + apply existT with g; tauto. +Defined. + +(* $\int_a^b f = -\int_b^a f$ *) +Lemma NewtonInt_P4 : + forall (f:R -> R) (a b:R) (pr:Newton_integrable f a b), + NewtonInt f a b pr = - NewtonInt f b a (NewtonInt_P3 f a b pr). +intros; unfold Newton_integrable in pr; elim pr; intros; elim p; intro. +unfold NewtonInt in |- *; + case + (NewtonInt_P3 f a b + (existT + (fun g:R -> R => antiderivative f g a b \/ antiderivative f g b a) x + p)). +intros; elim o; intro. +unfold antiderivative in H0; elim H0; intros; elim H2; intro. +unfold antiderivative in H; elim H; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H5 H3)). +rewrite H3; ring. +assert (H1 := antiderivative_Ucte f x x0 a b H H0); elim H1; intros; + unfold antiderivative in H0; elim H0; clear H0; intros _ H0. +assert (H3 : a <= a <= b). +split; [ right; reflexivity | assumption ]. +assert (H4 : a <= b <= b). +split; [ assumption | right; reflexivity ]. +assert (H5 := H2 _ H3); assert (H6 := H2 _ H4); rewrite H5; rewrite H6; ring. +unfold NewtonInt in |- *; + case + (NewtonInt_P3 f a b + (existT + (fun g:R -> R => antiderivative f g a b \/ antiderivative f g b a) x + p)); intros; elim o; intro. +assert (H1 := antiderivative_Ucte f x x0 b a H H0); elim H1; intros; + unfold antiderivative in H0; elim H0; clear H0; intros _ H0. +assert (H3 : b <= a <= a). +split; [ assumption | right; reflexivity ]. +assert (H4 : b <= b <= a). +split; [ right; reflexivity | assumption ]. +assert (H5 := H2 _ H3); assert (H6 := H2 _ H4); rewrite H5; rewrite H6; ring. +unfold antiderivative in H0; elim H0; intros; elim H2; intro. +unfold antiderivative in H; elim H; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H5 H3)). +rewrite H3; ring. +Qed. + +(* The set of Newton integrable functions is a vectorial space *) +Lemma NewtonInt_P5 : + forall (f g:R -> R) (l a b:R), + Newton_integrable f a b -> + Newton_integrable g a b -> + Newton_integrable (fun x:R => l * f x + g x) a b. +unfold Newton_integrable in |- *; intros; elim X; intros; elim X0; intros; + exists (fun y:R => l * x y + x0 y). +elim p; intro. +elim p0; intro. +left; unfold antiderivative in |- *; unfold antiderivative in H, H0; elim H; + clear H; intros; elim H0; clear H0; intros H0 _. +split. +intros; elim (H _ H2); elim (H0 _ H2); intros. +assert (H5 : derivable_pt (fun y:R => l * x y + x0 y) x1). +reg. +exists H5; symmetry in |- *; reg; rewrite <- H3; rewrite <- H4; reflexivity. +assumption. +unfold antiderivative in H, H0; elim H; elim H0; intros; elim H4; intro. +elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H5 H2)). +left; rewrite <- H5; unfold antiderivative in |- *; split. +intros; elim H6; intros; assert (H9 : x1 = a). +apply Rle_antisym; assumption. +assert (H10 : a <= x1 <= b). +split; right; [ symmetry in |- *; assumption | rewrite <- H5; assumption ]. +assert (H11 : b <= x1 <= a). +split; right; [ rewrite <- H5; symmetry in |- *; assumption | assumption ]. +assert (H12 : derivable_pt x x1). +unfold derivable_pt in |- *; exists (f x1); elim (H3 _ H10); intros; + eapply derive_pt_eq_1; symmetry in |- *; apply H12. +assert (H13 : derivable_pt x0 x1). +unfold derivable_pt in |- *; exists (g x1); elim (H1 _ H11); intros; + eapply derive_pt_eq_1; symmetry in |- *; apply H13. +assert (H14 : derivable_pt (fun y:R => l * x y + x0 y) x1). +reg. +exists H14; symmetry in |- *; reg. +assert (H15 : derive_pt x0 x1 H13 = g x1). +elim (H1 _ H11); intros; rewrite H15; apply pr_nu. +assert (H16 : derive_pt x x1 H12 = f x1). +elim (H3 _ H10); intros; rewrite H16; apply pr_nu. +rewrite H15; rewrite H16; ring. +right; reflexivity. +elim p0; intro. +unfold antiderivative in H, H0; elim H; elim H0; intros; elim H4; intro. +elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H5 H2)). +left; rewrite H5; unfold antiderivative in |- *; split. +intros; elim H6; intros; assert (H9 : x1 = a). +apply Rle_antisym; assumption. +assert (H10 : a <= x1 <= b). +split; right; [ symmetry in |- *; assumption | rewrite H5; assumption ]. +assert (H11 : b <= x1 <= a). +split; right; [ rewrite H5; symmetry in |- *; assumption | assumption ]. +assert (H12 : derivable_pt x x1). +unfold derivable_pt in |- *; exists (f x1); elim (H3 _ H11); intros; + eapply derive_pt_eq_1; symmetry in |- *; apply H12. +assert (H13 : derivable_pt x0 x1). +unfold derivable_pt in |- *; exists (g x1); elim (H1 _ H10); intros; + eapply derive_pt_eq_1; symmetry in |- *; apply H13. +assert (H14 : derivable_pt (fun y:R => l * x y + x0 y) x1). +reg. +exists H14; symmetry in |- *; reg. +assert (H15 : derive_pt x0 x1 H13 = g x1). +elim (H1 _ H10); intros; rewrite H15; apply pr_nu. +assert (H16 : derive_pt x x1 H12 = f x1). +elim (H3 _ H11); intros; rewrite H16; apply pr_nu. +rewrite H15; rewrite H16; ring. +right; reflexivity. +right; unfold antiderivative in |- *; unfold antiderivative in H, H0; elim H; + clear H; intros; elim H0; clear H0; intros H0 _; split. +intros; elim (H _ H2); elim (H0 _ H2); intros. +assert (H5 : derivable_pt (fun y:R => l * x y + x0 y) x1). +reg. +exists H5; symmetry in |- *; reg; rewrite <- H3; rewrite <- H4; reflexivity. +assumption. +Defined. + +(**********) +Lemma antiderivative_P1 : + forall (f g F G:R -> R) (l a b:R), + antiderivative f F a b -> + antiderivative g G a b -> + antiderivative (fun x:R => l * f x + g x) (fun x:R => l * F x + G x) a b. +unfold antiderivative in |- *; intros; elim H; elim H0; clear H H0; intros; + split. +intros; elim (H _ H3); elim (H1 _ H3); intros. +assert (H6 : derivable_pt (fun x:R => l * F x + G x) x). +reg. +exists H6; symmetry in |- *; reg; rewrite <- H4; rewrite <- H5; ring. +assumption. +Qed. + +(* $\int_a^b \lambda f + g = \lambda \int_a^b f + \int_a^b f *) +Lemma NewtonInt_P6 : + forall (f g:R -> R) (l a b:R) (pr1:Newton_integrable f a b) + (pr2:Newton_integrable g a b), + NewtonInt (fun x:R => l * f x + g x) a b (NewtonInt_P5 f g l a b pr1 pr2) = + l * NewtonInt f a b pr1 + NewtonInt g a b pr2. +intros f g l a b pr1 pr2; unfold NewtonInt in |- *; + case (NewtonInt_P5 f g l a b pr1 pr2); intros; case pr1; + intros; case pr2; intros; case (total_order_T a b); + intro. +elim s; intro. +elim o; intro. +elim o0; intro. +elim o1; intro. +assert (H2 := antiderivative_P1 f g x0 x1 l a b H0 H1); + assert (H3 := antiderivative_Ucte _ _ _ _ _ H H2); + elim H3; intros; assert (H5 : a <= a <= b). +split; [ right; reflexivity | left; assumption ]. +assert (H6 : a <= b <= b). +split; [ left; assumption | right; reflexivity ]. +assert (H7 := H4 _ H5); assert (H8 := H4 _ H6); rewrite H7; rewrite H8; ring. +unfold antiderivative in H1; elim H1; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H3 a0)). +unfold antiderivative in H0; elim H0; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)). +unfold antiderivative in H; elim H; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 a0)). +rewrite b0; ring. +elim o; intro. +unfold antiderivative in H; elim H; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 r)). +elim o0; intro. +unfold antiderivative in H0; elim H0; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 r)). +elim o1; intro. +unfold antiderivative in H1; elim H1; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H3 r)). +assert (H2 := antiderivative_P1 f g x0 x1 l b a H0 H1); + assert (H3 := antiderivative_Ucte _ _ _ _ _ H H2); + elim H3; intros; assert (H5 : b <= a <= a). +split; [ left; assumption | right; reflexivity ]. +assert (H6 : b <= b <= a). +split; [ right; reflexivity | left; assumption ]. +assert (H7 := H4 _ H5); assert (H8 := H4 _ H6); rewrite H7; rewrite H8; ring. +Qed. + +Lemma antiderivative_P2 : + forall (f F0 F1:R -> R) (a b c:R), + antiderivative f F0 a b -> + antiderivative f F1 b c -> + antiderivative f + (fun x:R => + match Rle_dec x b with + | left _ => F0 x + | right _ => F1 x + (F0 b - F1 b) + end) a c. +unfold antiderivative in |- *; intros; elim H; clear H; intros; elim H0; + clear H0; intros; split. +2: apply Rle_trans with b; assumption. +intros; elim H3; clear H3; intros; case (total_order_T x b); intro. +elim s; intro. +assert (H5 : a <= x <= b). +split; [ assumption | left; assumption ]. +assert (H6 := H _ H5); elim H6; clear H6; intros; + assert + (H7 : + derivable_pt_lim + (fun x:R => + match Rle_dec x b with + | left _ => F0 x + | right _ => F1 x + (F0 b - F1 b) + end) x (f x)). +unfold derivable_pt_lim in |- *; assert (H7 : derive_pt F0 x x0 = f x). +symmetry in |- *; assumption. +assert (H8 := derive_pt_eq_1 F0 x (f x) x0 H7); unfold derivable_pt_lim in H8; + intros; elim (H8 _ H9); intros; set (D := Rmin x1 (b - x)). +assert (H11 : 0 < D). +unfold D in |- *; unfold Rmin in |- *; case (Rle_dec x1 (b - x)); intro. +apply (cond_pos x1). +apply Rlt_Rminus; assumption. +exists (mkposreal _ H11); intros; case (Rle_dec x b); intro. +case (Rle_dec (x + h) b); intro. +apply H10. +assumption. +apply Rlt_le_trans with D; [ assumption | unfold D in |- *; apply Rmin_l ]. +elim n; left; apply Rlt_le_trans with (x + D). +apply Rplus_lt_compat_l; apply Rle_lt_trans with (Rabs h). +apply RRle_abs. +apply H13. +apply Rplus_le_reg_l with (- x); rewrite <- Rplus_assoc; rewrite Rplus_opp_l; + rewrite Rplus_0_l; rewrite Rplus_comm; unfold D in |- *; + apply Rmin_r. +elim n; left; assumption. +assert + (H8 : + derivable_pt + (fun x:R => + match Rle_dec x b with + | left _ => F0 x + | right _ => F1 x + (F0 b - F1 b) + end) x). +unfold derivable_pt in |- *; apply existT with (f x); apply H7. +exists H8; symmetry in |- *; apply derive_pt_eq_0; apply H7. +assert (H5 : a <= x <= b). +split; [ assumption | right; assumption ]. +assert (H6 : b <= x <= c). +split; [ right; symmetry in |- *; assumption | assumption ]. +elim (H _ H5); elim (H0 _ H6); intros; assert (H9 : derive_pt F0 x x1 = f x). +symmetry in |- *; assumption. +assert (H10 : derive_pt F1 x x0 = f x). +symmetry in |- *; assumption. +assert (H11 := derive_pt_eq_1 F0 x (f x) x1 H9); + assert (H12 := derive_pt_eq_1 F1 x (f x) x0 H10); + assert + (H13 : + derivable_pt_lim + (fun x:R => + match Rle_dec x b with + | left _ => F0 x + | right _ => F1 x + (F0 b - F1 b) + end) x (f x)). +unfold derivable_pt_lim in |- *; unfold derivable_pt_lim in H11, H12; intros; + elim (H11 _ H13); elim (H12 _ H13); intros; set (D := Rmin x2 x3); + assert (H16 : 0 < D). +unfold D in |- *; unfold Rmin in |- *; case (Rle_dec x2 x3); intro. +apply (cond_pos x2). +apply (cond_pos x3). +exists (mkposreal _ H16); intros; case (Rle_dec x b); intro. +case (Rle_dec (x + h) b); intro. +apply H15. +assumption. +apply Rlt_le_trans with D; [ assumption | unfold D in |- *; apply Rmin_r ]. +replace (F1 (x + h) + (F0 b - F1 b) - F0 x) with (F1 (x + h) - F1 x). +apply H14. +assumption. +apply Rlt_le_trans with D; [ assumption | unfold D in |- *; apply Rmin_l ]. +rewrite b0; ring. +elim n; right; assumption. +assert + (H14 : + derivable_pt + (fun x:R => + match Rle_dec x b with + | left _ => F0 x + | right _ => F1 x + (F0 b - F1 b) + end) x). +unfold derivable_pt in |- *; apply existT with (f x); apply H13. +exists H14; symmetry in |- *; apply derive_pt_eq_0; apply H13. +assert (H5 : b <= x <= c). +split; [ left; assumption | assumption ]. +assert (H6 := H0 _ H5); elim H6; clear H6; intros; + assert + (H7 : + derivable_pt_lim + (fun x:R => + match Rle_dec x b with + | left _ => F0 x + | right _ => F1 x + (F0 b - F1 b) + end) x (f x)). +unfold derivable_pt_lim in |- *; assert (H7 : derive_pt F1 x x0 = f x). +symmetry in |- *; assumption. +assert (H8 := derive_pt_eq_1 F1 x (f x) x0 H7); unfold derivable_pt_lim in H8; + intros; elim (H8 _ H9); intros; set (D := Rmin x1 (x - b)); + assert (H11 : 0 < D). +unfold D in |- *; unfold Rmin in |- *; case (Rle_dec x1 (x - b)); intro. +apply (cond_pos x1). +apply Rlt_Rminus; assumption. +exists (mkposreal _ H11); intros; case (Rle_dec x b); intro. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 r)). +case (Rle_dec (x + h) b); intro. +cut (b < x + h). +intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 H14)). +apply Rplus_lt_reg_r with (- h - b); replace (- h - b + b) with (- h); + [ idtac | ring ]; replace (- h - b + (x + h)) with (x - b); + [ idtac | ring ]; apply Rle_lt_trans with (Rabs h). +rewrite <- Rabs_Ropp; apply RRle_abs. +apply Rlt_le_trans with D. +apply H13. +unfold D in |- *; apply Rmin_r. +replace (F1 (x + h) + (F0 b - F1 b) - (F1 x + (F0 b - F1 b))) with + (F1 (x + h) - F1 x); [ idtac | ring ]; apply H10. +assumption. +apply Rlt_le_trans with D. +assumption. +unfold D in |- *; apply Rmin_l. +assert + (H8 : + derivable_pt + (fun x:R => + match Rle_dec x b with + | left _ => F0 x + | right _ => F1 x + (F0 b - F1 b) + end) x). +unfold derivable_pt in |- *; apply existT with (f x); apply H7. +exists H8; symmetry in |- *; apply derive_pt_eq_0; apply H7. +Qed. + +Lemma antiderivative_P3 : + forall (f F0 F1:R -> R) (a b c:R), + antiderivative f F0 a b -> + antiderivative f F1 c b -> + antiderivative f F1 c a \/ antiderivative f F0 a c. +intros; unfold antiderivative in H, H0; elim H; clear H; elim H0; clear H0; + intros; case (total_order_T a c); intro. +elim s; intro. +right; unfold antiderivative in |- *; split. +intros; apply H1; elim H3; intros; split; + [ assumption | apply Rle_trans with c; assumption ]. +left; assumption. +right; unfold antiderivative in |- *; split. +intros; apply H1; elim H3; intros; split; + [ assumption | apply Rle_trans with c; assumption ]. +right; assumption. +left; unfold antiderivative in |- *; split. +intros; apply H; elim H3; intros; split; + [ assumption | apply Rle_trans with a; assumption ]. +left; assumption. +Qed. + +Lemma antiderivative_P4 : + forall (f F0 F1:R -> R) (a b c:R), + antiderivative f F0 a b -> + antiderivative f F1 a c -> + antiderivative f F1 b c \/ antiderivative f F0 c b. +intros; unfold antiderivative in H, H0; elim H; clear H; elim H0; clear H0; + intros; case (total_order_T c b); intro. +elim s; intro. +right; unfold antiderivative in |- *; split. +intros; apply H1; elim H3; intros; split; + [ apply Rle_trans with c; assumption | assumption ]. +left; assumption. +right; unfold antiderivative in |- *; split. +intros; apply H1; elim H3; intros; split; + [ apply Rle_trans with c; assumption | assumption ]. +right; assumption. +left; unfold antiderivative in |- *; split. +intros; apply H; elim H3; intros; split; + [ apply Rle_trans with b; assumption | assumption ]. +left; assumption. +Qed. + +Lemma NewtonInt_P7 : + forall (f:R -> R) (a b c:R), + a < b -> + b < c -> + Newton_integrable f a b -> + Newton_integrable f b c -> Newton_integrable f a c. +unfold Newton_integrable in |- *; intros f a b c Hab Hbc X X0; elim X; + clear X; intros F0 H0; elim X0; clear X0; intros F1 H1; + set + (g := + fun x:R => + match Rle_dec x b with + | left _ => F0 x + | right _ => F1 x + (F0 b - F1 b) + end); apply existT with g; left; unfold g in |- *; + apply antiderivative_P2. +elim H0; intro. +assumption. +unfold antiderivative in H; elim H; clear H; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 Hab)). +elim H1; intro. +assumption. +unfold antiderivative in H; elim H; clear H; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 Hbc)). +Qed. + +Lemma NewtonInt_P8 : + forall (f:R -> R) (a b c:R), + Newton_integrable f a b -> + Newton_integrable f b c -> Newton_integrable f a c. +intros. +elim X; intros F0 H0. +elim X0; intros F1 H1. +case (total_order_T a b); intro. +elim s; intro. +case (total_order_T b c); intro. +elim s0; intro. +(* a<b & b<c *) +unfold Newton_integrable in |- *; + apply existT with + (fun x:R => + match Rle_dec x b with + | left _ => F0 x + | right _ => F1 x + (F0 b - F1 b) + end). +elim H0; intro. +elim H1; intro. +left; apply antiderivative_P2; assumption. +unfold antiderivative in H2; elim H2; clear H2; intros _ H2. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a1)). +unfold antiderivative in H; elim H; clear H; intros _ H. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)). +(* a<b & b=c *) +rewrite b0 in X; apply X. +(* a<b & b>c *) +case (total_order_T a c); intro. +elim s0; intro. +unfold Newton_integrable in |- *; apply existT with F0. +left. +elim H1; intro. +unfold antiderivative in H; elim H; clear H; intros _ H. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). +elim H0; intro. +assert (H3 := antiderivative_P3 f F0 F1 a b c H2 H). +elim H3; intro. +unfold antiderivative in H4; elim H4; clear H4; intros _ H4. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 a1)). +assumption. +unfold antiderivative in H2; elim H2; clear H2; intros _ H2. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)). +rewrite b0; apply NewtonInt_P1. +unfold Newton_integrable in |- *; apply existT with F1. +right. +elim H1; intro. +unfold antiderivative in H; elim H; clear H; intros _ H. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). +elim H0; intro. +assert (H3 := antiderivative_P3 f F0 F1 a b c H2 H). +elim H3; intro. +assumption. +unfold antiderivative in H4; elim H4; clear H4; intros _ H4. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 r0)). +unfold antiderivative in H2; elim H2; clear H2; intros _ H2. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)). +(* a=b *) +rewrite b0; apply X0. +case (total_order_T b c); intro. +elim s; intro. +(* a>b & b<c *) +case (total_order_T a c); intro. +elim s0; intro. +unfold Newton_integrable in |- *; apply existT with F1. +left. +elim H1; intro. +(*****************) +elim H0; intro. +unfold antiderivative in H2; elim H2; clear H2; intros _ H2. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 r)). +assert (H3 := antiderivative_P4 f F0 F1 b a c H2 H). +elim H3; intro. +assumption. +unfold antiderivative in H4; elim H4; clear H4; intros _ H4. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 a1)). +unfold antiderivative in H; elim H; clear H; intros _ H. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)). +rewrite b0; apply NewtonInt_P1. +unfold Newton_integrable in |- *; apply existT with F0. +right. +elim H0; intro. +unfold antiderivative in H; elim H; clear H; intros _ H. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). +elim H1; intro. +assert (H3 := antiderivative_P4 f F0 F1 b a c H H2). +elim H3; intro. +unfold antiderivative in H4; elim H4; clear H4; intros _ H4. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 r0)). +assumption. +unfold antiderivative in H2; elim H2; clear H2; intros _ H2. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)). +(* a>b & b=c *) +rewrite b0 in X; apply X. +(* a>b & b>c *) +assert (X1 := NewtonInt_P3 f a b X). +assert (X2 := NewtonInt_P3 f b c X0). +apply NewtonInt_P3. +apply NewtonInt_P7 with b; assumption. +Defined. + +(* Chasles' relation *) +Lemma NewtonInt_P9 : + forall (f:R -> R) (a b c:R) (pr1:Newton_integrable f a b) + (pr2:Newton_integrable f b c), + NewtonInt f a c (NewtonInt_P8 f a b c pr1 pr2) = + NewtonInt f a b pr1 + NewtonInt f b c pr2. +intros; unfold NewtonInt in |- *. +case (NewtonInt_P8 f a b c pr1 pr2); intros. +case pr1; intros. +case pr2; intros. +case (total_order_T a b); intro. +elim s; intro. +case (total_order_T b c); intro. +elim s0; intro. +(* a<b & b<c *) +elim o0; intro. +elim o1; intro. +elim o; intro. +assert (H2 := antiderivative_P2 f x0 x1 a b c H H0). +assert + (H3 := + antiderivative_Ucte f x + (fun x:R => + match Rle_dec x b with + | left _ => x0 x + | right _ => x1 x + (x0 b - x1 b) + end) a c H1 H2). +elim H3; intros. +assert (H5 : a <= a <= c). +split; [ right; reflexivity | left; apply Rlt_trans with b; assumption ]. +assert (H6 : a <= c <= c). +split; [ left; apply Rlt_trans with b; assumption | right; reflexivity ]. +rewrite (H4 _ H5); rewrite (H4 _ H6). +case (Rle_dec a b); intro. +case (Rle_dec c b); intro. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 a1)). +ring. +elim n; left; assumption. +unfold antiderivative in H1; elim H1; clear H1; intros _ H1. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 (Rlt_trans _ _ _ a0 a1))). +unfold antiderivative in H0; elim H0; clear H0; intros _ H0. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 a1)). +unfold antiderivative in H; elim H; clear H; intros _ H. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)). +(* a<b & b=c *) +rewrite <- b0. +unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rplus_0_r. +rewrite <- b0 in o. +elim o0; intro. +elim o; intro. +assert (H1 := antiderivative_Ucte f x x0 a b H0 H). +elim H1; intros. +rewrite (H2 b). +rewrite (H2 a). +ring. +split; [ right; reflexivity | left; assumption ]. +split; [ left; assumption | right; reflexivity ]. +unfold antiderivative in H0; elim H0; clear H0; intros _ H0. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 a0)). +unfold antiderivative in H; elim H; clear H; intros _ H. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)). +(* a<b & b>c *) +elim o1; intro. +unfold antiderivative in H; elim H; clear H; intros _ H. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). +elim o0; intro. +elim o; intro. +assert (H2 := antiderivative_P2 f x x1 a c b H1 H). +assert (H3 := antiderivative_Ucte _ _ _ a b H0 H2). +elim H3; intros. +rewrite (H4 a). +rewrite (H4 b). +case (Rle_dec b c); intro. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 r)). +case (Rle_dec a c); intro. +ring. +elim n0; unfold antiderivative in H1; elim H1; intros; assumption. +split; [ left; assumption | right; reflexivity ]. +split; [ right; reflexivity | left; assumption ]. +assert (H2 := antiderivative_P2 _ _ _ _ _ _ H1 H0). +assert (H3 := antiderivative_Ucte _ _ _ c b H H2). +elim H3; intros. +rewrite (H4 c). +rewrite (H4 b). +case (Rle_dec b a); intro. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 a0)). +case (Rle_dec c a); intro. +ring. +elim n0; unfold antiderivative in H1; elim H1; intros; assumption. +split; [ left; assumption | right; reflexivity ]. +split; [ right; reflexivity | left; assumption ]. +unfold antiderivative in H0; elim H0; clear H0; intros _ H0. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 a0)). +(* a=b *) +rewrite b0 in o; rewrite b0. +elim o; intro. +elim o1; intro. +assert (H1 := antiderivative_Ucte _ _ _ b c H H0). +elim H1; intros. +assert (H3 : b <= c). +unfold antiderivative in H; elim H; intros; assumption. +rewrite (H2 b). +rewrite (H2 c). +ring. +split; [ assumption | right; reflexivity ]. +split; [ right; reflexivity | assumption ]. +assert (H1 : b = c). +unfold antiderivative in H, H0; elim H; elim H0; intros; apply Rle_antisym; + assumption. +rewrite H1; ring. +elim o1; intro. +assert (H1 : b = c). +unfold antiderivative in H, H0; elim H; elim H0; intros; apply Rle_antisym; + assumption. +rewrite H1; ring. +assert (H1 := antiderivative_Ucte _ _ _ c b H H0). +elim H1; intros. +assert (H3 : c <= b). +unfold antiderivative in H; elim H; intros; assumption. +rewrite (H2 c). +rewrite (H2 b). +ring. +split; [ assumption | right; reflexivity ]. +split; [ right; reflexivity | assumption ]. +(* a>b & b<c *) +case (total_order_T b c); intro. +elim s; intro. +elim o0; intro. +unfold antiderivative in H; elim H; clear H; intros _ H. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). +elim o1; intro. +elim o; intro. +assert (H2 := antiderivative_P2 _ _ _ _ _ _ H H1). +assert (H3 := antiderivative_Ucte _ _ _ b c H0 H2). +elim H3; intros. +rewrite (H4 b). +rewrite (H4 c). +case (Rle_dec b a); intro. +case (Rle_dec c a); intro. +assert (H5 : a = c). +unfold antiderivative in H1; elim H1; intros; apply Rle_antisym; assumption. +rewrite H5; ring. +ring. +elim n; left; assumption. +split; [ left; assumption | right; reflexivity ]. +split; [ right; reflexivity | left; assumption ]. +assert (H2 := antiderivative_P2 _ _ _ _ _ _ H0 H1). +assert (H3 := antiderivative_Ucte _ _ _ b a H H2). +elim H3; intros. +rewrite (H4 a). +rewrite (H4 b). +case (Rle_dec b c); intro. +case (Rle_dec a c); intro. +assert (H5 : a = c). +unfold antiderivative in H1; elim H1; intros; apply Rle_antisym; assumption. +rewrite H5; ring. +ring. +elim n; left; assumption. +split; [ right; reflexivity | left; assumption ]. +split; [ left; assumption | right; reflexivity ]. +unfold antiderivative in H0; elim H0; clear H0; intros _ H0. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 a0)). +(* a>b & b=c *) +rewrite <- b0. +unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rplus_0_r. +rewrite <- b0 in o. +elim o0; intro. +unfold antiderivative in H; elim H; clear H; intros _ H. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). +elim o; intro. +unfold antiderivative in H0; elim H0; clear H0; intros _ H0. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 r)). +assert (H1 := antiderivative_Ucte f x x0 b a H0 H). +elim H1; intros. +rewrite (H2 b). +rewrite (H2 a). +ring. +split; [ left; assumption | right; reflexivity ]. +split; [ right; reflexivity | left; assumption ]. +(* a>b & b>c *) +elim o0; intro. +unfold antiderivative in H; elim H; clear H; intros _ H. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). +elim o1; intro. +unfold antiderivative in H0; elim H0; clear H0; intros _ H0. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 r0)). +elim o; intro. +unfold antiderivative in H1; elim H1; clear H1; intros _ H1. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 (Rlt_trans _ _ _ r0 r))). +assert (H2 := antiderivative_P2 _ _ _ _ _ _ H0 H). +assert (H3 := antiderivative_Ucte _ _ _ c a H1 H2). +elim H3; intros. +assert (H5 : c <= a). +unfold antiderivative in H1; elim H1; intros; assumption. +rewrite (H4 c). +rewrite (H4 a). +case (Rle_dec a b); intro. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r1 r)). +case (Rle_dec c b); intro. +ring. +elim n0; left; assumption. +split; [ assumption | right; reflexivity ]. +split; [ right; reflexivity | assumption ]. +Qed. diff --git a/theories/Reals/PSeries_reg.v b/theories/Reals/PSeries_reg.v new file mode 100644 index 00000000..0c19c8da --- /dev/null +++ b/theories/Reals/PSeries_reg.v @@ -0,0 +1,259 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: PSeries_reg.v,v 1.12.2.1 2004/07/16 19:31:10 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rfunctions. +Require Import SeqSeries. +Require Import Ranalysis1. +Require Import Max. +Require Import Even. Open Local Scope R_scope. + +Definition Boule (x:R) (r:posreal) (y:R) : Prop := Rabs (y - x) < r. + +(* Uniform convergence *) +Definition CVU (fn:nat -> R -> R) (f:R -> R) (x:R) + (r:posreal) : Prop := + forall eps:R, + 0 < eps -> + exists N : nat, + (forall (n:nat) (y:R), + (N <= n)%nat -> Boule x r y -> Rabs (f y - fn n y) < eps). + +(* Normal convergence *) +Definition CVN_r (fn:nat -> R -> R) (r:posreal) : Type := + sigT + (fun An:nat -> R => + sigT + (fun l:R => + Un_cv (fun n:nat => sum_f_R0 (fun k:nat => Rabs (An k)) n) l /\ + (forall (n:nat) (y:R), Boule 0 r y -> Rabs (fn n y) <= An n))). + +Definition CVN_R (fn:nat -> R -> R) : Type := forall r:posreal, CVN_r fn r. + +Definition SFL (fn:nat -> R -> R) + (cv:forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)) + (y:R) : R := match cv y with + | existT a b => a + end. + +(* In a complete space, normal convergence implies uniform convergence *) +Lemma CVN_CVU : + forall (fn:nat -> R -> R) + (cv:forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)) + (r:posreal), CVN_r fn r -> CVU (fun n:nat => SP fn n) (SFL fn cv) 0 r. +intros; unfold CVU in |- *; intros. +unfold CVN_r in X. +elim X; intros An X0. +elim X0; intros s H0. +elim H0; intros. +cut (Un_cv (fun n:nat => sum_f_R0 (fun k:nat => Rabs (An k)) n - s) 0). +intro; unfold Un_cv in H3. +elim (H3 eps H); intros N0 H4. +exists N0; intros. +apply Rle_lt_trans with (Rabs (sum_f_R0 (fun k:nat => Rabs (An k)) n - s)). +rewrite <- (Rabs_Ropp (sum_f_R0 (fun k:nat => Rabs (An k)) n - s)); + rewrite Ropp_minus_distr'; + rewrite (Rabs_right (s - sum_f_R0 (fun k:nat => Rabs (An k)) n)). +eapply sum_maj1. +unfold SFL in |- *; case (cv y); intro. +trivial. +apply H1. +intro; elim H0; intros. +rewrite (Rabs_right (An n0)). +apply H8; apply H6. +apply Rle_ge; apply Rle_trans with (Rabs (fn n0 y)). +apply Rabs_pos. +apply H8; apply H6. +apply Rle_ge; + apply Rplus_le_reg_l with (sum_f_R0 (fun k:nat => Rabs (An k)) n). +rewrite Rplus_0_r; unfold Rminus in |- *; rewrite (Rplus_comm s); + rewrite <- Rplus_assoc; rewrite Rplus_opp_r; rewrite Rplus_0_l; + apply sum_incr. +apply H1. +intro; apply Rabs_pos. +unfold R_dist in H4; unfold Rminus in H4; rewrite Ropp_0 in H4. +assert (H7 := H4 n H5). +rewrite Rplus_0_r in H7; apply H7. +unfold Un_cv in H1; unfold Un_cv in |- *; intros. +elim (H1 _ H3); intros. +exists x; intros. +unfold R_dist in |- *; unfold R_dist in H4. +rewrite Rminus_0_r; apply H4; assumption. +Qed. + +(* Each limit of a sequence of functions which converges uniformly is continue *) +Lemma CVU_continuity : + forall (fn:nat -> R -> R) (f:R -> R) (x:R) (r:posreal), + CVU fn f x r -> + (forall (n:nat) (y:R), Boule x r y -> continuity_pt (fn n) y) -> + forall y:R, Boule x r y -> continuity_pt f y. +intros; unfold continuity_pt in |- *; unfold continue_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold R_dist in |- *; intros. +unfold CVU in H. +cut (0 < eps / 3); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. +elim (H _ H3); intros N0 H4. +assert (H5 := H0 N0 y H1). +cut (exists del : posreal, (forall h:R, Rabs h < del -> Boule x r (y + h))). +intro. +elim H6; intros del1 H7. +unfold continuity_pt in H5; unfold continue_in in H5; unfold limit1_in in H5; + unfold limit_in in H5; simpl in H5; unfold R_dist in H5. +elim (H5 _ H3); intros del2 H8. +set (del := Rmin del1 del2). +exists del; intros. +split. +unfold del in |- *; unfold Rmin in |- *; case (Rle_dec del1 del2); intro. +apply (cond_pos del1). +elim H8; intros; assumption. +intros; + apply Rle_lt_trans with (Rabs (f x0 - fn N0 x0) + Rabs (fn N0 x0 - f y)). +replace (f x0 - f y) with (f x0 - fn N0 x0 + (fn N0 x0 - f y)); + [ apply Rabs_triang | ring ]. +apply Rle_lt_trans with + (Rabs (f x0 - fn N0 x0) + Rabs (fn N0 x0 - fn N0 y) + Rabs (fn N0 y - f y)). +rewrite Rplus_assoc; apply Rplus_le_compat_l. +replace (fn N0 x0 - f y) with (fn N0 x0 - fn N0 y + (fn N0 y - f y)); + [ apply Rabs_triang | ring ]. +replace eps with (eps / 3 + eps / 3 + eps / 3). +repeat apply Rplus_lt_compat. +apply H4. +apply le_n. +replace x0 with (y + (x0 - y)); [ idtac | ring ]; apply H7. +elim H9; intros. +apply Rlt_le_trans with del. +assumption. +unfold del in |- *; apply Rmin_l. +elim H8; intros. +apply H11. +split. +elim H9; intros; assumption. +elim H9; intros; apply Rlt_le_trans with del. +assumption. +unfold del in |- *; apply Rmin_r. +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr'; apply H4. +apply le_n. +assumption. +apply Rmult_eq_reg_l with 3. +do 2 rewrite Rmult_plus_distr_l; unfold Rdiv in |- *; rewrite <- Rmult_assoc; + rewrite Rinv_r_simpl_m. +ring. +discrR. +discrR. +cut (0 < r - Rabs (x - y)). +intro; exists (mkposreal _ H6). +simpl in |- *; intros. +unfold Boule in |- *; replace (y + h - x) with (h + (y - x)); + [ idtac | ring ]; apply Rle_lt_trans with (Rabs h + Rabs (y - x)). +apply Rabs_triang. +apply Rplus_lt_reg_r with (- Rabs (x - y)). +rewrite <- (Rabs_Ropp (y - x)); rewrite Ropp_minus_distr'. +replace (- Rabs (x - y) + r) with (r - Rabs (x - y)). +replace (- Rabs (x - y) + (Rabs h + Rabs (x - y))) with (Rabs h). +apply H7. +ring. +ring. +unfold Boule in H1; rewrite <- (Rabs_Ropp (x - y)); rewrite Ropp_minus_distr'; + apply Rplus_lt_reg_r with (Rabs (y - x)). +rewrite Rplus_0_r; replace (Rabs (y - x) + (r - Rabs (y - x))) with (pos r); + [ apply H1 | ring ]. +Qed. + +(**********) +Lemma continuity_pt_finite_SF : + forall (fn:nat -> R -> R) (N:nat) (x:R), + (forall n:nat, (n <= N)%nat -> continuity_pt (fn n) x) -> + continuity_pt (fun y:R => sum_f_R0 (fun k:nat => fn k y) N) x. +intros; induction N as [| N HrecN]. +simpl in |- *; apply (H 0%nat); apply le_n. +simpl in |- *; + replace (fun y:R => sum_f_R0 (fun k:nat => fn k y) N + fn (S N) y) with + ((fun y:R => sum_f_R0 (fun k:nat => fn k y) N) + (fun y:R => fn (S N) y))%F; + [ idtac | reflexivity ]. +apply continuity_pt_plus. +apply HrecN. +intros; apply H. +apply le_trans with N; [ assumption | apply le_n_Sn ]. +apply (H (S N)); apply le_n. +Qed. + +(* Continuity and normal convergence *) +Lemma SFL_continuity_pt : + forall (fn:nat -> R -> R) + (cv:forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)) + (r:posreal), + CVN_r fn r -> + (forall (n:nat) (y:R), Boule 0 r y -> continuity_pt (fn n) y) -> + forall y:R, Boule 0 r y -> continuity_pt (SFL fn cv) y. +intros; eapply CVU_continuity. +apply CVN_CVU. +apply X. +intros; unfold SP in |- *; apply continuity_pt_finite_SF. +intros; apply H. +apply H1. +apply H0. +Qed. + +Lemma SFL_continuity : + forall (fn:nat -> R -> R) + (cv:forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)), + CVN_R fn -> (forall n:nat, continuity (fn n)) -> continuity (SFL fn cv). +intros; unfold continuity in |- *; intro. +cut (0 < Rabs x + 1); + [ intro | apply Rplus_le_lt_0_compat; [ apply Rabs_pos | apply Rlt_0_1 ] ]. +cut (Boule 0 (mkposreal _ H0) x). +intro; eapply SFL_continuity_pt with (mkposreal _ H0). +apply X. +intros; apply (H n y). +apply H1. +unfold Boule in |- *; simpl in |- *; rewrite Rminus_0_r; + pattern (Rabs x) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_lt_compat_l; apply Rlt_0_1. +Qed. + +(* As R is complete, normal convergence implies that (fn) is simply-uniformly convergent *) +Lemma CVN_R_CVS : + forall fn:nat -> R -> R, + CVN_R fn -> forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l). +intros; apply R_complete. +unfold SP in |- *; set (An := fun N:nat => fn N x). +change (Cauchy_crit_series An) in |- *. +apply cauchy_abs. +unfold Cauchy_crit_series in |- *; apply CV_Cauchy. +unfold CVN_R in X; cut (0 < Rabs x + 1). +intro; assert (H0 := X (mkposreal _ H)). +unfold CVN_r in H0; elim H0; intros Bn H1. +elim H1; intros l H2. +elim H2; intros. +apply Rseries_CV_comp with Bn. +intro; split. +apply Rabs_pos. +unfold An in |- *; apply H4; unfold Boule in |- *; simpl in |- *; + rewrite Rminus_0_r. +pattern (Rabs x) at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; + apply Rlt_0_1. +apply existT with l. +cut (forall n:nat, 0 <= Bn n). +intro; unfold Un_cv in H3; unfold Un_cv in |- *; intros. +elim (H3 _ H6); intros. +exists x0; intros. +replace (sum_f_R0 Bn n) with (sum_f_R0 (fun k:nat => Rabs (Bn k)) n). +apply H7; assumption. +apply sum_eq; intros; apply Rabs_right; apply Rle_ge; apply H5. +intro; apply Rle_trans with (Rabs (An n)). +apply Rabs_pos. +unfold An in |- *; apply H4; unfold Boule in |- *; simpl in |- *; + rewrite Rminus_0_r; pattern (Rabs x) at 1 in |- *; + rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; apply Rlt_0_1. +apply Rplus_le_lt_0_compat; [ apply Rabs_pos | apply Rlt_0_1 ]. +Qed. diff --git a/theories/Reals/PartSum.v b/theories/Reals/PartSum.v new file mode 100644 index 00000000..13070bde --- /dev/null +++ b/theories/Reals/PartSum.v @@ -0,0 +1,603 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: PartSum.v,v 1.11.2.1 2004/07/16 19:31:11 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rfunctions. +Require Import Rseries. +Require Import Rcomplete. +Require Import Max. +Open Local Scope R_scope. + +Lemma tech1 : + forall (An:nat -> R) (N:nat), + (forall n:nat, (n <= N)%nat -> 0 < An n) -> 0 < sum_f_R0 An N. +intros; induction N as [| N HrecN]. +simpl in |- *; apply H; apply le_n. +simpl in |- *; apply Rplus_lt_0_compat. +apply HrecN; intros; apply H; apply le_S; assumption. +apply H; apply le_n. +Qed. + +(* Chasles' relation *) +Lemma tech2 : + forall (An:nat -> R) (m n:nat), + (m < n)%nat -> + sum_f_R0 An n = + sum_f_R0 An m + sum_f_R0 (fun i:nat => An (S m + i)%nat) (n - S m). +intros; induction n as [| n Hrecn]. +elim (lt_n_O _ H). +cut ((m < n)%nat \/ m = n). +intro; elim H0; intro. +replace (sum_f_R0 An (S n)) with (sum_f_R0 An n + An (S n)); + [ idtac | reflexivity ]. +replace (S n - S m)%nat with (S (n - S m)). +replace (sum_f_R0 (fun i:nat => An (S m + i)%nat) (S (n - S m))) with + (sum_f_R0 (fun i:nat => An (S m + i)%nat) (n - S m) + + An (S m + S (n - S m))%nat); [ idtac | reflexivity ]. +replace (S m + S (n - S m))%nat with (S n). +rewrite (Hrecn H1). +ring. +apply INR_eq; rewrite S_INR; rewrite plus_INR; do 2 rewrite S_INR; + rewrite minus_INR. +rewrite S_INR; ring. +apply lt_le_S; assumption. +apply INR_eq; rewrite S_INR; repeat rewrite minus_INR. +repeat rewrite S_INR; ring. +apply le_n_S; apply lt_le_weak; assumption. +apply lt_le_S; assumption. +rewrite H1; rewrite <- minus_n_n; simpl in |- *. +replace (n + 0)%nat with n; [ reflexivity | ring ]. +inversion H. +right; reflexivity. +left; apply lt_le_trans with (S m); [ apply lt_n_Sn | assumption ]. +Qed. + +(* Sum of geometric sequences *) +Lemma tech3 : + forall (k:R) (N:nat), + k <> 1 -> sum_f_R0 (fun i:nat => k ^ i) N = (1 - k ^ S N) / (1 - k). +intros; cut (1 - k <> 0). +intro; induction N as [| N HrecN]. +simpl in |- *; rewrite Rmult_1_r; unfold Rdiv in |- *; rewrite <- Rinv_r_sym. +reflexivity. +apply H0. +replace (sum_f_R0 (fun i:nat => k ^ i) (S N)) with + (sum_f_R0 (fun i:nat => k ^ i) N + k ^ S N); [ idtac | reflexivity ]; + rewrite HrecN; + replace ((1 - k ^ S N) / (1 - k) + k ^ S N) with + ((1 - k ^ S N + (1 - k) * k ^ S N) / (1 - k)). +apply Rmult_eq_reg_l with (1 - k). +unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ (1 - k))); + repeat rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; + [ do 2 rewrite Rmult_1_l; simpl in |- *; ring | apply H0 ]. +apply H0. +unfold Rdiv in |- *; rewrite Rmult_plus_distr_r; rewrite (Rmult_comm (1 - k)); + repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; reflexivity. +apply H0. +apply Rminus_eq_contra; red in |- *; intro; elim H; symmetry in |- *; + assumption. +Qed. + +Lemma tech4 : + forall (An:nat -> R) (k:R) (N:nat), + 0 <= k -> (forall i:nat, An (S i) < k * An i) -> An N <= An 0%nat * k ^ N. +intros; induction N as [| N HrecN]. +simpl in |- *; right; ring. +apply Rle_trans with (k * An N). +left; apply (H0 N). +replace (S N) with (N + 1)%nat; [ idtac | ring ]. +rewrite pow_add; simpl in |- *; rewrite Rmult_1_r; + replace (An 0%nat * (k ^ N * k)) with (k * (An 0%nat * k ^ N)); + [ idtac | ring ]; apply Rmult_le_compat_l. +assumption. +apply HrecN. +Qed. + +Lemma tech5 : + forall (An:nat -> R) (N:nat), sum_f_R0 An (S N) = sum_f_R0 An N + An (S N). +intros; reflexivity. +Qed. + +Lemma tech6 : + forall (An:nat -> R) (k:R) (N:nat), + 0 <= k -> + (forall i:nat, An (S i) < k * An i) -> + sum_f_R0 An N <= An 0%nat * sum_f_R0 (fun i:nat => k ^ i) N. +intros; induction N as [| N HrecN]. +simpl in |- *; right; ring. +apply Rle_trans with (An 0%nat * sum_f_R0 (fun i:nat => k ^ i) N + An (S N)). +rewrite tech5; do 2 rewrite <- (Rplus_comm (An (S N))); + apply Rplus_le_compat_l. +apply HrecN. +rewrite tech5; rewrite Rmult_plus_distr_l; apply Rplus_le_compat_l. +apply tech4; assumption. +Qed. + +Lemma tech7 : forall r1 r2:R, r1 <> 0 -> r2 <> 0 -> r1 <> r2 -> / r1 <> / r2. +intros; red in |- *; intro. +assert (H3 := Rmult_eq_compat_l r1 _ _ H2). +rewrite <- Rinv_r_sym in H3; [ idtac | assumption ]. +assert (H4 := Rmult_eq_compat_l r2 _ _ H3). +rewrite Rmult_1_r in H4; rewrite <- Rmult_assoc in H4. +rewrite Rinv_r_simpl_m in H4; [ idtac | assumption ]. +elim H1; symmetry in |- *; assumption. +Qed. + +Lemma tech11 : + forall (An Bn Cn:nat -> R) (N:nat), + (forall i:nat, An i = Bn i - Cn i) -> + sum_f_R0 An N = sum_f_R0 Bn N - sum_f_R0 Cn N. +intros; induction N as [| N HrecN]. +simpl in |- *; apply H. +do 3 rewrite tech5; rewrite HrecN; rewrite (H (S N)); ring. +Qed. + +Lemma tech12 : + forall (An:nat -> R) (x l:R), + Un_cv (fun N:nat => sum_f_R0 (fun i:nat => An i * x ^ i) N) l -> + Pser An x l. +intros; unfold Pser in |- *; unfold infinit_sum in |- *; unfold Un_cv in H; + assumption. +Qed. + +Lemma scal_sum : + forall (An:nat -> R) (N:nat) (x:R), + x * sum_f_R0 An N = sum_f_R0 (fun i:nat => An i * x) N. +intros; induction N as [| N HrecN]. +simpl in |- *; ring. +do 2 rewrite tech5. +rewrite Rmult_plus_distr_l; rewrite <- HrecN; ring. +Qed. + +Lemma decomp_sum : + forall (An:nat -> R) (N:nat), + (0 < N)%nat -> + sum_f_R0 An N = An 0%nat + sum_f_R0 (fun i:nat => An (S i)) (pred N). +intros; induction N as [| N HrecN]. +elim (lt_irrefl _ H). +cut ((0 < N)%nat \/ N = 0%nat). +intro; elim H0; intro. +cut (S (pred N) = pred (S N)). +intro; rewrite <- H2. +do 2 rewrite tech5. +replace (S (S (pred N))) with (S N). +rewrite (HrecN H1); ring. +rewrite H2; simpl in |- *; reflexivity. +assert (H2 := O_or_S N). +elim H2; intros. +elim a; intros. +rewrite <- p. +simpl in |- *; reflexivity. +rewrite <- b in H1; elim (lt_irrefl _ H1). +rewrite H1; simpl in |- *; reflexivity. +inversion H. +right; reflexivity. +left; apply lt_le_trans with 1%nat; [ apply lt_O_Sn | assumption ]. +Qed. + +Lemma plus_sum : + forall (An Bn:nat -> R) (N:nat), + sum_f_R0 (fun i:nat => An i + Bn i) N = sum_f_R0 An N + sum_f_R0 Bn N. +intros; induction N as [| N HrecN]. +simpl in |- *; ring. +do 3 rewrite tech5; rewrite HrecN; ring. +Qed. + +Lemma sum_eq : + forall (An Bn:nat -> R) (N:nat), + (forall i:nat, (i <= N)%nat -> An i = Bn i) -> + sum_f_R0 An N = sum_f_R0 Bn N. +intros; induction N as [| N HrecN]. +simpl in |- *; apply H; apply le_n. +do 2 rewrite tech5; rewrite HrecN. +rewrite (H (S N)); [ reflexivity | apply le_n ]. +intros; apply H; apply le_trans with N; [ assumption | apply le_n_Sn ]. +Qed. + +(* Unicity of the limit defined by convergent series *) +Lemma uniqueness_sum : + forall (An:nat -> R) (l1 l2:R), + infinit_sum An l1 -> infinit_sum An l2 -> l1 = l2. +unfold infinit_sum in |- *; intros. +case (Req_dec l1 l2); intro. +assumption. +cut (0 < Rabs ((l1 - l2) / 2)); [ intro | apply Rabs_pos_lt ]. +elim (H (Rabs ((l1 - l2) / 2)) H2); intros. +elim (H0 (Rabs ((l1 - l2) / 2)) H2); intros. +set (N := max x0 x); cut (N >= x0)%nat. +cut (N >= x)%nat. +intros; assert (H7 := H3 N H5); assert (H8 := H4 N H6). +cut (Rabs (l1 - l2) <= R_dist (sum_f_R0 An N) l1 + R_dist (sum_f_R0 An N) l2). +intro; assert (H10 := Rplus_lt_compat _ _ _ _ H7 H8); + assert (H11 := Rle_lt_trans _ _ _ H9 H10); unfold Rdiv in H11; + rewrite Rabs_mult in H11. +cut (Rabs (/ 2) = / 2). +intro; rewrite H12 in H11; assert (H13 := double_var); unfold Rdiv in H13; + rewrite <- H13 in H11. +elim (Rlt_irrefl _ H11). +apply Rabs_right; left; change (0 < / 2) in |- *; apply Rinv_0_lt_compat; + cut (0%nat <> 2%nat); + [ intro H20; generalize (lt_INR_0 2 (neq_O_lt 2 H20)); unfold INR in |- *; + intro; assumption + | discriminate ]. +unfold R_dist in |- *; rewrite <- (Rabs_Ropp (sum_f_R0 An N - l1)); + rewrite Ropp_minus_distr'. +replace (l1 - l2) with (l1 - sum_f_R0 An N + (sum_f_R0 An N - l2)); + [ idtac | ring ]. +apply Rabs_triang. +unfold ge in |- *; unfold N in |- *; apply le_max_r. +unfold ge in |- *; unfold N in |- *; apply le_max_l. +unfold Rdiv in |- *; apply prod_neq_R0. +apply Rminus_eq_contra; assumption. +apply Rinv_neq_0_compat; discrR. +Qed. + +Lemma minus_sum : + forall (An Bn:nat -> R) (N:nat), + sum_f_R0 (fun i:nat => An i - Bn i) N = sum_f_R0 An N - sum_f_R0 Bn N. +intros; induction N as [| N HrecN]. +simpl in |- *; ring. +do 3 rewrite tech5; rewrite HrecN; ring. +Qed. + +Lemma sum_decomposition : + forall (An:nat -> R) (N:nat), + sum_f_R0 (fun l:nat => An (2 * l)%nat) (S N) + + sum_f_R0 (fun l:nat => An (S (2 * l))) N = sum_f_R0 An (2 * S N). +intros. +induction N as [| N HrecN]. +simpl in |- *; ring. +rewrite tech5. +rewrite (tech5 (fun l:nat => An (S (2 * l))) N). +replace (2 * S (S N))%nat with (S (S (2 * S N))). +rewrite (tech5 An (S (2 * S N))). +rewrite (tech5 An (2 * S N)). +rewrite <- HrecN. +ring. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR. +ring. +Qed. + +Lemma sum_Rle : + forall (An Bn:nat -> R) (N:nat), + (forall n:nat, (n <= N)%nat -> An n <= Bn n) -> + sum_f_R0 An N <= sum_f_R0 Bn N. +intros. +induction N as [| N HrecN]. +simpl in |- *; apply H. +apply le_n. +do 2 rewrite tech5. +apply Rle_trans with (sum_f_R0 An N + Bn (S N)). +apply Rplus_le_compat_l. +apply H. +apply le_n. +do 2 rewrite <- (Rplus_comm (Bn (S N))). +apply Rplus_le_compat_l. +apply HrecN. +intros; apply H. +apply le_trans with N; [ assumption | apply le_n_Sn ]. +Qed. + +Lemma Rsum_abs : + forall (An:nat -> R) (N:nat), + Rabs (sum_f_R0 An N) <= sum_f_R0 (fun l:nat => Rabs (An l)) N. +intros. +induction N as [| N HrecN]. +simpl in |- *. +right; reflexivity. +do 2 rewrite tech5. +apply Rle_trans with (Rabs (sum_f_R0 An N) + Rabs (An (S N))). +apply Rabs_triang. +do 2 rewrite <- (Rplus_comm (Rabs (An (S N)))). +apply Rplus_le_compat_l. +apply HrecN. +Qed. + +Lemma sum_cte : + forall (x:R) (N:nat), sum_f_R0 (fun _:nat => x) N = x * INR (S N). +intros. +induction N as [| N HrecN]. +simpl in |- *; ring. +rewrite tech5. +rewrite HrecN; repeat rewrite S_INR; ring. +Qed. + +(**********) +Lemma sum_growing : + forall (An Bn:nat -> R) (N:nat), + (forall n:nat, An n <= Bn n) -> sum_f_R0 An N <= sum_f_R0 Bn N. +intros. +induction N as [| N HrecN]. +simpl in |- *; apply H. +do 2 rewrite tech5. +apply Rle_trans with (sum_f_R0 An N + Bn (S N)). +apply Rplus_le_compat_l; apply H. +do 2 rewrite <- (Rplus_comm (Bn (S N))). +apply Rplus_le_compat_l; apply HrecN. +Qed. + +(**********) +Lemma Rabs_triang_gen : + forall (An:nat -> R) (N:nat), + Rabs (sum_f_R0 An N) <= sum_f_R0 (fun i:nat => Rabs (An i)) N. +intros. +induction N as [| N HrecN]. +simpl in |- *. +right; reflexivity. +do 2 rewrite tech5. +apply Rle_trans with (Rabs (sum_f_R0 An N) + Rabs (An (S N))). +apply Rabs_triang. +do 2 rewrite <- (Rplus_comm (Rabs (An (S N)))). +apply Rplus_le_compat_l; apply HrecN. +Qed. + +(**********) +Lemma cond_pos_sum : + forall (An:nat -> R) (N:nat), + (forall n:nat, 0 <= An n) -> 0 <= sum_f_R0 An N. +intros. +induction N as [| N HrecN]. +simpl in |- *; apply H. +rewrite tech5. +apply Rplus_le_le_0_compat. +apply HrecN. +apply H. +Qed. + +(* Cauchy's criterion for series *) +Definition Cauchy_crit_series (An:nat -> R) : Prop := + Cauchy_crit (fun N:nat => sum_f_R0 An N). + +(* If (|An|) satisfies the Cauchy's criterion for series, then (An) too *) +Lemma cauchy_abs : + forall An:nat -> R, + Cauchy_crit_series (fun i:nat => Rabs (An i)) -> Cauchy_crit_series An. +unfold Cauchy_crit_series in |- *; unfold Cauchy_crit in |- *. +intros. +elim (H eps H0); intros. +exists x. +intros. +cut + (R_dist (sum_f_R0 An n) (sum_f_R0 An m) <= + R_dist (sum_f_R0 (fun i:nat => Rabs (An i)) n) + (sum_f_R0 (fun i:nat => Rabs (An i)) m)). +intro. +apply Rle_lt_trans with + (R_dist (sum_f_R0 (fun i:nat => Rabs (An i)) n) + (sum_f_R0 (fun i:nat => Rabs (An i)) m)). +assumption. +apply H1; assumption. +assert (H4 := lt_eq_lt_dec n m). +elim H4; intro. +elim a; intro. +rewrite (tech2 An n m); [ idtac | assumption ]. +rewrite (tech2 (fun i:nat => Rabs (An i)) n m); [ idtac | assumption ]. +unfold R_dist in |- *. +unfold Rminus in |- *. +do 2 rewrite Ropp_plus_distr. +do 2 rewrite <- Rplus_assoc. +do 2 rewrite Rplus_opp_r. +do 2 rewrite Rplus_0_l. +do 2 rewrite Rabs_Ropp. +rewrite + (Rabs_right (sum_f_R0 (fun i:nat => Rabs (An (S n + i)%nat)) (m - S n))) + . +set (Bn := fun i:nat => An (S n + i)%nat). +replace (fun i:nat => Rabs (An (S n + i)%nat)) with + (fun i:nat => Rabs (Bn i)). +apply Rabs_triang_gen. +unfold Bn in |- *; reflexivity. +apply Rle_ge. +apply cond_pos_sum. +intro; apply Rabs_pos. +rewrite b. +unfold R_dist in |- *. +unfold Rminus in |- *; do 2 rewrite Rplus_opp_r. +rewrite Rabs_R0; right; reflexivity. +rewrite (tech2 An m n); [ idtac | assumption ]. +rewrite (tech2 (fun i:nat => Rabs (An i)) m n); [ idtac | assumption ]. +unfold R_dist in |- *. +unfold Rminus in |- *. +do 2 rewrite Rplus_assoc. +rewrite (Rplus_comm (sum_f_R0 An m)). +rewrite (Rplus_comm (sum_f_R0 (fun i:nat => Rabs (An i)) m)). +do 2 rewrite Rplus_assoc. +do 2 rewrite Rplus_opp_l. +do 2 rewrite Rplus_0_r. +rewrite + (Rabs_right (sum_f_R0 (fun i:nat => Rabs (An (S m + i)%nat)) (n - S m))) + . +set (Bn := fun i:nat => An (S m + i)%nat). +replace (fun i:nat => Rabs (An (S m + i)%nat)) with + (fun i:nat => Rabs (Bn i)). +apply Rabs_triang_gen. +unfold Bn in |- *; reflexivity. +apply Rle_ge. +apply cond_pos_sum. +intro; apply Rabs_pos. +Qed. + +(**********) +Lemma cv_cauchy_1 : + forall An:nat -> R, + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l) -> + Cauchy_crit_series An. +intros. +elim X; intros. +unfold Un_cv in p. +unfold Cauchy_crit_series in |- *; unfold Cauchy_crit in |- *. +intros. +cut (0 < eps / 2). +intro. +elim (p (eps / 2) H0); intros. +exists x0. +intros. +apply Rle_lt_trans with (R_dist (sum_f_R0 An n) x + R_dist (sum_f_R0 An m) x). +unfold R_dist in |- *. +replace (sum_f_R0 An n - sum_f_R0 An m) with + (sum_f_R0 An n - x + - (sum_f_R0 An m - x)); [ idtac | ring ]. +rewrite <- (Rabs_Ropp (sum_f_R0 An m - x)). +apply Rabs_triang. +apply Rlt_le_trans with (eps / 2 + eps / 2). +apply Rplus_lt_compat. +apply H1; assumption. +apply H1; assumption. +right; symmetry in |- *; apply double_var. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +Qed. + +Lemma cv_cauchy_2 : + forall An:nat -> R, + Cauchy_crit_series An -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l). +intros. +apply R_complete. +unfold Cauchy_crit_series in H. +exact H. +Qed. + +(**********) +Lemma sum_eq_R0 : + forall (An:nat -> R) (N:nat), + (forall n:nat, (n <= N)%nat -> An n = 0) -> sum_f_R0 An N = 0. +intros; induction N as [| N HrecN]. +simpl in |- *; apply H; apply le_n. +rewrite tech5; rewrite HrecN; + [ rewrite Rplus_0_l; apply H; apply le_n + | intros; apply H; apply le_trans with N; [ assumption | apply le_n_Sn ] ]. +Qed. + +Definition SP (fn:nat -> R -> R) (N:nat) (x:R) : R := + sum_f_R0 (fun k:nat => fn k x) N. + +(**********) +Lemma sum_incr : + forall (An:nat -> R) (N:nat) (l:R), + Un_cv (fun n:nat => sum_f_R0 An n) l -> + (forall n:nat, 0 <= An n) -> sum_f_R0 An N <= l. +intros; case (total_order_T (sum_f_R0 An N) l); intro. +elim s; intro. +left; apply a. +right; apply b. +cut (Un_growing (fun n:nat => sum_f_R0 An n)). +intro; set (l1 := sum_f_R0 An N). +fold l1 in r. +unfold Un_cv in H; cut (0 < l1 - l). +intro; elim (H _ H2); intros. +set (N0 := max x N); cut (N0 >= x)%nat. +intro; assert (H5 := H3 N0 H4). +cut (l1 <= sum_f_R0 An N0). +intro; unfold R_dist in H5; rewrite Rabs_right in H5. +cut (sum_f_R0 An N0 < l1). +intro; elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H7 H6)). +apply Rplus_lt_reg_r with (- l). +do 2 rewrite (Rplus_comm (- l)). +apply H5. +apply Rle_ge; apply Rplus_le_reg_l with l. +rewrite Rplus_0_r; replace (l + (sum_f_R0 An N0 - l)) with (sum_f_R0 An N0); + [ idtac | ring ]; apply Rle_trans with l1. +left; apply r. +apply H6. +unfold l1 in |- *; apply Rge_le; + apply (growing_prop (fun k:nat => sum_f_R0 An k)). +apply H1. +unfold ge, N0 in |- *; apply le_max_r. +unfold ge, N0 in |- *; apply le_max_l. +apply Rplus_lt_reg_r with l; rewrite Rplus_0_r; + replace (l + (l1 - l)) with l1; [ apply r | ring ]. +unfold Un_growing in |- *; intro; simpl in |- *; + pattern (sum_f_R0 An n) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_le_compat_l; apply H0. +Qed. + +(**********) +Lemma sum_cv_maj : + forall (An:nat -> R) (fn:nat -> R -> R) (x l1 l2:R), + Un_cv (fun n:nat => SP fn n x) l1 -> + Un_cv (fun n:nat => sum_f_R0 An n) l2 -> + (forall n:nat, Rabs (fn n x) <= An n) -> Rabs l1 <= l2. +intros; case (total_order_T (Rabs l1) l2); intro. +elim s; intro. +left; apply a. +right; apply b. +cut (forall n0:nat, Rabs (SP fn n0 x) <= sum_f_R0 An n0). +intro; cut (0 < (Rabs l1 - l2) / 2). +intro; unfold Un_cv in H, H0. +elim (H _ H3); intros Na H4. +elim (H0 _ H3); intros Nb H5. +set (N := max Na Nb). +unfold R_dist in H4, H5. +cut (Rabs (sum_f_R0 An N - l2) < (Rabs l1 - l2) / 2). +intro; cut (Rabs (Rabs l1 - Rabs (SP fn N x)) < (Rabs l1 - l2) / 2). +intro; cut (sum_f_R0 An N < (Rabs l1 + l2) / 2). +intro; cut ((Rabs l1 + l2) / 2 < Rabs (SP fn N x)). +intro; cut (sum_f_R0 An N < Rabs (SP fn N x)). +intro; assert (H11 := H2 N). +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H11 H10)). +apply Rlt_trans with ((Rabs l1 + l2) / 2); assumption. +case (Rcase_abs (Rabs l1 - Rabs (SP fn N x))); intro. +apply Rlt_trans with (Rabs l1). +apply Rmult_lt_reg_l with 2. +prove_sup0. +unfold Rdiv in |- *; rewrite (Rmult_comm 2); rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; rewrite double; apply Rplus_lt_compat_l; apply r. +discrR. +apply (Rminus_lt _ _ r0). +rewrite (Rabs_right _ r0) in H7. +apply Rplus_lt_reg_r with ((Rabs l1 - l2) / 2 - Rabs (SP fn N x)). +replace ((Rabs l1 - l2) / 2 - Rabs (SP fn N x) + (Rabs l1 + l2) / 2) with + (Rabs l1 - Rabs (SP fn N x)). +unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_l; + rewrite Rplus_0_r; apply H7. +unfold Rdiv in |- *; rewrite Rmult_plus_distr_r; + rewrite <- (Rmult_comm (/ 2)); rewrite Rmult_minus_distr_l; + repeat rewrite (Rmult_comm (/ 2)); pattern (Rabs l1) at 1 in |- *; + rewrite double_var; unfold Rdiv in |- *; ring. +case (Rcase_abs (sum_f_R0 An N - l2)); intro. +apply Rlt_trans with l2. +apply (Rminus_lt _ _ r0). +apply Rmult_lt_reg_l with 2. +prove_sup0. +rewrite (double l2); unfold Rdiv in |- *; rewrite (Rmult_comm 2); + rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; rewrite (Rplus_comm (Rabs l1)); apply Rplus_lt_compat_l; + apply r. +discrR. +rewrite (Rabs_right _ r0) in H6; apply Rplus_lt_reg_r with (- l2). +replace (- l2 + (Rabs l1 + l2) / 2) with ((Rabs l1 - l2) / 2). +rewrite Rplus_comm; apply H6. +unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); + rewrite Rmult_minus_distr_l; rewrite Rmult_plus_distr_r; + pattern l2 at 2 in |- *; rewrite double_var; + repeat rewrite (Rmult_comm (/ 2)); rewrite Ropp_plus_distr; + unfold Rdiv in |- *; ring. +apply Rle_lt_trans with (Rabs (SP fn N x - l1)). +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr'; apply Rabs_triang_inv2. +apply H4; unfold ge, N in |- *; apply le_max_l. +apply H5; unfold ge, N in |- *; apply le_max_r. +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +apply Rplus_lt_reg_r with l2. +rewrite Rplus_0_r; replace (l2 + (Rabs l1 - l2)) with (Rabs l1); + [ apply r | ring ]. +apply Rinv_0_lt_compat; prove_sup0. +intros; induction n0 as [| n0 Hrecn0]. +unfold SP in |- *; simpl in |- *; apply H1. +unfold SP in |- *; simpl in |- *. +apply Rle_trans with + (Rabs (sum_f_R0 (fun k:nat => fn k x) n0) + Rabs (fn (S n0) x)). +apply Rabs_triang. +apply Rle_trans with (sum_f_R0 An n0 + Rabs (fn (S n0) x)). +do 2 rewrite <- (Rplus_comm (Rabs (fn (S n0) x))). +apply Rplus_le_compat_l; apply Hrecn0. +apply Rplus_le_compat_l; apply H1. +Qed.
\ No newline at end of file diff --git a/theories/Reals/RIneq.v b/theories/Reals/RIneq.v new file mode 100644 index 00000000..a23f53ff --- /dev/null +++ b/theories/Reals/RIneq.v @@ -0,0 +1,1631 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: RIneq.v,v 1.23.2.1 2004/07/16 19:31:11 herbelin Exp $ i*) + +(***************************************************************************) +(** Basic lemmas for the classical reals numbers *) +(***************************************************************************) + +Require Export Raxioms. +Require Export ZArithRing. +Require Import Omega. +Require Export Field. + +Open Local Scope Z_scope. +Open Local Scope R_scope. + +Implicit Type r : R. + +(***************************************************************************) +(** Instantiating Ring tactic on reals *) +(***************************************************************************) + +Lemma RTheory : Ring_Theory Rplus Rmult 1 0 Ropp (fun x y:R => false). + split. + exact Rplus_comm. + symmetry in |- *; apply Rplus_assoc. + exact Rmult_comm. + symmetry in |- *; apply Rmult_assoc. + intro; apply Rplus_0_l. + intro; apply Rmult_1_l. + exact Rplus_opp_r. + intros. + rewrite Rmult_comm. + rewrite (Rmult_comm n p). + rewrite (Rmult_comm m p). + apply Rmult_plus_distr_l. + intros; contradiction. +Defined. + +Add Field R Rplus Rmult 1 0 Ropp (fun x y:R => false) Rinv RTheory Rinv_l + with minus := Rminus div := Rdiv. + +(**************************************************************************) +(** Relation between orders and equality *) +(**************************************************************************) + +(**********) +Lemma Rlt_irrefl : forall r, ~ r < r. + generalize Rlt_asym. intuition eauto. +Qed. +Hint Resolve Rlt_irrefl: real. + +Lemma Rle_refl : forall r, r <= r. +intro; right; reflexivity. +Qed. + +Lemma Rlt_not_eq : forall r1 r2, r1 < r2 -> r1 <> r2. + red in |- *; intros r1 r2 H H0; apply (Rlt_irrefl r1). + pattern r1 at 2 in |- *; rewrite H0; trivial. +Qed. + +Lemma Rgt_not_eq : forall r1 r2, r1 > r2 -> r1 <> r2. +intros; apply sym_not_eq; apply Rlt_not_eq; auto with real. +Qed. + +(**********) +Lemma Rlt_dichotomy_converse : forall r1 r2, r1 < r2 \/ r1 > r2 -> r1 <> r2. +generalize Rlt_not_eq Rgt_not_eq. intuition eauto. +Qed. +Hint Resolve Rlt_dichotomy_converse: real. + +(** Reasoning by case on equalities and order *) + +(**********) +Lemma Req_dec : forall r1 r2, r1 = r2 \/ r1 <> r2. +intros; generalize (total_order_T r1 r2) Rlt_dichotomy_converse; + intuition eauto 3. +Qed. +Hint Resolve Req_dec: real. + +(**********) +Lemma Rtotal_order : forall r1 r2, r1 < r2 \/ r1 = r2 \/ r1 > r2. +intros; generalize (total_order_T r1 r2); tauto. +Qed. + +(**********) +Lemma Rdichotomy : forall r1 r2, r1 <> r2 -> r1 < r2 \/ r1 > r2. +intros; generalize (total_order_T r1 r2); tauto. +Qed. + + +(*********************************************************************************) +(** Order Lemma : relating [<], [>], [<=] and [>=] *) +(*********************************************************************************) + +(**********) +Lemma Rlt_le : forall r1 r2, r1 < r2 -> r1 <= r2. +intros; red in |- *; tauto. +Qed. +Hint Resolve Rlt_le: real. + +(**********) +Lemma Rle_ge : forall r1 r2, r1 <= r2 -> r2 >= r1. +destruct 1; red in |- *; auto with real. +Qed. + +Hint Immediate Rle_ge: real. + +(**********) +Lemma Rge_le : forall r1 r2, r1 >= r2 -> r2 <= r1. +destruct 1; red in |- *; auto with real. +Qed. + +Hint Resolve Rge_le: real. + +(**********) +Lemma Rnot_le_lt : forall r1 r2, ~ r1 <= r2 -> r2 < r1. +intros r1 r2; generalize (Rtotal_order r1 r2); unfold Rle in |- *; tauto. +Qed. + +Hint Immediate Rnot_le_lt: real. + +Lemma Rnot_ge_lt : forall r1 r2, ~ r1 >= r2 -> r1 < r2. +intros; apply Rnot_le_lt; auto with real. +Qed. + +(**********) +Lemma Rlt_not_le : forall r1 r2, r2 < r1 -> ~ r1 <= r2. +generalize Rlt_asym Rlt_dichotomy_converse; unfold Rle in |- *. +intuition eauto 3. +Qed. + +Lemma Rgt_not_le : forall r1 r2, r1 > r2 -> ~ r1 <= r2. +Proof Rlt_not_le. + +Hint Immediate Rlt_not_le: real. + +Lemma Rle_not_lt : forall r1 r2, r2 <= r1 -> ~ r1 < r2. +intros r1 r2. generalize (Rlt_asym r1 r2) (Rlt_dichotomy_converse r1 r2). +unfold Rle in |- *; intuition. +Qed. + +(**********) +Lemma Rlt_not_ge : forall r1 r2, r1 < r2 -> ~ r1 >= r2. +generalize Rlt_not_le. unfold Rle, Rge in |- *. intuition eauto 3. +Qed. + +Hint Immediate Rlt_not_ge: real. + +(**********) +Lemma Req_le : forall r1 r2, r1 = r2 -> r1 <= r2. +unfold Rle in |- *; tauto. +Qed. +Hint Immediate Req_le: real. + +Lemma Req_ge : forall r1 r2, r1 = r2 -> r1 >= r2. +unfold Rge in |- *; tauto. +Qed. +Hint Immediate Req_ge: real. + +Lemma Req_le_sym : forall r1 r2, r2 = r1 -> r1 <= r2. +unfold Rle in |- *; auto. +Qed. +Hint Immediate Req_le_sym: real. + +Lemma Req_ge_sym : forall r1 r2, r2 = r1 -> r1 >= r2. +unfold Rge in |- *; auto. +Qed. +Hint Immediate Req_ge_sym: real. + +Lemma Rle_antisym : forall r1 r2, r1 <= r2 -> r2 <= r1 -> r1 = r2. +intros r1 r2; generalize (Rlt_asym r1 r2); unfold Rle in |- *; intuition. +Qed. +Hint Resolve Rle_antisym: real. + +(**********) +Lemma Rle_le_eq : forall r1 r2, r1 <= r2 /\ r2 <= r1 <-> r1 = r2. +intuition. +Qed. + +Lemma Rlt_eq_compat : + forall r1 r2 r3 r4, r1 = r2 -> r2 < r4 -> r4 = r3 -> r1 < r3. +intros x x' y y'; intros; replace x with x'; replace y with y'; assumption. +Qed. + +(**********) +Lemma Rle_trans : forall r1 r2 r3, r1 <= r2 -> r2 <= r3 -> r1 <= r3. +generalize trans_eq Rlt_trans Rlt_eq_compat. +unfold Rle in |- *. +intuition eauto 2. +Qed. + +(**********) +Lemma Rle_lt_trans : forall r1 r2 r3, r1 <= r2 -> r2 < r3 -> r1 < r3. +generalize Rlt_trans Rlt_eq_compat. +unfold Rle in |- *. +intuition eauto 2. +Qed. + +(**********) +Lemma Rlt_le_trans : forall r1 r2 r3, r1 < r2 -> r2 <= r3 -> r1 < r3. +generalize Rlt_trans Rlt_eq_compat; unfold Rle in |- *; intuition eauto 2. +Qed. + + +(** Decidability of the order *) +Lemma Rlt_dec : forall r1 r2, {r1 < r2} + {~ r1 < r2}. +intros; generalize (total_order_T r1 r2) (Rlt_dichotomy_converse r1 r2); + intuition. +Qed. + +(**********) +Lemma Rle_dec : forall r1 r2, {r1 <= r2} + {~ r1 <= r2}. +intros r1 r2. +generalize (total_order_T r1 r2) (Rlt_dichotomy_converse r1 r2). +intuition eauto 4 with real. +Qed. + +(**********) +Lemma Rgt_dec : forall r1 r2, {r1 > r2} + {~ r1 > r2}. +intros; unfold Rgt in |- *; intros; apply Rlt_dec. +Qed. + +(**********) +Lemma Rge_dec : forall r1 r2, {r1 >= r2} + {~ r1 >= r2}. +intros; generalize (Rle_dec r2 r1); intuition. +Qed. + +Lemma Rlt_le_dec : forall r1 r2, {r1 < r2} + {r2 <= r1}. +intros; generalize (total_order_T r1 r2); intuition. +Qed. + +Lemma Rle_or_lt : forall r1 r2, r1 <= r2 \/ r2 < r1. +intros n m; elim (Rlt_le_dec m n); auto with real. +Qed. + +Lemma Rle_lt_or_eq_dec : forall r1 r2, r1 <= r2 -> {r1 < r2} + {r1 = r2}. +intros r1 r2 H; generalize (total_order_T r1 r2); intuition. +Qed. + +(**********) +Lemma inser_trans_R : + forall r1 r2 r3 r4, r1 <= r2 < r3 -> {r1 <= r2 < r4} + {r4 <= r2 < r3}. +intros n m p q; intros; generalize (Rlt_le_dec m q); intuition. +Qed. + +(****************************************************************) +(** Field Lemmas *) +(* This part contains lemma involving the Fields operations *) +(****************************************************************) +(*********************************************************) +(** Addition *) +(*********************************************************) + +Lemma Rplus_ne : forall r, r + 0 = r /\ 0 + r = r. +intro; split; ring. +Qed. +Hint Resolve Rplus_ne: real v62. + +Lemma Rplus_0_r : forall r, r + 0 = r. +intro; ring. +Qed. +Hint Resolve Rplus_0_r: real. + +(**********) +Lemma Rplus_opp_l : forall r, - r + r = 0. + intro; ring. +Qed. +Hint Resolve Rplus_opp_l: real. + + +(**********) +Lemma Rplus_opp_r_uniq : forall r1 r2, r1 + r2 = 0 -> r2 = - r1. + intros x y H; replace y with (- x + x + y); + [ rewrite Rplus_assoc; rewrite H; ring | ring ]. +Qed. + +(*i New i*) +Hint Resolve (f_equal (A:=R)): real. + +Lemma Rplus_eq_compat_l : forall r r1 r2, r1 = r2 -> r + r1 = r + r2. + auto with real. +Qed. + +(*i Old i*)Hint Resolve Rplus_eq_compat_l: v62. + +(**********) +Lemma Rplus_eq_reg_l : forall r r1 r2, r + r1 = r + r2 -> r1 = r2. + intros; transitivity (- r + r + r1). + ring. + transitivity (- r + r + r2). + repeat rewrite Rplus_assoc; rewrite <- H; reflexivity. + ring. +Qed. +Hint Resolve Rplus_eq_reg_l: real. + +(**********) +Lemma Rplus_0_r_uniq : forall r r1, r + r1 = r -> r1 = 0. + intros r b; pattern r at 2 in |- *; replace r with (r + 0); eauto with real. +Qed. + +(***********************************************************) +(** Multiplication *) +(***********************************************************) + +(**********) +Lemma Rinv_r : forall r, r <> 0 -> r * / r = 1. + intros; rewrite Rmult_comm; auto with real. +Qed. +Hint Resolve Rinv_r: real. + +Lemma Rinv_l_sym : forall r, r <> 0 -> 1 = / r * r. + symmetry in |- *; auto with real. +Qed. + +Lemma Rinv_r_sym : forall r, r <> 0 -> 1 = r * / r. + symmetry in |- *; auto with real. +Qed. +Hint Resolve Rinv_l_sym Rinv_r_sym: real. + + +(**********) +Lemma Rmult_0_r : forall r, r * 0 = 0. +intro; ring. +Qed. +Hint Resolve Rmult_0_r: real v62. + +(**********) +Lemma Rmult_0_l : forall r, 0 * r = 0. +intro; ring. +Qed. +Hint Resolve Rmult_0_l: real v62. + +(**********) +Lemma Rmult_ne : forall r, r * 1 = r /\ 1 * r = r. +intro; split; ring. +Qed. +Hint Resolve Rmult_ne: real v62. + +(**********) +Lemma Rmult_1_r : forall r, r * 1 = r. +intro; ring. +Qed. +Hint Resolve Rmult_1_r: real. + +(**********) +Lemma Rmult_eq_compat_l : forall r r1 r2, r1 = r2 -> r * r1 = r * r2. + auto with real. +Qed. + +(*i OLD i*)Hint Resolve Rmult_eq_compat_l: v62. + +(**********) +Lemma Rmult_eq_reg_l : forall r r1 r2, r * r1 = r * r2 -> r <> 0 -> r1 = r2. + intros; transitivity (/ r * r * r1). + rewrite Rinv_l; auto with real. + transitivity (/ r * r * r2). + repeat rewrite Rmult_assoc; rewrite H; trivial. + rewrite Rinv_l; auto with real. +Qed. + +(**********) +Lemma Rmult_integral : forall r1 r2, r1 * r2 = 0 -> r1 = 0 \/ r2 = 0. + intros; case (Req_dec r1 0); [ intro Hz | intro Hnotz ]. + auto. + right; apply Rmult_eq_reg_l with r1; trivial. + rewrite H; auto with real. +Qed. + +(**********) +Lemma Rmult_eq_0_compat : forall r1 r2, r1 = 0 \/ r2 = 0 -> r1 * r2 = 0. + intros r1 r2 [H| H]; rewrite H; auto with real. +Qed. + +Hint Resolve Rmult_eq_0_compat: real. + +(**********) +Lemma Rmult_eq_0_compat_r : forall r1 r2, r1 = 0 -> r1 * r2 = 0. + auto with real. +Qed. + +(**********) +Lemma Rmult_eq_0_compat_l : forall r1 r2, r2 = 0 -> r1 * r2 = 0. + auto with real. +Qed. + + +(**********) +Lemma Rmult_neq_0_reg : forall r1 r2, r1 * r2 <> 0 -> r1 <> 0 /\ r2 <> 0. +intros r1 r2 H; split; red in |- *; intro; apply H; auto with real. +Qed. + +(**********) +Lemma Rmult_integral_contrapositive : + forall r1 r2, r1 <> 0 /\ r2 <> 0 -> r1 * r2 <> 0. +red in |- *; intros r1 r2 [H1 H2] H. +case (Rmult_integral r1 r2); auto with real. +Qed. +Hint Resolve Rmult_integral_contrapositive: real. + +(**********) +Lemma Rmult_plus_distr_r : + forall r1 r2 r3, (r1 + r2) * r3 = r1 * r3 + r2 * r3. +intros; ring. +Qed. + +(** Square function *) + +(***********) +Definition Rsqr r : R := r * r. + +(***********) +Lemma Rsqr_0 : Rsqr 0 = 0. + unfold Rsqr in |- *; auto with real. +Qed. + +(***********) +Lemma Rsqr_0_uniq : forall r, Rsqr r = 0 -> r = 0. +unfold Rsqr in |- *; intros; elim (Rmult_integral r r H); trivial. +Qed. + +(*********************************************************) +(** Opposite *) +(*********************************************************) + +(**********) +Lemma Ropp_eq_compat : forall r1 r2, r1 = r2 -> - r1 = - r2. + auto with real. +Qed. +Hint Resolve Ropp_eq_compat: real. + +(**********) +Lemma Ropp_0 : -0 = 0. + ring. +Qed. +Hint Resolve Ropp_0: real v62. + +(**********) +Lemma Ropp_eq_0_compat : forall r, r = 0 -> - r = 0. + intros; rewrite H; auto with real. +Qed. +Hint Resolve Ropp_eq_0_compat: real. + +(**********) +Lemma Ropp_involutive : forall r, - - r = r. + intro; ring. +Qed. +Hint Resolve Ropp_involutive: real. + +(*********) +Lemma Ropp_neq_0_compat : forall r, r <> 0 -> - r <> 0. +red in |- *; intros r H H0. +apply H. +transitivity (- - r); auto with real. +Qed. +Hint Resolve Ropp_neq_0_compat: real. + +(**********) +Lemma Ropp_plus_distr : forall r1 r2, - (r1 + r2) = - r1 + - r2. + intros; ring. +Qed. +Hint Resolve Ropp_plus_distr: real. + +(** Opposite and multiplication *) + +Lemma Ropp_mult_distr_l_reverse : forall r1 r2, - r1 * r2 = - (r1 * r2). + intros; ring. +Qed. +Hint Resolve Ropp_mult_distr_l_reverse: real. + +(**********) +Lemma Rmult_opp_opp : forall r1 r2, - r1 * - r2 = r1 * r2. + intros; ring. +Qed. +Hint Resolve Rmult_opp_opp: real. + +Lemma Ropp_mult_distr_r_reverse : forall r1 r2, r1 * - r2 = - (r1 * r2). +intros; rewrite <- Ropp_mult_distr_l_reverse; ring. +Qed. + +(** Substraction *) + +Lemma Rminus_0_r : forall r, r - 0 = r. +intro; ring. +Qed. +Hint Resolve Rminus_0_r: real. + +Lemma Rminus_0_l : forall r, 0 - r = - r. +intro; ring. +Qed. +Hint Resolve Rminus_0_l: real. + +(**********) +Lemma Ropp_minus_distr : forall r1 r2, - (r1 - r2) = r2 - r1. + intros; ring. +Qed. +Hint Resolve Ropp_minus_distr: real. + +Lemma Ropp_minus_distr' : forall r1 r2, - (r2 - r1) = r1 - r2. +intros; ring. +Qed. +Hint Resolve Ropp_minus_distr': real. + +(**********) +Lemma Rminus_diag_eq : forall r1 r2, r1 = r2 -> r1 - r2 = 0. + intros; rewrite H; ring. +Qed. +Hint Resolve Rminus_diag_eq: real. + +(**********) +Lemma Rminus_diag_uniq : forall r1 r2, r1 - r2 = 0 -> r1 = r2. + intros r1 r2; unfold Rminus in |- *; rewrite Rplus_comm; intro. + rewrite <- (Ropp_involutive r2); apply (Rplus_opp_r_uniq (- r2) r1 H). +Qed. +Hint Immediate Rminus_diag_uniq: real. + +Lemma Rminus_diag_uniq_sym : forall r1 r2, r2 - r1 = 0 -> r1 = r2. +intros; generalize (Rminus_diag_uniq r2 r1 H); clear H; intro H; rewrite H; + ring. +Qed. +Hint Immediate Rminus_diag_uniq_sym: real. + +Lemma Rplus_minus : forall r1 r2, r1 + (r2 - r1) = r2. +intros; ring. +Qed. +Hint Resolve Rplus_minus: real. + +(**********) +Lemma Rminus_eq_contra : forall r1 r2, r1 <> r2 -> r1 - r2 <> 0. +red in |- *; intros r1 r2 H H0. +apply H; auto with real. +Qed. +Hint Resolve Rminus_eq_contra: real. + +Lemma Rminus_not_eq : forall r1 r2, r1 - r2 <> 0 -> r1 <> r2. +red in |- *; intros; elim H; apply Rminus_diag_eq; auto. +Qed. +Hint Resolve Rminus_not_eq: real. + +Lemma Rminus_not_eq_right : forall r1 r2, r2 - r1 <> 0 -> r1 <> r2. +red in |- *; intros; elim H; rewrite H0; ring. +Qed. +Hint Resolve Rminus_not_eq_right: real. + + +(**********) +Lemma Rmult_minus_distr_l : + forall r1 r2 r3, r1 * (r2 - r3) = r1 * r2 - r1 * r3. +intros; ring. +Qed. + +(** Inverse *) +Lemma Rinv_1 : / 1 = 1. +field; auto with real. +Qed. +Hint Resolve Rinv_1: real. + +(*********) +Lemma Rinv_neq_0_compat : forall r, r <> 0 -> / r <> 0. +red in |- *; intros; apply R1_neq_R0. +replace 1 with (/ r * r); auto with real. +Qed. +Hint Resolve Rinv_neq_0_compat: real. + +(*********) +Lemma Rinv_involutive : forall r, r <> 0 -> / / r = r. +intros; field; auto with real. +Qed. +Hint Resolve Rinv_involutive: real. + +(*********) +Lemma Rinv_mult_distr : + forall r1 r2, r1 <> 0 -> r2 <> 0 -> / (r1 * r2) = / r1 * / r2. +intros; field; auto with real. +Qed. + +(*********) +Lemma Ropp_inv_permute : forall r, r <> 0 -> - / r = / - r. +intros; field; auto with real. +Qed. + +Lemma Rinv_r_simpl_r : forall r1 r2, r1 <> 0 -> r1 * / r1 * r2 = r2. +intros; transitivity (1 * r2); auto with real. +rewrite Rinv_r; auto with real. +Qed. + +Lemma Rinv_r_simpl_l : forall r1 r2, r1 <> 0 -> r2 * r1 * / r1 = r2. +intros; transitivity (r2 * 1); auto with real. +transitivity (r2 * (r1 * / r1)); auto with real. +Qed. + +Lemma Rinv_r_simpl_m : forall r1 r2, r1 <> 0 -> r1 * r2 * / r1 = r2. +intros; transitivity (r2 * 1); auto with real. +transitivity (r2 * (r1 * / r1)); auto with real. +ring. +Qed. +Hint Resolve Rinv_r_simpl_l Rinv_r_simpl_r Rinv_r_simpl_m: real. + +(*********) +Lemma Rinv_mult_simpl : + forall r1 r2 r3, r1 <> 0 -> r1 * / r2 * (r3 * / r1) = r3 * / r2. +intros a b c; intros. +transitivity (a * / a * (c * / b)); auto with real. +ring. +Qed. + +(** Order and addition *) + +Lemma Rplus_lt_compat_r : forall r r1 r2, r1 < r2 -> r1 + r < r2 + r. +intros. +rewrite (Rplus_comm r1 r); rewrite (Rplus_comm r2 r); auto with real. +Qed. + +Hint Resolve Rplus_lt_compat_r: real. + +(**********) +Lemma Rplus_lt_reg_r : forall r r1 r2, r + r1 < r + r2 -> r1 < r2. +intros; cut (- r + r + r1 < - r + r + r2). +rewrite Rplus_opp_l. +elim (Rplus_ne r1); elim (Rplus_ne r2); intros; rewrite <- H3; rewrite <- H1; + auto with zarith real. +rewrite Rplus_assoc; rewrite Rplus_assoc; + apply (Rplus_lt_compat_l (- r) (r + r1) (r + r2) H). +Qed. + +(**********) +Lemma Rplus_le_compat_l : forall r r1 r2, r1 <= r2 -> r + r1 <= r + r2. +unfold Rle in |- *; intros; elim H; intro. +left; apply (Rplus_lt_compat_l r r1 r2 H0). +right; rewrite <- H0; auto with zarith real. +Qed. + +(**********) +Lemma Rplus_le_compat_r : forall r r1 r2, r1 <= r2 -> r1 + r <= r2 + r. +unfold Rle in |- *; intros; elim H; intro. +left; apply (Rplus_lt_compat_r r r1 r2 H0). +right; rewrite <- H0; auto with real. +Qed. + +Hint Resolve Rplus_le_compat_l Rplus_le_compat_r: real. + +(**********) +Lemma Rplus_le_reg_l : forall r r1 r2, r + r1 <= r + r2 -> r1 <= r2. +unfold Rle in |- *; intros; elim H; intro. +left; apply (Rplus_lt_reg_r r r1 r2 H0). +right; apply (Rplus_eq_reg_l r r1 r2 H0). +Qed. + +(**********) +Lemma sum_inequa_Rle_lt : + forall a x b c y d:R, + a <= x -> x < b -> c < y -> y <= d -> a + c < x + y < b + d. +intros; split. +apply Rlt_le_trans with (a + y); auto with real. +apply Rlt_le_trans with (b + y); auto with real. +Qed. + +(*********) +Lemma Rplus_lt_compat : + forall r1 r2 r3 r4, r1 < r2 -> r3 < r4 -> r1 + r3 < r2 + r4. +intros; apply Rlt_trans with (r2 + r3); auto with real. +Qed. + +Lemma Rplus_le_compat : + forall r1 r2 r3 r4, r1 <= r2 -> r3 <= r4 -> r1 + r3 <= r2 + r4. +intros; apply Rle_trans with (r2 + r3); auto with real. +Qed. + +(*********) +Lemma Rplus_lt_le_compat : + forall r1 r2 r3 r4, r1 < r2 -> r3 <= r4 -> r1 + r3 < r2 + r4. +intros; apply Rlt_le_trans with (r2 + r3); auto with real. +Qed. + +(*********) +Lemma Rplus_le_lt_compat : + forall r1 r2 r3 r4, r1 <= r2 -> r3 < r4 -> r1 + r3 < r2 + r4. +intros; apply Rle_lt_trans with (r2 + r3); auto with real. +Qed. + +Hint Immediate Rplus_lt_compat Rplus_le_compat Rplus_lt_le_compat + Rplus_le_lt_compat: real. + +(** Order and Opposite *) + +(**********) +Lemma Ropp_gt_lt_contravar : forall r1 r2, r1 > r2 -> - r1 < - r2. +unfold Rgt in |- *; intros. +apply (Rplus_lt_reg_r (r2 + r1)). +replace (r2 + r1 + - r1) with r2. +replace (r2 + r1 + - r2) with r1. +trivial. +ring. +ring. +Qed. +Hint Resolve Ropp_gt_lt_contravar. + +(**********) +Lemma Ropp_lt_gt_contravar : forall r1 r2, r1 < r2 -> - r1 > - r2. +unfold Rgt in |- *; auto with real. +Qed. +Hint Resolve Ropp_lt_gt_contravar: real. + +Lemma Ropp_lt_cancel : forall r1 r2, - r2 < - r1 -> r1 < r2. +intros x y H'. +rewrite <- (Ropp_involutive x); rewrite <- (Ropp_involutive y); + auto with real. +Qed. +Hint Immediate Ropp_lt_cancel: real. + +Lemma Ropp_lt_contravar : forall r1 r2, r2 < r1 -> - r1 < - r2. +auto with real. +Qed. +Hint Resolve Ropp_lt_contravar: real. + +(**********) +Lemma Ropp_le_ge_contravar : forall r1 r2, r1 <= r2 -> - r1 >= - r2. +unfold Rge in |- *; intros r1 r2 [H| H]; auto with real. +Qed. +Hint Resolve Ropp_le_ge_contravar: real. + +Lemma Ropp_le_cancel : forall r1 r2, - r2 <= - r1 -> r1 <= r2. +intros x y H. +elim H; auto with real. +intro H1; rewrite <- (Ropp_involutive x); rewrite <- (Ropp_involutive y); + rewrite H1; auto with real. +Qed. +Hint Immediate Ropp_le_cancel: real. + +Lemma Ropp_le_contravar : forall r1 r2, r2 <= r1 -> - r1 <= - r2. +intros r1 r2 H; elim H; auto with real. +Qed. +Hint Resolve Ropp_le_contravar: real. + +(**********) +Lemma Ropp_ge_le_contravar : forall r1 r2, r1 >= r2 -> - r1 <= - r2. +unfold Rge in |- *; intros r1 r2 [H| H]; auto with real. +Qed. +Hint Resolve Ropp_ge_le_contravar: real. + +(**********) +Lemma Ropp_0_lt_gt_contravar : forall r, 0 < r -> 0 > - r. +intros; replace 0 with (-0); auto with real. +Qed. +Hint Resolve Ropp_0_lt_gt_contravar: real. + +(**********) +Lemma Ropp_0_gt_lt_contravar : forall r, 0 > r -> 0 < - r. +intros; replace 0 with (-0); auto with real. +Qed. +Hint Resolve Ropp_0_gt_lt_contravar: real. + +(**********) +Lemma Ropp_lt_gt_0_contravar : forall r, r > 0 -> - r < 0. +intros; rewrite <- Ropp_0; auto with real. +Qed. + +(**********) +Lemma Ropp_gt_lt_0_contravar : forall r, r < 0 -> - r > 0. +intros; rewrite <- Ropp_0; auto with real. +Qed. +Hint Resolve Ropp_lt_gt_0_contravar Ropp_gt_lt_0_contravar: real. + +(**********) +Lemma Ropp_0_le_ge_contravar : forall r, 0 <= r -> 0 >= - r. +intros; replace 0 with (-0); auto with real. +Qed. +Hint Resolve Ropp_0_le_ge_contravar: real. + +(**********) +Lemma Ropp_0_ge_le_contravar : forall r, 0 >= r -> 0 <= - r. +intros; replace 0 with (-0); auto with real. +Qed. +Hint Resolve Ropp_0_ge_le_contravar: real. + +(** Order and multiplication *) + +Lemma Rmult_lt_compat_r : forall r r1 r2, 0 < r -> r1 < r2 -> r1 * r < r2 * r. +intros; rewrite (Rmult_comm r1 r); rewrite (Rmult_comm r2 r); auto with real. +Qed. +Hint Resolve Rmult_lt_compat_r. + +Lemma Rmult_lt_reg_l : forall r r1 r2, 0 < r -> r * r1 < r * r2 -> r1 < r2. +intros z x y H H0. +case (Rtotal_order x y); intros Eq0; auto; elim Eq0; clear Eq0; intros Eq0. + rewrite Eq0 in H0; elimtype False; apply (Rlt_irrefl (z * y)); auto. +generalize (Rmult_lt_compat_l z y x H Eq0); intro; elimtype False; + generalize (Rlt_trans (z * x) (z * y) (z * x) H0 H1); + intro; apply (Rlt_irrefl (z * x)); auto. +Qed. + + +Lemma Rmult_lt_gt_compat_neg_l : + forall r r1 r2, r < 0 -> r1 < r2 -> r * r1 > r * r2. +intros; replace r with (- - r); auto with real. +rewrite (Ropp_mult_distr_l_reverse (- r)); + rewrite (Ropp_mult_distr_l_reverse (- r)). +apply Ropp_lt_gt_contravar; auto with real. +Qed. + +(**********) +Lemma Rmult_le_compat_l : + forall r r1 r2, 0 <= r -> r1 <= r2 -> r * r1 <= r * r2. +intros r r1 r2 H H0; destruct H; destruct H0; unfold Rle in |- *; + auto with real. +right; rewrite <- H; do 2 rewrite Rmult_0_l; reflexivity. +Qed. +Hint Resolve Rmult_le_compat_l: real. + +Lemma Rmult_le_compat_r : + forall r r1 r2, 0 <= r -> r1 <= r2 -> r1 * r <= r2 * r. +intros r r1 r2 H; rewrite (Rmult_comm r1 r); rewrite (Rmult_comm r2 r); + auto with real. +Qed. +Hint Resolve Rmult_le_compat_r: real. + +Lemma Rmult_le_reg_l : forall r r1 r2, 0 < r -> r * r1 <= r * r2 -> r1 <= r2. +intros z x y H H0; case H0; auto with real. +intros H1; apply Rlt_le. +apply Rmult_lt_reg_l with (r := z); auto. +intros H1; replace x with (/ z * (z * x)); auto with real. +replace y with (/ z * (z * y)). + rewrite H1; auto with real. +rewrite <- Rmult_assoc; rewrite Rinv_l; auto with real. +rewrite <- Rmult_assoc; rewrite Rinv_l; auto with real. +Qed. + +Lemma Rmult_le_compat_neg_l : + forall r r1 r2, r <= 0 -> r1 <= r2 -> r * r2 <= r * r1. +intros; replace r with (- - r); auto with real. +do 2 rewrite (Ropp_mult_distr_l_reverse (- r)). +apply Ropp_le_contravar; auto with real. +Qed. +Hint Resolve Rmult_le_compat_neg_l: real. + +Lemma Rmult_le_ge_compat_neg_l : + forall r r1 r2, r <= 0 -> r1 <= r2 -> r * r1 >= r * r2. +intros; apply Rle_ge; auto with real. +Qed. +Hint Resolve Rmult_le_ge_compat_neg_l: real. + +Lemma Rmult_le_compat : + forall r1 r2 r3 r4, + 0 <= r1 -> 0 <= r3 -> r1 <= r2 -> r3 <= r4 -> r1 * r3 <= r2 * r4. +intros x y z t H' H'0 H'1 H'2. +apply Rle_trans with (r2 := x * t); auto with real. +repeat rewrite (fun x => Rmult_comm x t). +apply Rmult_le_compat_l; auto. +apply Rle_trans with z; auto. +Qed. +Hint Resolve Rmult_le_compat: real. + +Lemma Rmult_gt_0_lt_compat : + forall r1 r2 r3 r4, + r3 > 0 -> r2 > 0 -> r1 < r2 -> r3 < r4 -> r1 * r3 < r2 * r4. +intros; apply Rlt_trans with (r2 * r3); auto with real. +Qed. + +(*********) +Lemma Rmult_ge_0_gt_0_lt_compat : + forall r1 r2 r3 r4, + r3 >= 0 -> r2 > 0 -> r1 < r2 -> r3 < r4 -> r1 * r3 < r2 * r4. +intros; apply Rle_lt_trans with (r2 * r3); auto with real. +Qed. + +(** Order and Substractions *) +Lemma Rlt_minus : forall r1 r2, r1 < r2 -> r1 - r2 < 0. +intros; apply (Rplus_lt_reg_r r2). +replace (r2 + (r1 - r2)) with r1. +replace (r2 + 0) with r2; auto with real. +ring. +Qed. +Hint Resolve Rlt_minus: real. + +(**********) +Lemma Rle_minus : forall r1 r2, r1 <= r2 -> r1 - r2 <= 0. +destruct 1; unfold Rle in |- *; auto with real. +Qed. + +(**********) +Lemma Rminus_lt : forall r1 r2, r1 - r2 < 0 -> r1 < r2. +intros; replace r1 with (r1 - r2 + r2). +pattern r2 at 3 in |- *; replace r2 with (0 + r2); auto with real. +ring. +Qed. + +(**********) +Lemma Rminus_le : forall r1 r2, r1 - r2 <= 0 -> r1 <= r2. +intros; replace r1 with (r1 - r2 + r2). +pattern r2 at 3 in |- *; replace r2 with (0 + r2); auto with real. +ring. +Qed. + +(**********) +Lemma tech_Rplus : forall r (s:R), 0 <= r -> 0 < s -> r + s <> 0. +intros; apply sym_not_eq; apply Rlt_not_eq. +rewrite Rplus_comm; replace 0 with (0 + 0); auto with real. +Qed. +Hint Immediate tech_Rplus: real. + +(** Order and the square function *) +Lemma Rle_0_sqr : forall r, 0 <= Rsqr r. +intro; case (Rlt_le_dec r 0); unfold Rsqr in |- *; intro. +replace (r * r) with (- r * - r); auto with real. +replace 0 with (- r * 0); auto with real. +replace 0 with (0 * r); auto with real. +Qed. + +(***********) +Lemma Rlt_0_sqr : forall r, r <> 0 -> 0 < Rsqr r. +intros; case (Rdichotomy r 0); trivial; unfold Rsqr in |- *; intro. +replace (r * r) with (- r * - r); auto with real. +replace 0 with (- r * 0); auto with real. +replace 0 with (0 * r); auto with real. +Qed. +Hint Resolve Rle_0_sqr Rlt_0_sqr: real. + +(** Zero is less than one *) +Lemma Rlt_0_1 : 0 < 1. +replace 1 with (Rsqr 1); auto with real. +unfold Rsqr in |- *; auto with real. +Qed. +Hint Resolve Rlt_0_1: real. + +Lemma Rle_0_1 : 0 <= 1. +left. +exact Rlt_0_1. +Qed. + +(** Order and inverse *) +Lemma Rinv_0_lt_compat : forall r, 0 < r -> 0 < / r. +intros; apply Rnot_le_lt; red in |- *; intros. +absurd (1 <= 0); auto with real. +replace 1 with (r * / r); auto with real. +replace 0 with (r * 0); auto with real. +Qed. +Hint Resolve Rinv_0_lt_compat: real. + +(*********) +Lemma Rinv_lt_0_compat : forall r, r < 0 -> / r < 0. +intros; apply Rnot_le_lt; red in |- *; intros. +absurd (1 <= 0); auto with real. +replace 1 with (r * / r); auto with real. +replace 0 with (r * 0); auto with real. +Qed. +Hint Resolve Rinv_lt_0_compat: real. + +(*********) +Lemma Rinv_lt_contravar : forall r1 r2, 0 < r1 * r2 -> r1 < r2 -> / r2 < / r1. +intros; apply Rmult_lt_reg_l with (r1 * r2); auto with real. +case (Rmult_neq_0_reg r1 r2); intros; auto with real. +replace (r1 * r2 * / r2) with r1. +replace (r1 * r2 * / r1) with r2; trivial. +symmetry in |- *; auto with real. +symmetry in |- *; auto with real. +Qed. + +Lemma Rinv_1_lt_contravar : forall r1 r2, 1 <= r1 -> r1 < r2 -> / r2 < / r1. +intros x y H' H'0. +cut (0 < x); [ intros Lt0 | apply Rlt_le_trans with (r2 := 1) ]; + auto with real. +apply Rmult_lt_reg_l with (r := x); auto with real. +rewrite (Rmult_comm x (/ x)); rewrite Rinv_l; auto with real. +apply Rmult_lt_reg_l with (r := y); auto with real. +apply Rlt_trans with (r2 := x); auto. +cut (y * (x * / y) = x). +intro H1; rewrite H1; rewrite (Rmult_1_r y); auto. +rewrite (Rmult_comm x); rewrite <- Rmult_assoc; rewrite (Rmult_comm y (/ y)); + rewrite Rinv_l; auto with real. +apply Rlt_dichotomy_converse; right. +red in |- *; apply Rlt_trans with (r2 := x); auto with real. +Qed. +Hint Resolve Rinv_1_lt_contravar: real. + +(*********************************************************) +(** Greater *) +(*********************************************************) + +(**********) +Lemma Rge_antisym : forall r1 r2, r1 >= r2 -> r2 >= r1 -> r1 = r2. +intros; apply Rle_antisym; auto with real. +Qed. + +(**********) +Lemma Rnot_lt_ge : forall r1 r2, ~ r1 < r2 -> r1 >= r2. +intros; unfold Rge in |- *; elim (Rtotal_order r1 r2); intro. +absurd (r1 < r2); trivial. +case H0; auto. +Qed. + +(**********) +Lemma Rnot_lt_le : forall r1 r2, ~ r1 < r2 -> r2 <= r1. +intros; apply Rge_le; apply Rnot_lt_ge; assumption. +Qed. + +(**********) +Lemma Rnot_gt_le : forall r1 r2, ~ r1 > r2 -> r1 <= r2. +intros r1 r2 H; apply Rge_le. +exact (Rnot_lt_ge r2 r1 H). +Qed. + +(**********) +Lemma Rgt_ge : forall r1 r2, r1 > r2 -> r1 >= r2. +red in |- *; auto with real. +Qed. + + +(**********) +Lemma Rge_gt_trans : forall r1 r2 r3, r1 >= r2 -> r2 > r3 -> r1 > r3. +unfold Rgt in |- *; intros; apply Rlt_le_trans with r2; auto with real. +Qed. + +(**********) +Lemma Rgt_ge_trans : forall r1 r2 r3, r1 > r2 -> r2 >= r3 -> r1 > r3. +unfold Rgt in |- *; intros; apply Rle_lt_trans with r2; auto with real. +Qed. + +(**********) +Lemma Rgt_trans : forall r1 r2 r3, r1 > r2 -> r2 > r3 -> r1 > r3. +unfold Rgt in |- *; intros; apply Rlt_trans with r2; auto with real. +Qed. + +(**********) +Lemma Rge_trans : forall r1 r2 r3, r1 >= r2 -> r2 >= r3 -> r1 >= r3. +intros; apply Rle_ge. +apply Rle_trans with r2; auto with real. +Qed. + +(**********) +Lemma Rle_lt_0_plus_1 : forall r, 0 <= r -> 0 < r + 1. +intros. +apply Rlt_le_trans with 1; auto with real. +pattern 1 at 1 in |- *; replace 1 with (0 + 1); auto with real. +Qed. +Hint Resolve Rle_lt_0_plus_1: real. + +(**********) +Lemma Rlt_plus_1 : forall r, r < r + 1. +intros. +pattern r at 1 in |- *; replace r with (r + 0); auto with real. +Qed. +Hint Resolve Rlt_plus_1: real. + +(**********) +Lemma tech_Rgt_minus : forall r1 r2, 0 < r2 -> r1 > r1 - r2. +red in |- *; unfold Rminus in |- *; intros. +pattern r1 at 2 in |- *; replace r1 with (r1 + 0); auto with real. +Qed. + +(***********) +Lemma Rplus_gt_compat_l : forall r r1 r2, r1 > r2 -> r + r1 > r + r2. +unfold Rgt in |- *; auto with real. +Qed. +Hint Resolve Rplus_gt_compat_l: real. + +(***********) +Lemma Rplus_gt_reg_l : forall r r1 r2, r + r1 > r + r2 -> r1 > r2. +unfold Rgt in |- *; intros; apply (Rplus_lt_reg_r r r2 r1 H). +Qed. + +(***********) +Lemma Rplus_ge_compat_l : forall r r1 r2, r1 >= r2 -> r + r1 >= r + r2. +intros; apply Rle_ge; auto with real. +Qed. +Hint Resolve Rplus_ge_compat_l: real. + +(***********) +Lemma Rplus_ge_reg_l : forall r r1 r2, r + r1 >= r + r2 -> r1 >= r2. +intros; apply Rle_ge; apply Rplus_le_reg_l with r; auto with real. +Qed. + +(***********) +Lemma Rmult_ge_compat_r : + forall r r1 r2, r >= 0 -> r1 >= r2 -> r1 * r >= r2 * r. +intros; apply Rle_ge; apply Rmult_le_compat_r; apply Rge_le; assumption. +Qed. + +(***********) +Lemma Rgt_minus : forall r1 r2, r1 > r2 -> r1 - r2 > 0. +intros; replace 0 with (r2 - r2); auto with real. +unfold Rgt, Rminus in |- *; auto with real. +Qed. + +(*********) +Lemma minus_Rgt : forall r1 r2, r1 - r2 > 0 -> r1 > r2. +intros; replace r2 with (r2 + 0); auto with real. +intros; replace r1 with (r2 + (r1 - r2)); auto with real. +Qed. + +(**********) +Lemma Rge_minus : forall r1 r2, r1 >= r2 -> r1 - r2 >= 0. +unfold Rge in |- *; intros; elim H; intro. +left; apply (Rgt_minus r1 r2 H0). +right; apply (Rminus_diag_eq r1 r2 H0). +Qed. + +(*********) +Lemma minus_Rge : forall r1 r2, r1 - r2 >= 0 -> r1 >= r2. +intros; replace r2 with (r2 + 0); auto with real. +intros; replace r1 with (r2 + (r1 - r2)); auto with real. +Qed. + + +(*********) +Lemma Rmult_gt_0_compat : forall r1 r2, r1 > 0 -> r2 > 0 -> r1 * r2 > 0. +unfold Rgt in |- *; intros. +replace 0 with (0 * r2); auto with real. +Qed. + +(*********) +Lemma Rmult_lt_0_compat : forall r1 r2, 0 < r1 -> 0 < r2 -> 0 < r1 * r2. +Proof Rmult_gt_0_compat. + +(***********) +Lemma Rplus_eq_0_l : + forall r1 r2, 0 <= r1 -> 0 <= r2 -> r1 + r2 = 0 -> r1 = 0. +intros a b [H| H] H0 H1; auto with real. +absurd (0 < a + b). +rewrite H1; auto with real. +replace 0 with (0 + 0); auto with real. +Qed. + + +Lemma Rplus_eq_R0 : + forall r1 r2, 0 <= r1 -> 0 <= r2 -> r1 + r2 = 0 -> r1 = 0 /\ r2 = 0. +intros a b; split. +apply Rplus_eq_0_l with b; auto with real. +apply Rplus_eq_0_l with a; auto with real. +rewrite Rplus_comm; auto with real. +Qed. + + +(***********) +Lemma Rplus_sqr_eq_0_l : forall r1 r2, Rsqr r1 + Rsqr r2 = 0 -> r1 = 0. +intros a b; intros; apply Rsqr_0_uniq; apply Rplus_eq_0_l with (Rsqr b); + auto with real. +Qed. + +Lemma Rplus_sqr_eq_0 : + forall r1 r2, Rsqr r1 + Rsqr r2 = 0 -> r1 = 0 /\ r2 = 0. +intros a b; split. +apply Rplus_sqr_eq_0_l with b; auto with real. +apply Rplus_sqr_eq_0_l with a; auto with real. +rewrite Rplus_comm; auto with real. +Qed. + + +(**********************************************************) +(** Injection from [N] to [R] *) +(**********************************************************) + +(**********) +Lemma S_INR : forall n:nat, INR (S n) = INR n + 1. +intro; case n; auto with real. +Qed. + +(**********) +Lemma S_O_plus_INR : forall n:nat, INR (1 + n) = INR 1 + INR n. +intro; simpl in |- *; case n; intros; auto with real. +Qed. + +(**********) +Lemma plus_INR : forall n m:nat, INR (n + m) = INR n + INR m. +intros n m; induction n as [| n Hrecn]. +simpl in |- *; auto with real. +replace (S n + m)%nat with (S (n + m)); auto with arith. +repeat rewrite S_INR. +rewrite Hrecn; ring. +Qed. + +(**********) +Lemma minus_INR : forall n m:nat, (m <= n)%nat -> INR (n - m) = INR n - INR m. +intros n m le; pattern m, n in |- *; apply le_elim_rel; auto with real. +intros; rewrite <- minus_n_O; auto with real. +intros; repeat rewrite S_INR; simpl in |- *. +rewrite H0; ring. +Qed. + +(*********) +Lemma mult_INR : forall n m:nat, INR (n * m) = INR n * INR m. +intros n m; induction n as [| n Hrecn]. +simpl in |- *; auto with real. +intros; repeat rewrite S_INR; simpl in |- *. +rewrite plus_INR; rewrite Hrecn; ring. +Qed. + +Hint Resolve plus_INR minus_INR mult_INR: real. + +(*********) +Lemma lt_INR_0 : forall n:nat, (0 < n)%nat -> 0 < INR n. +simple induction 1; intros; auto with real. +rewrite S_INR; auto with real. +Qed. +Hint Resolve lt_INR_0: real. + +Lemma lt_INR : forall n m:nat, (n < m)%nat -> INR n < INR m. +simple induction 1; intros; auto with real. +rewrite S_INR; auto with real. +rewrite S_INR; apply Rlt_trans with (INR m0); auto with real. +Qed. +Hint Resolve lt_INR: real. + +Lemma INR_lt_1 : forall n:nat, (1 < n)%nat -> 1 < INR n. +intros; replace 1 with (INR 1); auto with real. +Qed. +Hint Resolve INR_lt_1: real. + +(**********) +Lemma INR_pos : forall p:positive, 0 < INR (nat_of_P p). +intro; apply lt_INR_0. +simpl in |- *; auto with real. +apply lt_O_nat_of_P. +Qed. +Hint Resolve INR_pos: real. + +(**********) +Lemma pos_INR : forall n:nat, 0 <= INR n. +intro n; case n. +simpl in |- *; auto with real. +auto with arith real. +Qed. +Hint Resolve pos_INR: real. + +Lemma INR_lt : forall n m:nat, INR n < INR m -> (n < m)%nat. +double induction n m; intros. +simpl in |- *; elimtype False; apply (Rlt_irrefl 0); auto. +auto with arith. +generalize (pos_INR (S n0)); intro; cut (INR 0 = 0); + [ intro H2; rewrite H2 in H0; idtac | simpl in |- *; trivial ]. +generalize (Rle_lt_trans 0 (INR (S n0)) 0 H1 H0); intro; elimtype False; + apply (Rlt_irrefl 0); auto. +do 2 rewrite S_INR in H1; cut (INR n1 < INR n0). +intro H2; generalize (H0 n0 H2); intro; auto with arith. +apply (Rplus_lt_reg_r 1 (INR n1) (INR n0)). +rewrite Rplus_comm; rewrite (Rplus_comm 1 (INR n0)); trivial. +Qed. +Hint Resolve INR_lt: real. + +(*********) +Lemma le_INR : forall n m:nat, (n <= m)%nat -> INR n <= INR m. +simple induction 1; intros; auto with real. +rewrite S_INR. +apply Rle_trans with (INR m0); auto with real. +Qed. +Hint Resolve le_INR: real. + +(**********) +Lemma not_INR_O : forall n:nat, INR n <> 0 -> n <> 0%nat. +red in |- *; intros n H H1. +apply H. +rewrite H1; trivial. +Qed. +Hint Immediate not_INR_O: real. + +(**********) +Lemma not_O_INR : forall n:nat, n <> 0%nat -> INR n <> 0. +intro n; case n. +intro; absurd (0%nat = 0%nat); trivial. +intros; rewrite S_INR. +apply Rgt_not_eq; red in |- *; auto with real. +Qed. +Hint Resolve not_O_INR: real. + +Lemma not_nm_INR : forall n m:nat, n <> m -> INR n <> INR m. +intros n m H; case (le_or_lt n m); intros H1. +case (le_lt_or_eq _ _ H1); intros H2. +apply Rlt_dichotomy_converse; auto with real. +elimtype False; auto. +apply sym_not_eq; apply Rlt_dichotomy_converse; auto with real. +Qed. +Hint Resolve not_nm_INR: real. + +Lemma INR_eq : forall n m:nat, INR n = INR m -> n = m. +intros; case (le_or_lt n m); intros H1. +case (le_lt_or_eq _ _ H1); intros H2; auto. +cut (n <> m). +intro H3; generalize (not_nm_INR n m H3); intro H4; elimtype False; auto. +omega. +symmetry in |- *; cut (m <> n). +intro H3; generalize (not_nm_INR m n H3); intro H4; elimtype False; auto. +omega. +Qed. +Hint Resolve INR_eq: real. + +Lemma INR_le : forall n m:nat, INR n <= INR m -> (n <= m)%nat. +intros; elim H; intro. +generalize (INR_lt n m H0); intro; auto with arith. +generalize (INR_eq n m H0); intro; rewrite H1; auto. +Qed. +Hint Resolve INR_le: real. + +Lemma not_1_INR : forall n:nat, n <> 1%nat -> INR n <> 1. +replace 1 with (INR 1); auto with real. +Qed. +Hint Resolve not_1_INR: real. + +(**********************************************************) +(** Injection from [Z] to [R] *) +(**********************************************************) + + +(**********) +Lemma IZN : forall n:Z, (0 <= n)%Z -> exists m : nat, n = Z_of_nat m. +intros z; idtac; apply Z_of_nat_complete; assumption. +Qed. + +(**********) +Lemma INR_IZR_INZ : forall n:nat, INR n = IZR (Z_of_nat n). +simple induction n; auto with real. +intros; simpl in |- *; rewrite nat_of_P_o_P_of_succ_nat_eq_succ; + auto with real. +Qed. + +Lemma plus_IZR_NEG_POS : + forall p q:positive, IZR (Zpos p + Zneg q) = IZR (Zpos p) + IZR (Zneg q). +intros. +case (lt_eq_lt_dec (nat_of_P p) (nat_of_P q)). +intros [H| H]; simpl in |- *. +rewrite nat_of_P_lt_Lt_compare_complement_morphism; simpl in |- *; trivial. +rewrite (nat_of_P_minus_morphism q p). +rewrite minus_INR; auto with arith; ring. +apply ZC2; apply nat_of_P_lt_Lt_compare_complement_morphism; trivial. +rewrite (nat_of_P_inj p q); trivial. +rewrite Pcompare_refl; simpl in |- *; auto with real. +intro H; simpl in |- *. +rewrite nat_of_P_gt_Gt_compare_complement_morphism; simpl in |- *; + auto with arith. +rewrite (nat_of_P_minus_morphism p q). +rewrite minus_INR; auto with arith; ring. +apply ZC2; apply nat_of_P_lt_Lt_compare_complement_morphism; trivial. +Qed. + +(**********) +Lemma plus_IZR : forall n m:Z, IZR (n + m) = IZR n + IZR m. +intro z; destruct z; intro t; destruct t; intros; auto with real. +simpl in |- *; intros; rewrite nat_of_P_plus_morphism; auto with real. +apply plus_IZR_NEG_POS. +rewrite Zplus_comm; rewrite Rplus_comm; apply plus_IZR_NEG_POS. +simpl in |- *; intros; rewrite nat_of_P_plus_morphism; rewrite plus_INR; + auto with real. +Qed. + +(**********) +Lemma mult_IZR : forall n m:Z, IZR (n * m) = IZR n * IZR m. +intros z t; case z; case t; simpl in |- *; auto with real. +intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real. +intros t1 z1; 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. +intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real. +rewrite Ropp_mult_distr_l_reverse; auto with real. +intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real. +rewrite Rmult_opp_opp; auto with real. +Qed. + +(**********) +Lemma Ropp_Ropp_IZR : forall n:Z, IZR (- n) = - IZR n. +intro z; case z; simpl in |- *; auto with real. +Qed. + +(**********) +Lemma Z_R_minus : forall n m:Z, IZR n - IZR m = IZR (n - m). +intros z1 z2; unfold Rminus in |- *; unfold Zminus in |- *. +rewrite <- (Ropp_Ropp_IZR z2); symmetry in |- *; apply plus_IZR. +Qed. + +(**********) +Lemma lt_O_IZR : forall n:Z, 0 < IZR n -> (0 < n)%Z. +intro z; case z; simpl in |- *; intros. +absurd (0 < 0); auto with real. +unfold Zlt in |- *; simpl in |- *; trivial. +case Rlt_not_le with (1 := H). +replace 0 with (-0); auto with real. +Qed. + +(**********) +Lemma lt_IZR : forall n m:Z, IZR n < IZR m -> (n < m)%Z. +intros z1 z2 H; apply Zlt_O_minus_lt. +apply lt_O_IZR. +rewrite <- Z_R_minus. +exact (Rgt_minus (IZR z2) (IZR z1) H). +Qed. + +(**********) +Lemma eq_IZR_R0 : forall n:Z, IZR n = 0 -> n = 0%Z. +intro z; destruct z; simpl in |- *; intros; auto with zarith. +case (Rlt_not_eq 0 (INR (nat_of_P p))); auto with real. +case (Rlt_not_eq (- INR (nat_of_P p)) 0); auto with real. +apply Ropp_lt_gt_0_contravar. unfold Rgt in |- *; apply INR_pos. +Qed. + +(**********) +Lemma eq_IZR : forall n m:Z, IZR n = IZR m -> n = m. +intros z1 z2 H; generalize (Rminus_diag_eq (IZR z1) (IZR z2) H); + rewrite (Z_R_minus z1 z2); intro; generalize (eq_IZR_R0 (z1 - z2) H0); + intro; omega. +Qed. + +(**********) +Lemma not_O_IZR : forall n:Z, n <> 0%Z -> IZR n <> 0. +intros z H; red in |- *; intros H0; case H. +apply eq_IZR; auto. +Qed. + +(*********) +Lemma le_O_IZR : forall n:Z, 0 <= IZR n -> (0 <= n)%Z. +unfold Rle in |- *; intros z [H| H]. +red in |- *; intro; apply (Zlt_le_weak 0 z (lt_O_IZR z H)); assumption. +rewrite (eq_IZR_R0 z); auto with zarith real. +Qed. + +(**********) +Lemma le_IZR : forall n m:Z, IZR n <= IZR m -> (n <= m)%Z. +unfold Rle in |- *; intros z1 z2 [H| H]. +apply (Zlt_le_weak z1 z2); auto with real. +apply lt_IZR; trivial. +rewrite (eq_IZR z1 z2); auto with zarith real. +Qed. + +(**********) +Lemma le_IZR_R1 : forall n:Z, IZR n <= 1 -> (n <= 1)%Z. +pattern 1 at 1 in |- *; replace 1 with (IZR 1); intros; auto. +apply le_IZR; trivial. +Qed. + +(**********) +Lemma IZR_ge : forall n m:Z, (n >= m)%Z -> IZR n >= IZR m. +intros m n H; apply Rnot_lt_ge; red in |- *; intro. +generalize (lt_IZR m n H0); intro; omega. +Qed. + +Lemma IZR_le : forall n m:Z, (n <= m)%Z -> IZR n <= IZR m. +intros m n H; apply Rnot_gt_le; red in |- *; intro. +unfold Rgt in H0; generalize (lt_IZR n m H0); intro; omega. +Qed. + +Lemma IZR_lt : forall n m:Z, (n < m)%Z -> IZR n < IZR m. +intros m n H; cut (m <= n)%Z. +intro H0; elim (IZR_le m n H0); intro; auto. +generalize (eq_IZR m n H1); intro; elimtype False; omega. +omega. +Qed. + +Lemma one_IZR_lt1 : forall n:Z, -1 < IZR n < 1 -> n = 0%Z. +intros z [H1 H2]. +apply Zle_antisym. +apply Zlt_succ_le; apply lt_IZR; trivial. +replace 0%Z with (Zsucc (-1)); trivial. +apply Zlt_le_succ; apply lt_IZR; trivial. +Qed. + +Lemma one_IZR_r_R1 : + forall r (n m:Z), r < IZR n <= r + 1 -> r < IZR m <= r + 1 -> n = m. +intros r z x [H1 H2] [H3 H4]. +cut ((z - x)%Z = 0%Z); auto with zarith. +apply one_IZR_lt1. +rewrite <- Z_R_minus; split. +replace (-1) with (r - (r + 1)). +unfold Rminus in |- *; apply Rplus_lt_le_compat; auto with real. +ring. +replace 1 with (r + 1 - r). +unfold Rminus in |- *; apply Rplus_le_lt_compat; auto with real. +ring. +Qed. + + +(**********) +Lemma single_z_r_R1 : + forall r (n m:Z), + r < IZR n -> IZR n <= r + 1 -> r < IZR m -> IZR m <= r + 1 -> n = m. +intros; apply one_IZR_r_R1 with r; auto. +Qed. + +(**********) +Lemma tech_single_z_r_R1 : + forall r (n:Z), + r < IZR n -> + IZR n <= r + 1 -> + (exists s : Z, s <> n /\ r < IZR s /\ IZR s <= r + 1) -> False. +intros r z H1 H2 [s [H3 [H4 H5]]]. +apply H3; apply single_z_r_R1 with r; trivial. +Qed. + +(*****************************************************************) +(** Definitions of new types *) +(*****************************************************************) + +Record nonnegreal : Type := mknonnegreal + {nonneg :> R; cond_nonneg : 0 <= nonneg}. + +Record posreal : Type := mkposreal {pos :> R; cond_pos : 0 < pos}. + +Record nonposreal : Type := mknonposreal + {nonpos :> R; cond_nonpos : nonpos <= 0}. + +Record negreal : Type := mknegreal {neg :> R; cond_neg : neg < 0}. + +Record nonzeroreal : Type := mknonzeroreal + {nonzero :> R; cond_nonzero : nonzero <> 0}. + +(**********) +Lemma prod_neq_R0 : forall r1 r2, r1 <> 0 -> r2 <> 0 -> r1 * r2 <> 0. +intros x y; intros; red in |- *; intro; generalize (Rmult_integral x y H1); + intro; elim H2; intro; + [ rewrite H3 in H; elim H | rewrite H3 in H0; elim H0 ]; + reflexivity. +Qed. + +(*********) +Lemma Rmult_le_pos : forall r1 r2, 0 <= r1 -> 0 <= r2 -> 0 <= r1 * r2. +intros x y H H0; rewrite <- (Rmult_0_l x); rewrite <- (Rmult_comm x); + apply (Rmult_le_compat_l x 0 y H H0). +Qed. + +Lemma double : forall r1, 2 * r1 = r1 + r1. +intro; ring. +Qed. + +Lemma double_var : forall r1, r1 = r1 / 2 + r1 / 2. +intro; rewrite <- double; unfold Rdiv in |- *; rewrite <- Rmult_assoc; + symmetry in |- *; apply Rinv_r_simpl_m. +replace 2 with (INR 2); + [ apply not_O_INR; discriminate | unfold INR in |- *; ring ]. +Qed. + +(**********************************************************) +(** Other rules about < and <= *) +(**********************************************************) + +Lemma Rplus_lt_0_compat : forall r1 r2, 0 < r1 -> 0 < r2 -> 0 < r1 + r2. +intros x y; intros; apply Rlt_trans with x; + [ assumption + | pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_lt_compat_l; + assumption ]. +Qed. + +Lemma Rplus_le_lt_0_compat : forall r1 r2, 0 <= r1 -> 0 < r2 -> 0 < r1 + r2. +intros x y; intros; apply Rle_lt_trans with x; + [ assumption + | pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_lt_compat_l; + assumption ]. +Qed. + +Lemma Rplus_lt_le_0_compat : forall r1 r2, 0 < r1 -> 0 <= r2 -> 0 < r1 + r2. +intros x y; intros; rewrite <- Rplus_comm; apply Rplus_le_lt_0_compat; + assumption. +Qed. + +Lemma Rplus_le_le_0_compat : forall r1 r2, 0 <= r1 -> 0 <= r2 -> 0 <= r1 + r2. +intros x y; intros; apply Rle_trans with x; + [ assumption + | pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l; + assumption ]. +Qed. + +Lemma plus_le_is_le : forall r1 r2 r3, 0 <= r2 -> r1 + r2 <= r3 -> r1 <= r3. +intros x y z; intros; apply Rle_trans with (x + y); + [ pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l; + assumption + | assumption ]. +Qed. + +Lemma plus_lt_is_lt : forall r1 r2 r3, 0 <= r2 -> r1 + r2 < r3 -> r1 < r3. +intros x y z; intros; apply Rle_lt_trans with (x + y); + [ pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l; + assumption + | assumption ]. +Qed. + +Lemma Rmult_le_0_lt_compat : + forall r1 r2 r3 r4, + 0 <= r1 -> 0 <= r3 -> r1 < r2 -> r3 < r4 -> r1 * r3 < r2 * r4. +intros; apply Rle_lt_trans with (r2 * r3); + [ apply Rmult_le_compat_r; [ assumption | left; assumption ] + | apply Rmult_lt_compat_l; + [ apply Rle_lt_trans with r1; assumption | assumption ] ]. +Qed. + +Lemma le_epsilon : + forall r1 r2, (forall eps:R, 0 < eps -> r1 <= r2 + eps) -> r1 <= r2. +intros x y; intros; elim (Rtotal_order x y); intro. +left; assumption. +elim H0; intro. +right; assumption. +clear H0; generalize (Rgt_minus x y H1); intro H2; change (0 < x - y) in H2. +cut (0 < 2). +intro. +generalize (Rmult_lt_0_compat (x - y) (/ 2) H2 (Rinv_0_lt_compat 2 H0)); + intro H3; generalize (H ((x - y) * / 2) H3); + replace (y + (x - y) * / 2) with ((y + x) * / 2). +intro H4; + generalize (Rmult_le_compat_l 2 x ((y + x) * / 2) (Rlt_le 0 2 H0) H4); + rewrite <- (Rmult_comm ((y + x) * / 2)); rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; replace (2 * x) with (x + x). +rewrite (Rplus_comm y); intro H5; apply Rplus_le_reg_l with x; assumption. +ring. +replace 2 with (INR 2); [ apply not_O_INR; discriminate | ring ]. +pattern y at 2 in |- *; replace y with (y / 2 + y / 2). +unfold Rminus, Rdiv in |- *. +repeat rewrite Rmult_plus_distr_r. +ring. +cut (forall z:R, 2 * z = z + z). +intro. +rewrite <- (H4 (y / 2)). +unfold Rdiv in |- *. +rewrite <- Rmult_assoc; apply Rinv_r_simpl_m. +replace 2 with (INR 2). +apply not_O_INR. +discriminate. +unfold INR in |- *; reflexivity. +intro; ring. +cut (0%nat <> 2%nat); + [ intro H0; generalize (lt_INR_0 2 (neq_O_lt 2 H0)); unfold INR in |- *; + intro; assumption + | discriminate ]. +Qed. + +(**********) +Lemma completeness_weak : + forall E:R -> Prop, + bound E -> (exists x : R, E x) -> exists m : R, is_lub E m. +intros; elim (completeness E H H0); intros; split with x; assumption. +Qed. diff --git a/theories/Reals/RList.v b/theories/Reals/RList.v new file mode 100644 index 00000000..3b58c02f --- /dev/null +++ b/theories/Reals/RList.v @@ -0,0 +1,744 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: RList.v,v 1.10.2.1 2004/07/16 19:31:11 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rfunctions. +Open Local Scope R_scope. + +Inductive Rlist : Type := + | nil : Rlist + | cons : R -> Rlist -> Rlist. + +Fixpoint In (x:R) (l:Rlist) {struct l} : Prop := + match l with + | nil => False + | cons a l' => x = a \/ In x l' + end. + +Fixpoint Rlength (l:Rlist) : nat := + match l with + | nil => 0%nat + | cons a l' => S (Rlength l') + end. + +Fixpoint MaxRlist (l:Rlist) : R := + match l with + | nil => 0 + | cons a l1 => + match l1 with + | nil => a + | cons a' l2 => Rmax a (MaxRlist l1) + end + end. + +Fixpoint MinRlist (l:Rlist) : R := + match l with + | nil => 1 + | cons a l1 => + match l1 with + | nil => a + | cons a' l2 => Rmin a (MinRlist l1) + end + end. + +Lemma MaxRlist_P1 : forall (l:Rlist) (x:R), In x l -> x <= MaxRlist l. +intros; induction l as [| r l Hrecl]. +simpl in H; elim H. +induction l as [| r0 l Hrecl0]. +simpl in H; elim H; intro. +simpl in |- *; right; assumption. +elim H0. +replace (MaxRlist (cons r (cons r0 l))) with (Rmax r (MaxRlist (cons r0 l))). +simpl in H; decompose [or] H. +rewrite H0; apply RmaxLess1. +unfold Rmax in |- *; case (Rle_dec r (MaxRlist (cons r0 l))); intro. +apply Hrecl; simpl in |- *; tauto. +apply Rle_trans with (MaxRlist (cons r0 l)); + [ apply Hrecl; simpl in |- *; tauto | left; auto with real ]. +unfold Rmax in |- *; case (Rle_dec r (MaxRlist (cons r0 l))); intro. +apply Hrecl; simpl in |- *; tauto. +apply Rle_trans with (MaxRlist (cons r0 l)); + [ apply Hrecl; simpl in |- *; tauto | left; auto with real ]. +reflexivity. +Qed. + +Fixpoint AbsList (l:Rlist) (x:R) {struct l} : Rlist := + match l with + | nil => nil + | cons a l' => cons (Rabs (a - x) / 2) (AbsList l' x) + end. + +Lemma MinRlist_P1 : forall (l:Rlist) (x:R), In x l -> MinRlist l <= x. +intros; induction l as [| r l Hrecl]. +simpl in H; elim H. +induction l as [| r0 l Hrecl0]. +simpl in H; elim H; intro. +simpl in |- *; right; symmetry in |- *; assumption. +elim H0. +replace (MinRlist (cons r (cons r0 l))) with (Rmin r (MinRlist (cons r0 l))). +simpl in H; decompose [or] H. +rewrite H0; apply Rmin_l. +unfold Rmin in |- *; case (Rle_dec r (MinRlist (cons r0 l))); intro. +apply Rle_trans with (MinRlist (cons r0 l)). +assumption. +apply Hrecl; simpl in |- *; tauto. +apply Hrecl; simpl in |- *; tauto. +apply Rle_trans with (MinRlist (cons r0 l)). +apply Rmin_r. +apply Hrecl; simpl in |- *; tauto. +reflexivity. +Qed. + +Lemma AbsList_P1 : + forall (l:Rlist) (x y:R), In y l -> In (Rabs (y - x) / 2) (AbsList l x). +intros; induction l as [| r l Hrecl]. +elim H. +simpl in |- *; simpl in H; elim H; intro. +left; rewrite H0; reflexivity. +right; apply Hrecl; assumption. +Qed. + +Lemma MinRlist_P2 : + forall l:Rlist, (forall y:R, In y l -> 0 < y) -> 0 < MinRlist l. +intros; induction l as [| r l Hrecl]. +apply Rlt_0_1. +induction l as [| r0 l Hrecl0]. +simpl in |- *; apply H; simpl in |- *; tauto. +replace (MinRlist (cons r (cons r0 l))) with (Rmin r (MinRlist (cons r0 l))). +unfold Rmin in |- *; case (Rle_dec r (MinRlist (cons r0 l))); intro. +apply H; simpl in |- *; tauto. +apply Hrecl; intros; apply H; simpl in |- *; simpl in H0; tauto. +reflexivity. +Qed. + +Lemma AbsList_P2 : + forall (l:Rlist) (x y:R), + In y (AbsList l x) -> exists z : R, In z l /\ y = Rabs (z - x) / 2. +intros; induction l as [| r l Hrecl]. +elim H. +elim H; intro. +exists r; split. +simpl in |- *; tauto. +assumption. +assert (H1 := Hrecl H0); elim H1; intros; elim H2; clear H2; intros; + exists x0; simpl in |- *; simpl in H2; tauto. +Qed. + +Lemma MaxRlist_P2 : + forall l:Rlist, (exists y : R, In y l) -> In (MaxRlist l) l. +intros; induction l as [| r l Hrecl]. +simpl in H; elim H; trivial. +induction l as [| r0 l Hrecl0]. +simpl in |- *; left; reflexivity. +change (In (Rmax r (MaxRlist (cons r0 l))) (cons r (cons r0 l))) in |- *; + unfold Rmax in |- *; case (Rle_dec r (MaxRlist (cons r0 l))); + intro. +right; apply Hrecl; exists r0; left; reflexivity. +left; reflexivity. +Qed. + +Fixpoint pos_Rl (l:Rlist) (i:nat) {struct l} : R := + match l with + | nil => 0 + | cons a l' => match i with + | O => a + | S i' => pos_Rl l' i' + end + end. + +Lemma pos_Rl_P1 : + forall (l:Rlist) (a:R), + (0 < Rlength l)%nat -> + pos_Rl (cons a l) (Rlength l) = pos_Rl l (pred (Rlength l)). +intros; induction l as [| r l Hrecl]; + [ elim (lt_n_O _ H) + | simpl in |- *; case (Rlength l); [ reflexivity | intro; reflexivity ] ]. +Qed. + +Lemma pos_Rl_P2 : + forall (l:Rlist) (x:R), + In x l <-> (exists i : nat, (i < Rlength l)%nat /\ x = pos_Rl l i). +intros; induction l as [| r l Hrecl]. +split; intro; + [ elim H | elim H; intros; elim H0; intros; elim (lt_n_O _ H1) ]. +split; intro. +elim H; intro. +exists 0%nat; split; + [ simpl in |- *; apply lt_O_Sn | simpl in |- *; apply H0 ]. +elim Hrecl; intros; assert (H3 := H1 H0); elim H3; intros; elim H4; intros; + exists (S x0); split; + [ simpl in |- *; apply lt_n_S; assumption | simpl in |- *; assumption ]. +elim H; intros; elim H0; intros; elim (zerop x0); intro. +rewrite a in H2; simpl in H2; left; assumption. +right; elim Hrecl; intros; apply H4; assert (H5 : S (pred x0) = x0). +symmetry in |- *; apply S_pred with 0%nat; assumption. +exists (pred x0); split; + [ simpl in H1; apply lt_S_n; rewrite H5; assumption + | rewrite <- H5 in H2; simpl in H2; assumption ]. +Qed. + +Lemma Rlist_P1 : + forall (l:Rlist) (P:R -> R -> Prop), + (forall x:R, In x l -> exists y : R, P x y) -> + exists l' : Rlist, + Rlength l = Rlength l' /\ + (forall i:nat, (i < Rlength l)%nat -> P (pos_Rl l i) (pos_Rl l' i)). +intros; induction l as [| r l Hrecl]. +exists nil; intros; split; + [ reflexivity | intros; simpl in H0; elim (lt_n_O _ H0) ]. +assert (H0 : In r (cons r l)). +simpl in |- *; left; reflexivity. +assert (H1 := H _ H0); + assert (H2 : forall x:R, In x l -> exists y : R, P x y). +intros; apply H; simpl in |- *; right; assumption. +assert (H3 := Hrecl H2); elim H1; intros; elim H3; intros; exists (cons x x0); + intros; elim H5; clear H5; intros; split. +simpl in |- *; rewrite H5; reflexivity. +intros; elim (zerop i); intro. +rewrite a; simpl in |- *; assumption. +assert (H8 : i = S (pred i)). +apply S_pred with 0%nat; assumption. +rewrite H8; simpl in |- *; apply H6; simpl in H7; apply lt_S_n; rewrite <- H8; + assumption. +Qed. + +Definition ordered_Rlist (l:Rlist) : Prop := + forall i:nat, (i < pred (Rlength l))%nat -> pos_Rl l i <= pos_Rl l (S i). + +Fixpoint insert (l:Rlist) (x:R) {struct l} : Rlist := + match l with + | nil => cons x nil + | cons a l' => + match Rle_dec a x with + | left _ => cons a (insert l' x) + | right _ => cons x l + end + end. + +Fixpoint cons_Rlist (l k:Rlist) {struct l} : Rlist := + match l with + | nil => k + | cons a l' => cons a (cons_Rlist l' k) + end. + +Fixpoint cons_ORlist (k l:Rlist) {struct k} : Rlist := + match k with + | nil => l + | cons a k' => cons_ORlist k' (insert l a) + end. + +Fixpoint app_Rlist (l:Rlist) (f:R -> R) {struct l} : Rlist := + match l with + | nil => nil + | cons a l' => cons (f a) (app_Rlist l' f) + end. + +Fixpoint mid_Rlist (l:Rlist) (x:R) {struct l} : Rlist := + match l with + | nil => nil + | cons a l' => cons ((x + a) / 2) (mid_Rlist l' a) + end. + +Definition Rtail (l:Rlist) : Rlist := + match l with + | nil => nil + | cons a l' => l' + end. + +Definition FF (l:Rlist) (f:R -> R) : Rlist := + match l with + | nil => nil + | cons a l' => app_Rlist (mid_Rlist l' a) f + end. + +Lemma RList_P0 : + forall (l:Rlist) (a:R), + pos_Rl (insert l a) 0 = a \/ pos_Rl (insert l a) 0 = pos_Rl l 0. +intros; induction l as [| r l Hrecl]; + [ left; reflexivity + | simpl in |- *; case (Rle_dec r a); intro; + [ right; reflexivity | left; reflexivity ] ]. +Qed. + +Lemma RList_P1 : + forall (l:Rlist) (a:R), ordered_Rlist l -> ordered_Rlist (insert l a). +intros; induction l as [| r l Hrecl]. +simpl in |- *; unfold ordered_Rlist in |- *; intros; simpl in H0; + elim (lt_n_O _ H0). +simpl in |- *; case (Rle_dec r a); intro. +assert (H1 : ordered_Rlist l). +unfold ordered_Rlist in |- *; unfold ordered_Rlist in H; intros; + assert (H1 : (S i < pred (Rlength (cons r l)))%nat); + [ simpl in |- *; replace (Rlength l) with (S (pred (Rlength l))); + [ apply lt_n_S; assumption + | symmetry in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *; + intro; rewrite <- H1 in H0; simpl in H0; elim (lt_n_O _ H0) ] + | apply (H _ H1) ]. +assert (H2 := Hrecl H1); unfold ordered_Rlist in |- *; intros; + induction i as [| i Hreci]. +simpl in |- *; assert (H3 := RList_P0 l a); elim H3; intro. +rewrite H4; assumption. +induction l as [| r1 l Hrecl0]; + [ simpl in |- *; assumption + | rewrite H4; apply (H 0%nat); simpl in |- *; apply lt_O_Sn ]. +simpl in |- *; apply H2; simpl in H0; apply lt_S_n; + replace (S (pred (Rlength (insert l a)))) with (Rlength (insert l a)); + [ assumption + | apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; + rewrite <- H3 in H0; elim (lt_n_O _ H0) ]. +unfold ordered_Rlist in |- *; intros; induction i as [| i Hreci]; + [ simpl in |- *; auto with real + | change (pos_Rl (cons r l) i <= pos_Rl (cons r l) (S i)) in |- *; apply H; + simpl in H0; simpl in |- *; apply (lt_S_n _ _ H0) ]. +Qed. + +Lemma RList_P2 : + forall l1 l2:Rlist, ordered_Rlist l2 -> ordered_Rlist (cons_ORlist l1 l2). +simple induction l1; + [ intros; simpl in |- *; apply H + | intros; simpl in |- *; apply H; apply RList_P1; assumption ]. +Qed. + +Lemma RList_P3 : + forall (l:Rlist) (x:R), + In x l <-> (exists i : nat, x = pos_Rl l i /\ (i < Rlength l)%nat). +intros; split; intro; + [ induction l as [| r l Hrecl] | induction l as [| r l Hrecl] ]. +elim H. +elim H; intro; + [ exists 0%nat; split; [ apply H0 | simpl in |- *; apply lt_O_Sn ] + | elim (Hrecl H0); intros; elim H1; clear H1; intros; exists (S x0); split; + [ apply H1 | simpl in |- *; apply lt_n_S; assumption ] ]. +elim H; intros; elim H0; intros; elim (lt_n_O _ H2). +simpl in |- *; elim H; intros; elim H0; clear H0; intros; + induction x0 as [| x0 Hrecx0]; + [ left; apply H0 + | right; apply Hrecl; exists x0; split; + [ apply H0 | simpl in H1; apply lt_S_n; assumption ] ]. +Qed. + +Lemma RList_P4 : + forall (l1:Rlist) (a:R), ordered_Rlist (cons a l1) -> ordered_Rlist l1. +intros; unfold ordered_Rlist in |- *; intros; apply (H (S i)); simpl in |- *; + replace (Rlength l1) with (S (pred (Rlength l1))); + [ apply lt_n_S; assumption + | symmetry in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *; + intro; rewrite <- H1 in H0; elim (lt_n_O _ H0) ]. +Qed. + +Lemma RList_P5 : + forall (l:Rlist) (x:R), ordered_Rlist l -> In x l -> pos_Rl l 0 <= x. +intros; induction l as [| r l Hrecl]; + [ elim H0 + | simpl in |- *; elim H0; intro; + [ rewrite H1; right; reflexivity + | apply Rle_trans with (pos_Rl l 0); + [ apply (H 0%nat); simpl in |- *; induction l as [| r0 l Hrecl0]; + [ elim H1 | simpl in |- *; apply lt_O_Sn ] + | apply Hrecl; [ eapply RList_P4; apply H | assumption ] ] ] ]. +Qed. + +Lemma RList_P6 : + forall l:Rlist, + ordered_Rlist l <-> + (forall i j:nat, + (i <= j)%nat -> (j < Rlength l)%nat -> pos_Rl l i <= pos_Rl l j). +simple induction l; split; intro. +intros; right; reflexivity. +unfold ordered_Rlist in |- *; intros; simpl in H0; elim (lt_n_O _ H0). +intros; induction i as [| i Hreci]; + [ induction j as [| j Hrecj]; + [ right; reflexivity + | simpl in |- *; apply Rle_trans with (pos_Rl r0 0); + [ apply (H0 0%nat); simpl in |- *; simpl in H2; apply neq_O_lt; + red in |- *; intro; rewrite <- H3 in H2; + assert (H4 := lt_S_n _ _ H2); elim (lt_n_O _ H4) + | elim H; intros; apply H3; + [ apply RList_P4 with r; assumption + | apply le_O_n + | simpl in H2; apply lt_S_n; assumption ] ] ] + | induction j as [| j Hrecj]; + [ elim (le_Sn_O _ H1) + | simpl in |- *; elim H; intros; apply H3; + [ apply RList_P4 with r; assumption + | apply le_S_n; assumption + | simpl in H2; apply lt_S_n; assumption ] ] ]. +unfold ordered_Rlist in |- *; intros; apply H0; + [ apply le_n_Sn | simpl in |- *; simpl in H1; apply lt_n_S; assumption ]. +Qed. + +Lemma RList_P7 : + forall (l:Rlist) (x:R), + ordered_Rlist l -> In x l -> x <= pos_Rl l (pred (Rlength l)). +intros; assert (H1 := RList_P6 l); elim H1; intros H2 _; assert (H3 := H2 H); + clear H1 H2; assert (H1 := RList_P3 l x); elim H1; + clear H1; intros; assert (H4 := H1 H0); elim H4; clear H4; + intros; elim H4; clear H4; intros; rewrite H4; + assert (H6 : Rlength l = S (pred (Rlength l))). +apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; + rewrite <- H6 in H5; elim (lt_n_O _ H5). +apply H3; + [ rewrite H6 in H5; apply lt_n_Sm_le; assumption + | apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H7 in H5; + elim (lt_n_O _ H5) ]. +Qed. + +Lemma RList_P8 : + forall (l:Rlist) (a x:R), In x (insert l a) <-> x = a \/ In x l. +simple induction l. +intros; split; intro; simpl in H; apply H. +intros; split; intro; + [ simpl in H0; generalize H0; case (Rle_dec r a); intros; + [ simpl in H1; elim H1; intro; + [ right; left; assumption + | elim (H a x); intros; elim (H3 H2); intro; + [ left; assumption | right; right; assumption ] ] + | simpl in H1; decompose [or] H1; + [ left; assumption + | right; left; assumption + | right; right; assumption ] ] + | simpl in |- *; case (Rle_dec r a); intro; + [ simpl in H0; decompose [or] H0; + [ right; elim (H a x); intros; apply H3; left + | left + | right; elim (H a x); intros; apply H3; right ] + | simpl in H0; decompose [or] H0; [ left | right; left | right; right ] ]; + assumption ]. +Qed. + +Lemma RList_P9 : + forall (l1 l2:Rlist) (x:R), In x (cons_ORlist l1 l2) <-> In x l1 \/ In x l2. +simple induction l1. +intros; split; intro; + [ simpl in H; right; assumption + | simpl in |- *; elim H; intro; [ elim H0 | assumption ] ]. +intros; split. +simpl in |- *; intros; elim (H (insert l2 r) x); intros; assert (H3 := H1 H0); + elim H3; intro; + [ left; right; assumption + | elim (RList_P8 l2 r x); intros H5 _; assert (H6 := H5 H4); elim H6; intro; + [ left; left; assumption | right; assumption ] ]. +intro; simpl in |- *; elim (H (insert l2 r) x); intros _ H1; apply H1; + elim H0; intro; + [ elim H2; intro; + [ right; elim (RList_P8 l2 r x); intros _ H4; apply H4; left; assumption + | left; assumption ] + | right; elim (RList_P8 l2 r x); intros _ H3; apply H3; right; assumption ]. +Qed. + +Lemma RList_P10 : + forall (l:Rlist) (a:R), Rlength (insert l a) = S (Rlength l). +intros; induction l as [| r l Hrecl]; + [ reflexivity + | simpl in |- *; case (Rle_dec r a); intro; + [ simpl in |- *; rewrite Hrecl; reflexivity | reflexivity ] ]. +Qed. + +Lemma RList_P11 : + forall l1 l2:Rlist, + Rlength (cons_ORlist l1 l2) = (Rlength l1 + Rlength l2)%nat. +simple induction l1; + [ intro; reflexivity + | intros; simpl in |- *; rewrite (H (insert l2 r)); rewrite RList_P10; + apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; + rewrite S_INR; ring ]. +Qed. + +Lemma RList_P12 : + forall (l:Rlist) (i:nat) (f:R -> R), + (i < Rlength l)%nat -> pos_Rl (app_Rlist l f) i = f (pos_Rl l i). +simple induction l; + [ intros; elim (lt_n_O _ H) + | intros; induction i as [| i Hreci]; + [ reflexivity | simpl in |- *; apply H; apply lt_S_n; apply H0 ] ]. +Qed. + +Lemma RList_P13 : + forall (l:Rlist) (i:nat) (a:R), + (i < pred (Rlength l))%nat -> + pos_Rl (mid_Rlist l a) (S i) = (pos_Rl l i + pos_Rl l (S i)) / 2. +simple induction l. +intros; simpl in H; elim (lt_n_O _ H). +simple induction r0. +intros; simpl in H0; elim (lt_n_O _ H0). +intros; simpl in H1; induction i as [| i Hreci]. +reflexivity. +change + (pos_Rl (mid_Rlist (cons r1 r2) r) (S i) = + (pos_Rl (cons r1 r2) i + pos_Rl (cons r1 r2) (S i)) / 2) + in |- *; apply H0; simpl in |- *; apply lt_S_n; assumption. +Qed. + +Lemma RList_P14 : forall (l:Rlist) (a:R), Rlength (mid_Rlist l a) = Rlength l. +simple induction l; intros; + [ reflexivity | simpl in |- *; rewrite (H r); reflexivity ]. +Qed. + +Lemma RList_P15 : + forall l1 l2:Rlist, + ordered_Rlist l1 -> + ordered_Rlist l2 -> + pos_Rl l1 0 = pos_Rl l2 0 -> pos_Rl (cons_ORlist l1 l2) 0 = pos_Rl l1 0. +intros; apply Rle_antisym. +induction l1 as [| r l1 Hrecl1]; + [ simpl in |- *; simpl in H1; right; symmetry in |- *; assumption + | elim (RList_P9 (cons r l1) l2 (pos_Rl (cons r l1) 0)); intros; + assert + (H4 : + In (pos_Rl (cons r l1) 0) (cons r l1) \/ In (pos_Rl (cons r l1) 0) l2); + [ left; left; reflexivity + | assert (H5 := H3 H4); apply RList_P5; + [ apply RList_P2; assumption | assumption ] ] ]. +induction l1 as [| r l1 Hrecl1]; + [ simpl in |- *; simpl in H1; right; assumption + | assert + (H2 : + In (pos_Rl (cons_ORlist (cons r l1) l2) 0) (cons_ORlist (cons r l1) l2)); + [ elim + (RList_P3 (cons_ORlist (cons r l1) l2) + (pos_Rl (cons_ORlist (cons r l1) l2) 0)); + intros; apply H3; exists 0%nat; split; + [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_O_Sn ] + | elim (RList_P9 (cons r l1) l2 (pos_Rl (cons_ORlist (cons r l1) l2) 0)); + intros; assert (H5 := H3 H2); elim H5; intro; + [ apply RList_P5; assumption + | rewrite H1; apply RList_P5; assumption ] ] ]. +Qed. + +Lemma RList_P16 : + forall l1 l2:Rlist, + ordered_Rlist l1 -> + ordered_Rlist l2 -> + pos_Rl l1 (pred (Rlength l1)) = pos_Rl l2 (pred (Rlength l2)) -> + pos_Rl (cons_ORlist l1 l2) (pred (Rlength (cons_ORlist l1 l2))) = + pos_Rl l1 (pred (Rlength l1)). +intros; apply Rle_antisym. +induction l1 as [| r l1 Hrecl1]. +simpl in |- *; simpl in H1; right; symmetry in |- *; assumption. +assert + (H2 : + In + (pos_Rl (cons_ORlist (cons r l1) l2) + (pred (Rlength (cons_ORlist (cons r l1) l2)))) + (cons_ORlist (cons r l1) l2)); + [ elim + (RList_P3 (cons_ORlist (cons r l1) l2) + (pos_Rl (cons_ORlist (cons r l1) l2) + (pred (Rlength (cons_ORlist (cons r l1) l2))))); + intros; apply H3; exists (pred (Rlength (cons_ORlist (cons r l1) l2))); + split; [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_n_Sn ] + | elim + (RList_P9 (cons r l1) l2 + (pos_Rl (cons_ORlist (cons r l1) l2) + (pred (Rlength (cons_ORlist (cons r l1) l2))))); + intros; assert (H5 := H3 H2); elim H5; intro; + [ apply RList_P7; assumption | rewrite H1; apply RList_P7; assumption ] ]. +induction l1 as [| r l1 Hrecl1]. +simpl in |- *; simpl in H1; right; assumption. +elim + (RList_P9 (cons r l1) l2 (pos_Rl (cons r l1) (pred (Rlength (cons r l1))))); + intros; + assert + (H4 : + In (pos_Rl (cons r l1) (pred (Rlength (cons r l1)))) (cons r l1) \/ + In (pos_Rl (cons r l1) (pred (Rlength (cons r l1)))) l2); + [ left; change (In (pos_Rl (cons r l1) (Rlength l1)) (cons r l1)) in |- *; + elim (RList_P3 (cons r l1) (pos_Rl (cons r l1) (Rlength l1))); + intros; apply H5; exists (Rlength l1); split; + [ reflexivity | simpl in |- *; apply lt_n_Sn ] + | assert (H5 := H3 H4); apply RList_P7; + [ apply RList_P2; assumption + | elim + (RList_P9 (cons r l1) l2 + (pos_Rl (cons r l1) (pred (Rlength (cons r l1))))); + intros; apply H7; left; + elim + (RList_P3 (cons r l1) + (pos_Rl (cons r l1) (pred (Rlength (cons r l1))))); + intros; apply H9; exists (pred (Rlength (cons r l1))); + split; [ reflexivity | simpl in |- *; apply lt_n_Sn ] ] ]. +Qed. + +Lemma RList_P17 : + forall (l1:Rlist) (x:R) (i:nat), + ordered_Rlist l1 -> + In x l1 -> + pos_Rl l1 i < x -> (i < pred (Rlength l1))%nat -> pos_Rl l1 (S i) <= x. +simple induction l1. +intros; elim H0. +intros; induction i as [| i Hreci]. +simpl in |- *; elim H1; intro; + [ simpl in H2; rewrite H4 in H2; elim (Rlt_irrefl _ H2) + | apply RList_P5; [ apply RList_P4 with r; assumption | assumption ] ]. +simpl in |- *; simpl in H2; elim H1; intro. +rewrite H4 in H2; assert (H5 : r <= pos_Rl r0 i); + [ apply Rle_trans with (pos_Rl r0 0); + [ apply (H0 0%nat); simpl in |- *; simpl in H3; apply neq_O_lt; + red in |- *; intro; rewrite <- H5 in H3; elim (lt_n_O _ H3) + | elim (RList_P6 r0); intros; apply H5; + [ apply RList_P4 with r; assumption + | apply le_O_n + | simpl in H3; apply lt_S_n; apply lt_trans with (Rlength r0); + [ apply H3 | apply lt_n_Sn ] ] ] + | elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H5 H2)) ]. +apply H; try assumption; + [ apply RList_P4 with r; assumption + | simpl in H3; apply lt_S_n; + replace (S (pred (Rlength r0))) with (Rlength r0); + [ apply H3 + | apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; + rewrite <- H5 in H3; elim (lt_n_O _ H3) ] ]. +Qed. + +Lemma RList_P18 : + forall (l:Rlist) (f:R -> R), Rlength (app_Rlist l f) = Rlength l. +simple induction l; intros; + [ reflexivity | simpl in |- *; rewrite H; reflexivity ]. +Qed. + +Lemma RList_P19 : + forall l:Rlist, + l <> nil -> exists r : R, (exists r0 : Rlist, l = cons r r0). +intros; induction l as [| r l Hrecl]; + [ elim H; reflexivity | exists r; exists l; reflexivity ]. +Qed. + +Lemma RList_P20 : + forall l:Rlist, + (2 <= Rlength l)%nat -> + exists r : R, + (exists r1 : R, (exists l' : Rlist, l = cons r (cons r1 l'))). +intros; induction l as [| r l Hrecl]; + [ simpl in H; elim (le_Sn_O _ H) + | induction l as [| r0 l Hrecl0]; + [ simpl in H; elim (le_Sn_O _ (le_S_n _ _ H)) + | exists r; exists r0; exists l; reflexivity ] ]. +Qed. + +Lemma RList_P21 : forall l l':Rlist, l = l' -> Rtail l = Rtail l'. +intros; rewrite H; reflexivity. +Qed. + +Lemma RList_P22 : + forall l1 l2:Rlist, l1 <> nil -> pos_Rl (cons_Rlist l1 l2) 0 = pos_Rl l1 0. +simple induction l1; [ intros; elim H; reflexivity | intros; reflexivity ]. +Qed. + +Lemma RList_P23 : + forall l1 l2:Rlist, + Rlength (cons_Rlist l1 l2) = (Rlength l1 + Rlength l2)%nat. +simple induction l1; + [ intro; reflexivity | intros; simpl in |- *; rewrite H; reflexivity ]. +Qed. + +Lemma RList_P24 : + forall l1 l2:Rlist, + l2 <> nil -> + pos_Rl (cons_Rlist l1 l2) (pred (Rlength (cons_Rlist l1 l2))) = + pos_Rl l2 (pred (Rlength l2)). +simple induction l1. +intros; reflexivity. +intros; rewrite <- (H l2 H0); induction l2 as [| r1 l2 Hrecl2]. +elim H0; reflexivity. +do 2 rewrite RList_P23; + replace (Rlength (cons r r0) + Rlength (cons r1 l2))%nat with + (S (S (Rlength r0 + Rlength l2))); + [ replace (Rlength r0 + Rlength (cons r1 l2))%nat with + (S (Rlength r0 + Rlength l2)); + [ reflexivity + | simpl in |- *; apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; + rewrite S_INR; ring ] + | simpl in |- *; apply INR_eq; do 3 rewrite S_INR; do 2 rewrite plus_INR; + rewrite S_INR; ring ]. +Qed. + +Lemma RList_P25 : + forall l1 l2:Rlist, + ordered_Rlist l1 -> + ordered_Rlist l2 -> + pos_Rl l1 (pred (Rlength l1)) <= pos_Rl l2 0 -> + ordered_Rlist (cons_Rlist l1 l2). +simple induction l1. +intros; simpl in |- *; assumption. +simple induction r0. +intros; simpl in |- *; simpl in H2; unfold ordered_Rlist in |- *; intros; + simpl in H3. +induction i as [| i Hreci]. +simpl in |- *; assumption. +change (pos_Rl l2 i <= pos_Rl l2 (S i)) in |- *; apply (H1 i); apply lt_S_n; + replace (S (pred (Rlength l2))) with (Rlength l2); + [ assumption + | apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; + rewrite <- H4 in H3; elim (lt_n_O _ H3) ]. +intros; clear H; assert (H : ordered_Rlist (cons_Rlist (cons r1 r2) l2)). +apply H0; try assumption. +apply RList_P4 with r; assumption. +unfold ordered_Rlist in |- *; intros; simpl in H4; + induction i as [| i Hreci]. +simpl in |- *; apply (H1 0%nat); simpl in |- *; apply lt_O_Sn. +change + (pos_Rl (cons_Rlist (cons r1 r2) l2) i <= + pos_Rl (cons_Rlist (cons r1 r2) l2) (S i)) in |- *; + apply (H i); simpl in |- *; apply lt_S_n; assumption. +Qed. + +Lemma RList_P26 : + forall (l1 l2:Rlist) (i:nat), + (i < Rlength l1)%nat -> pos_Rl (cons_Rlist l1 l2) i = pos_Rl l1 i. +simple induction l1. +intros; elim (lt_n_O _ H). +intros; induction i as [| i Hreci]. +apply RList_P22; discriminate. +apply (H l2 i); simpl in H0; apply lt_S_n; assumption. +Qed. + +Lemma RList_P27 : + forall l1 l2 l3:Rlist, + cons_Rlist l1 (cons_Rlist l2 l3) = cons_Rlist (cons_Rlist l1 l2) l3. +simple induction l1; intros; + [ reflexivity | simpl in |- *; rewrite (H l2 l3); reflexivity ]. +Qed. + +Lemma RList_P28 : forall l:Rlist, cons_Rlist l nil = l. +simple induction l; + [ reflexivity | intros; simpl in |- *; rewrite H; reflexivity ]. +Qed. + +Lemma RList_P29 : + forall (l2 l1:Rlist) (i:nat), + (Rlength l1 <= i)%nat -> + (i < Rlength (cons_Rlist l1 l2))%nat -> + pos_Rl (cons_Rlist l1 l2) i = pos_Rl l2 (i - Rlength l1). +simple induction l2. +intros; rewrite RList_P28 in H0; elim (lt_irrefl _ (le_lt_trans _ _ _ H H0)). +intros; + replace (cons_Rlist l1 (cons r r0)) with + (cons_Rlist (cons_Rlist l1 (cons r nil)) r0). +inversion H0. +rewrite <- minus_n_n; simpl in |- *; rewrite RList_P26. +clear l2 r0 H i H0 H1 H2; induction l1 as [| r0 l1 Hrecl1]. +reflexivity. +simpl in |- *; assumption. +rewrite RList_P23; rewrite plus_comm; simpl in |- *; apply lt_n_Sn. +replace (S m - Rlength l1)%nat with (S (S m - S (Rlength l1))). +rewrite H3; simpl in |- *; + replace (S (Rlength l1)) with (Rlength (cons_Rlist l1 (cons r nil))). +apply (H (cons_Rlist l1 (cons r nil)) i). +rewrite RList_P23; rewrite plus_comm; simpl in |- *; rewrite <- H3; + apply le_n_S; assumption. +repeat rewrite RList_P23; simpl in |- *; rewrite RList_P23 in H1; + rewrite plus_comm in H1; simpl in H1; rewrite (plus_comm (Rlength l1)); + simpl in |- *; rewrite plus_comm; apply H1. +rewrite RList_P23; rewrite plus_comm; reflexivity. +change (S (m - Rlength l1) = (S m - Rlength l1)%nat) in |- *; + apply minus_Sn_m; assumption. +replace (cons r r0) with (cons_Rlist (cons r nil) r0); + [ symmetry in |- *; apply RList_P27 | reflexivity ]. +Qed. diff --git a/theories/Reals/R_Ifp.v b/theories/Reals/R_Ifp.v new file mode 100644 index 00000000..289b1921 --- /dev/null +++ b/theories/Reals/R_Ifp.v @@ -0,0 +1,545 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: R_Ifp.v,v 1.14.2.1 2004/07/16 19:31:12 herbelin Exp $ i*) + +(**********************************************************) +(** Complements for the reals.Integer and fractional part *) +(* *) +(**********************************************************) + +Require Import Rbase. +Require Import Omega. +Open Local Scope R_scope. + +(*********************************************************) +(** Fractional part *) +(*********************************************************) + +(**********) +Definition Int_part (r:R) : Z := (up r - 1)%Z. + +(**********) +Definition frac_part (r:R) : R := r - IZR (Int_part r). + +(**********) +Lemma tech_up : forall (r:R) (z:Z), r < IZR z -> IZR z <= r + 1 -> z = up r. +intros; generalize (archimed r); intro; elim H1; intros; clear H1; + unfold Rgt in H2; unfold Rminus in H3; + generalize (Rplus_le_compat_l r (IZR (up r) + - r) 1 H3); + intro; clear H3; rewrite (Rplus_comm (IZR (up r)) (- r)) in H1; + rewrite <- (Rplus_assoc r (- r) (IZR (up r))) in H1; + rewrite (Rplus_opp_r r) in H1; elim (Rplus_ne (IZR (up r))); + intros a b; rewrite b in H1; clear a b; apply (single_z_r_R1 r z (up r)); + auto with zarith real. +Qed. + +(**********) +Lemma up_tech : + forall (r:R) (z:Z), IZR z <= r -> r < IZR (z + 1) -> (z + 1)%Z = up r. +intros; generalize (Rplus_le_compat_l 1 (IZR z) r H); intro; clear H; + rewrite (Rplus_comm 1 (IZR z)) in H1; rewrite (Rplus_comm 1 r) in H1; + cut (1 = IZR 1); auto with zarith real. +intro; generalize H1; pattern 1 at 1 in |- *; rewrite H; intro; clear H H1; + rewrite <- (plus_IZR z 1) in H2; apply (tech_up r (z + 1)); + auto with zarith real. +Qed. + +(**********) +Lemma fp_R0 : frac_part 0 = 0. +unfold frac_part in |- *; unfold Int_part in |- *; elim (archimed 0); intros; + unfold Rminus in |- *; elim (Rplus_ne (- IZR (up 0 - 1))); + intros a b; rewrite b; clear a b; rewrite <- Z_R_minus; + cut (up 0 = 1%Z). +intro; rewrite H1; + rewrite (Rminus_diag_eq (IZR 1) (IZR 1) (refl_equal (IZR 1))); + apply Ropp_0. +elim (archimed 0); intros; clear H2; unfold Rgt in H1; + rewrite (Rminus_0_r (IZR (up 0))) in H0; generalize (lt_O_IZR (up 0) H1); + intro; clear H1; generalize (le_IZR_R1 (up 0) H0); + intro; clear H H0; omega. +Qed. + +(**********) +Lemma for_base_fp : forall r:R, IZR (up r) - r > 0 /\ IZR (up r) - r <= 1. +intro; split; cut (IZR (up r) > r /\ IZR (up r) - r <= 1). +intro; elim H; intros. +apply (Rgt_minus (IZR (up r)) r H0). +apply archimed. +intro; elim H; intros. +exact H1. +apply archimed. +Qed. + +(**********) +Lemma base_fp : forall r:R, frac_part r >= 0 /\ frac_part r < 1. +intro; unfold frac_part in |- *; unfold Int_part in |- *; split. + (*sup a O*) +cut (r - IZR (up r) >= -1). +rewrite <- Z_R_minus; simpl in |- *; intro; unfold Rminus in |- *; + rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; + fold (r - IZR (up r)) in |- *; fold (r - IZR (up r) - -1) in |- *; + apply Rge_minus; auto with zarith real. +rewrite <- Ropp_minus_distr; apply Ropp_le_ge_contravar; elim (for_base_fp r); + auto with zarith real. + (*inf a 1*) +cut (r - IZR (up r) < 0). +rewrite <- Z_R_minus; simpl in |- *; intro; unfold Rminus in |- *; + rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; + fold (r - IZR (up r)) in |- *; rewrite Ropp_involutive; + elim (Rplus_ne 1); intros a b; pattern 1 at 2 in |- *; + rewrite <- a; clear a b; rewrite (Rplus_comm (r - IZR (up r)) 1); + apply Rplus_lt_compat_l; auto with zarith real. +elim (for_base_fp r); intros; rewrite <- Ropp_0; rewrite <- Ropp_minus_distr; + apply Ropp_gt_lt_contravar; auto with zarith real. +Qed. + +(*********************************************************) +(** Properties *) +(*********************************************************) + +(**********) +Lemma base_Int_part : + forall r:R, IZR (Int_part r) <= r /\ IZR (Int_part r) - r > -1. +intro; unfold Int_part in |- *; elim (archimed r); intros. +split; rewrite <- (Z_R_minus (up r) 1); simpl in |- *. +generalize (Rle_minus (IZR (up r) - r) 1 H0); intro; unfold Rminus in H1; + rewrite (Rplus_assoc (IZR (up r)) (- r) (-1)) in H1; + rewrite (Rplus_comm (- r) (-1)) in H1; + rewrite <- (Rplus_assoc (IZR (up r)) (-1) (- r)) in H1; + fold (IZR (up r) - 1) in H1; fold (IZR (up r) - 1 - r) in H1; + apply Rminus_le; auto with zarith real. +generalize (Rplus_gt_compat_l (-1) (IZR (up r)) r H); intro; + rewrite (Rplus_comm (-1) (IZR (up r))) in H1; + generalize (Rplus_gt_compat_l (- r) (IZR (up r) + -1) (-1 + r) H1); + intro; clear H H0 H1; rewrite (Rplus_comm (- r) (IZR (up r) + -1)) in H2; + fold (IZR (up r) - 1) in H2; fold (IZR (up r) - 1 - r) in H2; + rewrite (Rplus_comm (- r) (-1 + r)) in H2; + rewrite (Rplus_assoc (-1) r (- r)) in H2; rewrite (Rplus_opp_r r) in H2; + elim (Rplus_ne (-1)); intros a b; rewrite a in H2; + clear a b; auto with zarith real. +Qed. + +(**********) +Lemma 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 lt_INR; auto. +rewrite Zplus_comm; rewrite <- Znat.inj_plus; simpl in |- *; auto. +rewrite plus_IZR; simpl in |- *; auto with real. +repeat rewrite <- INR_IZR_INZ; auto with real. +Qed. + +(**********) +Lemma fp_nat : forall r:R, frac_part r = 0 -> exists c : Z, r = IZR c. +unfold frac_part in |- *; intros; split with (Int_part r); + apply Rminus_diag_uniq; auto with zarith real. +Qed. + +(**********) +Lemma R0_fp_O : forall r:R, 0 <> frac_part r -> 0 <> r. +red in |- *; intros; rewrite <- H0 in H; generalize fp_R0; intro; + auto with zarith real. +Qed. + +(**********) +Lemma Rminus_Int_part1 : + forall r1 r2:R, + frac_part r1 >= frac_part r2 -> + Int_part (r1 - r2) = (Int_part r1 - Int_part r2)%Z. +intros; elim (base_fp r1); elim (base_fp r2); intros; + generalize (Rge_le (frac_part r2) 0 H0); intro; clear H0; + generalize (Ropp_le_ge_contravar 0 (frac_part r2) H4); + intro; clear H4; rewrite Ropp_0 in H0; + generalize (Rge_le 0 (- frac_part r2) H0); intro; + clear H0; generalize (Rge_le (frac_part r1) 0 H2); + intro; clear H2; generalize (Ropp_lt_gt_contravar (frac_part r2) 1 H1); + intro; clear H1; unfold Rgt in H2; + generalize + (sum_inequa_Rle_lt 0 (frac_part r1) 1 (-1) (- frac_part r2) 0 H0 H3 H2 H4); + intro; elim H1; intros; clear H1; elim (Rplus_ne 1); + intros a b; rewrite a in H6; clear a b H5; + generalize (Rge_minus (frac_part r1) (frac_part r2) H); + intro; clear H; fold (frac_part r1 - frac_part r2) in H6; + generalize (Rge_le (frac_part r1 - frac_part r2) 0 H1); + intro; clear H1 H3 H4 H0 H2; unfold frac_part in H6, H; + unfold Rminus in H6, H; + rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))) in H; + rewrite (Ropp_involutive (IZR (Int_part r2))) in H; + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2))) + in H; + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2))) + in H; rewrite (Rplus_comm (- IZR (Int_part r1)) (- r2)) in H; + rewrite (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))) in H; + rewrite <- (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2))) + in H; rewrite (Rplus_comm (- IZR (Int_part r1)) (IZR (Int_part r2))) in H; + fold (r1 - r2) in H; fold (IZR (Int_part r2) - IZR (Int_part r1)) in H; + generalize + (Rplus_le_compat_l (IZR (Int_part r1) - IZR (Int_part r2)) 0 + (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) H); + intro; clear H; + rewrite (Rplus_comm (r1 - r2) (IZR (Int_part r2) - IZR (Int_part r1))) in H0; + rewrite <- + (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2)) + (IZR (Int_part r2) - IZR (Int_part r1)) (r1 - r2)) + in H0; unfold Rminus in H0; fold (r1 - r2) in H0; + rewrite + (Rplus_assoc (IZR (Int_part r1)) (- IZR (Int_part r2)) + (IZR (Int_part r2) + - IZR (Int_part r1))) in H0; + rewrite <- + (Rplus_assoc (- IZR (Int_part r2)) (IZR (Int_part r2)) + (- IZR (Int_part r1))) in H0; + rewrite (Rplus_opp_l (IZR (Int_part r2))) in H0; + elim (Rplus_ne (- IZR (Int_part r1))); intros a b; + rewrite b in H0; clear a b; + elim (Rplus_ne (IZR (Int_part r1) + - IZR (Int_part r2))); + intros a b; rewrite a in H0; clear a b; + rewrite (Rplus_opp_r (IZR (Int_part r1))) in H0; elim (Rplus_ne (r1 - r2)); + intros a b; rewrite b in H0; clear a b; + fold (IZR (Int_part r1) - IZR (Int_part r2)) in H0; + rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))) in H6; + rewrite (Ropp_involutive (IZR (Int_part r2))) in H6; + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2))) + in H6; + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2))) + in H6; rewrite (Rplus_comm (- IZR (Int_part r1)) (- r2)) in H6; + rewrite (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))) in H6; + rewrite <- (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2))) + in H6; + rewrite (Rplus_comm (- IZR (Int_part r1)) (IZR (Int_part r2))) in H6; + fold (r1 - r2) in H6; fold (IZR (Int_part r2) - IZR (Int_part r1)) in H6; + generalize + (Rplus_lt_compat_l (IZR (Int_part r1) - IZR (Int_part r2)) + (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) 1 H6); + intro; clear H6; + rewrite (Rplus_comm (r1 - r2) (IZR (Int_part r2) - IZR (Int_part r1))) in H; + rewrite <- + (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2)) + (IZR (Int_part r2) - IZR (Int_part r1)) (r1 - r2)) + in H; + rewrite <- (Ropp_minus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H; + rewrite (Rplus_opp_r (IZR (Int_part r1) - IZR (Int_part r2))) in H; + elim (Rplus_ne (r1 - r2)); intros a b; rewrite b in H; + clear a b; rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H0; + rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H; + cut (1 = IZR 1); auto with zarith real. +intro; rewrite H1 in H; clear H1; + rewrite <- (plus_IZR (Int_part r1 - Int_part r2) 1) in H; + generalize (up_tech (r1 - r2) (Int_part r1 - Int_part r2) H0 H); + intros; clear H H0; unfold Int_part at 1 in |- *; + omega. +Qed. + +(**********) +Lemma Rminus_Int_part2 : + forall r1 r2:R, + frac_part r1 < frac_part r2 -> + Int_part (r1 - r2) = (Int_part r1 - Int_part r2 - 1)%Z. +intros; elim (base_fp r1); elim (base_fp r2); intros; + generalize (Rge_le (frac_part r2) 0 H0); intro; clear H0; + generalize (Ropp_le_ge_contravar 0 (frac_part r2) H4); + intro; clear H4; rewrite Ropp_0 in H0; + generalize (Rge_le 0 (- frac_part r2) H0); intro; + clear H0; generalize (Rge_le (frac_part r1) 0 H2); + intro; clear H2; generalize (Ropp_lt_gt_contravar (frac_part r2) 1 H1); + intro; clear H1; unfold Rgt in H2; + generalize + (sum_inequa_Rle_lt 0 (frac_part r1) 1 (-1) (- frac_part r2) 0 H0 H3 H2 H4); + intro; elim H1; intros; clear H1; elim (Rplus_ne (-1)); + intros a b; rewrite b in H5; clear a b H6; + generalize (Rlt_minus (frac_part r1) (frac_part r2) H); + intro; clear H; fold (frac_part r1 - frac_part r2) in H5; + clear H3 H4 H0 H2; unfold frac_part in H5, H1; unfold Rminus in H5, H1; + rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))) in H5; + rewrite (Ropp_involutive (IZR (Int_part r2))) in H5; + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2))) + in H5; + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2))) + in H5; rewrite (Rplus_comm (- IZR (Int_part r1)) (- r2)) in H5; + rewrite (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))) in H5; + rewrite <- (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2))) + in H5; + rewrite (Rplus_comm (- IZR (Int_part r1)) (IZR (Int_part r2))) in H5; + fold (r1 - r2) in H5; fold (IZR (Int_part r2) - IZR (Int_part r1)) in H5; + generalize + (Rplus_lt_compat_l (IZR (Int_part r1) - IZR (Int_part r2)) (-1) + (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) H5); + intro; clear H5; + rewrite (Rplus_comm (r1 - r2) (IZR (Int_part r2) - IZR (Int_part r1))) in H; + rewrite <- + (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2)) + (IZR (Int_part r2) - IZR (Int_part r1)) (r1 - r2)) + in H; unfold Rminus in H; fold (r1 - r2) in H; + rewrite + (Rplus_assoc (IZR (Int_part r1)) (- IZR (Int_part r2)) + (IZR (Int_part r2) + - IZR (Int_part r1))) in H; + rewrite <- + (Rplus_assoc (- IZR (Int_part r2)) (IZR (Int_part r2)) + (- IZR (Int_part r1))) in H; + rewrite (Rplus_opp_l (IZR (Int_part r2))) in H; + elim (Rplus_ne (- IZR (Int_part r1))); intros a b; + rewrite b in H; clear a b; rewrite (Rplus_opp_r (IZR (Int_part r1))) in H; + elim (Rplus_ne (r1 - r2)); intros a b; rewrite b in H; + clear a b; fold (IZR (Int_part r1) - IZR (Int_part r2)) in H; + fold (IZR (Int_part r1) - IZR (Int_part r2) - 1) in H; + rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))) in H1; + rewrite (Ropp_involutive (IZR (Int_part r2))) in H1; + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2))) + in H1; + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2))) + in H1; rewrite (Rplus_comm (- IZR (Int_part r1)) (- r2)) in H1; + rewrite (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))) in H1; + rewrite <- (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2))) + in H1; + rewrite (Rplus_comm (- IZR (Int_part r1)) (IZR (Int_part r2))) in H1; + fold (r1 - r2) in H1; fold (IZR (Int_part r2) - IZR (Int_part r1)) in H1; + generalize + (Rplus_lt_compat_l (IZR (Int_part r1) - IZR (Int_part r2)) + (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) 0 H1); + intro; clear H1; + rewrite (Rplus_comm (r1 - r2) (IZR (Int_part r2) - IZR (Int_part r1))) in H0; + rewrite <- + (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2)) + (IZR (Int_part r2) - IZR (Int_part r1)) (r1 - r2)) + in H0; + rewrite <- (Ropp_minus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H0; + rewrite (Rplus_opp_r (IZR (Int_part r1) - IZR (Int_part r2))) in H0; + elim (Rplus_ne (r1 - r2)); intros a b; rewrite b in H0; + clear a b; rewrite <- (Rplus_opp_l 1) in H0; + rewrite <- (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2)) (-1) 1) + in H0; fold (IZR (Int_part r1) - IZR (Int_part r2) - 1) in H0; + rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H0; + rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H; + cut (1 = IZR 1); auto with zarith real. +intro; rewrite H1 in H; rewrite H1 in H0; clear H1; + rewrite (Z_R_minus (Int_part r1 - Int_part r2) 1) in H; + rewrite (Z_R_minus (Int_part r1 - Int_part r2) 1) in H0; + rewrite <- (plus_IZR (Int_part r1 - Int_part r2 - 1) 1) in H0; + generalize (Rlt_le (IZR (Int_part r1 - Int_part r2 - 1)) (r1 - r2) H); + intro; clear H; + generalize (up_tech (r1 - r2) (Int_part r1 - Int_part r2 - 1) H1 H0); + intros; clear H0 H1; unfold Int_part at 1 in |- *; + omega. +Qed. + +(**********) +Lemma Rminus_fp1 : + forall r1 r2:R, + frac_part r1 >= frac_part r2 -> + frac_part (r1 - r2) = frac_part r1 - frac_part r2. +intros; unfold frac_part in |- *; generalize (Rminus_Int_part1 r1 r2 H); + intro; rewrite H0; rewrite <- (Z_R_minus (Int_part r1) (Int_part r2)); + unfold Rminus in |- *; + rewrite (Ropp_plus_distr (IZR (Int_part r1)) (- IZR (Int_part r2))); + rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))); + rewrite (Ropp_involutive (IZR (Int_part r2))); + rewrite (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2))); + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2))); + rewrite <- (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))); + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2))); + rewrite (Rplus_comm (- r2) (- IZR (Int_part r1))); + auto with zarith real. +Qed. + +(**********) +Lemma Rminus_fp2 : + forall r1 r2:R, + frac_part r1 < frac_part r2 -> + frac_part (r1 - r2) = frac_part r1 - frac_part r2 + 1. +intros; unfold frac_part in |- *; generalize (Rminus_Int_part2 r1 r2 H); + intro; rewrite H0; rewrite <- (Z_R_minus (Int_part r1 - Int_part r2) 1); + rewrite <- (Z_R_minus (Int_part r1) (Int_part r2)); + unfold Rminus in |- *; + rewrite + (Ropp_plus_distr (IZR (Int_part r1) + - IZR (Int_part r2)) (- IZR 1)) + ; rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))); + rewrite (Ropp_involutive (IZR 1)); + rewrite (Ropp_involutive (IZR (Int_part r2))); + rewrite (Ropp_plus_distr (IZR (Int_part r1))); + rewrite (Ropp_involutive (IZR (Int_part r2))); simpl in |- *; + rewrite <- + (Rplus_assoc (r1 + - r2) (- IZR (Int_part r1) + IZR (Int_part r2)) 1) + ; rewrite (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2))); + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2))); + rewrite <- (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))); + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2))); + rewrite (Rplus_comm (- r2) (- IZR (Int_part r1))); + auto with zarith real. +Qed. + +(**********) +Lemma plus_Int_part1 : + forall r1 r2:R, + frac_part r1 + frac_part r2 >= 1 -> + Int_part (r1 + r2) = (Int_part r1 + Int_part r2 + 1)%Z. +intros; generalize (Rge_le (frac_part r1 + frac_part r2) 1 H); intro; clear H; + elim (base_fp r1); elim (base_fp r2); intros; clear H H2; + generalize (Rplus_lt_compat_l (frac_part r2) (frac_part r1) 1 H3); + intro; clear H3; generalize (Rplus_lt_compat_l 1 (frac_part r2) 1 H1); + intro; clear H1; rewrite (Rplus_comm 1 (frac_part r2)) in H2; + generalize + (Rlt_trans (frac_part r2 + frac_part r1) (frac_part r2 + 1) 2 H H2); + intro; clear H H2; rewrite (Rplus_comm (frac_part r2) (frac_part r1)) in H1; + unfold frac_part in H0, H1; unfold Rminus in H0, H1; + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2))) + in H1; rewrite (Rplus_comm r2 (- IZR (Int_part r2))) in H1; + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2) + in H1; + rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2) in H1; + rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2))) + in H1; + rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H1; + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2))) + in H0; rewrite (Rplus_comm r2 (- IZR (Int_part r2))) in H0; + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2) + in H0; + rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2) in H0; + rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2))) + in H0; + rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H0; + generalize + (Rplus_le_compat_l (IZR (Int_part r1) + IZR (Int_part r2)) 1 + (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) H0); + intro; clear H0; + generalize + (Rplus_lt_compat_l (IZR (Int_part r1) + IZR (Int_part r2)) + (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) 2 H1); + intro; clear H1; + rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2)))) + in H; + rewrite <- + (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) + (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2)) + in H; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H; + elim (Rplus_ne (r1 + r2)); intros a b; rewrite b in H; + clear a b; + rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2)))) + in H0; + rewrite <- + (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) + (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2)) + in H0; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H0; + elim (Rplus_ne (r1 + r2)); intros a b; rewrite b in H0; + clear a b; + rewrite <- (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) 1 1) in H0; + cut (1 = IZR 1); auto with zarith real. +intro; rewrite H1 in H0; rewrite H1 in H; clear H1; + rewrite <- (plus_IZR (Int_part r1) (Int_part r2)) in H; + rewrite <- (plus_IZR (Int_part r1) (Int_part r2)) in H0; + rewrite <- (plus_IZR (Int_part r1 + Int_part r2) 1) in H; + rewrite <- (plus_IZR (Int_part r1 + Int_part r2) 1) in H0; + rewrite <- (plus_IZR (Int_part r1 + Int_part r2 + 1) 1) in H0; + generalize (up_tech (r1 + r2) (Int_part r1 + Int_part r2 + 1) H H0); + intro; clear H H0; unfold Int_part at 1 in |- *; omega. +Qed. + +(**********) +Lemma plus_Int_part2 : + forall r1 r2:R, + frac_part r1 + frac_part r2 < 1 -> + Int_part (r1 + r2) = (Int_part r1 + Int_part r2)%Z. +intros; elim (base_fp r1); elim (base_fp r2); intros; clear H1 H3; + generalize (Rge_le (frac_part r2) 0 H0); intro; clear H0; + generalize (Rge_le (frac_part r1) 0 H2); intro; clear H2; + generalize (Rplus_le_compat_l (frac_part r1) 0 (frac_part r2) H1); + intro; clear H1; elim (Rplus_ne (frac_part r1)); intros a b; + rewrite a in H2; clear a b; + generalize (Rle_trans 0 (frac_part r1) (frac_part r1 + frac_part r2) H0 H2); + intro; clear H0 H2; unfold frac_part in H, H1; unfold Rminus in H, H1; + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2))) + in H1; rewrite (Rplus_comm r2 (- IZR (Int_part r2))) in H1; + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2) + in H1; + rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2) in H1; + rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2))) + in H1; + rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H1; + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2))) + in H; rewrite (Rplus_comm r2 (- IZR (Int_part r2))) in H; + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2) in H; + rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2) in H; + rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2))) + in H; + rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H; + generalize + (Rplus_le_compat_l (IZR (Int_part r1) + IZR (Int_part r2)) 0 + (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) H1); + intro; clear H1; + generalize + (Rplus_lt_compat_l (IZR (Int_part r1) + IZR (Int_part r2)) + (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) 1 H); + intro; clear H; + rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2)))) + in H1; + rewrite <- + (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) + (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2)) + in H1; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H1; + elim (Rplus_ne (r1 + r2)); intros a b; rewrite b in H1; + clear a b; + rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2)))) + in H0; + rewrite <- + (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) + (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2)) + in H0; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H0; + elim (Rplus_ne (IZR (Int_part r1) + IZR (Int_part r2))); + intros a b; rewrite a in H0; clear a b; elim (Rplus_ne (r1 + r2)); + intros a b; rewrite b in H0; clear a b; cut (1 = IZR 1); + auto with zarith real. +intro; rewrite H in H1; clear H; + rewrite <- (plus_IZR (Int_part r1) (Int_part r2)) in H0; + rewrite <- (plus_IZR (Int_part r1) (Int_part r2)) in H1; + rewrite <- (plus_IZR (Int_part r1 + Int_part r2) 1) in H1; + generalize (up_tech (r1 + r2) (Int_part r1 + Int_part r2) H0 H1); + intro; clear H0 H1; unfold Int_part at 1 in |- *; + omega. +Qed. + +(**********) +Lemma plus_frac_part1 : + forall r1 r2:R, + frac_part r1 + frac_part r2 >= 1 -> + frac_part (r1 + r2) = frac_part r1 + frac_part r2 - 1. +intros; unfold frac_part in |- *; generalize (plus_Int_part1 r1 r2 H); intro; + rewrite H0; rewrite (plus_IZR (Int_part r1 + Int_part r2) 1); + rewrite (plus_IZR (Int_part r1) (Int_part r2)); simpl in |- *; + unfold Rminus at 3 4 in |- *; + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2))); + rewrite (Rplus_comm r2 (- IZR (Int_part r2))); + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2); + rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2); + rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2))); + rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))); + unfold Rminus in |- *; + rewrite + (Rplus_assoc (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2))) (-1)) + ; rewrite <- (Ropp_plus_distr (IZR (Int_part r1) + IZR (Int_part r2)) 1); + trivial with zarith real. +Qed. + +(**********) +Lemma plus_frac_part2 : + forall r1 r2:R, + frac_part r1 + frac_part r2 < 1 -> + frac_part (r1 + r2) = frac_part r1 + frac_part r2. +intros; unfold frac_part in |- *; generalize (plus_Int_part2 r1 r2 H); intro; + rewrite H0; rewrite (plus_IZR (Int_part r1) (Int_part r2)); + unfold Rminus at 2 3 in |- *; + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2))); + rewrite (Rplus_comm r2 (- IZR (Int_part r2))); + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2); + rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2); + rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2))); + rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))); + unfold Rminus in |- *; trivial with zarith real. +Qed.
\ No newline at end of file diff --git a/theories/Reals/R_sqr.v b/theories/Reals/R_sqr.v new file mode 100644 index 00000000..0abf9064 --- /dev/null +++ b/theories/Reals/R_sqr.v @@ -0,0 +1,330 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: R_sqr.v,v 1.19.2.1 2004/07/16 19:31:12 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rbasic_fun. Open Local Scope R_scope. + +(****************************************************) +(* Rsqr : some results *) +(****************************************************) + +Ltac ring_Rsqr := unfold Rsqr in |- *; ring. + +Lemma Rsqr_neg : forall x:R, Rsqr x = Rsqr (- x). +intros; ring_Rsqr. +Qed. + +Lemma Rsqr_mult : forall x y:R, Rsqr (x * y) = Rsqr x * Rsqr y. +intros; ring_Rsqr. +Qed. + +Lemma Rsqr_plus : forall x y:R, Rsqr (x + y) = Rsqr x + Rsqr y + 2 * x * y. +intros; ring_Rsqr. +Qed. + +Lemma Rsqr_minus : forall x y:R, Rsqr (x - y) = Rsqr x + Rsqr y - 2 * x * y. +intros; ring_Rsqr. +Qed. + +Lemma Rsqr_neg_minus : forall x y:R, Rsqr (x - y) = Rsqr (y - x). +intros; ring_Rsqr. +Qed. + +Lemma Rsqr_1 : Rsqr 1 = 1. +ring_Rsqr. +Qed. + +Lemma Rsqr_gt_0_0 : forall x:R, 0 < Rsqr x -> x <> 0. +intros; red in |- *; intro; rewrite H0 in H; rewrite Rsqr_0 in H; + elim (Rlt_irrefl 0 H). +Qed. + +Lemma Rsqr_pos_lt : forall x:R, x <> 0 -> 0 < Rsqr x. +intros; case (Rtotal_order 0 x); intro; + [ unfold Rsqr in |- *; apply Rmult_lt_0_compat; assumption + | elim H0; intro; + [ elim H; symmetry in |- *; exact H1 + | rewrite Rsqr_neg; generalize (Ropp_lt_gt_contravar x 0 H1); + rewrite Ropp_0; intro; unfold Rsqr in |- *; + apply Rmult_lt_0_compat; assumption ] ]. +Qed. + +Lemma Rsqr_div : forall x y:R, y <> 0 -> Rsqr (x / y) = Rsqr x / Rsqr y. +intros; unfold Rsqr in |- *. +unfold Rdiv in |- *. +rewrite Rinv_mult_distr. +repeat rewrite Rmult_assoc. +apply Rmult_eq_compat_l. +pattern x at 2 in |- *; rewrite Rmult_comm. +repeat rewrite Rmult_assoc. +apply Rmult_eq_compat_l. +reflexivity. +assumption. +assumption. +Qed. + +Lemma Rsqr_eq_0 : forall x:R, Rsqr x = 0 -> x = 0. +unfold Rsqr in |- *; intros; generalize (Rmult_integral x x H); intro; + elim H0; intro; assumption. +Qed. + +Lemma Rsqr_minus_plus : forall a b:R, (a - b) * (a + b) = Rsqr a - Rsqr b. +intros; ring_Rsqr. +Qed. + +Lemma Rsqr_plus_minus : forall a b:R, (a + b) * (a - b) = Rsqr a - Rsqr b. +intros; ring_Rsqr. +Qed. + +Lemma Rsqr_incr_0 : + forall x y:R, Rsqr x <= Rsqr y -> 0 <= x -> 0 <= y -> x <= y. +intros; case (Rle_dec x y); intro; + [ assumption + | cut (y < x); + [ intro; unfold Rsqr in H; + generalize (Rmult_le_0_lt_compat y x y x H1 H1 H2 H2); + intro; generalize (Rle_lt_trans (x * x) (y * y) (x * x) H H3); + intro; elim (Rlt_irrefl (x * x) H4) + | auto with real ] ]. +Qed. + +Lemma Rsqr_incr_0_var : forall x y:R, Rsqr x <= Rsqr y -> 0 <= y -> x <= y. +intros; case (Rle_dec x y); intro; + [ assumption + | cut (y < x); + [ intro; unfold Rsqr in H; + generalize (Rmult_le_0_lt_compat y x y x H0 H0 H1 H1); + intro; generalize (Rle_lt_trans (x * x) (y * y) (x * x) H H2); + intro; elim (Rlt_irrefl (x * x) H3) + | auto with real ] ]. +Qed. + +Lemma Rsqr_incr_1 : + forall x y:R, x <= y -> 0 <= x -> 0 <= y -> Rsqr x <= Rsqr y. +intros; unfold Rsqr in |- *; apply Rmult_le_compat; assumption. +Qed. + +Lemma Rsqr_incrst_0 : + forall x y:R, Rsqr x < Rsqr y -> 0 <= x -> 0 <= y -> x < y. +intros; case (Rtotal_order x y); intro; + [ assumption + | elim H2; intro; + [ rewrite H3 in H; elim (Rlt_irrefl (Rsqr y) H) + | generalize (Rmult_le_0_lt_compat y x y x H1 H1 H3 H3); intro; + unfold Rsqr in H; generalize (Rlt_trans (x * x) (y * y) (x * x) H H4); + intro; elim (Rlt_irrefl (x * x) H5) ] ]. +Qed. + +Lemma Rsqr_incrst_1 : + forall x y:R, x < y -> 0 <= x -> 0 <= y -> Rsqr x < Rsqr y. +intros; unfold Rsqr in |- *; apply Rmult_le_0_lt_compat; assumption. +Qed. + +Lemma Rsqr_neg_pos_le_0 : + forall x y:R, Rsqr x <= Rsqr y -> 0 <= y -> - y <= x. +intros; case (Rcase_abs x); intro. +generalize (Ropp_lt_gt_contravar x 0 r); rewrite Ropp_0; intro; + generalize (Rlt_le 0 (- x) H1); intro; rewrite (Rsqr_neg x) in H; + generalize (Rsqr_incr_0 (- x) y H H2 H0); intro; + rewrite <- (Ropp_involutive x); apply Ropp_ge_le_contravar; + apply Rle_ge; assumption. +apply Rle_trans with 0; + [ rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; assumption + | apply Rge_le; assumption ]. +Qed. + +Lemma Rsqr_neg_pos_le_1 : + forall x y:R, - y <= x -> x <= y -> 0 <= y -> Rsqr x <= Rsqr y. +intros; case (Rcase_abs x); intro. +generalize (Ropp_lt_gt_contravar x 0 r); rewrite Ropp_0; intro; + generalize (Rlt_le 0 (- x) H2); intro; + generalize (Ropp_le_ge_contravar (- y) x H); rewrite Ropp_involutive; + intro; generalize (Rge_le y (- x) H4); intro; rewrite (Rsqr_neg x); + apply Rsqr_incr_1; assumption. +generalize (Rge_le x 0 r); intro; apply Rsqr_incr_1; assumption. +Qed. + +Lemma neg_pos_Rsqr_le : forall x y:R, - y <= x -> x <= y -> Rsqr x <= Rsqr y. +intros; case (Rcase_abs x); intro. +generalize (Ropp_lt_gt_contravar x 0 r); rewrite Ropp_0; intro; + generalize (Ropp_le_ge_contravar (- y) x H); rewrite Ropp_involutive; + intro; generalize (Rge_le y (- x) H2); intro; generalize (Rlt_le 0 (- x) H1); + intro; generalize (Rle_trans 0 (- x) y H4 H3); intro; + rewrite (Rsqr_neg x); apply Rsqr_incr_1; assumption. +generalize (Rge_le x 0 r); intro; generalize (Rle_trans 0 x y H1 H0); intro; + apply Rsqr_incr_1; assumption. +Qed. + +Lemma Rsqr_abs : forall x:R, Rsqr x = Rsqr (Rabs x). +intro; unfold Rabs in |- *; case (Rcase_abs x); intro; + [ apply Rsqr_neg | reflexivity ]. +Qed. + +Lemma Rsqr_le_abs_0 : forall x y:R, Rsqr x <= Rsqr y -> Rabs x <= Rabs y. +intros; apply Rsqr_incr_0; repeat rewrite <- Rsqr_abs; + [ assumption | apply Rabs_pos | apply Rabs_pos ]. +Qed. + +Lemma Rsqr_le_abs_1 : forall x y:R, Rabs x <= Rabs y -> Rsqr x <= Rsqr y. +intros; rewrite (Rsqr_abs x); rewrite (Rsqr_abs y); + apply (Rsqr_incr_1 (Rabs x) (Rabs y) H (Rabs_pos x) (Rabs_pos y)). +Qed. + +Lemma Rsqr_lt_abs_0 : forall x y:R, Rsqr x < Rsqr y -> Rabs x < Rabs y. +intros; apply Rsqr_incrst_0; repeat rewrite <- Rsqr_abs; + [ assumption | apply Rabs_pos | apply Rabs_pos ]. +Qed. + +Lemma Rsqr_lt_abs_1 : forall x y:R, Rabs x < Rabs y -> Rsqr x < Rsqr y. +intros; rewrite (Rsqr_abs x); rewrite (Rsqr_abs y); + apply (Rsqr_incrst_1 (Rabs x) (Rabs y) H (Rabs_pos x) (Rabs_pos y)). +Qed. + +Lemma Rsqr_inj : forall x y:R, 0 <= x -> 0 <= y -> Rsqr x = Rsqr y -> x = y. +intros; generalize (Rle_le_eq (Rsqr x) (Rsqr y)); intro; elim H2; intros _ H3; + generalize (H3 H1); intro; elim H4; intros; apply Rle_antisym; + apply Rsqr_incr_0; assumption. +Qed. + +Lemma Rsqr_eq_abs_0 : forall x y:R, Rsqr x = Rsqr y -> Rabs x = Rabs y. +intros; unfold Rabs in |- *; case (Rcase_abs x); case (Rcase_abs y); intros. +rewrite (Rsqr_neg x) in H; rewrite (Rsqr_neg y) in H; + generalize (Ropp_lt_gt_contravar y 0 r); + generalize (Ropp_lt_gt_contravar x 0 r0); rewrite Ropp_0; + intros; generalize (Rlt_le 0 (- x) H0); generalize (Rlt_le 0 (- y) H1); + intros; apply Rsqr_inj; assumption. +rewrite (Rsqr_neg x) in H; generalize (Rge_le y 0 r); intro; + generalize (Ropp_lt_gt_contravar x 0 r0); rewrite Ropp_0; + intro; generalize (Rlt_le 0 (- x) H1); intro; apply Rsqr_inj; + assumption. +rewrite (Rsqr_neg y) in H; generalize (Rge_le x 0 r0); intro; + generalize (Ropp_lt_gt_contravar y 0 r); rewrite Ropp_0; + intro; generalize (Rlt_le 0 (- y) H1); intro; apply Rsqr_inj; + assumption. +generalize (Rge_le x 0 r0); generalize (Rge_le y 0 r); intros; apply Rsqr_inj; + assumption. +Qed. + +Lemma Rsqr_eq_asb_1 : forall x y:R, Rabs x = Rabs y -> Rsqr x = Rsqr y. +intros; cut (Rsqr (Rabs x) = Rsqr (Rabs y)). +intro; repeat rewrite <- Rsqr_abs in H0; assumption. +rewrite H; reflexivity. +Qed. + +Lemma triangle_rectangle : + forall x y z:R, + 0 <= z -> Rsqr x + Rsqr y <= Rsqr z -> - z <= x <= z /\ - z <= y <= z. +intros; + generalize (plus_le_is_le (Rsqr x) (Rsqr y) (Rsqr z) (Rle_0_sqr y) H0); + rewrite Rplus_comm in H0; + generalize (plus_le_is_le (Rsqr y) (Rsqr x) (Rsqr z) (Rle_0_sqr x) H0); + intros; split; + [ split; + [ apply Rsqr_neg_pos_le_0; assumption + | apply Rsqr_incr_0_var; assumption ] + | split; + [ apply Rsqr_neg_pos_le_0; assumption + | apply Rsqr_incr_0_var; assumption ] ]. +Qed. + +Lemma triangle_rectangle_lt : + forall x y z:R, + Rsqr x + Rsqr y < Rsqr z -> Rabs x < Rabs z /\ Rabs y < Rabs z. +intros; split; + [ generalize (plus_lt_is_lt (Rsqr x) (Rsqr y) (Rsqr z) (Rle_0_sqr y) H); + intro; apply Rsqr_lt_abs_0; assumption + | rewrite Rplus_comm in H; + generalize (plus_lt_is_lt (Rsqr y) (Rsqr x) (Rsqr z) (Rle_0_sqr x) H); + intro; apply Rsqr_lt_abs_0; assumption ]. +Qed. + +Lemma triangle_rectangle_le : + forall x y z:R, + Rsqr x + Rsqr y <= Rsqr z -> Rabs x <= Rabs z /\ Rabs y <= Rabs z. +intros; split; + [ generalize (plus_le_is_le (Rsqr x) (Rsqr y) (Rsqr z) (Rle_0_sqr y) H); + intro; apply Rsqr_le_abs_0; assumption + | rewrite Rplus_comm in H; + generalize (plus_le_is_le (Rsqr y) (Rsqr x) (Rsqr z) (Rle_0_sqr x) H); + intro; apply Rsqr_le_abs_0; assumption ]. +Qed. + +Lemma Rsqr_inv : forall x:R, x <> 0 -> Rsqr (/ x) = / Rsqr x. +intros; unfold Rsqr in |- *. +rewrite Rinv_mult_distr; try reflexivity || assumption. +Qed. + +Lemma canonical_Rsqr : + forall (a:nonzeroreal) (b c x:R), + a * Rsqr x + b * x + c = + a * Rsqr (x + b / (2 * a)) + (4 * a * c - Rsqr b) / (4 * a). +intros. +rewrite Rsqr_plus. +repeat rewrite Rmult_plus_distr_l. +repeat rewrite Rplus_assoc. +apply Rplus_eq_compat_l. +unfold Rdiv, Rminus in |- *. +replace (2 * 1 + 2 * 1) with 4; [ idtac | ring ]. +rewrite (Rmult_plus_distr_r (4 * a * c) (- Rsqr b) (/ (4 * a))). +rewrite Rsqr_mult. +repeat rewrite Rinv_mult_distr. +repeat rewrite (Rmult_comm a). +repeat rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +rewrite (Rmult_comm 2). +repeat rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +rewrite (Rmult_comm (/ 2)). +rewrite (Rmult_comm 2). +repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +rewrite (Rmult_comm a). +repeat rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +rewrite (Rmult_comm 2). +repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +repeat rewrite Rplus_assoc. +rewrite (Rplus_comm (Rsqr b * (Rsqr (/ a * / 2) * a))). +repeat rewrite Rplus_assoc. +rewrite (Rmult_comm x). +apply Rplus_eq_compat_l. +rewrite (Rmult_comm (/ a)). +unfold Rsqr in |- *; repeat rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +ring. +apply (cond_nonzero a). +discrR. +apply (cond_nonzero a). +discrR. +discrR. +apply (cond_nonzero a). +discrR. +discrR. +discrR. +apply (cond_nonzero a). +discrR. +apply (cond_nonzero a). +Qed. + +Lemma Rsqr_eq : forall x y:R, Rsqr x = Rsqr y -> x = y \/ x = - y. +intros; unfold Rsqr in H; + generalize (Rplus_eq_compat_l (- (y * y)) (x * x) (y * y) H); + rewrite Rplus_opp_l; replace (- (y * y) + x * x) with ((x - y) * (x + y)). +intro; generalize (Rmult_integral (x - y) (x + y) H0); intro; elim H1; intros. +left; apply Rminus_diag_uniq; assumption. +right; apply Rminus_diag_uniq; unfold Rminus in |- *; rewrite Ropp_involutive; + assumption. +ring. +Qed.
\ No newline at end of file diff --git a/theories/Reals/R_sqrt.v b/theories/Reals/R_sqrt.v new file mode 100644 index 00000000..660b0527 --- /dev/null +++ b/theories/Reals/R_sqrt.v @@ -0,0 +1,399 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: R_sqrt.v,v 1.10.2.1 2004/07/16 19:31:12 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rfunctions. +Require Import Rsqrt_def. Open Local Scope R_scope. + +(* Here is a continuous extension of Rsqrt on R *) +Definition sqrt (x:R) : R := + match Rcase_abs x with + | left _ => 0 + | right a => Rsqrt (mknonnegreal x (Rge_le _ _ a)) + end. + +Lemma sqrt_positivity : forall x:R, 0 <= x -> 0 <= sqrt x. +intros. +unfold sqrt in |- *. +case (Rcase_abs x); intro. +elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ r H)). +apply Rsqrt_positivity. +Qed. + +Lemma sqrt_sqrt : forall x:R, 0 <= x -> sqrt x * sqrt x = x. +intros. +unfold sqrt in |- *. +case (Rcase_abs x); intro. +elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ r H)). +rewrite Rsqrt_Rsqrt; reflexivity. +Qed. + +Lemma sqrt_0 : sqrt 0 = 0. +apply Rsqr_eq_0; unfold Rsqr in |- *; apply sqrt_sqrt; right; reflexivity. +Qed. + +Lemma sqrt_1 : sqrt 1 = 1. +apply (Rsqr_inj (sqrt 1) 1); + [ apply sqrt_positivity; left + | left + | unfold Rsqr in |- *; rewrite sqrt_sqrt; [ ring | left ] ]; + apply Rlt_0_1. +Qed. + +Lemma sqrt_eq_0 : forall x:R, 0 <= x -> sqrt x = 0 -> x = 0. +intros; cut (Rsqr (sqrt x) = 0). +intro; unfold Rsqr in H1; rewrite sqrt_sqrt in H1; assumption. +rewrite H0; apply Rsqr_0. +Qed. + +Lemma sqrt_lem_0 : forall x y:R, 0 <= x -> 0 <= y -> sqrt x = y -> y * y = x. +intros; rewrite <- H1; apply (sqrt_sqrt x H). +Qed. + +Lemma sqtr_lem_1 : forall x y:R, 0 <= x -> 0 <= y -> y * y = x -> sqrt x = y. +intros; apply Rsqr_inj; + [ apply (sqrt_positivity x H) + | assumption + | unfold Rsqr in |- *; rewrite H1; apply (sqrt_sqrt x H) ]. +Qed. + +Lemma sqrt_def : forall x:R, 0 <= x -> sqrt x * sqrt x = x. +intros; apply (sqrt_sqrt x H). +Qed. + +Lemma sqrt_square : forall x:R, 0 <= x -> sqrt (x * x) = x. +intros; + apply + (Rsqr_inj (sqrt (Rsqr x)) x (sqrt_positivity (Rsqr x) (Rle_0_sqr x)) H); + unfold Rsqr in |- *; apply (sqrt_sqrt (Rsqr x) (Rle_0_sqr x)). +Qed. + +Lemma sqrt_Rsqr : forall x:R, 0 <= x -> sqrt (Rsqr x) = x. +intros; unfold Rsqr in |- *; apply sqrt_square; assumption. +Qed. + +Lemma sqrt_Rsqr_abs : forall x:R, sqrt (Rsqr x) = Rabs x. +intro x; rewrite Rsqr_abs; apply sqrt_Rsqr; apply Rabs_pos. +Qed. + +Lemma Rsqr_sqrt : forall x:R, 0 <= x -> Rsqr (sqrt x) = x. +intros x H1; unfold Rsqr in |- *; apply (sqrt_sqrt x H1). +Qed. + +Lemma sqrt_mult : + forall x y:R, 0 <= x -> 0 <= y -> sqrt (x * y) = sqrt x * sqrt y. +intros x y H1 H2; + apply + (Rsqr_inj (sqrt (x * y)) (sqrt x * sqrt y) + (sqrt_positivity (x * y) (Rmult_le_pos x y H1 H2)) + (Rmult_le_pos (sqrt x) (sqrt y) (sqrt_positivity x H1) + (sqrt_positivity y H2))); rewrite Rsqr_mult; + repeat rewrite Rsqr_sqrt; + [ ring | assumption | assumption | apply (Rmult_le_pos x y H1 H2) ]. +Qed. + +Lemma sqrt_lt_R0 : forall x:R, 0 < x -> 0 < sqrt x. +intros x H1; apply Rsqr_incrst_0; + [ rewrite Rsqr_0; rewrite Rsqr_sqrt; [ assumption | left; assumption ] + | right; reflexivity + | apply (sqrt_positivity x (Rlt_le 0 x H1)) ]. +Qed. + +Lemma sqrt_div : + forall x y:R, 0 <= x -> 0 < y -> sqrt (x / y) = sqrt x / sqrt y. +intros x y H1 H2; apply Rsqr_inj; + [ apply sqrt_positivity; apply (Rmult_le_pos x (/ y)); + [ assumption + | generalize (Rinv_0_lt_compat y H2); clear H2; intro H2; left; + assumption ] + | apply (Rmult_le_pos (sqrt x) (/ sqrt y)); + [ apply (sqrt_positivity x H1) + | generalize (sqrt_lt_R0 y H2); clear H2; intro H2; + generalize (Rinv_0_lt_compat (sqrt y) H2); clear H2; + intro H2; left; assumption ] + | rewrite Rsqr_div; repeat rewrite Rsqr_sqrt; + [ reflexivity + | left; assumption + | assumption + | generalize (Rinv_0_lt_compat y H2); intro H3; + generalize (Rlt_le 0 (/ y) H3); intro H4; + apply (Rmult_le_pos x (/ y) H1 H4) + | red in |- *; intro H3; generalize (Rlt_le 0 y H2); intro H4; + generalize (sqrt_eq_0 y H4 H3); intro H5; rewrite H5 in H2; + elim (Rlt_irrefl 0 H2) ] ]. +Qed. + +Lemma sqrt_lt_0 : forall x y:R, 0 <= x -> 0 <= y -> sqrt x < sqrt y -> x < y. +intros x y H1 H2 H3; + generalize + (Rsqr_incrst_1 (sqrt x) (sqrt y) H3 (sqrt_positivity x H1) + (sqrt_positivity y H2)); intro H4; rewrite (Rsqr_sqrt x H1) in H4; + rewrite (Rsqr_sqrt y H2) in H4; assumption. +Qed. + +Lemma sqrt_lt_1 : forall x y:R, 0 <= x -> 0 <= y -> x < y -> sqrt x < sqrt y. +intros x y H1 H2 H3; apply Rsqr_incrst_0; + [ rewrite (Rsqr_sqrt x H1); rewrite (Rsqr_sqrt y H2); assumption + | apply (sqrt_positivity x H1) + | apply (sqrt_positivity y H2) ]. +Qed. + +Lemma sqrt_le_0 : + forall x y:R, 0 <= x -> 0 <= y -> sqrt x <= sqrt y -> x <= y. +intros x y H1 H2 H3; + generalize + (Rsqr_incr_1 (sqrt x) (sqrt y) H3 (sqrt_positivity x H1) + (sqrt_positivity y H2)); intro H4; rewrite (Rsqr_sqrt x H1) in H4; + rewrite (Rsqr_sqrt y H2) in H4; assumption. +Qed. + +Lemma sqrt_le_1 : + forall x y:R, 0 <= x -> 0 <= y -> x <= y -> sqrt x <= sqrt y. +intros x y H1 H2 H3; apply Rsqr_incr_0; + [ rewrite (Rsqr_sqrt x H1); rewrite (Rsqr_sqrt y H2); assumption + | apply (sqrt_positivity x H1) + | apply (sqrt_positivity y H2) ]. +Qed. + +Lemma sqrt_inj : forall x y:R, 0 <= x -> 0 <= y -> sqrt x = sqrt y -> x = y. +intros; cut (Rsqr (sqrt x) = Rsqr (sqrt y)). +intro; rewrite (Rsqr_sqrt x H) in H2; rewrite (Rsqr_sqrt y H0) in H2; + assumption. +rewrite H1; reflexivity. +Qed. + +Lemma sqrt_less : forall x:R, 0 <= x -> 1 < x -> sqrt x < x. +intros x H1 H2; generalize (sqrt_lt_1 1 x (Rlt_le 0 1 Rlt_0_1) H1 H2); + intro H3; rewrite sqrt_1 in H3; generalize (Rmult_ne (sqrt x)); + intro H4; elim H4; intros H5 H6; rewrite <- H5; pattern x at 2 in |- *; + rewrite <- (sqrt_def x H1); + apply + (Rmult_lt_compat_l (sqrt x) 1 (sqrt x) + (sqrt_lt_R0 x (Rlt_trans 0 1 x Rlt_0_1 H2)) H3). +Qed. + +Lemma sqrt_more : forall x:R, 0 < x -> x < 1 -> x < sqrt x. +intros x H1 H2; + generalize (sqrt_lt_1 x 1 (Rlt_le 0 x H1) (Rlt_le 0 1 Rlt_0_1) H2); + intro H3; rewrite sqrt_1 in H3; generalize (Rmult_ne (sqrt x)); + intro H4; elim H4; intros H5 H6; rewrite <- H5; pattern x at 1 in |- *; + rewrite <- (sqrt_def x (Rlt_le 0 x H1)); + apply (Rmult_lt_compat_l (sqrt x) (sqrt x) 1 (sqrt_lt_R0 x H1) H3). +Qed. + +Lemma sqrt_cauchy : + forall a b c d:R, + a * c + b * d <= sqrt (Rsqr a + Rsqr b) * sqrt (Rsqr c + Rsqr d). +intros a b c d; apply Rsqr_incr_0_var; + [ rewrite Rsqr_mult; repeat rewrite Rsqr_sqrt; unfold Rsqr in |- *; + [ replace ((a * c + b * d) * (a * c + b * d)) with + (a * a * c * c + b * b * d * d + 2 * a * b * c * d); + [ replace ((a * a + b * b) * (c * c + d * d)) with + (a * a * c * c + b * b * d * d + (a * a * d * d + b * b * c * c)); + [ apply Rplus_le_compat_l; + replace (a * a * d * d + b * b * c * c) with + (2 * a * b * c * d + + (a * a * d * d + b * b * c * c - 2 * a * b * c * d)); + [ pattern (2 * a * b * c * d) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_le_compat_l; + replace (a * a * d * d + b * b * c * c - 2 * a * b * c * d) + with (Rsqr (a * d - b * c)); + [ apply Rle_0_sqr | unfold Rsqr in |- *; ring ] + | ring ] + | ring ] + | ring ] + | apply + (Rplus_le_le_0_compat (Rsqr c) (Rsqr d) (Rle_0_sqr c) (Rle_0_sqr d)) + | apply + (Rplus_le_le_0_compat (Rsqr a) (Rsqr b) (Rle_0_sqr a) (Rle_0_sqr b)) ] + | apply Rmult_le_pos; apply sqrt_positivity; apply Rplus_le_le_0_compat; + apply Rle_0_sqr ]. +Qed. + +(************************************************************) +(* Resolution of [a*X^2+b*X+c=0] *) +(************************************************************) + +Definition Delta (a:nonzeroreal) (b c:R) : R := Rsqr b - 4 * a * c. + +Definition Delta_is_pos (a:nonzeroreal) (b c:R) : Prop := 0 <= Delta a b c. + +Definition sol_x1 (a:nonzeroreal) (b c:R) : R := + (- b + sqrt (Delta a b c)) / (2 * a). + +Definition sol_x2 (a:nonzeroreal) (b c:R) : R := + (- b - sqrt (Delta a b c)) / (2 * a). + +Lemma Rsqr_sol_eq_0_1 : + forall (a:nonzeroreal) (b c x:R), + Delta_is_pos a b c -> + x = sol_x1 a b c \/ x = sol_x2 a b c -> a * Rsqr x + b * x + c = 0. +intros; elim H0; intro. +unfold sol_x1 in H1; unfold Delta in H1; rewrite H1; unfold Rdiv in |- *; + repeat rewrite Rsqr_mult; rewrite Rsqr_plus; rewrite <- Rsqr_neg; + rewrite Rsqr_sqrt. +rewrite Rsqr_inv. +unfold Rsqr in |- *; repeat rewrite Rinv_mult_distr. +repeat rewrite Rmult_assoc; rewrite (Rmult_comm a). +repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; rewrite Rmult_plus_distr_r. +repeat rewrite Rmult_assoc. +pattern 2 at 2 in |- *; rewrite (Rmult_comm 2). +repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +rewrite + (Rmult_plus_distr_r (- b) (sqrt (b * b - 2 * (2 * (a * c)))) (/ 2 * / a)) + . +rewrite Rmult_plus_distr_l; repeat rewrite Rplus_assoc. +replace + (- b * (sqrt (b * b - 2 * (2 * (a * c))) * (/ 2 * / a)) + + (b * (- b * (/ 2 * / a)) + + (b * (sqrt (b * b - 2 * (2 * (a * c))) * (/ 2 * / a)) + c))) with + (b * (- b * (/ 2 * / a)) + c). +unfold Rminus in |- *; repeat rewrite <- Rplus_assoc. +replace (b * b + b * b) with (2 * (b * b)). +rewrite Rmult_plus_distr_r; repeat rewrite Rmult_assoc. +rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +rewrite Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc; + rewrite (Rmult_comm 2). +repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; rewrite (Rmult_comm (/ 2)); repeat rewrite Rmult_assoc; + rewrite (Rmult_comm 2). +repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; repeat rewrite Rmult_assoc. +rewrite (Rmult_comm a); rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; rewrite <- Rmult_opp_opp. +ring. +apply (cond_nonzero a). +discrR. +discrR. +discrR. +ring. +ring. +discrR. +apply (cond_nonzero a). +discrR. +apply (cond_nonzero a). +apply prod_neq_R0; [ discrR | apply (cond_nonzero a) ]. +apply prod_neq_R0; [ discrR | apply (cond_nonzero a) ]. +apply prod_neq_R0; [ discrR | apply (cond_nonzero a) ]. +assumption. +unfold sol_x2 in H1; unfold Delta in H1; rewrite H1; unfold Rdiv in |- *; + repeat rewrite Rsqr_mult; rewrite Rsqr_minus; rewrite <- Rsqr_neg; + rewrite Rsqr_sqrt. +rewrite Rsqr_inv. +unfold Rsqr in |- *; repeat rewrite Rinv_mult_distr; + repeat rewrite Rmult_assoc. +rewrite (Rmult_comm a); repeat rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; unfold Rminus in |- *; rewrite Rmult_plus_distr_r. +rewrite Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc; + pattern 2 at 2 in |- *; rewrite (Rmult_comm 2). +repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; + rewrite + (Rmult_plus_distr_r (- b) (- sqrt (b * b + - (2 * (2 * (a * c))))) + (/ 2 * / a)). +rewrite Rmult_plus_distr_l; repeat rewrite Rplus_assoc. +rewrite Ropp_mult_distr_l_reverse; rewrite Ropp_involutive. +replace + (b * (sqrt (b * b + - (2 * (2 * (a * c)))) * (/ 2 * / a)) + + (b * (- b * (/ 2 * / a)) + + (b * (- sqrt (b * b + - (2 * (2 * (a * c)))) * (/ 2 * / a)) + c))) with + (b * (- b * (/ 2 * / a)) + c). +repeat rewrite <- Rplus_assoc; replace (b * b + b * b) with (2 * (b * b)). +rewrite Rmult_plus_distr_r; repeat rewrite Rmult_assoc; + rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. +rewrite Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc. +rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; rewrite (Rmult_comm (/ 2)); repeat rewrite Rmult_assoc. +rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; repeat rewrite Rmult_assoc; rewrite (Rmult_comm a); + rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; rewrite <- Rmult_opp_opp; ring. +apply (cond_nonzero a). +discrR. +discrR. +discrR. +ring. +ring. +discrR. +apply (cond_nonzero a). +discrR. +discrR. +apply (cond_nonzero a). +apply prod_neq_R0; discrR || apply (cond_nonzero a). +apply prod_neq_R0; discrR || apply (cond_nonzero a). +apply prod_neq_R0; discrR || apply (cond_nonzero a). +assumption. +Qed. + +Lemma Rsqr_sol_eq_0_0 : + forall (a:nonzeroreal) (b c x:R), + Delta_is_pos a b c -> + a * Rsqr x + b * x + c = 0 -> x = sol_x1 a b c \/ x = sol_x2 a b c. +intros; rewrite (canonical_Rsqr a b c x) in H0; rewrite Rplus_comm in H0; + generalize + (Rplus_opp_r_uniq ((4 * a * c - Rsqr b) / (4 * a)) + (a * Rsqr (x + b / (2 * a))) H0); cut (Rsqr b - 4 * a * c = Delta a b c). +intro; + replace (- ((4 * a * c - Rsqr b) / (4 * a))) with + ((Rsqr b - 4 * a * c) / (4 * a)). +rewrite H1; intro; + generalize + (Rmult_eq_compat_l (/ a) (a * Rsqr (x + b / (2 * a))) + (Delta a b c / (4 * a)) H2); + replace (/ a * (a * Rsqr (x + b / (2 * a)))) with (Rsqr (x + b / (2 * a))). +replace (/ a * (Delta a b c / (4 * a))) with + (Rsqr (sqrt (Delta a b c) / (2 * a))). +intro; + generalize (Rsqr_eq (x + b / (2 * a)) (sqrt (Delta a b c) / (2 * a)) H3); + intro; elim H4; intro. +left; unfold sol_x1 in |- *; + generalize + (Rplus_eq_compat_l (- (b / (2 * a))) (x + b / (2 * a)) + (sqrt (Delta a b c) / (2 * a)) H5); + replace (- (b / (2 * a)) + (x + b / (2 * a))) with x. +intro; rewrite H6; unfold Rdiv in |- *; ring. +ring. +right; unfold sol_x2 in |- *; + generalize + (Rplus_eq_compat_l (- (b / (2 * a))) (x + b / (2 * a)) + (- (sqrt (Delta a b c) / (2 * a))) H5); + replace (- (b / (2 * a)) + (x + b / (2 * a))) with x. +intro; rewrite H6; unfold Rdiv in |- *; ring. +ring. +rewrite Rsqr_div. +rewrite Rsqr_sqrt. +unfold Rdiv in |- *. +repeat rewrite Rmult_assoc. +rewrite (Rmult_comm (/ a)). +rewrite Rmult_assoc. +rewrite <- Rinv_mult_distr. +replace (2 * (2 * a) * a) with (Rsqr (2 * a)). +reflexivity. +ring_Rsqr. +rewrite <- Rmult_assoc; apply prod_neq_R0; + [ discrR | apply (cond_nonzero a) ]. +apply (cond_nonzero a). +assumption. +apply prod_neq_R0; [ discrR | apply (cond_nonzero a) ]. +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +symmetry in |- *; apply Rmult_1_l. +apply (cond_nonzero a). +unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse. +rewrite Ropp_minus_distr. +reflexivity. +reflexivity. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Ranalysis.v b/theories/Reals/Ranalysis.v new file mode 100644 index 00000000..88af8b20 --- /dev/null +++ b/theories/Reals/Ranalysis.v @@ -0,0 +1,802 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Ranalysis.v,v 1.19.2.1 2004/07/16 19:31:12 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rfunctions. +Require Import Rtrigo. +Require Import SeqSeries. +Require Export Ranalysis1. +Require Export Ranalysis2. +Require Export Ranalysis3. +Require Export Rtopology. +Require Export MVT. +Require Export PSeries_reg. +Require Export Exp_prop. +Require Export Rtrigo_reg. +Require Export Rsqrt_def. +Require Export R_sqrt. +Require Export Rtrigo_calc. +Require Export Rgeom. +Require Export RList. +Require Export Sqrt_reg. +Require Export Ranalysis4. +Require Export Rpower. Open Local Scope R_scope. + +Axiom AppVar : R. + +(**********) +Ltac intro_hyp_glob trm := + match constr:trm with + | (?X1 + ?X2)%F => + match goal with + | |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2 + | |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2 + | _ => idtac + end + | (?X1 - ?X2)%F => + match goal with + | |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2 + | |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2 + | _ => idtac + end + | (?X1 * ?X2)%F => + match goal with + | |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2 + | |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2 + | _ => idtac + end + | (?X1 / ?X2)%F => + let aux := constr:X2 in + match goal with + | _:(forall x0:R, aux x0 <> 0) |- (derivable _) => + intro_hyp_glob X1; intro_hyp_glob X2 + | _:(forall x0:R, aux x0 <> 0) |- (continuity _) => + intro_hyp_glob X1; intro_hyp_glob X2 + | |- (derivable _) => + cut (forall x0:R, aux x0 <> 0); + [ intro; intro_hyp_glob X1; intro_hyp_glob X2 | try assumption ] + | |- (continuity _) => + cut (forall x0:R, aux x0 <> 0); + [ intro; intro_hyp_glob X1; intro_hyp_glob X2 | try assumption ] + | _ => idtac + end + | (comp ?X1 ?X2) => + match goal with + | |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2 + | |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2 + | _ => idtac + end + | (- ?X1)%F => + match goal with + | |- (derivable _) => intro_hyp_glob X1 + | |- (continuity _) => intro_hyp_glob X1 + | _ => idtac + end + | (/ ?X1)%F => + let aux := constr:X1 in + match goal with + | _:(forall x0:R, aux x0 <> 0) |- (derivable _) => + intro_hyp_glob X1 + | _:(forall x0:R, aux x0 <> 0) |- (continuity _) => + intro_hyp_glob X1 + | |- (derivable _) => + cut (forall x0:R, aux x0 <> 0); + [ intro; intro_hyp_glob X1 | try assumption ] + | |- (continuity _) => + cut (forall x0:R, aux x0 <> 0); + [ intro; intro_hyp_glob X1 | try assumption ] + | _ => idtac + end + | cos => idtac + | sin => idtac + | cosh => idtac + | sinh => idtac + | exp => idtac + | Rsqr => idtac + | sqrt => idtac + | id => idtac + | (fct_cte _) => idtac + | (pow_fct _) => idtac + | Rabs => idtac + | ?X1 => + let p := constr:X1 in + match goal with + | _:(derivable p) |- _ => idtac + | |- (derivable p) => idtac + | |- (derivable _) => + cut (True -> derivable p); + [ intro HYPPD; cut (derivable p); + [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ] + | idtac ] + | _:(continuity p) |- _ => idtac + | |- (continuity p) => idtac + | |- (continuity _) => + cut (True -> continuity p); + [ intro HYPPD; cut (continuity p); + [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ] + | idtac ] + | _ => idtac + end + end. + +(**********) +Ltac intro_hyp_pt trm pt := + match constr:trm with + | (?X1 + ?X2)%F => + match goal with + | |- (derivable_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt + | |- (continuity_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt + | |- (derive_pt _ _ _ = _) => + intro_hyp_pt X1 pt; intro_hyp_pt X2 pt + | _ => idtac + end + | (?X1 - ?X2)%F => + match goal with + | |- (derivable_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt + | |- (continuity_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt + | |- (derive_pt _ _ _ = _) => + intro_hyp_pt X1 pt; intro_hyp_pt X2 pt + | _ => idtac + end + | (?X1 * ?X2)%F => + match goal with + | |- (derivable_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt + | |- (continuity_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt + | |- (derive_pt _ _ _ = _) => + intro_hyp_pt X1 pt; intro_hyp_pt X2 pt + | _ => idtac + end + | (?X1 / ?X2)%F => + let aux := constr:X2 in + match goal with + | _:(aux pt <> 0) |- (derivable_pt _ _) => + intro_hyp_pt X1 pt; intro_hyp_pt X2 pt + | _:(aux pt <> 0) |- (continuity_pt _ _) => + intro_hyp_pt X1 pt; intro_hyp_pt X2 pt + | _:(aux pt <> 0) |- (derive_pt _ _ _ = _) => + intro_hyp_pt X1 pt; intro_hyp_pt X2 pt + | id:(forall x0:R, aux x0 <> 0) |- (derivable_pt _ _) => + generalize (id pt); intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt + | id:(forall x0:R, aux x0 <> 0) |- (continuity_pt _ _) => + generalize (id pt); intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt + | id:(forall x0:R, aux x0 <> 0) |- (derive_pt _ _ _ = _) => + generalize (id pt); intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt + | |- (derivable_pt _ _) => + cut (aux pt <> 0); + [ intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | try assumption ] + | |- (continuity_pt _ _) => + cut (aux pt <> 0); + [ intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | try assumption ] + | |- (derive_pt _ _ _ = _) => + cut (aux pt <> 0); + [ intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | try assumption ] + | _ => idtac + end + | (comp ?X1 ?X2) => + match goal with + | |- (derivable_pt _ _) => + let pt_f1 := eval cbv beta in (X2 pt) in + (intro_hyp_pt X1 pt_f1; intro_hyp_pt X2 pt) + | |- (continuity_pt _ _) => + let pt_f1 := eval cbv beta in (X2 pt) in + (intro_hyp_pt X1 pt_f1; intro_hyp_pt X2 pt) + | |- (derive_pt _ _ _ = _) => + let pt_f1 := eval cbv beta in (X2 pt) in + (intro_hyp_pt X1 pt_f1; intro_hyp_pt X2 pt) + | _ => idtac + end + | (- ?X1)%F => + match goal with + | |- (derivable_pt _ _) => intro_hyp_pt X1 pt + | |- (continuity_pt _ _) => intro_hyp_pt X1 pt + | |- (derive_pt _ _ _ = _) => intro_hyp_pt X1 pt + | _ => idtac + end + | (/ ?X1)%F => + let aux := constr:X1 in + match goal with + | _:(aux pt <> 0) |- (derivable_pt _ _) => + intro_hyp_pt X1 pt + | _:(aux pt <> 0) |- (continuity_pt _ _) => + intro_hyp_pt X1 pt + | _:(aux pt <> 0) |- (derive_pt _ _ _ = _) => + intro_hyp_pt X1 pt + | id:(forall x0:R, aux x0 <> 0) |- (derivable_pt _ _) => + generalize (id pt); intro; intro_hyp_pt X1 pt + | id:(forall x0:R, aux x0 <> 0) |- (continuity_pt _ _) => + generalize (id pt); intro; intro_hyp_pt X1 pt + | id:(forall x0:R, aux x0 <> 0) |- (derive_pt _ _ _ = _) => + generalize (id pt); intro; intro_hyp_pt X1 pt + | |- (derivable_pt _ _) => + cut (aux pt <> 0); [ intro; intro_hyp_pt X1 pt | try assumption ] + | |- (continuity_pt _ _) => + cut (aux pt <> 0); [ intro; intro_hyp_pt X1 pt | try assumption ] + | |- (derive_pt _ _ _ = _) => + cut (aux pt <> 0); [ intro; intro_hyp_pt X1 pt | try assumption ] + | _ => idtac + end + | cos => idtac + | sin => idtac + | cosh => idtac + | sinh => idtac + | exp => idtac + | Rsqr => idtac + | id => idtac + | (fct_cte _) => idtac + | (pow_fct _) => idtac + | sqrt => + match goal with + | |- (derivable_pt _ _) => cut (0 < pt); [ intro | try assumption ] + | |- (continuity_pt _ _) => + cut (0 <= pt); [ intro | try assumption ] + | |- (derive_pt _ _ _ = _) => + cut (0 < pt); [ intro | try assumption ] + | _ => idtac + end + | Rabs => + match goal with + | |- (derivable_pt _ _) => + cut (pt <> 0); [ intro | try assumption ] + | _ => idtac + end + | ?X1 => + let p := constr:X1 in + match goal with + | _:(derivable_pt p pt) |- _ => idtac + | |- (derivable_pt p pt) => idtac + | |- (derivable_pt _ _) => + cut (True -> derivable_pt p pt); + [ intro HYPPD; cut (derivable_pt p pt); + [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ] + | idtac ] + | _:(continuity_pt p pt) |- _ => idtac + | |- (continuity_pt p pt) => idtac + | |- (continuity_pt _ _) => + cut (True -> continuity_pt p pt); + [ intro HYPPD; cut (continuity_pt p pt); + [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ] + | idtac ] + | |- (derive_pt _ _ _ = _) => + cut (True -> derivable_pt p pt); + [ intro HYPPD; cut (derivable_pt p pt); + [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ] + | idtac ] + | _ => idtac + end + end. + +(**********) +Ltac is_diff_pt := + match goal with + | |- (derivable_pt Rsqr _) => + + (* fonctions de base *) + apply derivable_pt_Rsqr + | |- (derivable_pt id ?X1) => apply (derivable_pt_id X1) + | |- (derivable_pt (fct_cte _) _) => apply derivable_pt_const + | |- (derivable_pt sin _) => apply derivable_pt_sin + | |- (derivable_pt cos _) => apply derivable_pt_cos + | |- (derivable_pt sinh _) => apply derivable_pt_sinh + | |- (derivable_pt cosh _) => apply derivable_pt_cosh + | |- (derivable_pt exp _) => apply derivable_pt_exp + | |- (derivable_pt (pow_fct _) _) => + unfold pow_fct in |- *; apply derivable_pt_pow + | |- (derivable_pt sqrt ?X1) => + apply (derivable_pt_sqrt X1); + assumption || + unfold plus_fct, minus_fct, opp_fct, mult_fct, div_fct, inv_fct, + comp, id, fct_cte, pow_fct in |- * + | |- (derivable_pt Rabs ?X1) => + apply (Rderivable_pt_abs X1); + assumption || + unfold plus_fct, minus_fct, opp_fct, mult_fct, div_fct, inv_fct, + comp, id, fct_cte, pow_fct in |- * + (* regles de differentiabilite *) + (* PLUS *) + | |- (derivable_pt (?X1 + ?X2) ?X3) => + apply (derivable_pt_plus X1 X2 X3); is_diff_pt + (* MOINS *) + | |- (derivable_pt (?X1 - ?X2) ?X3) => + apply (derivable_pt_minus X1 X2 X3); is_diff_pt + (* OPPOSE *) + | |- (derivable_pt (- ?X1) ?X2) => + apply (derivable_pt_opp X1 X2); + is_diff_pt + (* MULTIPLICATION PAR UN SCALAIRE *) + | |- (derivable_pt (mult_real_fct ?X1 ?X2) ?X3) => + apply (derivable_pt_scal X2 X1 X3); is_diff_pt + (* MULTIPLICATION *) + | |- (derivable_pt (?X1 * ?X2) ?X3) => + apply (derivable_pt_mult X1 X2 X3); is_diff_pt + (* DIVISION *) + | |- (derivable_pt (?X1 / ?X2) ?X3) => + apply (derivable_pt_div X1 X2 X3); + [ is_diff_pt + | is_diff_pt + | try + assumption || + unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, + comp, pow_fct, id, fct_cte in |- * ] + | |- (derivable_pt (/ ?X1) ?X2) => + + (* INVERSION *) + apply (derivable_pt_inv X1 X2); + [ assumption || + unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, + comp, pow_fct, id, fct_cte in |- * + | is_diff_pt ] + | |- (derivable_pt (comp ?X1 ?X2) ?X3) => + + (* COMPOSITION *) + apply (derivable_pt_comp X2 X1 X3); is_diff_pt + | _:(derivable_pt ?X1 ?X2) |- (derivable_pt ?X1 ?X2) => + assumption + | _:(derivable ?X1) |- (derivable_pt ?X1 ?X2) => + cut (derivable X1); [ intro HypDDPT; apply HypDDPT | assumption ] + | |- (True -> derivable_pt _ _) => + intro HypTruE; clear HypTruE; is_diff_pt + | _ => + try + unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id, + fct_cte, comp, pow_fct in |- * + end. + +(**********) +Ltac is_diff_glob := + match goal with + | |- (derivable Rsqr) => + (* fonctions de base *) + apply derivable_Rsqr + | |- (derivable id) => apply derivable_id + | |- (derivable (fct_cte _)) => apply derivable_const + | |- (derivable sin) => apply derivable_sin + | |- (derivable cos) => apply derivable_cos + | |- (derivable cosh) => apply derivable_cosh + | |- (derivable sinh) => apply derivable_sinh + | |- (derivable exp) => apply derivable_exp + | |- (derivable (pow_fct _)) => + unfold pow_fct in |- *; + apply derivable_pow + (* regles de differentiabilite *) + (* PLUS *) + | |- (derivable (?X1 + ?X2)) => + apply (derivable_plus X1 X2); is_diff_glob + (* MOINS *) + | |- (derivable (?X1 - ?X2)) => + apply (derivable_minus X1 X2); is_diff_glob + (* OPPOSE *) + | |- (derivable (- ?X1)) => + apply (derivable_opp X1); + is_diff_glob + (* MULTIPLICATION PAR UN SCALAIRE *) + | |- (derivable (mult_real_fct ?X1 ?X2)) => + apply (derivable_scal X2 X1); is_diff_glob + (* MULTIPLICATION *) + | |- (derivable (?X1 * ?X2)) => + apply (derivable_mult X1 X2); is_diff_glob + (* DIVISION *) + | |- (derivable (?X1 / ?X2)) => + apply (derivable_div X1 X2); + [ is_diff_glob + | is_diff_glob + | try + assumption || + unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, + id, fct_cte, comp, pow_fct in |- * ] + | |- (derivable (/ ?X1)) => + + (* INVERSION *) + apply (derivable_inv X1); + [ try + assumption || + unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, + id, fct_cte, comp, pow_fct in |- * + | is_diff_glob ] + | |- (derivable (comp sqrt _)) => + + (* COMPOSITION *) + unfold derivable in |- *; intro; try is_diff_pt + | |- (derivable (comp Rabs _)) => + unfold derivable in |- *; intro; try is_diff_pt + | |- (derivable (comp ?X1 ?X2)) => + apply (derivable_comp X2 X1); is_diff_glob + | _:(derivable ?X1) |- (derivable ?X1) => assumption + | |- (True -> derivable _) => + intro HypTruE; clear HypTruE; is_diff_glob + | _ => + try + unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id, + fct_cte, comp, pow_fct in |- * + end. + +(**********) +Ltac is_cont_pt := + match goal with + | |- (continuity_pt Rsqr _) => + + (* fonctions de base *) + apply derivable_continuous_pt; apply derivable_pt_Rsqr + | |- (continuity_pt id ?X1) => + apply derivable_continuous_pt; apply (derivable_pt_id X1) + | |- (continuity_pt (fct_cte _) _) => + apply derivable_continuous_pt; apply derivable_pt_const + | |- (continuity_pt sin _) => + apply derivable_continuous_pt; apply derivable_pt_sin + | |- (continuity_pt cos _) => + apply derivable_continuous_pt; apply derivable_pt_cos + | |- (continuity_pt sinh _) => + apply derivable_continuous_pt; apply derivable_pt_sinh + | |- (continuity_pt cosh _) => + apply derivable_continuous_pt; apply derivable_pt_cosh + | |- (continuity_pt exp _) => + apply derivable_continuous_pt; apply derivable_pt_exp + | |- (continuity_pt (pow_fct _) _) => + unfold pow_fct in |- *; apply derivable_continuous_pt; + apply derivable_pt_pow + | |- (continuity_pt sqrt ?X1) => + apply continuity_pt_sqrt; + assumption || + unfold plus_fct, minus_fct, opp_fct, mult_fct, div_fct, inv_fct, + comp, id, fct_cte, pow_fct in |- * + | |- (continuity_pt Rabs ?X1) => + apply (Rcontinuity_abs X1) + (* regles de differentiabilite *) + (* PLUS *) + | |- (continuity_pt (?X1 + ?X2) ?X3) => + apply (continuity_pt_plus X1 X2 X3); is_cont_pt + (* MOINS *) + | |- (continuity_pt (?X1 - ?X2) ?X3) => + apply (continuity_pt_minus X1 X2 X3); is_cont_pt + (* OPPOSE *) + | |- (continuity_pt (- ?X1) ?X2) => + apply (continuity_pt_opp X1 X2); + is_cont_pt + (* MULTIPLICATION PAR UN SCALAIRE *) + | |- (continuity_pt (mult_real_fct ?X1 ?X2) ?X3) => + apply (continuity_pt_scal X2 X1 X3); is_cont_pt + (* MULTIPLICATION *) + | |- (continuity_pt (?X1 * ?X2) ?X3) => + apply (continuity_pt_mult X1 X2 X3); is_cont_pt + (* DIVISION *) + | |- (continuity_pt (?X1 / ?X2) ?X3) => + apply (continuity_pt_div X1 X2 X3); + [ is_cont_pt + | is_cont_pt + | try + assumption || + unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, + comp, id, fct_cte, pow_fct in |- * ] + | |- (continuity_pt (/ ?X1) ?X2) => + + (* INVERSION *) + apply (continuity_pt_inv X1 X2); + [ is_cont_pt + | assumption || + unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, + comp, id, fct_cte, pow_fct in |- * ] + | |- (continuity_pt (comp ?X1 ?X2) ?X3) => + + (* COMPOSITION *) + apply (continuity_pt_comp X2 X1 X3); is_cont_pt + | _:(continuity_pt ?X1 ?X2) |- (continuity_pt ?X1 ?X2) => + assumption + | _:(continuity ?X1) |- (continuity_pt ?X1 ?X2) => + cut (continuity X1); [ intro HypDDPT; apply HypDDPT | assumption ] + | _:(derivable_pt ?X1 ?X2) |- (continuity_pt ?X1 ?X2) => + apply derivable_continuous_pt; assumption + | _:(derivable ?X1) |- (continuity_pt ?X1 ?X2) => + cut (continuity X1); + [ intro HypDDPT; apply HypDDPT + | apply derivable_continuous; assumption ] + | |- (True -> continuity_pt _ _) => + intro HypTruE; clear HypTruE; is_cont_pt + | _ => + try + unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id, + fct_cte, comp, pow_fct in |- * + end. + +(**********) +Ltac is_cont_glob := + match goal with + | |- (continuity Rsqr) => + + (* fonctions de base *) + apply derivable_continuous; apply derivable_Rsqr + | |- (continuity id) => apply derivable_continuous; apply derivable_id + | |- (continuity (fct_cte _)) => + apply derivable_continuous; apply derivable_const + | |- (continuity sin) => apply derivable_continuous; apply derivable_sin + | |- (continuity cos) => apply derivable_continuous; apply derivable_cos + | |- (continuity exp) => apply derivable_continuous; apply derivable_exp + | |- (continuity (pow_fct _)) => + unfold pow_fct in |- *; apply derivable_continuous; apply derivable_pow + | |- (continuity sinh) => + apply derivable_continuous; apply derivable_sinh + | |- (continuity cosh) => + apply derivable_continuous; apply derivable_cosh + | |- (continuity Rabs) => + apply Rcontinuity_abs + (* regles de continuite *) + (* PLUS *) + | |- (continuity (?X1 + ?X2)) => + apply (continuity_plus X1 X2); + try is_cont_glob || assumption + (* MOINS *) + | |- (continuity (?X1 - ?X2)) => + apply (continuity_minus X1 X2); + try is_cont_glob || assumption + (* OPPOSE *) + | |- (continuity (- ?X1)) => + apply (continuity_opp X1); try is_cont_glob || assumption + (* INVERSE *) + | |- (continuity (/ ?X1)) => + apply (continuity_inv X1); + try is_cont_glob || assumption + (* MULTIPLICATION PAR UN SCALAIRE *) + | |- (continuity (mult_real_fct ?X1 ?X2)) => + apply (continuity_scal X2 X1); + try is_cont_glob || assumption + (* MULTIPLICATION *) + | |- (continuity (?X1 * ?X2)) => + apply (continuity_mult X1 X2); + try is_cont_glob || assumption + (* DIVISION *) + | |- (continuity (?X1 / ?X2)) => + apply (continuity_div X1 X2); + [ try is_cont_glob || assumption + | try is_cont_glob || assumption + | try + assumption || + unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, + id, fct_cte, pow_fct in |- * ] + | |- (continuity (comp sqrt _)) => + + (* COMPOSITION *) + unfold continuity_pt in |- *; intro; try is_cont_pt + | |- (continuity (comp ?X1 ?X2)) => + apply (continuity_comp X2 X1); try is_cont_glob || assumption + | _:(continuity ?X1) |- (continuity ?X1) => assumption + | |- (True -> continuity _) => + intro HypTruE; clear HypTruE; is_cont_glob + | _:(derivable ?X1) |- (continuity ?X1) => + apply derivable_continuous; assumption + | _ => + try + unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id, + fct_cte, comp, pow_fct in |- * + end. + +(**********) +Ltac rew_term trm := + match constr:trm with + | (?X1 + ?X2) => + let p1 := rew_term X1 with p2 := rew_term X2 in + match constr:p1 with + | (fct_cte ?X3) => + match constr:p2 with + | (fct_cte ?X4) => constr:(fct_cte (X3 + X4)) + | _ => constr:(p1 + p2)%F + end + | _ => constr:(p1 + p2)%F + end + | (?X1 - ?X2) => + let p1 := rew_term X1 with p2 := rew_term X2 in + match constr:p1 with + | (fct_cte ?X3) => + match constr:p2 with + | (fct_cte ?X4) => constr:(fct_cte (X3 - X4)) + | _ => constr:(p1 - p2)%F + end + | _ => constr:(p1 - p2)%F + end + | (?X1 / ?X2) => + let p1 := rew_term X1 with p2 := rew_term X2 in + match constr:p1 with + | (fct_cte ?X3) => + match constr:p2 with + | (fct_cte ?X4) => constr:(fct_cte (X3 / X4)) + | _ => constr:(p1 / p2)%F + end + | _ => + match constr:p2 with + | (fct_cte ?X4) => constr:(p1 * fct_cte (/ X4))%F + | _ => constr:(p1 / p2)%F + end + end + | (?X1 * / ?X2) => + let p1 := rew_term X1 with p2 := rew_term X2 in + match constr:p1 with + | (fct_cte ?X3) => + match constr:p2 with + | (fct_cte ?X4) => constr:(fct_cte (X3 / X4)) + | _ => constr:(p1 / p2)%F + end + | _ => + match constr:p2 with + | (fct_cte ?X4) => constr:(p1 * fct_cte (/ X4))%F + | _ => constr:(p1 / p2)%F + end + end + | (?X1 * ?X2) => + let p1 := rew_term X1 with p2 := rew_term X2 in + match constr:p1 with + | (fct_cte ?X3) => + match constr:p2 with + | (fct_cte ?X4) => constr:(fct_cte (X3 * X4)) + | _ => constr:(p1 * p2)%F + end + | _ => constr:(p1 * p2)%F + end + | (- ?X1) => + let p := rew_term X1 in + match constr:p with + | (fct_cte ?X2) => constr:(fct_cte (- X2)) + | _ => constr:(- p)%F + end + | (/ ?X1) => + let p := rew_term X1 in + match constr:p with + | (fct_cte ?X2) => constr:(fct_cte (/ X2)) + | _ => constr:(/ p)%F + end + | (?X1 AppVar) => constr:X1 + | (?X1 ?X2) => + let p := rew_term X2 in + match constr:p with + | (fct_cte ?X3) => constr:(fct_cte (X1 X3)) + | _ => constr:(comp X1 p) + end + | AppVar => constr:id + | (AppVar ^ ?X1) => constr:(pow_fct X1) + | (?X1 ^ ?X2) => + let p := rew_term X1 in + match constr:p with + | (fct_cte ?X3) => constr:(fct_cte (pow_fct X2 X3)) + | _ => constr:(comp (pow_fct X2) p) + end + | ?X1 => constr:(fct_cte X1) + end. + +(**********) +Ltac deriv_proof trm pt := + match constr:trm with + | (?X1 + ?X2)%F => + let p1 := deriv_proof X1 pt with p2 := deriv_proof X2 pt in + constr:(derivable_pt_plus X1 X2 pt p1 p2) + | (?X1 - ?X2)%F => + let p1 := deriv_proof X1 pt with p2 := deriv_proof X2 pt in + constr:(derivable_pt_minus X1 X2 pt p1 p2) + | (?X1 * ?X2)%F => + let p1 := deriv_proof X1 pt with p2 := deriv_proof X2 pt in + constr:(derivable_pt_mult X1 X2 pt p1 p2) + | (?X1 / ?X2)%F => + match goal with + | id:(?X2 pt <> 0) |- _ => + let p1 := deriv_proof X1 pt with p2 := deriv_proof X2 pt in + constr:(derivable_pt_div X1 X2 pt p1 p2 id) + | _ => constr:False + end + | (/ ?X1)%F => + match goal with + | id:(?X1 pt <> 0) |- _ => + let p1 := deriv_proof X1 pt in + constr:(derivable_pt_inv X1 pt p1 id) + | _ => constr:False + end + | (comp ?X1 ?X2) => + let pt_f1 := eval cbv beta in (X2 pt) in + let p1 := deriv_proof X1 pt_f1 with p2 := deriv_proof X2 pt in + constr:(derivable_pt_comp X2 X1 pt p2 p1) + | (- ?X1)%F => + let p1 := deriv_proof X1 pt in + constr:(derivable_pt_opp X1 pt p1) + | sin => constr:(derivable_pt_sin pt) + | cos => constr:(derivable_pt_cos pt) + | sinh => constr:(derivable_pt_sinh pt) + | cosh => constr:(derivable_pt_cosh pt) + | exp => constr:(derivable_pt_exp pt) + | id => constr:(derivable_pt_id pt) + | Rsqr => constr:(derivable_pt_Rsqr pt) + | sqrt => + match goal with + | id:(0 < pt) |- _ => constr:(derivable_pt_sqrt pt id) + | _ => constr:False + end + | (fct_cte ?X1) => constr:(derivable_pt_const X1 pt) + | ?X1 => + let aux := constr:X1 in + match goal with + | id:(derivable_pt aux pt) |- _ => constr:id + | id:(derivable aux) |- _ => constr:(id pt) + | _ => constr:False + end + end. + +(**********) +Ltac simplify_derive trm pt := + match constr:trm with + | (?X1 + ?X2)%F => + try rewrite derive_pt_plus; simplify_derive X1 pt; + simplify_derive X2 pt + | (?X1 - ?X2)%F => + try rewrite derive_pt_minus; simplify_derive X1 pt; + simplify_derive X2 pt + | (?X1 * ?X2)%F => + try rewrite derive_pt_mult; simplify_derive X1 pt; + simplify_derive X2 pt + | (?X1 / ?X2)%F => + try rewrite derive_pt_div; simplify_derive X1 pt; simplify_derive X2 pt + | (comp ?X1 ?X2) => + let pt_f1 := eval cbv beta in (X2 pt) in + (try rewrite derive_pt_comp; simplify_derive X1 pt_f1; + simplify_derive X2 pt) + | (- ?X1)%F => try rewrite derive_pt_opp; simplify_derive X1 pt + | (/ ?X1)%F => + try rewrite derive_pt_inv; simplify_derive X1 pt + | (fct_cte ?X1) => try rewrite derive_pt_const + | id => try rewrite derive_pt_id + | sin => try rewrite derive_pt_sin + | cos => try rewrite derive_pt_cos + | sinh => try rewrite derive_pt_sinh + | cosh => try rewrite derive_pt_cosh + | exp => try rewrite derive_pt_exp + | Rsqr => try rewrite derive_pt_Rsqr + | sqrt => try rewrite derive_pt_sqrt + | ?X1 => + let aux := constr:X1 in + match goal with + | id:(derive_pt aux pt ?X2 = _),H:(derivable aux) |- _ => + try replace (derive_pt aux pt (H pt)) with (derive_pt aux pt X2); + [ rewrite id | apply pr_nu ] + | id:(derive_pt aux pt ?X2 = _),H:(derivable_pt aux pt) |- _ => + try replace (derive_pt aux pt H) with (derive_pt aux pt X2); + [ rewrite id | apply pr_nu ] + | _ => idtac + end + | _ => idtac + end. + +(**********) +Ltac reg := + match goal with + | |- (derivable_pt ?X1 ?X2) => + let trm := eval cbv beta in (X1 AppVar) in + let aux := rew_term trm in + (intro_hyp_pt aux X2; + try (change (derivable_pt aux X2) in |- *; is_diff_pt) || is_diff_pt) + | |- (derivable ?X1) => + let trm := eval cbv beta in (X1 AppVar) in + let aux := rew_term trm in + (intro_hyp_glob aux; + try (change (derivable aux) in |- *; is_diff_glob) || is_diff_glob) + | |- (continuity ?X1) => + let trm := eval cbv beta in (X1 AppVar) in + let aux := rew_term trm in + (intro_hyp_glob aux; + try (change (continuity aux) in |- *; is_cont_glob) || is_cont_glob) + | |- (continuity_pt ?X1 ?X2) => + let trm := eval cbv beta in (X1 AppVar) in + let aux := rew_term trm in + (intro_hyp_pt aux X2; + try (change (continuity_pt aux X2) in |- *; is_cont_pt) || is_cont_pt) + | |- (derive_pt ?X1 ?X2 ?X3 = ?X4) => + let trm := eval cbv beta in (X1 AppVar) in + let aux := rew_term trm in + (intro_hyp_pt aux X2; + let aux2 := deriv_proof aux X2 in + (try + (replace (derive_pt X1 X2 X3) with (derive_pt aux X2 aux2); + [ simplify_derive aux X2; + try + unfold plus_fct, minus_fct, mult_fct, div_fct, id, fct_cte, + inv_fct, opp_fct in |- *; try ring + | try apply pr_nu ]) || is_diff_pt)) + end.
\ No newline at end of file diff --git a/theories/Reals/Ranalysis1.v b/theories/Reals/Ranalysis1.v new file mode 100644 index 00000000..918ebfc0 --- /dev/null +++ b/theories/Reals/Ranalysis1.v @@ -0,0 +1,1479 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Ranalysis1.v,v 1.21.2.1 2004/07/16 19:31:12 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rfunctions. +Require Export Rlimit. +Require Export Rderiv. Open Local Scope R_scope. +Implicit Type f : R -> R. + +(****************************************************) +(** Basic operations on functions *) +(****************************************************) +Definition plus_fct f1 f2 (x:R) : R := f1 x + f2 x. +Definition opp_fct f (x:R) : R := - f x. +Definition mult_fct f1 f2 (x:R) : R := f1 x * f2 x. +Definition mult_real_fct (a:R) f (x:R) : R := a * f x. +Definition minus_fct f1 f2 (x:R) : R := f1 x - f2 x. +Definition div_fct f1 f2 (x:R) : R := f1 x / f2 x. +Definition div_real_fct (a:R) f (x:R) : R := a / f x. +Definition comp f1 f2 (x:R) : R := f1 (f2 x). +Definition inv_fct f (x:R) : R := / f x. + +Infix "+" := plus_fct : Rfun_scope. +Notation "- x" := (opp_fct x) : Rfun_scope. +Infix "*" := mult_fct : Rfun_scope. +Infix "-" := minus_fct : Rfun_scope. +Infix "/" := div_fct : Rfun_scope. +Notation Local "f1 'o' f2" := (comp f1 f2) + (at level 20, right associativity) : Rfun_scope. +Notation "/ x" := (inv_fct x) : Rfun_scope. + +Delimit Scope Rfun_scope with F. + +Definition fct_cte (a x:R) : R := a. +Definition id (x:R) := x. + +(****************************************************) +(** Variations of functions *) +(****************************************************) +Definition increasing f : Prop := forall x y:R, x <= y -> f x <= f y. +Definition decreasing f : Prop := forall x y:R, x <= y -> f y <= f x. +Definition strict_increasing f : Prop := forall x y:R, x < y -> f x < f y. +Definition strict_decreasing f : Prop := forall x y:R, x < y -> f y < f x. +Definition constant f : Prop := forall x y:R, f x = f y. + +(**********) +Definition no_cond (x:R) : Prop := True. + +(**********) +Definition constant_D_eq f (D:R -> Prop) (c:R) : Prop := + forall x:R, D x -> f x = c. + +(***************************************************) +(** Definition of continuity as a limit *) +(***************************************************) + +(**********) +Definition continuity_pt f (x0:R) : Prop := continue_in f no_cond x0. +Definition continuity f : Prop := forall x:R, continuity_pt f x. + +Arguments Scope continuity_pt [Rfun_scope R_scope]. +Arguments Scope continuity [Rfun_scope]. + +(**********) +Lemma continuity_pt_plus : + forall f1 f2 (x0:R), + continuity_pt f1 x0 -> continuity_pt f2 x0 -> continuity_pt (f1 + f2) x0. +unfold continuity_pt, plus_fct in |- *; unfold continue_in in |- *; intros; + apply limit_plus; assumption. +Qed. + +Lemma continuity_pt_opp : + forall f (x0:R), continuity_pt f x0 -> continuity_pt (- f) x0. +unfold continuity_pt, opp_fct in |- *; unfold continue_in in |- *; intros; + apply limit_Ropp; assumption. +Qed. + +Lemma continuity_pt_minus : + forall f1 f2 (x0:R), + continuity_pt f1 x0 -> continuity_pt f2 x0 -> continuity_pt (f1 - f2) x0. +unfold continuity_pt, minus_fct in |- *; unfold continue_in in |- *; intros; + apply limit_minus; assumption. +Qed. + +Lemma continuity_pt_mult : + forall f1 f2 (x0:R), + continuity_pt f1 x0 -> continuity_pt f2 x0 -> continuity_pt (f1 * f2) x0. +unfold continuity_pt, mult_fct in |- *; unfold continue_in in |- *; intros; + apply limit_mul; assumption. +Qed. + +Lemma continuity_pt_const : forall f (x0:R), constant f -> continuity_pt f x0. +unfold constant, continuity_pt in |- *; unfold continue_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + intros; exists 1; split; + [ apply Rlt_0_1 + | intros; generalize (H x x0); intro; rewrite H2; simpl in |- *; + rewrite R_dist_eq; assumption ]. +Qed. + +Lemma continuity_pt_scal : + forall f (a x0:R), + continuity_pt f x0 -> continuity_pt (mult_real_fct a f) x0. +unfold continuity_pt, mult_real_fct in |- *; unfold continue_in in |- *; + intros; apply (limit_mul (fun x:R => a) f (D_x no_cond x0) a (f x0) x0). +unfold limit1_in in |- *; unfold limit_in in |- *; intros; exists 1; split. +apply Rlt_0_1. +intros; rewrite R_dist_eq; assumption. +assumption. +Qed. + +Lemma continuity_pt_inv : + forall f (x0:R), continuity_pt f x0 -> f x0 <> 0 -> continuity_pt (/ f) x0. +intros. +replace (/ f)%F with (fun x:R => / f x). +unfold continuity_pt in |- *; unfold continue_in in |- *; intros; + apply limit_inv; assumption. +unfold inv_fct in |- *; reflexivity. +Qed. + +Lemma div_eq_inv : forall f1 f2, (f1 / f2)%F = (f1 * / f2)%F. +intros; reflexivity. +Qed. + +Lemma continuity_pt_div : + forall f1 f2 (x0:R), + continuity_pt f1 x0 -> + continuity_pt f2 x0 -> f2 x0 <> 0 -> continuity_pt (f1 / f2) x0. +intros; rewrite (div_eq_inv f1 f2); apply continuity_pt_mult; + [ assumption | apply continuity_pt_inv; assumption ]. +Qed. + +Lemma continuity_pt_comp : + forall f1 f2 (x:R), + continuity_pt f1 x -> continuity_pt f2 (f1 x) -> continuity_pt (f2 o f1) x. +unfold continuity_pt in |- *; unfold continue_in in |- *; intros; + unfold comp in |- *. +cut + (limit1_in (fun x0:R => f2 (f1 x0)) + (Dgf (D_x no_cond x) (D_x no_cond (f1 x)) f1) ( + f2 (f1 x)) x -> + limit1_in (fun x0:R => f2 (f1 x0)) (D_x no_cond x) (f2 (f1 x)) x). +intro; apply H1. +eapply limit_comp. +apply H. +apply H0. +unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *; + simpl in |- *; unfold R_dist in |- *; intros. +assert (H3 := H1 eps H2). +elim H3; intros. +exists x0. +split. +elim H4; intros; assumption. +intros; case (Req_dec (f1 x) (f1 x1)); intro. +rewrite H6; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + assumption. +elim H4; intros; apply H8. +split. +unfold Dgf, D_x, no_cond in |- *. +split. +split. +trivial. +elim H5; unfold D_x, no_cond in |- *; intros. +elim H9; intros; assumption. +split. +trivial. +assumption. +elim H5; intros; assumption. +Qed. + +(**********) +Lemma continuity_plus : + forall f1 f2, continuity f1 -> continuity f2 -> continuity (f1 + f2). +unfold continuity in |- *; intros; + apply (continuity_pt_plus f1 f2 x (H x) (H0 x)). +Qed. + +Lemma continuity_opp : forall f, continuity f -> continuity (- f). +unfold continuity in |- *; intros; apply (continuity_pt_opp f x (H x)). +Qed. + +Lemma continuity_minus : + forall f1 f2, continuity f1 -> continuity f2 -> continuity (f1 - f2). +unfold continuity in |- *; intros; + apply (continuity_pt_minus f1 f2 x (H x) (H0 x)). +Qed. + +Lemma continuity_mult : + forall f1 f2, continuity f1 -> continuity f2 -> continuity (f1 * f2). +unfold continuity in |- *; intros; + apply (continuity_pt_mult f1 f2 x (H x) (H0 x)). +Qed. + +Lemma continuity_const : forall f, constant f -> continuity f. +unfold continuity in |- *; intros; apply (continuity_pt_const f x H). +Qed. + +Lemma continuity_scal : + forall f (a:R), continuity f -> continuity (mult_real_fct a f). +unfold continuity in |- *; intros; apply (continuity_pt_scal f a x (H x)). +Qed. + +Lemma continuity_inv : + forall f, continuity f -> (forall x:R, f x <> 0) -> continuity (/ f). +unfold continuity in |- *; intros; apply (continuity_pt_inv f x (H x) (H0 x)). +Qed. + +Lemma continuity_div : + forall f1 f2, + continuity f1 -> + continuity f2 -> (forall x:R, f2 x <> 0) -> continuity (f1 / f2). +unfold continuity in |- *; intros; + apply (continuity_pt_div f1 f2 x (H x) (H0 x) (H1 x)). +Qed. + +Lemma continuity_comp : + forall f1 f2, continuity f1 -> continuity f2 -> continuity (f2 o f1). +unfold continuity in |- *; intros. +apply (continuity_pt_comp f1 f2 x (H x) (H0 (f1 x))). +Qed. + + +(*****************************************************) +(** Derivative's definition using Landau's kernel *) +(*****************************************************) + +Definition derivable_pt_lim f (x l:R) : Prop := + forall eps:R, + 0 < eps -> + exists delta : posreal, + (forall h:R, + h <> 0 -> Rabs h < delta -> Rabs ((f (x + h) - f x) / h - l) < eps). + +Definition derivable_pt_abs f (x l:R) : Prop := derivable_pt_lim f x l. + +Definition derivable_pt f (x:R) := sigT (derivable_pt_abs f x). +Definition derivable f := forall x:R, derivable_pt f x. + +Definition derive_pt f (x:R) (pr:derivable_pt f x) := projT1 pr. +Definition derive f (pr:derivable f) (x:R) := derive_pt f x (pr x). + +Arguments Scope derivable_pt_lim [Rfun_scope R_scope]. +Arguments Scope derivable_pt_abs [Rfun_scope R_scope R_scope]. +Arguments Scope derivable_pt [Rfun_scope R_scope]. +Arguments Scope derivable [Rfun_scope]. +Arguments Scope derive_pt [Rfun_scope R_scope _]. +Arguments Scope derive [Rfun_scope _]. + +Definition antiderivative f (g:R -> R) (a b:R) : Prop := + (forall x:R, + a <= x <= b -> exists pr : derivable_pt g x, f x = derive_pt g x pr) /\ + a <= b. +(************************************) +(** Class of differential functions *) +(************************************) +Record Differential : Type := mkDifferential + {d1 :> R -> R; cond_diff : derivable d1}. + +Record Differential_D2 : Type := mkDifferential_D2 + {d2 :> R -> R; + cond_D1 : derivable d2; + cond_D2 : derivable (derive d2 cond_D1)}. + +(**********) +Lemma uniqueness_step1 : + forall f (x l1 l2:R), + limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l1 0 -> + limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l2 0 -> + l1 = l2. +intros; + apply + (single_limit (fun h:R => (f (x + h) - f x) / h) ( + fun h:R => h <> 0) l1 l2 0); try assumption. +unfold adhDa in |- *; intros; exists (alp / 2). +split. +unfold Rdiv in |- *; apply prod_neq_R0. +red in |- *; intro; rewrite H2 in H1; elim (Rlt_irrefl _ H1). +apply Rinv_neq_0_compat; discrR. +unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; unfold Rdiv in |- *; rewrite Rabs_mult. +replace (Rabs (/ 2)) with (/ 2). +replace (Rabs alp) with alp. +apply Rmult_lt_reg_l with 2. +prove_sup0. +rewrite (Rmult_comm 2); rewrite Rmult_assoc; rewrite <- Rinv_l_sym; + [ idtac | discrR ]; rewrite Rmult_1_r; rewrite double; + pattern alp at 1 in |- *; replace alp with (alp + 0); + [ idtac | ring ]; apply Rplus_lt_compat_l; assumption. +symmetry in |- *; apply Rabs_right; left; assumption. +symmetry in |- *; apply Rabs_right; left; change (0 < / 2) in |- *; + apply Rinv_0_lt_compat; prove_sup0. +Qed. + +Lemma uniqueness_step2 : + forall f (x l:R), + derivable_pt_lim f x l -> + limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l 0. +unfold derivable_pt_lim in |- *; intros; unfold limit1_in in |- *; + unfold limit_in in |- *; intros. +assert (H1 := H eps H0). +elim H1; intros. +exists (pos x0). +split. +apply (cond_pos x0). +simpl in |- *; unfold R_dist in |- *; intros. +elim H3; intros. +apply H2; + [ assumption + | unfold Rminus in H5; rewrite Ropp_0 in H5; rewrite Rplus_0_r in H5; + assumption ]. +Qed. + +Lemma uniqueness_step3 : + forall f (x l:R), + limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l 0 -> + derivable_pt_lim f x l. +unfold limit1_in, derivable_pt_lim in |- *; unfold limit_in in |- *; + unfold dist in |- *; simpl in |- *; intros. +elim (H eps H0). +intros; elim H1; intros. +exists (mkposreal x0 H2). +simpl in |- *; intros; unfold R_dist in H3; apply (H3 h). +split; + [ assumption + | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; assumption ]. +Qed. + +Lemma uniqueness_limite : + forall f (x l1 l2:R), + derivable_pt_lim f x l1 -> derivable_pt_lim f x l2 -> l1 = l2. +intros. +assert (H1 := uniqueness_step2 _ _ _ H). +assert (H2 := uniqueness_step2 _ _ _ H0). +assert (H3 := uniqueness_step1 _ _ _ _ H1 H2). +assumption. +Qed. + +Lemma derive_pt_eq : + forall f (x l:R) (pr:derivable_pt f x), + derive_pt f x pr = l <-> derivable_pt_lim f x l. +intros; split. +intro; assert (H1 := projT2 pr); unfold derive_pt in H; rewrite H in H1; + assumption. +intro; assert (H1 := projT2 pr); unfold derivable_pt_abs in H1. +assert (H2 := uniqueness_limite _ _ _ _ H H1). +unfold derive_pt in |- *; unfold derivable_pt_abs in |- *. +symmetry in |- *; assumption. +Qed. + +(**********) +Lemma derive_pt_eq_0 : + forall f (x l:R) (pr:derivable_pt f x), + derivable_pt_lim f x l -> derive_pt f x pr = l. +intros; elim (derive_pt_eq f x l pr); intros. +apply (H1 H). +Qed. + +(**********) +Lemma derive_pt_eq_1 : + forall f (x l:R) (pr:derivable_pt f x), + derive_pt f x pr = l -> derivable_pt_lim f x l. +intros; elim (derive_pt_eq f x l pr); intros. +apply (H0 H). +Qed. + + +(********************************************************************) +(** Equivalence of this definition with the one using limit concept *) +(********************************************************************) +Lemma derive_pt_D_in : + forall f (df:R -> R) (x:R) (pr:derivable_pt f x), + D_in f df no_cond x <-> derive_pt f x pr = df x. +intros; split. +unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold R_dist in |- *; intros. +apply derive_pt_eq_0. +unfold derivable_pt_lim in |- *. +intros; elim (H eps H0); intros alpha H1; elim H1; intros; + exists (mkposreal alpha H2); intros; generalize (H3 (x + h)); + intro; cut (x + h - x = h); + [ intro; cut (D_x no_cond x (x + h) /\ Rabs (x + h - x) < alpha); + [ intro; generalize (H6 H8); rewrite H7; intro; assumption + | split; + [ unfold D_x in |- *; split; + [ unfold no_cond in |- *; trivial + | apply Rminus_not_eq_right; rewrite H7; assumption ] + | rewrite H7; assumption ] ] + | ring ]. +intro. +assert (H0 := derive_pt_eq_1 f x (df x) pr H). +unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *; + unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; + intros. +elim (H0 eps H1); intros alpha H2; exists (pos alpha); split. +apply (cond_pos alpha). +intros; elim H3; intros; unfold D_x in H4; elim H4; intros; cut (x0 - x <> 0). +intro; generalize (H2 (x0 - x) H8 H5); replace (x + (x0 - x)) with x0. +intro; assumption. +ring. +auto with real. +Qed. + +Lemma derivable_pt_lim_D_in : + forall f (df:R -> R) (x:R), + D_in f df no_cond x <-> derivable_pt_lim f x (df x). +intros; split. +unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold R_dist in |- *; intros. +unfold derivable_pt_lim in |- *. +intros; elim (H eps H0); intros alpha H1; elim H1; intros; + exists (mkposreal alpha H2); intros; generalize (H3 (x + h)); + intro; cut (x + h - x = h); + [ intro; cut (D_x no_cond x (x + h) /\ Rabs (x + h - x) < alpha); + [ intro; generalize (H6 H8); rewrite H7; intro; assumption + | split; + [ unfold D_x in |- *; split; + [ unfold no_cond in |- *; trivial + | apply Rminus_not_eq_right; rewrite H7; assumption ] + | rewrite H7; assumption ] ] + | ring ]. +intro. +unfold derivable_pt_lim in H. +unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *; + unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; + intros. +elim (H eps H0); intros alpha H2; exists (pos alpha); split. +apply (cond_pos alpha). +intros. +elim H1; intros; unfold D_x in H3; elim H3; intros; cut (x0 - x <> 0). +intro; generalize (H2 (x0 - x) H7 H4); replace (x + (x0 - x)) with x0. +intro; assumption. +ring. +auto with real. +Qed. + + +(***********************************) +(** derivability -> continuity *) +(***********************************) +(**********) +Lemma derivable_derive : + forall f (x:R) (pr:derivable_pt f x), exists l : R, derive_pt f x pr = l. +intros; exists (projT1 pr). +unfold derive_pt in |- *; reflexivity. +Qed. + +Theorem derivable_continuous_pt : + forall f (x:R), derivable_pt f x -> continuity_pt f x. +intros. +generalize (derivable_derive f x X); intro. +elim H; intros l H1. +cut (l = fct_cte l x). +intro. +rewrite H0 in H1. +generalize (derive_pt_D_in f (fct_cte l) x); intro. +elim (H2 X); intros. +generalize (H4 H1); intro. +unfold continuity_pt in |- *. +apply (cont_deriv f (fct_cte l) no_cond x H5). +unfold fct_cte in |- *; reflexivity. +Qed. + +Theorem derivable_continuous : forall f, derivable f -> continuity f. +unfold derivable, continuity in |- *; intros. +apply (derivable_continuous_pt f x (X x)). +Qed. + +(****************************************************************) +(** Main rules *) +(****************************************************************) + +Lemma derivable_pt_lim_plus : + forall f1 f2 (x l1 l2:R), + derivable_pt_lim f1 x l1 -> + derivable_pt_lim f2 x l2 -> derivable_pt_lim (f1 + f2) x (l1 + l2). +intros. +apply uniqueness_step3. +assert (H1 := uniqueness_step2 _ _ _ H). +assert (H2 := uniqueness_step2 _ _ _ H0). +unfold plus_fct in |- *. +cut + (forall h:R, + (f1 (x + h) + f2 (x + h) - (f1 x + f2 x)) / h = + (f1 (x + h) - f1 x) / h + (f2 (x + h) - f2 x) / h). +intro. +generalize + (limit_plus (fun h':R => (f1 (x + h') - f1 x) / h') + (fun h':R => (f2 (x + h') - f2 x) / h') (fun h:R => h <> 0) l1 l2 0 H1 H2). +unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *; + simpl in |- *; unfold R_dist in |- *; intros. +elim (H4 eps H5); intros. +exists x0. +elim H6; intros. +split. +assumption. +intros; rewrite H3; apply H8; assumption. +intro; unfold Rdiv in |- *; ring. +Qed. + +Lemma derivable_pt_lim_opp : + forall f (x l:R), derivable_pt_lim f x l -> derivable_pt_lim (- f) x (- l). +intros. +apply uniqueness_step3. +assert (H1 := uniqueness_step2 _ _ _ H). +unfold opp_fct in |- *. +cut (forall h:R, (- f (x + h) - - f x) / h = - ((f (x + h) - f x) / h)). +intro. +generalize + (limit_Ropp (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l 0 H1). +unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *; + simpl in |- *; unfold R_dist in |- *; intros. +elim (H2 eps H3); intros. +exists x0. +elim H4; intros. +split. +assumption. +intros; rewrite H0; apply H6; assumption. +intro; unfold Rdiv in |- *; ring. +Qed. + +Lemma derivable_pt_lim_minus : + forall f1 f2 (x l1 l2:R), + derivable_pt_lim f1 x l1 -> + derivable_pt_lim f2 x l2 -> derivable_pt_lim (f1 - f2) x (l1 - l2). +intros. +apply uniqueness_step3. +assert (H1 := uniqueness_step2 _ _ _ H). +assert (H2 := uniqueness_step2 _ _ _ H0). +unfold minus_fct in |- *. +cut + (forall h:R, + (f1 (x + h) - f1 x) / h - (f2 (x + h) - f2 x) / h = + (f1 (x + h) - f2 (x + h) - (f1 x - f2 x)) / h). +intro. +generalize + (limit_minus (fun h':R => (f1 (x + h') - f1 x) / h') + (fun h':R => (f2 (x + h') - f2 x) / h') (fun h:R => h <> 0) l1 l2 0 H1 H2). +unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *; + simpl in |- *; unfold R_dist in |- *; intros. +elim (H4 eps H5); intros. +exists x0. +elim H6; intros. +split. +assumption. +intros; rewrite <- H3; apply H8; assumption. +intro; unfold Rdiv in |- *; ring. +Qed. + +Lemma derivable_pt_lim_mult : + forall f1 f2 (x l1 l2:R), + derivable_pt_lim f1 x l1 -> + derivable_pt_lim f2 x l2 -> + derivable_pt_lim (f1 * f2) x (l1 * f2 x + f1 x * l2). +intros. +assert (H1 := derivable_pt_lim_D_in f1 (fun y:R => l1) x). +elim H1; intros. +assert (H4 := H3 H). +assert (H5 := derivable_pt_lim_D_in f2 (fun y:R => l2) x). +elim H5; intros. +assert (H8 := H7 H0). +clear H1 H2 H3 H5 H6 H7. +assert + (H1 := + derivable_pt_lim_D_in (f1 * f2)%F (fun y:R => l1 * f2 x + f1 x * l2) x). +elim H1; intros. +clear H1 H3. +apply H2. +unfold mult_fct in |- *. +apply (Dmult no_cond (fun y:R => l1) (fun y:R => l2) f1 f2 x); assumption. +Qed. + +Lemma derivable_pt_lim_const : forall a x:R, derivable_pt_lim (fct_cte a) x 0. +intros; unfold fct_cte, derivable_pt_lim in |- *. +intros; exists (mkposreal 1 Rlt_0_1); intros; unfold Rminus in |- *; + rewrite Rplus_opp_r; unfold Rdiv in |- *; rewrite Rmult_0_l; + rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. +Qed. + +Lemma derivable_pt_lim_scal : + forall f (a x l:R), + derivable_pt_lim f x l -> derivable_pt_lim (mult_real_fct a f) x (a * l). +intros. +assert (H0 := derivable_pt_lim_const a x). +replace (mult_real_fct a f) with (fct_cte a * f)%F. +replace (a * l) with (0 * f x + a * l); [ idtac | ring ]. +apply (derivable_pt_lim_mult (fct_cte a) f x 0 l); assumption. +unfold mult_real_fct, mult_fct, fct_cte in |- *; reflexivity. +Qed. + +Lemma derivable_pt_lim_id : forall x:R, derivable_pt_lim id x 1. +intro; unfold derivable_pt_lim in |- *. +intros eps Heps; exists (mkposreal eps Heps); intros h H1 H2; + unfold id in |- *; replace ((x + h - x) / h - 1) with 0. +rewrite Rabs_R0; apply Rle_lt_trans with (Rabs h). +apply Rabs_pos. +assumption. +unfold Rminus in |- *; rewrite Rplus_assoc; rewrite (Rplus_comm x); + rewrite Rplus_assoc. +rewrite Rplus_opp_l; rewrite Rplus_0_r; unfold Rdiv in |- *; + rewrite <- Rinv_r_sym. +symmetry in |- *; apply Rplus_opp_r. +assumption. +Qed. + +Lemma derivable_pt_lim_Rsqr : forall x:R, derivable_pt_lim Rsqr x (2 * x). +intro; unfold derivable_pt_lim in |- *. +unfold Rsqr in |- *; intros eps Heps; exists (mkposreal eps Heps); + intros h H1 H2; replace (((x + h) * (x + h) - x * x) / h - 2 * x) with h. +assumption. +replace ((x + h) * (x + h) - x * x) with (2 * x * h + h * h); + [ idtac | ring ]. +unfold Rdiv in |- *; rewrite Rmult_plus_distr_r. +repeat rewrite Rmult_assoc. +repeat rewrite <- Rinv_r_sym; [ idtac | assumption ]. +ring. +Qed. + +Lemma derivable_pt_lim_comp : + forall f1 f2 (x l1 l2:R), + derivable_pt_lim f1 x l1 -> + derivable_pt_lim f2 (f1 x) l2 -> derivable_pt_lim (f2 o f1) x (l2 * l1). +intros; assert (H1 := derivable_pt_lim_D_in f1 (fun y:R => l1) x). +elim H1; intros. +assert (H4 := H3 H). +assert (H5 := derivable_pt_lim_D_in f2 (fun y:R => l2) (f1 x)). +elim H5; intros. +assert (H8 := H7 H0). +clear H1 H2 H3 H5 H6 H7. +assert (H1 := derivable_pt_lim_D_in (f2 o f1)%F (fun y:R => l2 * l1) x). +elim H1; intros. +clear H1 H3; apply H2. +unfold comp in |- *; + cut + (D_in (fun x0:R => f2 (f1 x0)) (fun y:R => l2 * l1) + (Dgf no_cond no_cond f1) x -> + D_in (fun x0:R => f2 (f1 x0)) (fun y:R => l2 * l1) no_cond x). +intro; apply H1. +rewrite Rmult_comm; + apply (Dcomp no_cond no_cond (fun y:R => l1) (fun y:R => l2) f1 f2 x); + assumption. +unfold Dgf, D_in, no_cond in |- *; unfold limit1_in in |- *; + unfold limit_in in |- *; unfold dist in |- *; simpl in |- *; + unfold R_dist in |- *; intros. +elim (H1 eps H3); intros. +exists x0; intros; split. +elim H5; intros; assumption. +intros; elim H5; intros; apply H9; split. +unfold D_x in |- *; split. +split; trivial. +elim H6; intros; unfold D_x in H10; elim H10; intros; assumption. +elim H6; intros; assumption. +Qed. + +Lemma derivable_pt_plus : + forall f1 f2 (x:R), + derivable_pt f1 x -> derivable_pt f2 x -> derivable_pt (f1 + f2) x. +unfold derivable_pt in |- *; intros. +elim X; intros. +elim X0; intros. +apply existT with (x0 + x1). +apply derivable_pt_lim_plus; assumption. +Qed. + +Lemma derivable_pt_opp : + forall f (x:R), derivable_pt f x -> derivable_pt (- f) x. +unfold derivable_pt in |- *; intros. +elim X; intros. +apply existT with (- x0). +apply derivable_pt_lim_opp; assumption. +Qed. + +Lemma derivable_pt_minus : + forall f1 f2 (x:R), + derivable_pt f1 x -> derivable_pt f2 x -> derivable_pt (f1 - f2) x. +unfold derivable_pt in |- *; intros. +elim X; intros. +elim X0; intros. +apply existT with (x0 - x1). +apply derivable_pt_lim_minus; assumption. +Qed. + +Lemma derivable_pt_mult : + forall f1 f2 (x:R), + derivable_pt f1 x -> derivable_pt f2 x -> derivable_pt (f1 * f2) x. +unfold derivable_pt in |- *; intros. +elim X; intros. +elim X0; intros. +apply existT with (x0 * f2 x + f1 x * x1). +apply derivable_pt_lim_mult; assumption. +Qed. + +Lemma derivable_pt_const : forall a x:R, derivable_pt (fct_cte a) x. +intros; unfold derivable_pt in |- *. +apply existT with 0. +apply derivable_pt_lim_const. +Qed. + +Lemma derivable_pt_scal : + forall f (a x:R), derivable_pt f x -> derivable_pt (mult_real_fct a f) x. +unfold derivable_pt in |- *; intros. +elim X; intros. +apply existT with (a * x0). +apply derivable_pt_lim_scal; assumption. +Qed. + +Lemma derivable_pt_id : forall x:R, derivable_pt id x. +unfold derivable_pt in |- *; intro. +exists 1. +apply derivable_pt_lim_id. +Qed. + +Lemma derivable_pt_Rsqr : forall x:R, derivable_pt Rsqr x. +unfold derivable_pt in |- *; intro; apply existT with (2 * x). +apply derivable_pt_lim_Rsqr. +Qed. + +Lemma derivable_pt_comp : + forall f1 f2 (x:R), + derivable_pt f1 x -> derivable_pt f2 (f1 x) -> derivable_pt (f2 o f1) x. +unfold derivable_pt in |- *; intros. +elim X; intros. +elim X0; intros. +apply existT with (x1 * x0). +apply derivable_pt_lim_comp; assumption. +Qed. + +Lemma derivable_plus : + forall f1 f2, derivable f1 -> derivable f2 -> derivable (f1 + f2). +unfold derivable in |- *; intros. +apply (derivable_pt_plus _ _ x (X _) (X0 _)). +Qed. + +Lemma derivable_opp : forall f, derivable f -> derivable (- f). +unfold derivable in |- *; intros. +apply (derivable_pt_opp _ x (X _)). +Qed. + +Lemma derivable_minus : + forall f1 f2, derivable f1 -> derivable f2 -> derivable (f1 - f2). +unfold derivable in |- *; intros. +apply (derivable_pt_minus _ _ x (X _) (X0 _)). +Qed. + +Lemma derivable_mult : + forall f1 f2, derivable f1 -> derivable f2 -> derivable (f1 * f2). +unfold derivable in |- *; intros. +apply (derivable_pt_mult _ _ x (X _) (X0 _)). +Qed. + +Lemma derivable_const : forall a:R, derivable (fct_cte a). +unfold derivable in |- *; intros. +apply derivable_pt_const. +Qed. + +Lemma derivable_scal : + forall f (a:R), derivable f -> derivable (mult_real_fct a f). +unfold derivable in |- *; intros. +apply (derivable_pt_scal _ a x (X _)). +Qed. + +Lemma derivable_id : derivable id. +unfold derivable in |- *; intro; apply derivable_pt_id. +Qed. + +Lemma derivable_Rsqr : derivable Rsqr. +unfold derivable in |- *; intro; apply derivable_pt_Rsqr. +Qed. + +Lemma derivable_comp : + forall f1 f2, derivable f1 -> derivable f2 -> derivable (f2 o f1). +unfold derivable in |- *; intros. +apply (derivable_pt_comp _ _ x (X _) (X0 _)). +Qed. + +Lemma derive_pt_plus : + forall f1 f2 (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 x), + derive_pt (f1 + f2) x (derivable_pt_plus _ _ _ pr1 pr2) = + derive_pt f1 x pr1 + derive_pt f2 x pr2. +intros. +assert (H := derivable_derive f1 x pr1). +assert (H0 := derivable_derive f2 x pr2). +assert + (H1 := derivable_derive (f1 + f2)%F x (derivable_pt_plus _ _ _ pr1 pr2)). +elim H; clear H; intros l1 H. +elim H0; clear H0; intros l2 H0. +elim H1; clear H1; intros l H1. +rewrite H; rewrite H0; apply derive_pt_eq_0. +assert (H3 := projT2 pr1). +unfold derive_pt in H; rewrite H in H3. +assert (H4 := projT2 pr2). +unfold derive_pt in H0; rewrite H0 in H4. +apply derivable_pt_lim_plus; assumption. +Qed. + +Lemma derive_pt_opp : + forall f (x:R) (pr1:derivable_pt f x), + derive_pt (- f) x (derivable_pt_opp _ _ pr1) = - derive_pt f x pr1. +intros. +assert (H := derivable_derive f x pr1). +assert (H0 := derivable_derive (- f)%F x (derivable_pt_opp _ _ pr1)). +elim H; clear H; intros l1 H. +elim H0; clear H0; intros l2 H0. +rewrite H; apply derive_pt_eq_0. +assert (H3 := projT2 pr1). +unfold derive_pt in H; rewrite H in H3. +apply derivable_pt_lim_opp; assumption. +Qed. + +Lemma derive_pt_minus : + forall f1 f2 (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 x), + derive_pt (f1 - f2) x (derivable_pt_minus _ _ _ pr1 pr2) = + derive_pt f1 x pr1 - derive_pt f2 x pr2. +intros. +assert (H := derivable_derive f1 x pr1). +assert (H0 := derivable_derive f2 x pr2). +assert + (H1 := derivable_derive (f1 - f2)%F x (derivable_pt_minus _ _ _ pr1 pr2)). +elim H; clear H; intros l1 H. +elim H0; clear H0; intros l2 H0. +elim H1; clear H1; intros l H1. +rewrite H; rewrite H0; apply derive_pt_eq_0. +assert (H3 := projT2 pr1). +unfold derive_pt in H; rewrite H in H3. +assert (H4 := projT2 pr2). +unfold derive_pt in H0; rewrite H0 in H4. +apply derivable_pt_lim_minus; assumption. +Qed. + +Lemma derive_pt_mult : + forall f1 f2 (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 x), + derive_pt (f1 * f2) x (derivable_pt_mult _ _ _ pr1 pr2) = + derive_pt f1 x pr1 * f2 x + f1 x * derive_pt f2 x pr2. +intros. +assert (H := derivable_derive f1 x pr1). +assert (H0 := derivable_derive f2 x pr2). +assert + (H1 := derivable_derive (f1 * f2)%F x (derivable_pt_mult _ _ _ pr1 pr2)). +elim H; clear H; intros l1 H. +elim H0; clear H0; intros l2 H0. +elim H1; clear H1; intros l H1. +rewrite H; rewrite H0; apply derive_pt_eq_0. +assert (H3 := projT2 pr1). +unfold derive_pt in H; rewrite H in H3. +assert (H4 := projT2 pr2). +unfold derive_pt in H0; rewrite H0 in H4. +apply derivable_pt_lim_mult; assumption. +Qed. + +Lemma derive_pt_const : + forall a x:R, derive_pt (fct_cte a) x (derivable_pt_const a x) = 0. +intros. +apply derive_pt_eq_0. +apply derivable_pt_lim_const. +Qed. + +Lemma derive_pt_scal : + forall f (a x:R) (pr:derivable_pt f x), + derive_pt (mult_real_fct a f) x (derivable_pt_scal _ _ _ pr) = + a * derive_pt f x pr. +intros. +assert (H := derivable_derive f x pr). +assert + (H0 := derivable_derive (mult_real_fct a f) x (derivable_pt_scal _ _ _ pr)). +elim H; clear H; intros l1 H. +elim H0; clear H0; intros l2 H0. +rewrite H; apply derive_pt_eq_0. +assert (H3 := projT2 pr). +unfold derive_pt in H; rewrite H in H3. +apply derivable_pt_lim_scal; assumption. +Qed. + +Lemma derive_pt_id : forall x:R, derive_pt id x (derivable_pt_id _) = 1. +intros. +apply derive_pt_eq_0. +apply derivable_pt_lim_id. +Qed. + +Lemma derive_pt_Rsqr : + forall x:R, derive_pt Rsqr x (derivable_pt_Rsqr _) = 2 * x. +intros. +apply derive_pt_eq_0. +apply derivable_pt_lim_Rsqr. +Qed. + +Lemma derive_pt_comp : + forall f1 f2 (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 (f1 x)), + derive_pt (f2 o f1) x (derivable_pt_comp _ _ _ pr1 pr2) = + derive_pt f2 (f1 x) pr2 * derive_pt f1 x pr1. +intros. +assert (H := derivable_derive f1 x pr1). +assert (H0 := derivable_derive f2 (f1 x) pr2). +assert + (H1 := derivable_derive (f2 o f1)%F x (derivable_pt_comp _ _ _ pr1 pr2)). +elim H; clear H; intros l1 H. +elim H0; clear H0; intros l2 H0. +elim H1; clear H1; intros l H1. +rewrite H; rewrite H0; apply derive_pt_eq_0. +assert (H3 := projT2 pr1). +unfold derive_pt in H; rewrite H in H3. +assert (H4 := projT2 pr2). +unfold derive_pt in H0; rewrite H0 in H4. +apply derivable_pt_lim_comp; assumption. +Qed. + +(* Pow *) +Definition pow_fct (n:nat) (y:R) : R := y ^ n. + +Lemma derivable_pt_lim_pow_pos : + forall (x:R) (n:nat), + (0 < n)%nat -> derivable_pt_lim (fun y:R => y ^ n) x (INR n * x ^ pred n). +intros. +induction n as [| n Hrecn]. +elim (lt_irrefl _ H). +cut (n = 0%nat \/ (0 < n)%nat). +intro; elim H0; intro. +rewrite H1; simpl in |- *. +replace (fun y:R => y * 1) with (id * fct_cte 1)%F. +replace (1 * 1) with (1 * fct_cte 1 x + id x * 0). +apply derivable_pt_lim_mult. +apply derivable_pt_lim_id. +apply derivable_pt_lim_const. +unfold fct_cte, id in |- *; ring. +reflexivity. +replace (fun y:R => y ^ S n) with (fun y:R => y * y ^ n). +replace (pred (S n)) with n; [ idtac | reflexivity ]. +replace (fun y:R => y * y ^ n) with (id * (fun y:R => y ^ n))%F. +set (f := fun y:R => y ^ n). +replace (INR (S n) * x ^ n) with (1 * f x + id x * (INR n * x ^ pred n)). +apply derivable_pt_lim_mult. +apply derivable_pt_lim_id. +unfold f in |- *; apply Hrecn; assumption. +unfold f in |- *. +pattern n at 1 5 in |- *; replace n with (S (pred n)). +unfold id in |- *; rewrite S_INR; simpl in |- *. +ring. +symmetry in |- *; apply S_pred with 0%nat; assumption. +unfold mult_fct, id in |- *; reflexivity. +reflexivity. +inversion H. +left; reflexivity. +right. +apply lt_le_trans with 1%nat. +apply lt_O_Sn. +assumption. +Qed. + +Lemma derivable_pt_lim_pow : + forall (x:R) (n:nat), + derivable_pt_lim (fun y:R => y ^ n) x (INR n * x ^ pred n). +intros. +induction n as [| n Hrecn]. +simpl in |- *. +rewrite Rmult_0_l. +replace (fun _:R => 1) with (fct_cte 1); + [ apply derivable_pt_lim_const | reflexivity ]. +apply derivable_pt_lim_pow_pos. +apply lt_O_Sn. +Qed. + +Lemma derivable_pt_pow : + forall (n:nat) (x:R), derivable_pt (fun y:R => y ^ n) x. +intros; unfold derivable_pt in |- *. +apply existT with (INR n * x ^ pred n). +apply derivable_pt_lim_pow. +Qed. + +Lemma derivable_pow : forall n:nat, derivable (fun y:R => y ^ n). +intro; unfold derivable in |- *; intro; apply derivable_pt_pow. +Qed. + +Lemma derive_pt_pow : + forall (n:nat) (x:R), + derive_pt (fun y:R => y ^ n) x (derivable_pt_pow n x) = INR n * x ^ pred n. +intros; apply derive_pt_eq_0. +apply derivable_pt_lim_pow. +Qed. + +Lemma pr_nu : + forall f (x:R) (pr1 pr2:derivable_pt f x), + derive_pt f x pr1 = derive_pt f x pr2. +intros. +unfold derivable_pt in pr1. +unfold derivable_pt in pr2. +elim pr1; intros. +elim pr2; intros. +unfold derivable_pt_abs in p. +unfold derivable_pt_abs in p0. +simpl in |- *. +apply (uniqueness_limite f x x0 x1 p p0). +Qed. + + +(************************************************************) +(** Local extremum's condition *) +(************************************************************) + +Theorem deriv_maximum : + forall f (a b c:R) (pr:derivable_pt f c), + a < c -> + c < b -> + (forall x:R, a < x -> x < b -> f x <= f c) -> derive_pt f c pr = 0. +intros; case (Rtotal_order 0 (derive_pt f c pr)); intro. +assert (H3 := derivable_derive f c pr). +elim H3; intros l H4; rewrite H4 in H2. +assert (H5 := derive_pt_eq_1 f c l pr H4). +cut (0 < l / 2); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. +elim (H5 (l / 2) H6); intros delta H7. +cut (0 < (b - c) / 2). +intro; cut (Rmin (delta / 2) ((b - c) / 2) <> 0). +intro; cut (Rabs (Rmin (delta / 2) ((b - c) / 2)) < delta). +intro. +assert (H11 := H7 (Rmin (delta / 2) ((b - c) / 2)) H9 H10). +cut (0 < Rmin (delta / 2) ((b - c) / 2)). +intro; cut (a < c + Rmin (delta / 2) ((b - c) / 2)). +intro; cut (c + Rmin (delta / 2) ((b - c) / 2) < b). +intro; assert (H15 := H1 (c + Rmin (delta / 2) ((b - c) / 2)) H13 H14). +cut + ((f (c + Rmin (delta / 2) ((b - c) / 2)) - f c) / + Rmin (delta / 2) ((b - c) / 2) <= 0). +intro; cut (- l < 0). +intro; unfold Rminus in H11. +cut + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / + Rmin (delta / 2) ((b + - c) / 2) + - l < 0). +intro; + cut + (Rabs + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / + Rmin (delta / 2) ((b + - c) / 2) + - l) < l / 2). +unfold Rabs in |- *; + case + (Rcase_abs + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / + Rmin (delta / 2) ((b + - c) / 2) + - l)); intro. +replace + (- + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / + Rmin (delta / 2) ((b + - c) / 2) + - l)) with + (l + + - + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / + Rmin (delta / 2) ((b + - c) / 2))). +intro; + generalize + (Rplus_lt_compat_l (- l) + (l + + - + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / + Rmin (delta / 2) ((b + - c) / 2))) (l / 2) H19); + repeat rewrite <- Rplus_assoc; rewrite Rplus_opp_l; + rewrite Rplus_0_l; replace (- l + l / 2) with (- (l / 2)). +intro; + generalize + (Ropp_lt_gt_contravar + (- + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / + Rmin (delta / 2) ((b + - c) / 2))) (- (l / 2)) H20); + repeat rewrite Ropp_involutive; intro; + generalize + (Rlt_trans 0 (l / 2) + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / + Rmin (delta / 2) ((b + - c) / 2)) H6 H21); intro; + elim + (Rlt_irrefl 0 + (Rlt_le_trans 0 + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / + Rmin (delta / 2) ((b + - c) / 2)) 0 H22 H16)). +pattern l at 2 in |- *; rewrite double_var. +ring. +ring. +intro. +assert + (H20 := + Rge_le + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / + Rmin (delta / 2) ((b + - c) / 2) + - l) 0 r). +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H20 H18)). +assumption. +rewrite <- Ropp_0; + replace + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / + Rmin (delta / 2) ((b + - c) / 2) + - l) with + (- + (l + + - + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) - f c) / + Rmin (delta / 2) ((b + - c) / 2)))). +apply Ropp_gt_lt_contravar; + change + (0 < + l + + - + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) - f c) / + Rmin (delta / 2) ((b + - c) / 2))) in |- *; apply Rplus_lt_le_0_compat; + [ assumption + | rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; assumption ]. +ring. +rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption. +replace + ((f (c + Rmin (delta / 2) ((b - c) / 2)) - f c) / + Rmin (delta / 2) ((b - c) / 2)) with + (- + ((f c - f (c + Rmin (delta / 2) ((b - c) / 2))) / + Rmin (delta / 2) ((b - c) / 2))). +rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; + unfold Rdiv in |- *; apply Rmult_le_pos; + [ generalize + (Rplus_le_compat_r (- f (c + Rmin (delta * / 2) ((b - c) * / 2))) + (f (c + Rmin (delta * / 2) ((b - c) * / 2))) ( + f c) H15); rewrite Rplus_opp_r; intro; assumption + | left; apply Rinv_0_lt_compat; assumption ]. +unfold Rdiv in |- *. +rewrite <- Ropp_mult_distr_l_reverse. +repeat rewrite <- (Rmult_comm (/ Rmin (delta * / 2) ((b - c) * / 2))). +apply Rmult_eq_reg_l with (Rmin (delta * / 2) ((b - c) * / 2)). +repeat rewrite <- Rmult_assoc. +rewrite <- Rinv_r_sym. +repeat rewrite Rmult_1_l. +ring. +red in |- *; intro. +unfold Rdiv in H12; rewrite H16 in H12; elim (Rlt_irrefl 0 H12). +red in |- *; intro. +unfold Rdiv in H12; rewrite H16 in H12; elim (Rlt_irrefl 0 H12). +assert (H14 := Rmin_r (delta / 2) ((b - c) / 2)). +assert + (H15 := + Rplus_le_compat_l c (Rmin (delta / 2) ((b - c) / 2)) ((b - c) / 2) H14). +apply Rle_lt_trans with (c + (b - c) / 2). +assumption. +apply Rmult_lt_reg_l with 2. +prove_sup0. +replace (2 * (c + (b - c) / 2)) with (c + b). +replace (2 * b) with (b + b). +apply Rplus_lt_compat_r; assumption. +ring. +unfold Rdiv in |- *; rewrite Rmult_plus_distr_l. +repeat rewrite (Rmult_comm 2). +rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +ring. +discrR. +apply Rlt_trans with c. +assumption. +pattern c at 1 in |- *; rewrite <- (Rplus_0_r c); apply Rplus_lt_compat_l; + assumption. +cut (0 < delta / 2). +intro; + apply + (Rmin_stable_in_posreal (mkposreal (delta / 2) H12) + (mkposreal ((b - c) / 2) H8)). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ]. +unfold Rabs in |- *; case (Rcase_abs (Rmin (delta / 2) ((b - c) / 2))). +intro. +cut (0 < delta / 2). +intro. +generalize + (Rmin_stable_in_posreal (mkposreal (delta / 2) H10) + (mkposreal ((b - c) / 2) H8)); simpl in |- *; intro; + elim (Rlt_irrefl 0 (Rlt_trans 0 (Rmin (delta / 2) ((b - c) / 2)) 0 H11 r)). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ]. +intro; apply Rle_lt_trans with (delta / 2). +apply Rmin_l. +unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2. +prove_sup0. +rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. +rewrite Rmult_1_l. +replace (2 * delta) with (delta + delta). +pattern delta at 2 in |- *; rewrite <- (Rplus_0_r delta); + apply Rplus_lt_compat_l. +rewrite Rplus_0_r; apply (cond_pos delta). +symmetry in |- *; apply double. +discrR. +cut (0 < delta / 2). +intro; + generalize + (Rmin_stable_in_posreal (mkposreal (delta / 2) H9) + (mkposreal ((b - c) / 2) H8)); simpl in |- *; + intro; red in |- *; intro; rewrite H11 in H10; elim (Rlt_irrefl 0 H10). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ]. +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +generalize (Rplus_lt_compat_r (- c) c b H0); rewrite Rplus_opp_r; intro; + assumption. +apply Rinv_0_lt_compat; prove_sup0. +elim H2; intro. +symmetry in |- *; assumption. +generalize (derivable_derive f c pr); intro; elim H4; intros l H5. +rewrite H5 in H3; generalize (derive_pt_eq_1 f c l pr H5); intro; + cut (0 < - (l / 2)). +intro; elim (H6 (- (l / 2)) H7); intros delta H9. +cut (0 < (c - a) / 2). +intro; cut (Rmax (- (delta / 2)) ((a - c) / 2) < 0). +intro; cut (Rmax (- (delta / 2)) ((a - c) / 2) <> 0). +intro; cut (Rabs (Rmax (- (delta / 2)) ((a - c) / 2)) < delta). +intro; generalize (H9 (Rmax (- (delta / 2)) ((a - c) / 2)) H11 H12); intro; + cut (a < c + Rmax (- (delta / 2)) ((a - c) / 2)). +cut (c + Rmax (- (delta / 2)) ((a - c) / 2) < b). +intros; generalize (H1 (c + Rmax (- (delta / 2)) ((a - c) / 2)) H15 H14); + intro; + cut + (0 <= + (f (c + Rmax (- (delta / 2)) ((a - c) / 2)) - f c) / + Rmax (- (delta / 2)) ((a - c) / 2)). +intro; cut (0 < - l). +intro; unfold Rminus in H13; + cut + (0 < + (f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) / + Rmax (- (delta / 2)) ((a + - c) / 2) + - l). +intro; + cut + (Rabs + ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) / + Rmax (- (delta / 2)) ((a + - c) / 2) + - l) < + - (l / 2)). +unfold Rabs in |- *; + case + (Rcase_abs + ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) / + Rmax (- (delta / 2)) ((a + - c) / 2) + - l)). +intro; + elim + (Rlt_irrefl 0 + (Rlt_trans 0 + ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) / + Rmax (- (delta / 2)) ((a + - c) / 2) + - l) 0 H19 r)). +intros; + generalize + (Rplus_lt_compat_r l + ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) / + Rmax (- (delta / 2)) ((a + - c) / 2) + - l) ( + - (l / 2)) H20); repeat rewrite Rplus_assoc; rewrite Rplus_opp_l; + rewrite Rplus_0_r; replace (- (l / 2) + l) with (l / 2). +cut (l / 2 < 0). +intros; + generalize + (Rlt_trans + ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) / + Rmax (- (delta / 2)) ((a + - c) / 2)) (l / 2) 0 H22 H21); + intro; + elim + (Rlt_irrefl 0 + (Rle_lt_trans 0 + ((f (c + Rmax (- (delta / 2)) ((a - c) / 2)) - f c) / + Rmax (- (delta / 2)) ((a - c) / 2)) 0 H17 H23)). +rewrite <- (Ropp_involutive (l / 2)); rewrite <- Ropp_0; + apply Ropp_lt_gt_contravar; assumption. +pattern l at 3 in |- *; rewrite double_var. +ring. +assumption. +apply Rplus_le_lt_0_compat; assumption. +rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption. +unfold Rdiv in |- *; + replace + ((f (c + Rmax (- (delta * / 2)) ((a - c) * / 2)) - f c) * + / Rmax (- (delta * / 2)) ((a - c) * / 2)) with + (- (f (c + Rmax (- (delta * / 2)) ((a - c) * / 2)) - f c) * + / - Rmax (- (delta * / 2)) ((a - c) * / 2)). +apply Rmult_le_pos. +generalize + (Rplus_le_compat_l (- f (c + Rmax (- (delta * / 2)) ((a - c) * / 2))) + (f (c + Rmax (- (delta * / 2)) ((a - c) * / 2))) ( + f c) H16); rewrite Rplus_opp_l; + replace (- (f (c + Rmax (- (delta * / 2)) ((a - c) * / 2)) - f c)) with + (- f (c + Rmax (- (delta * / 2)) ((a - c) * / 2)) + f c). +intro; assumption. +ring. +left; apply Rinv_0_lt_compat; rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; + assumption. +unfold Rdiv in |- *. +rewrite <- Ropp_inv_permute. +rewrite Rmult_opp_opp. +reflexivity. +unfold Rdiv in H11; assumption. +generalize (Rplus_lt_compat_l c (Rmax (- (delta / 2)) ((a - c) / 2)) 0 H10); + rewrite Rplus_0_r; intro; apply Rlt_trans with c; + assumption. +generalize (RmaxLess2 (- (delta / 2)) ((a - c) / 2)); intro; + generalize + (Rplus_le_compat_l c ((a - c) / 2) (Rmax (- (delta / 2)) ((a - c) / 2)) H14); + intro; apply Rlt_le_trans with (c + (a - c) / 2). +apply Rmult_lt_reg_l with 2. +prove_sup0. +replace (2 * (c + (a - c) / 2)) with (a + c). +rewrite double. +apply Rplus_lt_compat_l; assumption. +ring. +rewrite <- Rplus_assoc. +rewrite <- double_var. +ring. +assumption. +unfold Rabs in |- *; case (Rcase_abs (Rmax (- (delta / 2)) ((a - c) / 2))). +intro; generalize (RmaxLess1 (- (delta / 2)) ((a - c) / 2)); intro; + generalize + (Ropp_le_ge_contravar (- (delta / 2)) (Rmax (- (delta / 2)) ((a - c) / 2)) + H12); rewrite Ropp_involutive; intro; + generalize (Rge_le (delta / 2) (- Rmax (- (delta / 2)) ((a - c) / 2)) H13); + intro; apply Rle_lt_trans with (delta / 2). +assumption. +apply Rmult_lt_reg_l with 2. +prove_sup0. +unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym. +rewrite Rmult_1_l; rewrite double. +pattern delta at 2 in |- *; rewrite <- (Rplus_0_r delta); + apply Rplus_lt_compat_l; rewrite Rplus_0_r; apply (cond_pos delta). +discrR. +cut (- (delta / 2) < 0). +cut ((a - c) / 2 < 0). +intros; + generalize + (Rmax_stable_in_negreal (mknegreal (- (delta / 2)) H13) + (mknegreal ((a - c) / 2) H12)); simpl in |- *; + intro; generalize (Rge_le (Rmax (- (delta / 2)) ((a - c) / 2)) 0 r); + intro; + elim + (Rlt_irrefl 0 + (Rle_lt_trans 0 (Rmax (- (delta / 2)) ((a - c) / 2)) 0 H15 H14)). +rewrite <- Ropp_0; rewrite <- (Ropp_involutive ((a - c) / 2)); + apply Ropp_lt_gt_contravar; replace (- ((a - c) / 2)) with ((c - a) / 2). +assumption. +unfold Rdiv in |- *. +rewrite <- Ropp_mult_distr_l_reverse. +rewrite (Ropp_minus_distr a c). +reflexivity. +rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; unfold Rdiv in |- *; + apply Rmult_lt_0_compat; + [ apply (cond_pos delta) + | assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ] ]. +red in |- *; intro; rewrite H11 in H10; elim (Rlt_irrefl 0 H10). +cut ((a - c) / 2 < 0). +intro; cut (- (delta / 2) < 0). +intro; + apply + (Rmax_stable_in_negreal (mknegreal (- (delta / 2)) H11) + (mknegreal ((a - c) / 2) H10)). +rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; unfold Rdiv in |- *; + apply Rmult_lt_0_compat; + [ apply (cond_pos delta) + | assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ] ]. +rewrite <- Ropp_0; rewrite <- (Ropp_involutive ((a - c) / 2)); + apply Ropp_lt_gt_contravar; replace (- ((a - c) / 2)) with ((c - a) / 2). +assumption. +unfold Rdiv in |- *. +rewrite <- Ropp_mult_distr_l_reverse. +rewrite (Ropp_minus_distr a c). +reflexivity. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ generalize (Rplus_lt_compat_r (- a) a c H); rewrite Rplus_opp_r; intro; + assumption + | assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ] ]. +replace (- (l / 2)) with (- l / 2). +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption. +assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ]. +unfold Rdiv in |- *; apply Ropp_mult_distr_l_reverse. +Qed. + +Theorem deriv_minimum : + forall f (a b c:R) (pr:derivable_pt f c), + a < c -> + c < b -> + (forall x:R, a < x -> x < b -> f c <= f x) -> derive_pt f c pr = 0. +intros. +rewrite <- (Ropp_involutive (derive_pt f c pr)). +apply Ropp_eq_0_compat. +rewrite <- (derive_pt_opp f c pr). +cut (forall x:R, a < x -> x < b -> (- f)%F x <= (- f)%F c). +intro. +apply (deriv_maximum (- f)%F a b c (derivable_pt_opp _ _ pr) H H0 H2). +intros; unfold opp_fct in |- *; apply Ropp_ge_le_contravar; apply Rle_ge. +apply (H1 x H2 H3). +Qed. + +Theorem deriv_constant2 : + forall f (a b c:R) (pr:derivable_pt f c), + a < c -> + c < b -> (forall x:R, a < x -> x < b -> f x = f c) -> derive_pt f c pr = 0. +intros. +eapply deriv_maximum with a b; try assumption. +intros; right; apply (H1 x H2 H3). +Qed. + +(**********) +Lemma nonneg_derivative_0 : + forall f (pr:derivable f), + increasing f -> forall x:R, 0 <= derive_pt f x (pr x). +intros; unfold increasing in H. +assert (H0 := derivable_derive f x (pr x)). +elim H0; intros l H1. +rewrite H1; case (Rtotal_order 0 l); intro. +left; assumption. +elim H2; intro. +right; assumption. +assert (H4 := derive_pt_eq_1 f x l (pr x) H1). +cut (0 < - (l / 2)). +intro; elim (H4 (- (l / 2)) H5); intros delta H6. +cut (delta / 2 <> 0 /\ 0 < delta / 2 /\ Rabs (delta / 2) < delta). +intro; decompose [and] H7; intros; generalize (H6 (delta / 2) H8 H11); + cut (0 <= (f (x + delta / 2) - f x) / (delta / 2)). +intro; cut (0 <= (f (x + delta / 2) - f x) / (delta / 2) - l). +intro; unfold Rabs in |- *; + case (Rcase_abs ((f (x + delta / 2) - f x) / (delta / 2) - l)). +intro; + elim + (Rlt_irrefl 0 + (Rle_lt_trans 0 ((f (x + delta / 2) - f x) / (delta / 2) - l) 0 H12 r)). +intros; + generalize + (Rplus_lt_compat_r l ((f (x + delta / 2) - f x) / (delta / 2) - l) + (- (l / 2)) H13); unfold Rminus in |- *; + replace (- (l / 2) + l) with (l / 2). +rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; intro; + generalize + (Rle_lt_trans 0 ((f (x + delta / 2) - f x) / (delta / 2)) (l / 2) H9 H14); + intro; cut (l / 2 < 0). +intro; elim (Rlt_irrefl 0 (Rlt_trans 0 (l / 2) 0 H15 H16)). +rewrite <- Ropp_0 in H5; + generalize (Ropp_lt_gt_contravar (-0) (- (l / 2)) H5); + repeat rewrite Ropp_involutive; intro; assumption. +pattern l at 3 in |- *; rewrite double_var. +ring. +unfold Rminus in |- *; apply Rplus_le_le_0_compat. +unfold Rdiv in |- *; apply Rmult_le_pos. +cut (x <= x + delta * / 2). +intro; generalize (H x (x + delta * / 2) H12); intro; + generalize (Rplus_le_compat_l (- f x) (f x) (f (x + delta * / 2)) H13); + rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption. +pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l; + left; assumption. +left; apply Rinv_0_lt_compat; assumption. +left; rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption. +unfold Rdiv in |- *; apply Rmult_le_pos. +cut (x <= x + delta * / 2). +intro; generalize (H x (x + delta * / 2) H9); intro; + generalize (Rplus_le_compat_l (- f x) (f x) (f (x + delta * / 2)) H12); + rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption. +pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l; + left; assumption. +left; apply Rinv_0_lt_compat; assumption. +split. +unfold Rdiv in |- *; apply prod_neq_R0. +generalize (cond_pos delta); intro; red in |- *; intro H9; rewrite H9 in H7; + elim (Rlt_irrefl 0 H7). +apply Rinv_neq_0_compat; discrR. +split. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ]. +replace (Rabs (delta / 2)) with (delta / 2). +unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2. +prove_sup0. +rewrite (Rmult_comm 2). +rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ]. +rewrite Rmult_1_r. +rewrite double. +pattern (pos delta) at 1 in |- *; rewrite <- Rplus_0_r. +apply Rplus_lt_compat_l; apply (cond_pos delta). +symmetry in |- *; apply Rabs_right. +left; change (0 < delta / 2) in |- *; unfold Rdiv in |- *; + apply Rmult_lt_0_compat; + [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ]. +unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse; + apply Rmult_lt_0_compat. +apply Rplus_lt_reg_r with l. +unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rplus_0_r; assumption. +apply Rinv_0_lt_compat; prove_sup0. +Qed. diff --git a/theories/Reals/Ranalysis2.v b/theories/Reals/Ranalysis2.v new file mode 100644 index 00000000..35f7eab8 --- /dev/null +++ b/theories/Reals/Ranalysis2.v @@ -0,0 +1,450 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Ranalysis2.v,v 1.11.2.1 2004/07/16 19:31:12 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rfunctions. +Require Import Ranalysis1. Open Local Scope R_scope. + +(**********) +Lemma formule : + forall (x h l1 l2:R) (f1 f2:R -> R), + h <> 0 -> + f2 x <> 0 -> + f2 (x + h) <> 0 -> + (f1 (x + h) / f2 (x + h) - f1 x / f2 x) / h - + (l1 * f2 x - l2 * f1 x) / Rsqr (f2 x) = + / f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1) + + l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h)) - + f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2) + + l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x). +intros; unfold Rdiv, Rminus, Rsqr in |- *. +repeat rewrite Rmult_plus_distr_r; repeat rewrite Rmult_plus_distr_l; + repeat rewrite Rinv_mult_distr; try assumption. +replace (l1 * f2 x * (/ f2 x * / f2 x)) with (l1 * / f2 x * (f2 x * / f2 x)); + [ idtac | ring ]. +replace (l1 * (/ f2 x * / f2 (x + h)) * f2 x) with + (l1 * / f2 (x + h) * (f2 x * / f2 x)); [ idtac | ring ]. +replace (l1 * (/ f2 x * / f2 (x + h)) * - f2 (x + h)) with + (- (l1 * / f2 x * (f2 (x + h) * / f2 (x + h)))); [ idtac | ring ]. +replace (f1 x * (/ f2 x * / f2 (x + h)) * (f2 (x + h) * / h)) with + (f1 x * / f2 x * / h * (f2 (x + h) * / f2 (x + h))); + [ idtac | ring ]. +replace (f1 x * (/ f2 x * / f2 (x + h)) * (- f2 x * / h)) with + (- (f1 x * / f2 (x + h) * / h * (f2 x * / f2 x))); + [ idtac | ring ]. +replace (l2 * f1 x * (/ f2 x * / f2 x * / f2 (x + h)) * f2 (x + h)) with + (l2 * f1 x * / f2 x * / f2 x * (f2 (x + h) * / f2 (x + h))); + [ idtac | ring ]. +replace (l2 * f1 x * (/ f2 x * / f2 x * / f2 (x + h)) * - f2 x) with + (- (l2 * f1 x * / f2 x * / f2 (x + h) * (f2 x * / f2 x))); + [ idtac | ring ]. +repeat rewrite <- Rinv_r_sym; try assumption || ring. +apply prod_neq_R0; assumption. +Qed. + +Lemma Rmin_pos : forall x y:R, 0 < x -> 0 < y -> 0 < Rmin x y. +intros; unfold Rmin in |- *. +case (Rle_dec x y); intro; assumption. +Qed. + +Lemma maj_term1 : + forall (x h eps l1 alp_f2:R) (eps_f2 alp_f1d:posreal) + (f1 f2:R -> R), + 0 < eps -> + f2 x <> 0 -> + f2 (x + h) <> 0 -> + (forall h:R, + h <> 0 -> + Rabs h < alp_f1d -> + Rabs ((f1 (x + h) - f1 x) / h - l1) < Rabs (eps * f2 x / 8)) -> + (forall a:R, + Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < 2 / Rabs (f2 x)) -> + h <> 0 -> + Rabs h < alp_f1d -> + Rabs h < Rmin eps_f2 alp_f2 -> + Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) < eps / 4. +intros. +assert (H7 := H3 h H6). +assert (H8 := H2 h H4 H5). +apply Rle_lt_trans with + (2 / Rabs (f2 x) * Rabs ((f1 (x + h) - f1 x) / h - l1)). +rewrite Rabs_mult. +apply Rmult_le_compat_r. +apply Rabs_pos. +rewrite Rabs_Rinv; [ left; exact H7 | assumption ]. +apply Rlt_le_trans with (2 / Rabs (f2 x) * Rabs (eps * f2 x / 8)). +apply Rmult_lt_compat_l. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ prove_sup0 | apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption ]. +exact H8. +right; unfold Rdiv in |- *. +repeat rewrite Rabs_mult. +rewrite Rabs_Rinv; discrR. +replace (Rabs 8) with 8. +replace 8 with 8; [ idtac | ring ]. +rewrite Rinv_mult_distr; [ idtac | discrR | discrR ]. +replace (2 * / Rabs (f2 x) * (Rabs eps * Rabs (f2 x) * (/ 2 * / 4))) with + (Rabs eps * / 4 * (2 * / 2) * (Rabs (f2 x) * / Rabs (f2 x))); + [ idtac | ring ]. +replace (Rabs eps) with eps. +repeat rewrite <- Rinv_r_sym; try discrR || (apply Rabs_no_R0; assumption). +ring. +symmetry in |- *; apply Rabs_right; left; assumption. +symmetry in |- *; apply Rabs_right; left; prove_sup. +Qed. + +Lemma maj_term2 : + forall (x h eps l1 alp_f2 alp_f2t2:R) (eps_f2:posreal) + (f2:R -> R), + 0 < eps -> + f2 x <> 0 -> + f2 (x + h) <> 0 -> + (forall a:R, + Rabs a < alp_f2t2 -> + Rabs (f2 (x + a) - f2 x) < Rabs (eps * Rsqr (f2 x) / (8 * l1))) -> + (forall a:R, + Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < 2 / Rabs (f2 x)) -> + h <> 0 -> + Rabs h < alp_f2t2 -> + Rabs h < Rmin eps_f2 alp_f2 -> + l1 <> 0 -> Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) < eps / 4. +intros. +assert (H8 := H3 h H6). +assert (H9 := H2 h H5). +apply Rle_lt_trans with + (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (eps * Rsqr (f2 x) / (8 * l1))). +rewrite Rabs_mult; apply Rmult_le_compat_l. +apply Rabs_pos. +rewrite <- (Rabs_Ropp (f2 x - f2 (x + h))); rewrite Ropp_minus_distr. +left; apply H9. +apply Rlt_le_trans with + (Rabs (2 * (l1 / (f2 x * f2 x))) * Rabs (eps * Rsqr (f2 x) / (8 * l1))). +apply Rmult_lt_compat_r. +apply Rabs_pos_lt. +unfold Rdiv in |- *; unfold Rsqr in |- *; repeat apply prod_neq_R0; + try assumption || discrR. +red in |- *; intro H10; rewrite H10 in H; elim (Rlt_irrefl _ H). +apply Rinv_neq_0_compat; apply prod_neq_R0; try assumption || discrR. +unfold Rdiv in |- *. +repeat rewrite Rinv_mult_distr; try assumption. +repeat rewrite Rabs_mult. +replace (Rabs 2) with 2. +rewrite (Rmult_comm 2). +replace (Rabs l1 * (Rabs (/ f2 x) * Rabs (/ f2 x)) * 2) with + (Rabs l1 * (Rabs (/ f2 x) * (Rabs (/ f2 x) * 2))); + [ idtac | ring ]. +repeat apply Rmult_lt_compat_l. +apply Rabs_pos_lt; assumption. +apply Rabs_pos_lt; apply Rinv_neq_0_compat; assumption. +repeat rewrite Rabs_Rinv; try assumption. +rewrite <- (Rmult_comm 2). +unfold Rdiv in H8; exact H8. +symmetry in |- *; apply Rabs_right; left; prove_sup0. +right. +unfold Rsqr, Rdiv in |- *. +do 1 rewrite Rinv_mult_distr; try assumption || discrR. +do 1 rewrite Rinv_mult_distr; try assumption || discrR. +repeat rewrite Rabs_mult. +repeat rewrite Rabs_Rinv; try assumption || discrR. +replace (Rabs eps) with eps. +replace (Rabs 8) with 8. +replace (Rabs 2) with 2. +replace 8 with (4 * 2); [ idtac | ring ]. +rewrite Rinv_mult_distr; discrR. +replace + (2 * (Rabs l1 * (/ Rabs (f2 x) * / Rabs (f2 x))) * + (eps * (Rabs (f2 x) * Rabs (f2 x)) * (/ 4 * / 2 * / Rabs l1))) with + (eps * / 4 * (Rabs l1 * / Rabs l1) * (Rabs (f2 x) * / Rabs (f2 x)) * + (Rabs (f2 x) * / Rabs (f2 x)) * (2 * / 2)); [ idtac | ring ]. +repeat rewrite <- Rinv_r_sym; try (apply Rabs_no_R0; assumption) || discrR. +ring. +symmetry in |- *; apply Rabs_right; left; prove_sup0. +symmetry in |- *; apply Rabs_right; left; prove_sup. +symmetry in |- *; apply Rabs_right; left; assumption. +Qed. + +Lemma maj_term3 : + forall (x h eps l2 alp_f2:R) (eps_f2 alp_f2d:posreal) + (f1 f2:R -> R), + 0 < eps -> + f2 x <> 0 -> + f2 (x + h) <> 0 -> + (forall h:R, + h <> 0 -> + Rabs h < alp_f2d -> + Rabs ((f2 (x + h) - f2 x) / h - l2) < + Rabs (Rsqr (f2 x) * eps / (8 * f1 x))) -> + (forall a:R, + Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < 2 / Rabs (f2 x)) -> + h <> 0 -> + Rabs h < alp_f2d -> + Rabs h < Rmin eps_f2 alp_f2 -> + f1 x <> 0 -> + Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) < + eps / 4. +intros. +assert (H8 := H2 h H4 H5). +assert (H9 := H3 h H6). +apply Rle_lt_trans with + (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs (Rsqr (f2 x) * eps / (8 * f1 x))). +rewrite Rabs_mult. +apply Rmult_le_compat_l. +apply Rabs_pos. +left; apply H8. +apply Rlt_le_trans with + (Rabs (2 * (f1 x / (f2 x * f2 x))) * Rabs (Rsqr (f2 x) * eps / (8 * f1 x))). +apply Rmult_lt_compat_r. +apply Rabs_pos_lt. +unfold Rdiv in |- *; unfold Rsqr in |- *; repeat apply prod_neq_R0; + try assumption. +red in |- *; intro H10; rewrite H10 in H; elim (Rlt_irrefl _ H). +apply Rinv_neq_0_compat; apply prod_neq_R0; discrR || assumption. +unfold Rdiv in |- *. +repeat rewrite Rinv_mult_distr; try assumption. +repeat rewrite Rabs_mult. +replace (Rabs 2) with 2. +rewrite (Rmult_comm 2). +replace (Rabs (f1 x) * (Rabs (/ f2 x) * Rabs (/ f2 x)) * 2) with + (Rabs (f1 x) * (Rabs (/ f2 x) * (Rabs (/ f2 x) * 2))); + [ idtac | ring ]. +repeat apply Rmult_lt_compat_l. +apply Rabs_pos_lt; assumption. +apply Rabs_pos_lt; apply Rinv_neq_0_compat; assumption. +repeat rewrite Rabs_Rinv; assumption || idtac. +rewrite <- (Rmult_comm 2). +unfold Rdiv in H9; exact H9. +symmetry in |- *; apply Rabs_right; left; prove_sup0. +right. +unfold Rsqr, Rdiv in |- *. +rewrite Rinv_mult_distr; try assumption || discrR. +rewrite Rinv_mult_distr; try assumption || discrR. +repeat rewrite Rabs_mult. +repeat rewrite Rabs_Rinv; try assumption || discrR. +replace (Rabs eps) with eps. +replace (Rabs 8) with 8. +replace (Rabs 2) with 2. +replace 8 with (4 * 2); [ idtac | ring ]. +rewrite Rinv_mult_distr; discrR. +replace + (2 * (Rabs (f1 x) * (/ Rabs (f2 x) * / Rabs (f2 x))) * + (Rabs (f2 x) * Rabs (f2 x) * eps * (/ 4 * / 2 * / Rabs (f1 x)))) with + (eps * / 4 * (Rabs (f2 x) * / Rabs (f2 x)) * (Rabs (f2 x) * / Rabs (f2 x)) * + (Rabs (f1 x) * / Rabs (f1 x)) * (2 * / 2)); [ idtac | ring ]. +repeat rewrite <- Rinv_r_sym; try discrR || (apply Rabs_no_R0; assumption). +ring. +symmetry in |- *; apply Rabs_right; left; prove_sup0. +symmetry in |- *; apply Rabs_right; left; prove_sup. +symmetry in |- *; apply Rabs_right; left; assumption. +Qed. + +Lemma maj_term4 : + forall (x h eps l2 alp_f2 alp_f2c:R) (eps_f2:posreal) + (f1 f2:R -> R), + 0 < eps -> + f2 x <> 0 -> + f2 (x + h) <> 0 -> + (forall a:R, + Rabs a < alp_f2c -> + Rabs (f2 (x + a) - f2 x) < + Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))) -> + (forall a:R, + Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < 2 / Rabs (f2 x)) -> + h <> 0 -> + Rabs h < alp_f2c -> + Rabs h < Rmin eps_f2 alp_f2 -> + f1 x <> 0 -> + l2 <> 0 -> + Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x)) < + eps / 4. +intros. +assert (H9 := H2 h H5). +assert (H10 := H3 h H6). +apply Rle_lt_trans with + (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * + Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))). +rewrite Rabs_mult. +apply Rmult_le_compat_l. +apply Rabs_pos. +left; apply H9. +apply Rlt_le_trans with + (Rabs (2 * l2 * (f1 x / (Rsqr (f2 x) * f2 x))) * + Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))). +apply Rmult_lt_compat_r. +apply Rabs_pos_lt. +unfold Rdiv in |- *; unfold Rsqr in |- *; repeat apply prod_neq_R0; + assumption || idtac. +red in |- *; intro H11; rewrite H11 in H; elim (Rlt_irrefl _ H). +apply Rinv_neq_0_compat; apply prod_neq_R0. +apply prod_neq_R0. +discrR. +assumption. +assumption. +unfold Rdiv in |- *. +repeat rewrite Rinv_mult_distr; + try assumption || (unfold Rsqr in |- *; apply prod_neq_R0; assumption). +repeat rewrite Rabs_mult. +replace (Rabs 2) with 2. +replace + (2 * Rabs l2 * (Rabs (f1 x) * (Rabs (/ Rsqr (f2 x)) * Rabs (/ f2 x)))) with + (Rabs l2 * (Rabs (f1 x) * (Rabs (/ Rsqr (f2 x)) * (Rabs (/ f2 x) * 2)))); + [ idtac | ring ]. +replace + (Rabs l2 * Rabs (f1 x) * (Rabs (/ Rsqr (f2 x)) * Rabs (/ f2 (x + h)))) with + (Rabs l2 * (Rabs (f1 x) * (Rabs (/ Rsqr (f2 x)) * Rabs (/ f2 (x + h))))); + [ idtac | ring ]. +repeat apply Rmult_lt_compat_l. +apply Rabs_pos_lt; assumption. +apply Rabs_pos_lt; assumption. +apply Rabs_pos_lt; apply Rinv_neq_0_compat; unfold Rsqr in |- *; + apply prod_neq_R0; assumption. +repeat rewrite Rabs_Rinv; [ idtac | assumption | assumption ]. +rewrite <- (Rmult_comm 2). +unfold Rdiv in H10; exact H10. +symmetry in |- *; apply Rabs_right; left; prove_sup0. +right; unfold Rsqr, Rdiv in |- *. +rewrite Rinv_mult_distr; try assumption || discrR. +rewrite Rinv_mult_distr; try assumption || discrR. +rewrite Rinv_mult_distr; try assumption || discrR. +rewrite Rinv_mult_distr; try assumption || discrR. +repeat rewrite Rabs_mult. +repeat rewrite Rabs_Rinv; try assumption || discrR. +replace (Rabs eps) with eps. +replace (Rabs 8) with 8. +replace (Rabs 2) with 2. +replace 8 with (4 * 2); [ idtac | ring ]. +rewrite Rinv_mult_distr; discrR. +replace + (2 * Rabs l2 * + (Rabs (f1 x) * (/ Rabs (f2 x) * / Rabs (f2 x) * / Rabs (f2 x))) * + (Rabs (f2 x) * Rabs (f2 x) * Rabs (f2 x) * eps * + (/ 4 * / 2 * / Rabs (f1 x) * / Rabs l2))) with + (eps * / 4 * (Rabs l2 * / Rabs l2) * (Rabs (f1 x) * / Rabs (f1 x)) * + (Rabs (f2 x) * / Rabs (f2 x)) * (Rabs (f2 x) * / Rabs (f2 x)) * + (Rabs (f2 x) * / Rabs (f2 x)) * (2 * / 2)); [ idtac | ring ]. +repeat rewrite <- Rinv_r_sym; try discrR || (apply Rabs_no_R0; assumption). +ring. +symmetry in |- *; apply Rabs_right; left; prove_sup0. +symmetry in |- *; apply Rabs_right; left; prove_sup. +symmetry in |- *; apply Rabs_right; left; assumption. +apply prod_neq_R0; assumption || discrR. +apply prod_neq_R0; assumption. +Qed. + +Lemma D_x_no_cond : forall x a:R, a <> 0 -> D_x no_cond x (x + a). +intros. +unfold D_x, no_cond in |- *. +split. +trivial. +apply Rminus_not_eq. +unfold Rminus in |- *. +rewrite Ropp_plus_distr. +rewrite <- Rplus_assoc. +rewrite Rplus_opp_r. +rewrite Rplus_0_l. +apply Ropp_neq_0_compat; assumption. +Qed. + +Lemma Rabs_4 : + forall a b c d:R, Rabs (a + b + c + d) <= Rabs a + Rabs b + Rabs c + Rabs d. +intros. +apply Rle_trans with (Rabs (a + b) + Rabs (c + d)). +replace (a + b + c + d) with (a + b + (c + d)); [ apply Rabs_triang | ring ]. +apply Rle_trans with (Rabs a + Rabs b + Rabs (c + d)). +apply Rplus_le_compat_r. +apply Rabs_triang. +repeat rewrite Rplus_assoc; repeat apply Rplus_le_compat_l. +apply Rabs_triang. +Qed. + +Lemma Rlt_4 : + forall a b c d e f g h:R, + a < b -> c < d -> e < f -> g < h -> a + c + e + g < b + d + f + h. +intros; apply Rlt_trans with (b + c + e + g). +repeat apply Rplus_lt_compat_r; assumption. +repeat rewrite Rplus_assoc; apply Rplus_lt_compat_l. +apply Rlt_trans with (d + e + g). +rewrite Rplus_assoc; apply Rplus_lt_compat_r; assumption. +rewrite Rplus_assoc; apply Rplus_lt_compat_l; apply Rlt_trans with (f + g). +apply Rplus_lt_compat_r; assumption. +apply Rplus_lt_compat_l; assumption. +Qed. + +Lemma Rmin_2 : forall a b c:R, a < b -> a < c -> a < Rmin b c. +intros; unfold Rmin in |- *; case (Rle_dec b c); intro; assumption. +Qed. + +Lemma quadruple : forall x:R, 4 * x = x + x + x + x. +intro; ring. +Qed. + +Lemma quadruple_var : forall x:R, x = x / 4 + x / 4 + x / 4 + x / 4. +intro; rewrite <- quadruple. +unfold Rdiv in |- *; rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m; discrR. +reflexivity. +Qed. + +(**********) +Lemma continuous_neq_0 : + forall (f:R -> R) (x0:R), + continuity_pt f x0 -> + f x0 <> 0 -> + exists eps : posreal, (forall h:R, Rabs h < eps -> f (x0 + h) <> 0). +intros; unfold continuity_pt in H; unfold continue_in in H; + unfold limit1_in in H; unfold limit_in in H; elim (H (Rabs (f x0 / 2))). +intros; elim H1; intros. +exists (mkposreal x H2). +intros; assert (H5 := H3 (x0 + h)). +cut + (dist R_met (x0 + h) x0 < x -> + dist R_met (f (x0 + h)) (f x0) < Rabs (f x0 / 2)). +unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; + replace (x0 + h - x0) with h. +intros; assert (H7 := H6 H4). +red in |- *; intro. +rewrite H8 in H7; unfold Rminus in H7; rewrite Rplus_0_l in H7; + rewrite Rabs_Ropp in H7; unfold Rdiv in H7; rewrite Rabs_mult in H7; + pattern (Rabs (f x0)) at 1 in H7; rewrite <- Rmult_1_r in H7. +cut (0 < Rabs (f x0)). +intro; assert (H10 := Rmult_lt_reg_l _ _ _ H9 H7). +cut (Rabs (/ 2) = / 2). +assert (Hyp : 0 < 2). +prove_sup0. +intro; rewrite H11 in H10; assert (H12 := Rmult_lt_compat_l 2 _ _ Hyp H10); + rewrite Rmult_1_r in H12; rewrite <- Rinv_r_sym in H12; + [ idtac | discrR ]. +cut (IZR 1 < IZR 2). +unfold IZR in |- *; unfold INR, nat_of_P in |- *; simpl in |- *; intro; + elim (Rlt_irrefl 1 (Rlt_trans _ _ _ H13 H12)). +apply IZR_lt; omega. +unfold Rabs in |- *; case (Rcase_abs (/ 2)); intro. +assert (Hyp : 0 < 2). +prove_sup0. +assert (H11 := Rmult_lt_compat_l 2 _ _ Hyp r); rewrite Rmult_0_r in H11; + rewrite <- Rinv_r_sym in H11; [ idtac | discrR ]. +elim (Rlt_irrefl 0 (Rlt_trans _ _ _ Rlt_0_1 H11)). +reflexivity. +apply (Rabs_pos_lt _ H0). +ring. +assert (H6 := Req_dec x0 (x0 + h)); elim H6; intro. +intro; rewrite <- H7; unfold dist, R_met in |- *; unfold R_dist in |- *; + unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + apply Rabs_pos_lt. +unfold Rdiv in |- *; apply prod_neq_R0; + [ assumption | apply Rinv_neq_0_compat; discrR ]. +intro; apply H5. +split. +unfold D_x, no_cond in |- *. +split; trivial || assumption. +assumption. +change (0 < Rabs (f x0 / 2)) in |- *. +apply Rabs_pos_lt; unfold Rdiv in |- *; apply prod_neq_R0. +assumption. +apply Rinv_neq_0_compat; discrR. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Ranalysis3.v b/theories/Reals/Ranalysis3.v new file mode 100644 index 00000000..9f85b00a --- /dev/null +++ b/theories/Reals/Ranalysis3.v @@ -0,0 +1,793 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Ranalysis3.v,v 1.10.2.1 2004/07/16 19:31:12 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rfunctions. +Require Import Ranalysis1. +Require Import Ranalysis2. Open Local Scope R_scope. + +(* Division *) +Theorem derivable_pt_lim_div : + forall (f1 f2:R -> R) (x l1 l2:R), + derivable_pt_lim f1 x l1 -> + derivable_pt_lim f2 x l2 -> + f2 x <> 0 -> + derivable_pt_lim (f1 / f2) x ((l1 * f2 x - l2 * f1 x) / Rsqr (f2 x)). +intros. +cut (derivable_pt f2 x); + [ intro | unfold derivable_pt in |- *; apply existT with l2; exact H0 ]. +assert (H2 := continuous_neq_0 _ _ (derivable_continuous_pt _ _ X) H1). +elim H2; clear H2; intros eps_f2 H2. +unfold div_fct in |- *. +assert (H3 := derivable_continuous_pt _ _ X). +unfold continuity_pt in H3; unfold continue_in in H3; unfold limit1_in in H3; + unfold limit_in in H3; unfold dist in H3. +simpl in H3; unfold R_dist in H3. +elim (H3 (Rabs (f2 x) / 2)); + [ idtac + | unfold Rdiv in |- *; change (0 < Rabs (f2 x) * / 2) in |- *; + apply Rmult_lt_0_compat; + [ apply Rabs_pos_lt; assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. +clear H3; intros alp_f2 H3. +cut + (forall x0:R, + Rabs (x0 - x) < alp_f2 -> Rabs (f2 x0 - f2 x) < Rabs (f2 x) / 2). +intro H4. +cut (forall a:R, Rabs (a - x) < alp_f2 -> Rabs (f2 x) / 2 < Rabs (f2 a)). +intro H5. +cut + (forall a:R, + Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < 2 / Rabs (f2 x)). +intro Maj. +unfold derivable_pt_lim in |- *; intros. +elim (H (Rabs (eps * f2 x / 8))); + [ idtac + | unfold Rdiv in |- *; change (0 < Rabs (eps * f2 x * / 8)) in |- *; + apply Rabs_pos_lt; repeat apply prod_neq_R0; + [ red in |- *; intro H7; rewrite H7 in H6; elim (Rlt_irrefl _ H6) + | assumption + | apply Rinv_neq_0_compat; discrR ] ]. +intros alp_f1d H7. +case (Req_dec (f1 x) 0); intro. +case (Req_dec l1 0); intro. +(***********************************) +(* Cas n° 1 *) +(* (f1 x)=0 l1 =0 *) +(***********************************) +cut (0 < Rmin eps_f2 (Rmin alp_f2 alp_f1d)); + [ intro + | repeat apply Rmin_pos; + [ apply (cond_pos eps_f2) + | elim H3; intros; assumption + | apply (cond_pos alp_f1d) ] ]. +exists (mkposreal (Rmin eps_f2 (Rmin alp_f2 alp_f1d)) H10). +simpl in |- *; intros. +assert (H13 := Rlt_le_trans _ _ _ H12 (Rmin_r _ _)). +assert (H14 := Rlt_le_trans _ _ _ H12 (Rmin_l _ _)). +assert (H15 := Rlt_le_trans _ _ _ H13 (Rmin_r _ _)). +assert (H16 := Rlt_le_trans _ _ _ H13 (Rmin_l _ _)). +assert (H17 := H7 _ H11 H15). +rewrite formule; [ idtac | assumption | assumption | apply H2; apply H14 ]. +apply Rle_lt_trans with + (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) + + Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) + + Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) + + Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))). +unfold Rminus in |- *. +rewrite <- + (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))) + . +apply Rabs_4. +repeat rewrite Rabs_mult. +apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4). +cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4). +cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4). +cut + (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) < + eps / 4). +cut + (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) < + eps / 4). +intros. +apply Rlt_4; assumption. +rewrite H8. +unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. +rewrite Rabs_R0; rewrite Rmult_0_l. +apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. +rewrite H8. +unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. +rewrite Rabs_R0; rewrite Rmult_0_l. +apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. +rewrite H9. +unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. +rewrite Rabs_R0; rewrite Rmult_0_l. +apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. +rewrite <- Rabs_mult. +apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); + try assumption || apply H2. +apply H14. +apply Rmin_2; assumption. +right; symmetry in |- *; apply quadruple_var. +(***********************************) +(* Cas n° 2 *) +(* (f1 x)=0 l1<>0 *) +(***********************************) +assert (H10 := derivable_continuous_pt _ _ X). +unfold continuity_pt in H10. +unfold continue_in in H10. +unfold limit1_in in H10. +unfold limit_in in H10. +unfold dist in H10. +simpl in H10. +unfold R_dist in H10. +elim (H10 (Rabs (eps * Rsqr (f2 x) / (8 * l1)))). +clear H10; intros alp_f2t2 H10. +cut + (forall a:R, + Rabs a < alp_f2t2 -> + Rabs (f2 (x + a) - f2 x) < Rabs (eps * Rsqr (f2 x) / (8 * l1))). +intro H11. +cut (0 < Rmin (Rmin eps_f2 alp_f1d) (Rmin alp_f2 alp_f2t2)). +intro. +exists (mkposreal (Rmin (Rmin eps_f2 alp_f1d) (Rmin alp_f2 alp_f2t2)) H12). +simpl in |- *. +intros. +assert (H15 := Rlt_le_trans _ _ _ H14 (Rmin_r _ _)). +assert (H16 := Rlt_le_trans _ _ _ H14 (Rmin_l _ _)). +assert (H17 := Rlt_le_trans _ _ _ H15 (Rmin_l _ _)). +assert (H18 := Rlt_le_trans _ _ _ H15 (Rmin_r _ _)). +assert (H19 := Rlt_le_trans _ _ _ H16 (Rmin_l _ _)). +assert (H20 := Rlt_le_trans _ _ _ H16 (Rmin_r _ _)). +clear H14 H15 H16. +rewrite formule; try assumption. +apply Rle_lt_trans with + (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) + + Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) + + Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) + + Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))). +unfold Rminus in |- *. +rewrite <- + (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))) + . +apply Rabs_4. +repeat rewrite Rabs_mult. +apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4). +cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4). +cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4). +cut + (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) < + eps / 4). +cut + (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) < + eps / 4). +intros. +apply Rlt_4; assumption. +rewrite H8. +unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. +rewrite Rabs_R0; rewrite Rmult_0_l. +apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. +rewrite H8. +unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. +rewrite Rabs_R0; rewrite Rmult_0_l. +apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. +rewrite <- Rabs_mult. +apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); try assumption. +apply H2; assumption. +apply Rmin_2; assumption. +rewrite <- Rabs_mult. +apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption. +apply H2; assumption. +apply Rmin_2; assumption. +right; symmetry in |- *; apply quadruple_var. +apply H2; assumption. +repeat apply Rmin_pos. +apply (cond_pos eps_f2). +apply (cond_pos alp_f1d). +elim H3; intros; assumption. +elim H10; intros; assumption. +intros. +elim H10; intros. +case (Req_dec a 0); intro. +rewrite H14; rewrite Rplus_0_r. +unfold Rminus in |- *; rewrite Rplus_opp_r. +rewrite Rabs_R0. +apply Rabs_pos_lt. +unfold Rdiv, Rsqr in |- *; repeat rewrite Rmult_assoc. +repeat apply prod_neq_R0; try assumption. +red in |- *; intro; rewrite H15 in H6; elim (Rlt_irrefl _ H6). +apply Rinv_neq_0_compat; repeat apply prod_neq_R0; discrR || assumption. +apply H13. +split. +apply D_x_no_cond; assumption. +replace (x + a - x) with a; [ assumption | ring ]. +change (0 < Rabs (eps * Rsqr (f2 x) / (8 * l1))) in |- *. +apply Rabs_pos_lt; unfold Rdiv, Rsqr in |- *; repeat rewrite Rmult_assoc; + repeat apply prod_neq_R0. +red in |- *; intro; rewrite H11 in H6; elim (Rlt_irrefl _ H6). +assumption. +assumption. +apply Rinv_neq_0_compat; repeat apply prod_neq_R0; + [ discrR | discrR | discrR | assumption ]. +(***********************************) +(* Cas n° 3 *) +(* (f1 x)<>0 l1=0 l2=0 *) +(***********************************) +case (Req_dec l1 0); intro. +case (Req_dec l2 0); intro. +elim (H0 (Rabs (Rsqr (f2 x) * eps / (8 * f1 x)))); + [ idtac + | apply Rabs_pos_lt; unfold Rdiv, Rsqr in |- *; repeat rewrite Rmult_assoc; + repeat apply prod_neq_R0; + [ assumption + | assumption + | red in |- *; intro; rewrite H11 in H6; elim (Rlt_irrefl _ H6) + | apply Rinv_neq_0_compat; repeat apply prod_neq_R0; discrR || assumption ] ]. +intros alp_f2d H12. +cut (0 < Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)). +intro. +exists (mkposreal (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)) H11). +simpl in |- *. +intros. +assert (H15 := Rlt_le_trans _ _ _ H14 (Rmin_l _ _)). +assert (H16 := Rlt_le_trans _ _ _ H14 (Rmin_r _ _)). +assert (H17 := Rlt_le_trans _ _ _ H15 (Rmin_l _ _)). +assert (H18 := Rlt_le_trans _ _ _ H15 (Rmin_r _ _)). +assert (H19 := Rlt_le_trans _ _ _ H16 (Rmin_l _ _)). +assert (H20 := Rlt_le_trans _ _ _ H16 (Rmin_r _ _)). +clear H15 H16. +rewrite formule; try assumption. +apply Rle_lt_trans with + (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) + + Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) + + Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) + + Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))). +unfold Rminus in |- *. +rewrite <- + (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))) + . +apply Rabs_4. +repeat rewrite Rabs_mult. +apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4). +cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4). +cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4). +cut + (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) < + eps / 4). +cut + (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) < + eps / 4). +intros. +apply Rlt_4; assumption. +rewrite H10. +unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. +rewrite Rabs_R0; rewrite Rmult_0_l. +apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. +rewrite <- Rabs_mult. +apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); try assumption. +apply H2; assumption. +apply Rmin_2; assumption. +rewrite H9. +unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. +rewrite Rabs_R0; rewrite Rmult_0_l. +apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. +rewrite <- Rabs_mult. +apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); assumption || idtac. +apply H2; assumption. +apply Rmin_2; assumption. +right; symmetry in |- *; apply quadruple_var. +apply H2; assumption. +repeat apply Rmin_pos. +apply (cond_pos eps_f2). +elim H3; intros; assumption. +apply (cond_pos alp_f1d). +apply (cond_pos alp_f2d). +(***********************************) +(* Cas n° 4 *) +(* (f1 x)<>0 l1=0 l2<>0 *) +(***********************************) +elim (H0 (Rabs (Rsqr (f2 x) * eps / (8 * f1 x)))); + [ idtac + | apply Rabs_pos_lt; unfold Rsqr, Rdiv in |- *; + repeat rewrite Rinv_mult_distr; repeat apply prod_neq_R0; + try assumption || discrR ]. +intros alp_f2d H11. +assert (H12 := derivable_continuous_pt _ _ X). +unfold continuity_pt in H12. +unfold continue_in in H12. +unfold limit1_in in H12. +unfold limit_in in H12. +unfold dist in H12. +simpl in H12. +unfold R_dist in H12. +elim (H12 (Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2)))). +intros alp_f2c H13. +cut (0 < Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2c))). +intro. +exists + (mkposreal (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2c))) + H14). +simpl in |- *; intros. +assert (H17 := Rlt_le_trans _ _ _ H16 (Rmin_l _ _)). +assert (H18 := Rlt_le_trans _ _ _ H16 (Rmin_r _ _)). +assert (H19 := Rlt_le_trans _ _ _ H18 (Rmin_r _ _)). +assert (H20 := Rlt_le_trans _ _ _ H19 (Rmin_l _ _)). +assert (H21 := Rlt_le_trans _ _ _ H19 (Rmin_r _ _)). +assert (H22 := Rlt_le_trans _ _ _ H18 (Rmin_l _ _)). +assert (H23 := Rlt_le_trans _ _ _ H17 (Rmin_l _ _)). +assert (H24 := Rlt_le_trans _ _ _ H17 (Rmin_r _ _)). +clear H16 H17 H18 H19. +cut + (forall a:R, + Rabs a < alp_f2c -> + Rabs (f2 (x + a) - f2 x) < + Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))). +intro. +rewrite formule; try assumption. +apply Rle_lt_trans with + (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) + + Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) + + Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) + + Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))). +unfold Rminus in |- *. +rewrite <- + (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))) + . +apply Rabs_4. +repeat rewrite Rabs_mult. +apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4). +cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4). +cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4). +cut + (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) < + eps / 4). +cut + (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) < + eps / 4). +intros. +apply Rlt_4; assumption. +rewrite <- Rabs_mult. +apply (maj_term4 x h eps l2 alp_f2 alp_f2c eps_f2 f1 f2); try assumption. +apply H2; assumption. +apply Rmin_2; assumption. +rewrite <- Rabs_mult. +apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); try assumption. +apply H2; assumption. +apply Rmin_2; assumption. +rewrite H9. +unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. +rewrite Rabs_R0; rewrite Rmult_0_l. +apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. +rewrite <- Rabs_mult. +apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption. +apply H2; assumption. +apply Rmin_2; assumption. +right; symmetry in |- *; apply quadruple_var. +apply H2; assumption. +intros. +case (Req_dec a 0); intro. +rewrite H17; rewrite Rplus_0_r. +unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0. +apply Rabs_pos_lt. +unfold Rdiv, Rsqr in |- *. +repeat rewrite Rinv_mult_distr; try assumption. +repeat apply prod_neq_R0; try assumption. +red in |- *; intro H18; rewrite H18 in H6; elim (Rlt_irrefl _ H6). +apply Rinv_neq_0_compat; discrR. +apply Rinv_neq_0_compat; discrR. +apply Rinv_neq_0_compat; discrR. +apply Rinv_neq_0_compat; assumption. +apply Rinv_neq_0_compat; assumption. +discrR. +discrR. +discrR. +discrR. +discrR. +apply prod_neq_R0; [ discrR | assumption ]. +elim H13; intros. +apply H19. +split. +apply D_x_no_cond; assumption. +replace (x + a - x) with a; [ assumption | ring ]. +repeat apply Rmin_pos. +apply (cond_pos eps_f2). +elim H3; intros; assumption. +apply (cond_pos alp_f1d). +apply (cond_pos alp_f2d). +elim H13; intros; assumption. +change (0 < Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))) in |- *. +apply Rabs_pos_lt. +unfold Rsqr, Rdiv in |- *. +repeat rewrite Rinv_mult_distr; try assumption || discrR. +repeat apply prod_neq_R0; try assumption. +red in |- *; intro H13; rewrite H13 in H6; elim (Rlt_irrefl _ H6). +apply Rinv_neq_0_compat; discrR. +apply Rinv_neq_0_compat; discrR. +apply Rinv_neq_0_compat; discrR. +apply Rinv_neq_0_compat; assumption. +apply Rinv_neq_0_compat; assumption. +apply prod_neq_R0; [ discrR | assumption ]. +red in |- *; intro H11; rewrite H11 in H6; elim (Rlt_irrefl _ H6). +apply Rinv_neq_0_compat; discrR. +apply Rinv_neq_0_compat; discrR. +apply Rinv_neq_0_compat; discrR. +apply Rinv_neq_0_compat; assumption. +(***********************************) +(* Cas n° 5 *) +(* (f1 x)<>0 l1<>0 l2=0 *) +(***********************************) +case (Req_dec l2 0); intro. +assert (H11 := derivable_continuous_pt _ _ X). +unfold continuity_pt in H11. +unfold continue_in in H11. +unfold limit1_in in H11. +unfold limit_in in H11. +unfold dist in H11. +simpl in H11. +unfold R_dist in H11. +elim (H11 (Rabs (eps * Rsqr (f2 x) / (8 * l1)))). +clear H11; intros alp_f2t2 H11. +elim (H0 (Rabs (Rsqr (f2 x) * eps / (8 * f1 x)))). +intros alp_f2d H12. +cut (0 < Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2t2))). +intro. +exists + (mkposreal + (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2t2))) H13). +simpl in |- *. +intros. +cut + (forall a:R, + Rabs a < alp_f2t2 -> + Rabs (f2 (x + a) - f2 x) < Rabs (eps * Rsqr (f2 x) / (8 * l1))). +intro. +assert (H17 := Rlt_le_trans _ _ _ H15 (Rmin_l _ _)). +assert (H18 := Rlt_le_trans _ _ _ H15 (Rmin_r _ _)). +assert (H19 := Rlt_le_trans _ _ _ H17 (Rmin_r _ _)). +assert (H20 := Rlt_le_trans _ _ _ H17 (Rmin_l _ _)). +assert (H21 := Rlt_le_trans _ _ _ H18 (Rmin_r _ _)). +assert (H22 := Rlt_le_trans _ _ _ H18 (Rmin_l _ _)). +assert (H23 := Rlt_le_trans _ _ _ H21 (Rmin_l _ _)). +assert (H24 := Rlt_le_trans _ _ _ H21 (Rmin_r _ _)). +clear H15 H17 H18 H21. +rewrite formule; try assumption. +apply Rle_lt_trans with + (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) + + Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) + + Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) + + Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))). +unfold Rminus in |- *. +rewrite <- + (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))) + . +apply Rabs_4. +repeat rewrite Rabs_mult. +apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4). +cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4). +cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4). +cut + (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) < + eps / 4). +cut + (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) < + eps / 4). +intros. +apply Rlt_4; assumption. +rewrite H10. +unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. +rewrite Rabs_R0; rewrite Rmult_0_l. +apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. +rewrite <- Rabs_mult. +apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); try assumption. +apply H2; assumption. +apply Rmin_2; assumption. +rewrite <- Rabs_mult. +apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); try assumption. +apply H2; assumption. +apply Rmin_2; assumption. +rewrite <- Rabs_mult. +apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption. +apply H2; assumption. +apply Rmin_2; assumption. +right; symmetry in |- *; apply quadruple_var. +apply H2; assumption. +intros. +case (Req_dec a 0); intro. +rewrite H17; rewrite Rplus_0_r; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rabs_R0. +apply Rabs_pos_lt. +unfold Rdiv in |- *; rewrite Rinv_mult_distr; try discrR || assumption. +unfold Rsqr in |- *. +repeat apply prod_neq_R0; + assumption || + (apply Rinv_neq_0_compat; assumption) || + (apply Rinv_neq_0_compat; discrR) || + (red in |- *; intro H18; rewrite H18 in H6; elim (Rlt_irrefl _ H6)). +elim H11; intros. +apply H19. +split. +apply D_x_no_cond; assumption. +replace (x + a - x) with a; [ assumption | ring ]. +repeat apply Rmin_pos. +apply (cond_pos eps_f2). +elim H3; intros; assumption. +apply (cond_pos alp_f1d). +apply (cond_pos alp_f2d). +elim H11; intros; assumption. +apply Rabs_pos_lt. +unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr; try discrR || assumption. +repeat apply prod_neq_R0; + assumption || + (apply Rinv_neq_0_compat; assumption) || + (apply Rinv_neq_0_compat; discrR) || + (red in |- *; intro H12; rewrite H12 in H6; elim (Rlt_irrefl _ H6)). +change (0 < Rabs (eps * Rsqr (f2 x) / (8 * l1))) in |- *. +apply Rabs_pos_lt. +unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr; try discrR || assumption. +repeat apply prod_neq_R0; + assumption || + (apply Rinv_neq_0_compat; assumption) || + (apply Rinv_neq_0_compat; discrR) || + (red in |- *; intro H12; rewrite H12 in H6; elim (Rlt_irrefl _ H6)). +(***********************************) +(* Cas n° 6 *) +(* (f1 x)<>0 l1<>0 l2<>0 *) +(***********************************) +elim (H0 (Rabs (Rsqr (f2 x) * eps / (8 * f1 x)))). +intros alp_f2d H11. +assert (H12 := derivable_continuous_pt _ _ X). +unfold continuity_pt in H12. +unfold continue_in in H12. +unfold limit1_in in H12. +unfold limit_in in H12. +unfold dist in H12. +simpl in H12. +unfold R_dist in H12. +elim (H12 (Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2)))). +intros alp_f2c H13. +elim (H12 (Rabs (eps * Rsqr (f2 x) / (8 * l1)))). +intros alp_f2t2 H14. +cut + (0 < + Rmin (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)) + (Rmin alp_f2c alp_f2t2)). +intro. +exists + (mkposreal + (Rmin (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)) + (Rmin alp_f2c alp_f2t2)) H15). +simpl in |- *. +intros. +assert (H18 := Rlt_le_trans _ _ _ H17 (Rmin_l _ _)). +assert (H19 := Rlt_le_trans _ _ _ H17 (Rmin_r _ _)). +assert (H20 := Rlt_le_trans _ _ _ H18 (Rmin_l _ _)). +assert (H21 := Rlt_le_trans _ _ _ H18 (Rmin_r _ _)). +assert (H22 := Rlt_le_trans _ _ _ H19 (Rmin_l _ _)). +assert (H23 := Rlt_le_trans _ _ _ H19 (Rmin_r _ _)). +assert (H24 := Rlt_le_trans _ _ _ H20 (Rmin_l _ _)). +assert (H25 := Rlt_le_trans _ _ _ H20 (Rmin_r _ _)). +assert (H26 := Rlt_le_trans _ _ _ H21 (Rmin_l _ _)). +assert (H27 := Rlt_le_trans _ _ _ H21 (Rmin_r _ _)). +clear H17 H18 H19 H20 H21. +cut + (forall a:R, + Rabs a < alp_f2t2 -> + Rabs (f2 (x + a) - f2 x) < Rabs (eps * Rsqr (f2 x) / (8 * l1))). +cut + (forall a:R, + Rabs a < alp_f2c -> + Rabs (f2 (x + a) - f2 x) < + Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))). +intros. +rewrite formule; try assumption. +apply Rle_lt_trans with + (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) + + Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) + + Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) + + Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))). +unfold Rminus in |- *. +rewrite <- + (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))) + . +apply Rabs_4. +repeat rewrite Rabs_mult. +apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4). +cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4). +cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4). +cut + (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) < + eps / 4). +cut + (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) < + eps / 4). +intros. +apply Rlt_4; assumption. +rewrite <- Rabs_mult. +apply (maj_term4 x h eps l2 alp_f2 alp_f2c eps_f2 f1 f2); try assumption. +apply H2; assumption. +apply Rmin_2; assumption. +rewrite <- Rabs_mult. +apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); try assumption. +apply H2; assumption. +apply Rmin_2; assumption. +rewrite <- Rabs_mult. +apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); try assumption. +apply H2; assumption. +apply Rmin_2; assumption. +rewrite <- Rabs_mult. +apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption. +apply H2; assumption. +apply Rmin_2; assumption. +right; symmetry in |- *; apply quadruple_var. +apply H2; assumption. +intros. +case (Req_dec a 0); intro. +rewrite H18; rewrite Rplus_0_r; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rabs_R0; apply Rabs_pos_lt. +unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr. +repeat apply prod_neq_R0; + assumption || + (apply Rinv_neq_0_compat; assumption) || + (apply Rinv_neq_0_compat; discrR) || + (red in |- *; intro H28; rewrite H28 in H6; elim (Rlt_irrefl _ H6)). +apply prod_neq_R0; [ discrR | assumption ]. +apply prod_neq_R0; [ discrR | assumption ]. +assumption. +elim H13; intros. +apply H20. +split. +apply D_x_no_cond; assumption. +replace (x + a - x) with a; [ assumption | ring ]. +intros. +case (Req_dec a 0); intro. +rewrite H18; rewrite Rplus_0_r; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rabs_R0; apply Rabs_pos_lt. +unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr. +repeat apply prod_neq_R0; + assumption || + (apply Rinv_neq_0_compat; assumption) || + (apply Rinv_neq_0_compat; discrR) || + (red in |- *; intro H28; rewrite H28 in H6; elim (Rlt_irrefl _ H6)). +discrR. +assumption. +elim H14; intros. +apply H20. +split. +unfold D_x, no_cond in |- *; split. +trivial. +apply Rminus_not_eq_right. +replace (x + a - x) with a; [ assumption | ring ]. +replace (x + a - x) with a; [ assumption | ring ]. +repeat apply Rmin_pos. +apply (cond_pos eps_f2). +elim H3; intros; assumption. +apply (cond_pos alp_f1d). +apply (cond_pos alp_f2d). +elim H13; intros; assumption. +elim H14; intros; assumption. +change (0 < Rabs (eps * Rsqr (f2 x) / (8 * l1))) in |- *; apply Rabs_pos_lt. +unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr; try discrR || assumption. +repeat apply prod_neq_R0; + assumption || + (apply Rinv_neq_0_compat; assumption) || + (apply Rinv_neq_0_compat; discrR) || + (red in |- *; intro H14; rewrite H14 in H6; elim (Rlt_irrefl _ H6)). +change (0 < Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))) in |- *; + apply Rabs_pos_lt. +unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr. +repeat apply prod_neq_R0; + assumption || + (apply Rinv_neq_0_compat; assumption) || + (apply Rinv_neq_0_compat; discrR) || + (red in |- *; intro H13; rewrite H13 in H6; elim (Rlt_irrefl _ H6)). +apply prod_neq_R0; [ discrR | assumption ]. +apply prod_neq_R0; [ discrR | assumption ]. +assumption. +apply Rabs_pos_lt. +unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr; + [ idtac | discrR | assumption ]. +repeat apply prod_neq_R0; + assumption || + (apply Rinv_neq_0_compat; assumption) || + (apply Rinv_neq_0_compat; discrR) || + (red in |- *; intro H11; rewrite H11 in H6; elim (Rlt_irrefl _ H6)). +intros. +unfold Rdiv in |- *. +apply Rmult_lt_reg_l with (Rabs (f2 (x + a))). +apply Rabs_pos_lt; apply H2. +apply Rlt_le_trans with (Rmin eps_f2 alp_f2). +assumption. +apply Rmin_l. +rewrite <- Rinv_r_sym. +apply Rmult_lt_reg_l with (Rabs (f2 x)). +apply Rabs_pos_lt; assumption. +rewrite Rmult_1_r. +rewrite (Rmult_comm (Rabs (f2 x))). +repeat rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +apply Rmult_lt_reg_l with (/ 2). +apply Rinv_0_lt_compat; prove_sup0. +repeat rewrite (Rmult_comm (/ 2)). +repeat rewrite Rmult_assoc. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_r. +unfold Rdiv in H5; apply H5. +replace (x + a - x) with a. +assert (H7 := Rlt_le_trans _ _ _ H6 (Rmin_r _ _)); assumption. +ring. +discrR. +apply Rabs_no_R0; assumption. +apply Rabs_no_R0; apply H2. +assert (H7 := Rlt_le_trans _ _ _ H6 (Rmin_l _ _)); assumption. +intros. +assert (H6 := H4 a H5). +rewrite <- (Rabs_Ropp (f2 a - f2 x)) in H6. +rewrite Ropp_minus_distr in H6. +assert (H7 := Rle_lt_trans _ _ _ (Rabs_triang_inv _ _) H6). +apply Rplus_lt_reg_r with (- Rabs (f2 a) + Rabs (f2 x) / 2). +rewrite Rplus_assoc. +rewrite <- double_var. +do 2 rewrite (Rplus_comm (- Rabs (f2 a))). +rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r. +unfold Rminus in H7; assumption. +intros. +case (Req_dec x x0); intro. +rewrite <- H5; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply Rabs_pos_lt; assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +elim H3; intros. +apply H7. +split. +unfold D_x, no_cond in |- *; split. +trivial. +assumption. +assumption. +Qed. + +Lemma derivable_pt_div : + forall (f1 f2:R -> R) (x:R), + derivable_pt f1 x -> + derivable_pt f2 x -> f2 x <> 0 -> derivable_pt (f1 / f2) x. +unfold derivable_pt in |- *. +intros. +elim X; intros. +elim X0; intros. +apply existT with ((x0 * f2 x - x1 * f1 x) / Rsqr (f2 x)). +apply derivable_pt_lim_div; assumption. +Qed. + +Lemma derivable_div : + forall f1 f2:R -> R, + derivable f1 -> + derivable f2 -> (forall x:R, f2 x <> 0) -> derivable (f1 / f2). +unfold derivable in |- *; intros. +apply (derivable_pt_div _ _ _ (X x) (X0 x) (H x)). +Qed. + +Lemma derive_pt_div : + forall (f1 f2:R -> R) (x:R) (pr1:derivable_pt f1 x) + (pr2:derivable_pt f2 x) (na:f2 x <> 0), + derive_pt (f1 / f2) x (derivable_pt_div _ _ _ pr1 pr2 na) = + (derive_pt f1 x pr1 * f2 x - derive_pt f2 x pr2 * f1 x) / Rsqr (f2 x). +intros. +assert (H := derivable_derive f1 x pr1). +assert (H0 := derivable_derive f2 x pr2). +assert + (H1 := derivable_derive (f1 / f2)%F x (derivable_pt_div _ _ _ pr1 pr2 na)). +elim H; clear H; intros l1 H. +elim H0; clear H0; intros l2 H0. +elim H1; clear H1; intros l H1. +rewrite H; rewrite H0; apply derive_pt_eq_0. +assert (H3 := projT2 pr1). +unfold derive_pt in H; rewrite H in H3. +assert (H4 := projT2 pr2). +unfold derive_pt in H0; rewrite H0 in H4. +apply derivable_pt_lim_div; assumption. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Ranalysis4.v b/theories/Reals/Ranalysis4.v new file mode 100644 index 00000000..86f49cd4 --- /dev/null +++ b/theories/Reals/Ranalysis4.v @@ -0,0 +1,384 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Ranalysis4.v,v 1.19.2.1 2004/07/16 19:31:12 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rfunctions. +Require Import SeqSeries. +Require Import Rtrigo. +Require Import Ranalysis1. +Require Import Ranalysis3. +Require Import Exp_prop. Open Local Scope R_scope. + +(**********) +Lemma derivable_pt_inv : + forall (f:R -> R) (x:R), + f x <> 0 -> derivable_pt f x -> derivable_pt (/ f) x. +intros; cut (derivable_pt (fct_cte 1 / f) x -> derivable_pt (/ f) x). +intro; apply X0. +apply derivable_pt_div. +apply derivable_pt_const. +assumption. +assumption. +unfold div_fct, inv_fct, fct_cte in |- *; intro; elim X0; intros; + unfold derivable_pt in |- *; apply existT with x0; + unfold derivable_pt_abs in |- *; unfold derivable_pt_lim in |- *; + unfold derivable_pt_abs in p; unfold derivable_pt_lim in p; + intros; elim (p eps H0); intros; exists x1; intros; + unfold Rdiv in H1; unfold Rdiv in |- *; rewrite <- (Rmult_1_l (/ f x)); + rewrite <- (Rmult_1_l (/ f (x + h))). +apply H1; assumption. +Qed. + +(**********) +Lemma pr_nu_var : + forall (f g:R -> R) (x:R) (pr1:derivable_pt f x) (pr2:derivable_pt g x), + f = g -> derive_pt f x pr1 = derive_pt g x pr2. +unfold derivable_pt, derive_pt in |- *; intros. +elim pr1; intros. +elim pr2; intros. +simpl in |- *. +rewrite H in p. +apply uniqueness_limite with g x; assumption. +Qed. + +(**********) +Lemma pr_nu_var2 : + forall (f g:R -> R) (x:R) (pr1:derivable_pt f x) (pr2:derivable_pt g x), + (forall h:R, f h = g h) -> derive_pt f x pr1 = derive_pt g x pr2. +unfold derivable_pt, derive_pt in |- *; intros. +elim pr1; intros. +elim pr2; intros. +simpl in |- *. +assert (H0 := uniqueness_step2 _ _ _ p). +assert (H1 := uniqueness_step2 _ _ _ p0). +cut (limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) x1 0). +intro; assert (H3 := uniqueness_step1 _ _ _ _ H0 H2). +assumption. +unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *; + simpl in |- *; unfold R_dist in |- *; unfold limit1_in in H1; + unfold limit_in in H1; unfold dist in H1; simpl in H1; + unfold R_dist in H1. +intros; elim (H1 eps H2); intros. +elim H3; intros. +exists x2. +split. +assumption. +intros; do 2 rewrite H; apply H5; assumption. +Qed. + +(**********) +Lemma derivable_inv : + forall f:R -> R, (forall x:R, f x <> 0) -> derivable f -> derivable (/ f). +intros. +unfold derivable in |- *; intro. +apply derivable_pt_inv. +apply (H x). +apply (X x). +Qed. + +Lemma derive_pt_inv : + forall (f:R -> R) (x:R) (pr:derivable_pt f x) (na:f x <> 0), + derive_pt (/ f) x (derivable_pt_inv f x na pr) = + - derive_pt f x pr / Rsqr (f x). +intros; + replace (derive_pt (/ f) x (derivable_pt_inv f x na pr)) with + (derive_pt (fct_cte 1 / f) x + (derivable_pt_div (fct_cte 1) f x (derivable_pt_const 1 x) pr na)). +rewrite derive_pt_div; rewrite derive_pt_const; unfold fct_cte in |- *; + rewrite Rmult_0_l; rewrite Rmult_1_r; unfold Rminus in |- *; + rewrite Rplus_0_l; reflexivity. +apply pr_nu_var2. +intro; unfold div_fct, fct_cte, inv_fct in |- *. +unfold Rdiv in |- *; ring. +Qed. + +(* Rabsolu *) +Lemma Rabs_derive_1 : forall x:R, 0 < x -> derivable_pt_lim Rabs x 1. +intros. +unfold derivable_pt_lim in |- *; intros. +exists (mkposreal x H); intros. +rewrite (Rabs_right x). +rewrite (Rabs_right (x + h)). +rewrite Rplus_comm. +unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_r. +rewrite Rplus_0_r; unfold Rdiv in |- *; rewrite <- Rinv_r_sym. +rewrite Rplus_opp_r; rewrite Rabs_R0; apply H0. +apply H1. +apply Rle_ge. +case (Rcase_abs h); intro. +rewrite (Rabs_left h r) in H2. +left; rewrite Rplus_comm; apply Rplus_lt_reg_r with (- h); rewrite Rplus_0_r; + rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; + apply H2. +apply Rplus_le_le_0_compat. +left; apply H. +apply Rge_le; apply r. +left; apply H. +Qed. + +Lemma Rabs_derive_2 : forall x:R, x < 0 -> derivable_pt_lim Rabs x (-1). +intros. +unfold derivable_pt_lim in |- *; intros. +cut (0 < - x). +intro; exists (mkposreal (- x) H1); intros. +rewrite (Rabs_left x). +rewrite (Rabs_left (x + h)). +rewrite Rplus_comm. +rewrite Ropp_plus_distr. +unfold Rminus in |- *; rewrite Ropp_involutive; rewrite Rplus_assoc; + rewrite Rplus_opp_l. +rewrite Rplus_0_r; unfold Rdiv in |- *. +rewrite Ropp_mult_distr_l_reverse. +rewrite <- Rinv_r_sym. +rewrite Ropp_involutive; rewrite Rplus_opp_l; rewrite Rabs_R0; apply H0. +apply H2. +case (Rcase_abs h); intro. +apply Ropp_lt_cancel. +rewrite Ropp_0; rewrite Ropp_plus_distr; apply Rplus_lt_0_compat. +apply H1. +apply Ropp_0_gt_lt_contravar; apply r. +rewrite (Rabs_right h r) in H3. +apply Rplus_lt_reg_r with (- x); rewrite Rplus_0_r; rewrite <- Rplus_assoc; + rewrite Rplus_opp_l; rewrite Rplus_0_l; apply H3. +apply H. +apply Ropp_0_gt_lt_contravar; apply H. +Qed. + +(* Rabsolu is derivable for all x <> 0 *) +Lemma Rderivable_pt_abs : forall x:R, x <> 0 -> derivable_pt Rabs x. +intros. +case (total_order_T x 0); intro. +elim s; intro. +unfold derivable_pt in |- *; apply existT with (-1). +apply (Rabs_derive_2 x a). +elim H; exact b. +unfold derivable_pt in |- *; apply existT with 1. +apply (Rabs_derive_1 x r). +Qed. + +(* Rabsolu is continuous for all x *) +Lemma Rcontinuity_abs : continuity Rabs. +unfold continuity in |- *; intro. +case (Req_dec x 0); intro. +unfold continuity_pt in |- *; unfold continue_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold R_dist in |- *; intros; exists eps; + split. +apply H0. +intros; rewrite H; rewrite Rabs_R0; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; rewrite Rabs_Rabsolu; elim H1; + intros; rewrite H in H3; unfold Rminus in H3; rewrite Ropp_0 in H3; + rewrite Rplus_0_r in H3; apply H3. +apply derivable_continuous_pt; apply (Rderivable_pt_abs x H). +Qed. + +(* Finite sums : Sum a_k x^k *) +Lemma continuity_finite_sum : + forall (An:nat -> R) (N:nat), + continuity (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N). +intros; unfold continuity in |- *; intro. +induction N as [| N HrecN]. +simpl in |- *. +apply continuity_pt_const. +unfold constant in |- *; intros; reflexivity. +replace (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) (S N)) with + ((fun y:R => sum_f_R0 (fun k:nat => (An k * y ^ k)%R) N) + + (fun y:R => (An (S N) * y ^ S N)%R))%F. +apply continuity_pt_plus. +apply HrecN. +replace (fun y:R => An (S N) * y ^ S N) with + (mult_real_fct (An (S N)) (fun y:R => y ^ S N)). +apply continuity_pt_scal. +apply derivable_continuous_pt. +apply derivable_pt_pow. +reflexivity. +reflexivity. +Qed. + +Lemma derivable_pt_lim_fs : + forall (An:nat -> R) (x:R) (N:nat), + (0 < N)%nat -> + derivable_pt_lim (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N) x + (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred N)). +intros; induction N as [| N HrecN]. +elim (lt_irrefl _ H). +cut (N = 0%nat \/ (0 < N)%nat). +intro; elim H0; intro. +rewrite H1. +simpl in |- *. +replace (fun y:R => An 0%nat * 1 + An 1%nat * (y * 1)) with + (fct_cte (An 0%nat * 1) + mult_real_fct (An 1%nat) (id * fct_cte 1))%F. +replace (1 * An 1%nat * 1) with (0 + An 1%nat * (1 * fct_cte 1 x + id x * 0)). +apply derivable_pt_lim_plus. +apply derivable_pt_lim_const. +apply derivable_pt_lim_scal. +apply derivable_pt_lim_mult. +apply derivable_pt_lim_id. +apply derivable_pt_lim_const. +unfold fct_cte, id in |- *; ring. +reflexivity. +replace (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) (S N)) with + ((fun y:R => sum_f_R0 (fun k:nat => (An k * y ^ k)%R) N) + + (fun y:R => (An (S N) * y ^ S N)%R))%F. +replace (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred (S N))) + with + (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred N) + + An (S N) * (INR (S (pred (S N))) * x ^ pred (S N))). +apply derivable_pt_lim_plus. +apply HrecN. +assumption. +replace (fun y:R => An (S N) * y ^ S N) with + (mult_real_fct (An (S N)) (fun y:R => y ^ S N)). +apply derivable_pt_lim_scal. +replace (pred (S N)) with N; [ idtac | reflexivity ]. +pattern N at 3 in |- *; replace N with (pred (S N)). +apply derivable_pt_lim_pow. +reflexivity. +reflexivity. +cut (pred (S N) = S (pred N)). +intro; rewrite H2. +rewrite tech5. +apply Rplus_eq_compat_l. +rewrite <- H2. +replace (pred (S N)) with N; [ idtac | reflexivity ]. +ring. +simpl in |- *. +apply S_pred with 0%nat; assumption. +unfold plus_fct in |- *. +simpl in |- *; reflexivity. +inversion H. +left; reflexivity. +right; apply lt_le_trans with 1%nat; [ apply lt_O_Sn | assumption ]. +Qed. + +Lemma derivable_pt_lim_finite_sum : + forall (An:nat -> R) (x:R) (N:nat), + derivable_pt_lim (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N) x + match N with + | O => 0 + | _ => sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred N) + end. +intros. +induction N as [| N HrecN]. +simpl in |- *. +rewrite Rmult_1_r. +replace (fun _:R => An 0%nat) with (fct_cte (An 0%nat)); + [ apply derivable_pt_lim_const | reflexivity ]. +apply derivable_pt_lim_fs; apply lt_O_Sn. +Qed. + +Lemma derivable_pt_finite_sum : + forall (An:nat -> R) (N:nat) (x:R), + derivable_pt (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N) x. +intros. +unfold derivable_pt in |- *. +assert (H := derivable_pt_lim_finite_sum An x N). +induction N as [| N HrecN]. +apply existT with 0; apply H. +apply existT with + (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred (S N))); + apply H. +Qed. + +Lemma derivable_finite_sum : + forall (An:nat -> R) (N:nat), + derivable (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N). +intros; unfold derivable in |- *; intro; apply derivable_pt_finite_sum. +Qed. + +(* Regularity of hyperbolic functions *) +Lemma derivable_pt_lim_cosh : forall x:R, derivable_pt_lim cosh x (sinh x). +intro. +unfold cosh, sinh in |- *; unfold Rdiv in |- *. +replace (fun x0:R => (exp x0 + exp (- x0)) * / 2) with + ((exp + comp exp (- id)) * fct_cte (/ 2))%F; [ idtac | reflexivity ]. +replace ((exp x - exp (- x)) * / 2) with + ((exp x + exp (- x) * -1) * fct_cte (/ 2) x + + (exp + comp exp (- id))%F x * 0). +apply derivable_pt_lim_mult. +apply derivable_pt_lim_plus. +apply derivable_pt_lim_exp. +apply derivable_pt_lim_comp. +apply derivable_pt_lim_opp. +apply derivable_pt_lim_id. +apply derivable_pt_lim_exp. +apply derivable_pt_lim_const. +unfold plus_fct, mult_real_fct, comp, opp_fct, id, fct_cte in |- *; ring. +Qed. + +Lemma derivable_pt_lim_sinh : forall x:R, derivable_pt_lim sinh x (cosh x). +intro. +unfold cosh, sinh in |- *; unfold Rdiv in |- *. +replace (fun x0:R => (exp x0 - exp (- x0)) * / 2) with + ((exp - comp exp (- id)) * fct_cte (/ 2))%F; [ idtac | reflexivity ]. +replace ((exp x + exp (- x)) * / 2) with + ((exp x - exp (- x) * -1) * fct_cte (/ 2) x + + (exp - comp exp (- id))%F x * 0). +apply derivable_pt_lim_mult. +apply derivable_pt_lim_minus. +apply derivable_pt_lim_exp. +apply derivable_pt_lim_comp. +apply derivable_pt_lim_opp. +apply derivable_pt_lim_id. +apply derivable_pt_lim_exp. +apply derivable_pt_lim_const. +unfold plus_fct, mult_real_fct, comp, opp_fct, id, fct_cte in |- *; ring. +Qed. + +Lemma derivable_pt_exp : forall x:R, derivable_pt exp x. +intro. +unfold derivable_pt in |- *. +apply existT with (exp x). +apply derivable_pt_lim_exp. +Qed. + +Lemma derivable_pt_cosh : forall x:R, derivable_pt cosh x. +intro. +unfold derivable_pt in |- *. +apply existT with (sinh x). +apply derivable_pt_lim_cosh. +Qed. + +Lemma derivable_pt_sinh : forall x:R, derivable_pt sinh x. +intro. +unfold derivable_pt in |- *. +apply existT with (cosh x). +apply derivable_pt_lim_sinh. +Qed. + +Lemma derivable_exp : derivable exp. +unfold derivable in |- *; apply derivable_pt_exp. +Qed. + +Lemma derivable_cosh : derivable cosh. +unfold derivable in |- *; apply derivable_pt_cosh. +Qed. + +Lemma derivable_sinh : derivable sinh. +unfold derivable in |- *; apply derivable_pt_sinh. +Qed. + +Lemma derive_pt_exp : + forall x:R, derive_pt exp x (derivable_pt_exp x) = exp x. +intro; apply derive_pt_eq_0. +apply derivable_pt_lim_exp. +Qed. + +Lemma derive_pt_cosh : + forall x:R, derive_pt cosh x (derivable_pt_cosh x) = sinh x. +intro; apply derive_pt_eq_0. +apply derivable_pt_lim_cosh. +Qed. + +Lemma derive_pt_sinh : + forall x:R, derive_pt sinh x (derivable_pt_sinh x) = cosh x. +intro; apply derive_pt_eq_0. +apply derivable_pt_lim_sinh. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Raxioms.v b/theories/Reals/Raxioms.v new file mode 100644 index 00000000..bef9f89c --- /dev/null +++ b/theories/Reals/Raxioms.v @@ -0,0 +1,157 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Raxioms.v,v 1.20.2.1 2004/07/16 19:31:12 herbelin Exp $ i*) + +(*********************************************************) +(** Axiomatisation of the classical reals *) +(*********************************************************) + +Require Export ZArith_base. +Require Export Rdefinitions. +Open Local Scope R_scope. + +(*********************************************************) +(* Field axioms *) +(*********************************************************) + +(*********************************************************) +(** Addition *) +(*********************************************************) + +(**********) +Axiom Rplus_comm : forall r1 r2:R, r1 + r2 = r2 + r1. +Hint Resolve Rplus_comm: real. + +(**********) +Axiom Rplus_assoc : forall r1 r2 r3:R, r1 + r2 + r3 = r1 + (r2 + r3). +Hint Resolve Rplus_assoc: real. + +(**********) +Axiom Rplus_opp_r : forall r:R, r + - r = 0. +Hint Resolve Rplus_opp_r: real v62. + +(**********) +Axiom Rplus_0_l : forall r:R, 0 + r = r. +Hint Resolve Rplus_0_l: real. + +(***********************************************************) +(** Multiplication *) +(***********************************************************) + +(**********) +Axiom Rmult_comm : forall r1 r2:R, r1 * r2 = r2 * r1. +Hint Resolve Rmult_comm: real v62. + +(**********) +Axiom Rmult_assoc : forall r1 r2 r3:R, r1 * r2 * r3 = r1 * (r2 * r3). +Hint Resolve Rmult_assoc: real v62. + +(**********) +Axiom Rinv_l : forall r:R, r <> 0 -> / r * r = 1. +Hint Resolve Rinv_l: real. + +(**********) +Axiom Rmult_1_l : forall r:R, 1 * r = r. +Hint Resolve Rmult_1_l: real. + +(**********) +Axiom R1_neq_R0 : 1 <> 0. +Hint Resolve R1_neq_R0: real. + +(*********************************************************) +(** Distributivity *) +(*********************************************************) + +(**********) +Axiom + Rmult_plus_distr_l : forall r1 r2 r3:R, r1 * (r2 + r3) = r1 * r2 + r1 * r3. +Hint Resolve Rmult_plus_distr_l: real v62. + +(*********************************************************) +(** Order axioms *) +(*********************************************************) +(*********************************************************) +(** Total Order *) +(*********************************************************) + +(**********) +Axiom total_order_T : forall r1 r2:R, {r1 < r2} + {r1 = r2} + {r1 > r2}. + +(*********************************************************) +(** Lower *) +(*********************************************************) + +(**********) +Axiom Rlt_asym : forall r1 r2:R, r1 < r2 -> ~ r2 < r1. + +(**********) +Axiom Rlt_trans : forall r1 r2 r3:R, r1 < r2 -> r2 < r3 -> r1 < r3. + +(**********) +Axiom Rplus_lt_compat_l : forall r r1 r2:R, r1 < r2 -> r + r1 < r + r2. + +(**********) +Axiom + Rmult_lt_compat_l : forall r r1 r2:R, 0 < r -> r1 < r2 -> r * r1 < r * r2. + +Hint Resolve Rlt_asym Rplus_lt_compat_l Rmult_lt_compat_l: real. + +(**********************************************************) +(** Injection from N to R *) +(**********************************************************) + +(**********) +Fixpoint INR (n:nat) : R := + match n with + | O => 0 + | S O => 1 + | S n => INR n + 1 + end. +Arguments Scope INR [nat_scope]. + + +(**********************************************************) +(** Injection from [Z] to [R] *) +(**********************************************************) + +(**********) +Definition IZR (z:Z) : R := + match z with + | Z0 => 0 + | Zpos n => INR (nat_of_P n) + | Zneg n => - INR (nat_of_P n) + end. +Arguments Scope IZR [Z_scope]. + +(**********************************************************) +(** [R] Archimedian *) +(**********************************************************) + +(**********) +Axiom archimed : forall r:R, IZR (up r) > r /\ IZR (up r) - r <= 1. + +(**********************************************************) +(** [R] Complete *) +(**********************************************************) + +(**********) +Definition is_upper_bound (E:R -> Prop) (m:R) := forall x:R, E x -> x <= m. + +(**********) +Definition bound (E:R -> Prop) := exists m : R, is_upper_bound E m. + +(**********) +Definition is_lub (E:R -> Prop) (m:R) := + is_upper_bound E m /\ (forall b:R, is_upper_bound E b -> m <= b). + +(**********) +Axiom + completeness : + forall E:R -> Prop, + bound E -> (exists x : R, E x) -> sigT (fun m:R => is_lub E m). diff --git a/theories/Reals/Rbase.v b/theories/Reals/Rbase.v new file mode 100644 index 00000000..773819a2 --- /dev/null +++ b/theories/Reals/Rbase.v @@ -0,0 +1,14 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Rbase.v,v 1.39.2.1 2004/07/16 19:31:12 herbelin Exp $ i*) + +Require Export Rdefinitions. +Require Export Raxioms. +Require Export RIneq. +Require Export DiscrR.
\ No newline at end of file diff --git a/theories/Reals/Rbasic_fun.v b/theories/Reals/Rbasic_fun.v new file mode 100644 index 00000000..49ba48f7 --- /dev/null +++ b/theories/Reals/Rbasic_fun.v @@ -0,0 +1,470 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Rbasic_fun.v,v 1.22.2.1 2004/07/16 19:31:12 herbelin Exp $ i*) + +(*********************************************************) +(** Complements for the real numbers *) +(* *) +(*********************************************************) + +Require Import Rbase. +Require Import R_Ifp. +Require Import Fourier. Open Local Scope R_scope. + +Implicit Type r : R. + +(*******************************) +(** Rmin *) +(*******************************) + +(*********) +Definition Rmin (x y:R) : R := + match Rle_dec x y with + | left _ => x + | right _ => y + end. + +(*********) +Lemma Rmin_Rgt_l : forall r1 r2 r, Rmin r1 r2 > r -> r1 > r /\ r2 > r. +intros r1 r2 r; unfold Rmin in |- *; case (Rle_dec r1 r2); intros. +split. +assumption. +unfold Rgt in |- *; unfold Rgt in H; exact (Rlt_le_trans r r1 r2 H r0). +split. +generalize (Rnot_le_lt r1 r2 n); intro; exact (Rgt_trans r1 r2 r H0 H). +assumption. +Qed. + +(*********) +Lemma Rmin_Rgt_r : forall r1 r2 r, r1 > r /\ r2 > r -> Rmin r1 r2 > r. +intros; unfold Rmin in |- *; case (Rle_dec r1 r2); elim H; clear H; intros; + assumption. +Qed. + +(*********) +Lemma Rmin_Rgt : forall r1 r2 r, Rmin r1 r2 > r <-> r1 > r /\ r2 > r. +intros; split. +exact (Rmin_Rgt_l r1 r2 r). +exact (Rmin_Rgt_r r1 r2 r). +Qed. + +(*********) +Lemma Rmin_l : forall x y:R, Rmin x y <= x. +intros; unfold Rmin in |- *; case (Rle_dec x y); intro H1; + [ right; reflexivity | auto with real ]. +Qed. + +(*********) +Lemma Rmin_r : forall x y:R, Rmin x y <= y. +intros; unfold Rmin in |- *; case (Rle_dec x y); intro H1; + [ assumption | auto with real ]. +Qed. + +(*********) +Lemma Rmin_comm : forall a b:R, Rmin a b = Rmin b a. +intros; unfold Rmin in |- *; case (Rle_dec a b); case (Rle_dec b a); intros; + try reflexivity || (apply Rle_antisym; assumption || auto with real). +Qed. + +(*********) +Lemma Rmin_stable_in_posreal : forall x y:posreal, 0 < Rmin x y. +intros; apply Rmin_Rgt_r; split; [ apply (cond_pos x) | apply (cond_pos y) ]. +Qed. + +(*******************************) +(** Rmax *) +(*******************************) + +(*********) +Definition Rmax (x y:R) : R := + match Rle_dec x y with + | left _ => y + | right _ => x + end. + +(*********) +Lemma Rmax_Rle : forall r1 r2 r, r <= Rmax r1 r2 <-> r <= r1 \/ r <= r2. +intros; split. +unfold Rmax in |- *; case (Rle_dec r1 r2); intros; auto. +intro; unfold Rmax in |- *; case (Rle_dec r1 r2); elim H; clear H; intros; + auto. +apply (Rle_trans r r1 r2); auto. +generalize (Rnot_le_lt r1 r2 n); clear n; intro; unfold Rgt in H0; + apply (Rlt_le r r1 (Rle_lt_trans r r2 r1 H H0)). +Qed. + +Lemma RmaxLess1 : forall r1 r2, r1 <= Rmax r1 r2. +intros r1 r2; unfold Rmax in |- *; case (Rle_dec r1 r2); auto with real. +Qed. + +Lemma RmaxLess2 : forall r1 r2, r2 <= Rmax r1 r2. +intros r1 r2; unfold Rmax in |- *; case (Rle_dec r1 r2); auto with real. +Qed. + +Lemma 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 with real. +Qed. + +Lemma RmaxRmult : + forall (p q:R) r, 0 <= r -> Rmax (r * p) (r * q) = r * Rmax p q. +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. + +Lemma Rmax_stable_in_negreal : forall x y:negreal, Rmax x y < 0. +intros; unfold Rmax in |- *; case (Rle_dec x y); intro; + [ apply (cond_neg y) | apply (cond_neg x) ]. +Qed. + +(*******************************) +(** Rabsolu *) +(*******************************) + +(*********) +Lemma Rcase_abs : forall r, {r < 0} + {r >= 0}. +intro; generalize (Rle_dec 0 r); intro X; elim X; intro; clear X. +right; apply (Rle_ge 0 r a). +left; fold (0 > r) in |- *; apply (Rnot_le_lt 0 r b). +Qed. + +(*********) +Definition Rabs r : R := + match Rcase_abs r with + | left _ => - r + | right _ => r + end. + +(*********) +Lemma Rabs_R0 : Rabs 0 = 0. +unfold Rabs in |- *; case (Rcase_abs 0); auto; intro. +generalize (Rlt_irrefl 0); intro; elimtype False; auto. +Qed. + +Lemma Rabs_R1 : Rabs 1 = 1. +unfold Rabs in |- *; case (Rcase_abs 1); auto with real. +intros H; absurd (1 < 0); auto with real. +Qed. + +(*********) +Lemma Rabs_no_R0 : forall r, r <> 0 -> Rabs r <> 0. +intros; unfold Rabs in |- *; case (Rcase_abs r); intro; auto. +apply Ropp_neq_0_compat; auto. +Qed. + +(*********) +Lemma Rabs_left : forall r, r < 0 -> Rabs r = - r. +intros; unfold Rabs in |- *; case (Rcase_abs r); trivial; intro; + absurd (r >= 0). +exact (Rlt_not_ge r 0 H). +assumption. +Qed. + +(*********) +Lemma Rabs_right : forall r, r >= 0 -> Rabs r = r. +intros; unfold Rabs in |- *; case (Rcase_abs r); intro. +absurd (r >= 0). +exact (Rlt_not_ge r 0 r0). +assumption. +trivial. +Qed. + +Lemma Rabs_left1 : forall a:R, a <= 0 -> Rabs a = - a. +intros a H; case H; intros H1. +apply Rabs_left; auto. +rewrite H1; simpl in |- *; rewrite Rabs_right; auto with real. +Qed. + +(*********) +Lemma Rabs_pos : forall x:R, 0 <= Rabs x. +intros; unfold Rabs in |- *; case (Rcase_abs x); intro. +generalize (Ropp_lt_gt_contravar x 0 r); intro; unfold Rgt in H; + rewrite Ropp_0 in H; unfold Rle in |- *; left; assumption. +apply Rge_le; assumption. +Qed. + +Lemma RRle_abs : forall x:R, x <= Rabs x. +intro; unfold Rabs in |- *; case (Rcase_abs x); intros; fourier. +Qed. + +(*********) +Lemma Rabs_pos_eq : forall x:R, 0 <= x -> Rabs x = x. +intros; unfold Rabs in |- *; case (Rcase_abs x); intro; + [ generalize (Rgt_not_le 0 x r); intro; elimtype False; auto | trivial ]. +Qed. + +(*********) +Lemma Rabs_Rabsolu : forall x:R, Rabs (Rabs x) = Rabs x. +intro; apply (Rabs_pos_eq (Rabs x) (Rabs_pos x)). +Qed. + +(*********) +Lemma Rabs_pos_lt : forall x:R, x <> 0 -> 0 < Rabs x. +intros; generalize (Rabs_pos x); intro; unfold Rle in H0; elim H0; intro; + auto. +elimtype False; clear H0; elim H; clear H; generalize H1; unfold Rabs in |- *; + case (Rcase_abs x); intros; auto. +clear r H1; generalize (Rplus_eq_compat_l x 0 (- x) H0); + rewrite (let (H1, H2) := Rplus_ne x in H1); rewrite (Rplus_opp_r x); + trivial. +Qed. + +(*********) +Lemma Rabs_minus_sym : forall x y:R, Rabs (x - y) = Rabs (y - x). +intros; unfold Rabs in |- *; case (Rcase_abs (x - y)); + case (Rcase_abs (y - x)); intros. + generalize (Rminus_lt y x r); generalize (Rminus_lt x y r0); intros; + generalize (Rlt_asym x y H); intro; elimtype False; + auto. +rewrite (Ropp_minus_distr x y); trivial. +rewrite (Ropp_minus_distr y x); trivial. +unfold Rge in r, r0; elim r; elim r0; intros; clear r r0. +generalize (Ropp_lt_gt_0_contravar (x - y) H); rewrite (Ropp_minus_distr x y); + intro; unfold Rgt in H0; generalize (Rlt_asym 0 (y - x) H0); + intro; elimtype False; auto. +rewrite (Rminus_diag_uniq x y H); trivial. +rewrite (Rminus_diag_uniq y x H0); trivial. +rewrite (Rminus_diag_uniq y x H0); trivial. +Qed. + +(*********) +Lemma Rabs_mult : forall x y:R, Rabs (x * y) = Rabs x * Rabs y. +intros; unfold Rabs in |- *; case (Rcase_abs (x * y)); case (Rcase_abs x); + case (Rcase_abs y); intros; auto. +generalize (Rmult_lt_gt_compat_neg_l y x 0 r r0); intro; + rewrite (Rmult_0_r y) in H; generalize (Rlt_asym (x * y) 0 r1); + intro; unfold Rgt in H; elimtype False; rewrite (Rmult_comm y x) in H; + auto. +rewrite (Ropp_mult_distr_l_reverse x y); trivial. +rewrite (Rmult_comm x (- y)); rewrite (Ropp_mult_distr_l_reverse y x); + rewrite (Rmult_comm x y); trivial. +unfold Rge in r, r0; elim r; elim r0; clear r r0; intros; unfold Rgt in H, H0. +generalize (Rmult_lt_compat_l x 0 y H H0); intro; rewrite (Rmult_0_r x) in H1; + generalize (Rlt_asym (x * y) 0 r1); intro; elimtype False; + auto. +rewrite H in r1; rewrite (Rmult_0_l y) in r1; generalize (Rlt_irrefl 0); + intro; elimtype False; auto. +rewrite H0 in r1; rewrite (Rmult_0_r x) in r1; generalize (Rlt_irrefl 0); + intro; elimtype False; auto. +rewrite H0 in r1; rewrite (Rmult_0_r x) in r1; generalize (Rlt_irrefl 0); + intro; elimtype False; auto. +rewrite (Rmult_opp_opp x y); trivial. +unfold Rge in r, r1; elim r; elim r1; clear r r1; intros; unfold Rgt in H0, H. +generalize (Rmult_lt_compat_l y x 0 H0 r0); intro; + rewrite (Rmult_0_r y) in H1; rewrite (Rmult_comm y x) in H1; + generalize (Rlt_asym (x * y) 0 H1); intro; elimtype False; + auto. +generalize (Rlt_dichotomy_converse x 0 (or_introl (x > 0) r0)); + generalize (Rlt_dichotomy_converse y 0 (or_intror (y < 0) H0)); + intros; generalize (Rmult_integral x y H); intro; + elim H3; intro; elimtype False; auto. +rewrite H0 in H; rewrite (Rmult_0_r x) in H; unfold Rgt in H; + generalize (Rlt_irrefl 0); intro; elimtype False; + auto. +rewrite H0; rewrite (Rmult_0_r x); rewrite (Rmult_0_r (- x)); trivial. +unfold Rge in r0, r1; elim r0; elim r1; clear r0 r1; intros; + unfold Rgt in H0, H. +generalize (Rmult_lt_compat_l x y 0 H0 r); intro; rewrite (Rmult_0_r x) in H1; + generalize (Rlt_asym (x * y) 0 H1); intro; elimtype False; + auto. +generalize (Rlt_dichotomy_converse y 0 (or_introl (y > 0) r)); + generalize (Rlt_dichotomy_converse 0 x (or_introl (0 > x) H0)); + intros; generalize (Rmult_integral x y H); intro; + elim H3; intro; elimtype False; auto. +rewrite H0 in H; rewrite (Rmult_0_l y) in H; unfold Rgt in H; + generalize (Rlt_irrefl 0); intro; elimtype False; + auto. +rewrite H0; rewrite (Rmult_0_l y); rewrite (Rmult_0_l (- y)); trivial. +Qed. + +(*********) +Lemma Rabs_Rinv : forall r, r <> 0 -> Rabs (/ r) = / Rabs r. +intro; unfold Rabs in |- *; case (Rcase_abs r); case (Rcase_abs (/ r)); auto; + intros. +apply Ropp_inv_permute; auto. +generalize (Rinv_lt_0_compat r r1); intro; unfold Rge in r0; elim r0; intros. +unfold Rgt in H1; generalize (Rlt_asym 0 (/ r) H1); intro; elimtype False; + auto. +generalize (Rlt_dichotomy_converse (/ r) 0 (or_introl (/ r > 0) H0)); intro; + elimtype False; auto. +unfold Rge in r1; elim r1; clear r1; intro. +unfold Rgt in H0; generalize (Rlt_asym 0 (/ r) (Rinv_0_lt_compat r H0)); + intro; elimtype False; auto. +elimtype False; auto. +Qed. + +Lemma Rabs_Ropp : forall x:R, Rabs (- x) = Rabs x. +intro; cut (- x = -1 * x). +intros; rewrite H. +rewrite Rabs_mult. +cut (Rabs (-1) = 1). +intros; rewrite H0. +ring. +unfold Rabs in |- *; case (Rcase_abs (-1)). +intro; ring. +intro H0; generalize (Rge_le (-1) 0 H0); intros. +generalize (Ropp_le_ge_contravar 0 (-1) H1). +rewrite Ropp_involutive; rewrite Ropp_0. +intro; generalize (Rgt_not_le 1 0 Rlt_0_1); intro; generalize (Rge_le 0 1 H2); + intro; elimtype False; auto. +ring. +Qed. + +(*********) +Lemma Rabs_triang : forall a b:R, Rabs (a + b) <= Rabs a + Rabs b. +intros a b; unfold Rabs in |- *; case (Rcase_abs (a + b)); case (Rcase_abs a); + case (Rcase_abs b); intros. +apply (Req_le (- (a + b)) (- a + - b)); rewrite (Ropp_plus_distr a b); + reflexivity. +(**) +rewrite (Ropp_plus_distr a b); apply (Rplus_le_compat_l (- a) (- b) b); + unfold Rle in |- *; unfold Rge in r; elim r; intro. +left; unfold Rgt in H; generalize (Rplus_lt_compat_l (- b) 0 b H); intro; + elim (Rplus_ne (- b)); intros v w; rewrite v in H0; + clear v w; rewrite (Rplus_opp_l b) in H0; apply (Rlt_trans (- b) 0 b H0 H). +right; rewrite H; apply Ropp_0. +(**) +rewrite (Ropp_plus_distr a b); rewrite (Rplus_comm (- a) (- b)); + rewrite (Rplus_comm a (- b)); apply (Rplus_le_compat_l (- b) (- a) a); + unfold Rle in |- *; unfold Rge in r0; elim r0; intro. +left; unfold Rgt in H; generalize (Rplus_lt_compat_l (- a) 0 a H); intro; + elim (Rplus_ne (- a)); intros v w; rewrite v in H0; + clear v w; rewrite (Rplus_opp_l a) in H0; apply (Rlt_trans (- a) 0 a H0 H). +right; rewrite H; apply Ropp_0. +(**) +elimtype False; generalize (Rplus_ge_compat_l a b 0 r); intro; + elim (Rplus_ne a); intros v w; rewrite v in H; clear v w; + generalize (Rge_trans (a + b) a 0 H r0); intro; clear H; + unfold Rge in H0; elim H0; intro; clear H0. +unfold Rgt in H; generalize (Rlt_asym (a + b) 0 r1); intro; auto. +absurd (a + b = 0); auto. +apply (Rlt_dichotomy_converse (a + b) 0); left; assumption. +(**) +elimtype False; generalize (Rplus_lt_compat_l a b 0 r); intro; + elim (Rplus_ne a); intros v w; rewrite v in H; clear v w; + generalize (Rlt_trans (a + b) a 0 H r0); intro; clear H; + unfold Rge in r1; elim r1; clear r1; intro. +unfold Rgt in H; generalize (Rlt_trans (a + b) 0 (a + b) H0 H); intro; + apply (Rlt_irrefl (a + b)); assumption. +rewrite H in H0; apply (Rlt_irrefl 0); assumption. +(**) +rewrite (Rplus_comm a b); rewrite (Rplus_comm (- a) b); + apply (Rplus_le_compat_l b a (- a)); apply (Rminus_le a (- a)); + unfold Rminus in |- *; rewrite (Ropp_involutive a); + generalize (Rplus_lt_compat_l a a 0 r0); clear r r1; + intro; elim (Rplus_ne a); intros v w; rewrite v in H; + clear v w; generalize (Rlt_trans (a + a) a 0 H r0); + intro; apply (Rlt_le (a + a) 0 H0). +(**) +apply (Rplus_le_compat_l a b (- b)); apply (Rminus_le b (- b)); + unfold Rminus in |- *; rewrite (Ropp_involutive b); + generalize (Rplus_lt_compat_l b b 0 r); clear r0 r1; + intro; elim (Rplus_ne b); intros v w; rewrite v in H; + clear v w; generalize (Rlt_trans (b + b) b 0 H r); + intro; apply (Rlt_le (b + b) 0 H0). +(**) +unfold Rle in |- *; right; reflexivity. +Qed. + +(*********) +Lemma Rabs_triang_inv : forall a b:R, Rabs a - Rabs b <= Rabs (a - b). +intros; apply (Rplus_le_reg_l (Rabs b) (Rabs a - Rabs b) (Rabs (a - b))); + unfold Rminus in |- *; rewrite <- (Rplus_assoc (Rabs b) (Rabs a) (- Rabs b)); + rewrite (Rplus_comm (Rabs b) (Rabs a)); + rewrite (Rplus_assoc (Rabs a) (Rabs b) (- Rabs b)); + rewrite (Rplus_opp_r (Rabs b)); rewrite (proj1 (Rplus_ne (Rabs a))); + replace (Rabs a) with (Rabs (a + 0)). + rewrite <- (Rplus_opp_r b); rewrite <- (Rplus_assoc a b (- b)); + rewrite (Rplus_comm a b); rewrite (Rplus_assoc b a (- b)). + exact (Rabs_triang b (a + - b)). + rewrite (proj1 (Rplus_ne a)); trivial. +Qed. + +(* ||a|-|b||<=|a-b| *) +Lemma Rabs_triang_inv2 : forall a b:R, Rabs (Rabs a - Rabs b) <= Rabs (a - b). +cut + (forall a b:R, Rabs b <= Rabs a -> Rabs (Rabs a - Rabs b) <= Rabs (a - b)). +intros; destruct (Rtotal_order (Rabs a) (Rabs b)) as [Hlt| [Heq| Hgt]]. +rewrite <- (Rabs_Ropp (Rabs a - Rabs b)); rewrite <- (Rabs_Ropp (a - b)); + do 2 rewrite Ropp_minus_distr. +apply H; left; assumption. +rewrite Heq; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + apply Rabs_pos. +apply H; left; assumption. +intros; replace (Rabs (Rabs a - Rabs b)) with (Rabs a - Rabs b). +apply Rabs_triang_inv. +rewrite (Rabs_right (Rabs a - Rabs b)); + [ reflexivity + | apply Rle_ge; apply Rplus_le_reg_l with (Rabs b); rewrite Rplus_0_r; + replace (Rabs b + (Rabs a - Rabs b)) with (Rabs a); + [ assumption | ring ] ]. +Qed. + +(*********) +Lemma Rabs_def1 : forall x a:R, x < a -> - a < x -> Rabs x < a. +unfold Rabs in |- *; intros; case (Rcase_abs x); intro. +generalize (Ropp_lt_gt_contravar (- a) x H0); unfold Rgt in |- *; + rewrite Ropp_involutive; intro; assumption. +assumption. +Qed. + +(*********) +Lemma Rabs_def2 : forall x a:R, Rabs x < a -> x < a /\ - a < x. +unfold Rabs in |- *; intro x; case (Rcase_abs x); intros. +generalize (Ropp_gt_lt_0_contravar x r); unfold Rgt in |- *; intro; + generalize (Rlt_trans 0 (- x) a H0 H); intro; split. +apply (Rlt_trans x 0 a r H1). +generalize (Ropp_lt_gt_contravar (- x) a H); rewrite (Ropp_involutive x); + unfold Rgt in |- *; trivial. +fold (a > x) in H; generalize (Rgt_ge_trans a x 0 H r); intro; + generalize (Ropp_lt_gt_0_contravar a H0); intro; fold (0 > - a) in |- *; + generalize (Rge_gt_trans x 0 (- a) r H1); unfold Rgt in |- *; + intro; split; assumption. +Qed. + +Lemma RmaxAbs : + forall (p q:R) r, p <= q -> q <= r -> Rabs q <= Rmax (Rabs p) (Rabs 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); auto with real. +apply RmaxLess1; auto. +rewrite (Rabs_left r); auto. +apply Rle_trans with (- p); auto with real. +apply RmaxLess1; auto. +Qed. + +Lemma Rabs_Zabs : forall z:Z, Rabs (IZR z) = IZR (Zabs 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; rewrite Rabs_Ropp. +apply Rabs_right; auto with real zarith. +Qed. +
\ No newline at end of file diff --git a/theories/Reals/Rcomplete.v b/theories/Reals/Rcomplete.v new file mode 100644 index 00000000..dd8379cb --- /dev/null +++ b/theories/Reals/Rcomplete.v @@ -0,0 +1,198 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Rcomplete.v,v 1.10.2.1 2004/07/16 19:31:12 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rfunctions. +Require Import Rseries. +Require Import SeqProp. +Require Import Max. +Open Local Scope R_scope. + +(****************************************************) +(* R is complete : *) +(* Each sequence which satisfies *) +(* the Cauchy's criterion converges *) +(* *) +(* Proof with adjacent sequences (Vn and Wn) *) +(****************************************************) + +Theorem R_complete : + forall Un:nat -> R, Cauchy_crit Un -> sigT (fun l:R => Un_cv Un l). +intros. +set (Vn := sequence_minorant Un (cauchy_min Un H)). +set (Wn := sequence_majorant Un (cauchy_maj Un H)). +assert (H0 := maj_cv Un H). +fold Wn in H0. +assert (H1 := min_cv Un H). +fold Vn in H1. +elim H0; intros. +elim H1; intros. +cut (x = x0). +intros. +apply existT with x. +rewrite <- H2 in p0. +unfold Un_cv in |- *. +intros. +unfold Un_cv in p; unfold Un_cv in p0. +cut (0 < eps / 3). +intro. +elim (p (eps / 3) H4); intros. +elim (p0 (eps / 3) H4); intros. +exists (max x1 x2). +intros. +unfold R_dist in |- *. +apply Rle_lt_trans with (Rabs (Un n - Vn n) + Rabs (Vn n - x)). +replace (Un n - x) with (Un n - Vn n + (Vn n - x)); + [ apply Rabs_triang | ring ]. +apply Rle_lt_trans with (Rabs (Wn n - Vn n) + Rabs (Vn n - x)). +do 2 rewrite <- (Rplus_comm (Rabs (Vn n - x))). +apply Rplus_le_compat_l. +repeat rewrite Rabs_right. +unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- Vn n)); + apply Rplus_le_compat_l. +assert (H8 := Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)). +fold Vn Wn in H8. +elim (H8 n); intros. +assumption. +apply Rle_ge. +unfold Rminus in |- *; apply Rplus_le_reg_l with (Vn n). +rewrite Rplus_0_r. +replace (Vn n + (Wn n + - Vn n)) with (Wn n); [ idtac | ring ]. +assert (H8 := Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)). +fold Vn Wn in H8. +elim (H8 n); intros. +apply Rle_trans with (Un n); assumption. +apply Rle_ge. +unfold Rminus in |- *; apply Rplus_le_reg_l with (Vn n). +rewrite Rplus_0_r. +replace (Vn n + (Un n + - Vn n)) with (Un n); [ idtac | ring ]. +assert (H8 := Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)). +fold Vn Wn in H8. +elim (H8 n); intros. +assumption. +apply Rle_lt_trans with (Rabs (Wn n - x) + Rabs (x - Vn n) + Rabs (Vn n - x)). +do 2 rewrite <- (Rplus_comm (Rabs (Vn n - x))). +apply Rplus_le_compat_l. +replace (Wn n - Vn n) with (Wn n - x + (x - Vn n)); + [ apply Rabs_triang | ring ]. +apply Rlt_le_trans with (eps / 3 + eps / 3 + eps / 3). +repeat apply Rplus_lt_compat. +unfold R_dist in H5. +apply H5. +unfold ge in |- *; apply le_trans with (max x1 x2). +apply le_max_l. +assumption. +rewrite <- Rabs_Ropp. +replace (- (x - Vn n)) with (Vn n - x); [ idtac | ring ]. +unfold R_dist in H6. +apply H6. +unfold ge in |- *; apply le_trans with (max x1 x2). +apply le_max_r. +assumption. +unfold R_dist in H6. +apply H6. +unfold ge in |- *; apply le_trans with (max x1 x2). +apply le_max_r. +assumption. +right. +pattern eps at 4 in |- *; replace eps with (3 * (eps / 3)). +ring. +unfold Rdiv in |- *; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m; discrR. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +apply cond_eq. +intros. +cut (0 < eps / 5). +intro. +unfold Un_cv in p; unfold Un_cv in p0. +unfold R_dist in p; unfold R_dist in p0. +elim (p (eps / 5) H3); intros N1 H4. +elim (p0 (eps / 5) H3); intros N2 H5. +unfold Cauchy_crit in H. +unfold R_dist in H. +elim (H (eps / 5) H3); intros N3 H6. +set (N := max (max N1 N2) N3). +apply Rle_lt_trans with (Rabs (x - Wn N) + Rabs (Wn N - x0)). +replace (x - x0) with (x - Wn N + (Wn N - x0)); [ apply Rabs_triang | ring ]. +apply Rle_lt_trans with + (Rabs (x - Wn N) + Rabs (Wn N - Vn N) + Rabs (Vn N - x0)). +rewrite Rplus_assoc. +apply Rplus_le_compat_l. +replace (Wn N - x0) with (Wn N - Vn N + (Vn N - x0)); + [ apply Rabs_triang | ring ]. +replace eps with (eps / 5 + 3 * (eps / 5) + eps / 5). +repeat apply Rplus_lt_compat. +rewrite <- Rabs_Ropp. +replace (- (x - Wn N)) with (Wn N - x); [ apply H4 | ring ]. +unfold ge, N in |- *. +apply le_trans with (max N1 N2); apply le_max_l. +unfold Wn, Vn in |- *. +unfold sequence_majorant, sequence_minorant in |- *. +assert + (H7 := + approx_maj (fun k:nat => Un (N + k)%nat) (maj_ss Un N (cauchy_maj Un H))). +assert + (H8 := + approx_min (fun k:nat => Un (N + k)%nat) (min_ss Un N (cauchy_min Un H))). +cut + (Wn N = + majorant (fun k:nat => Un (N + k)%nat) (maj_ss Un N (cauchy_maj Un H))). +cut + (Vn N = + minorant (fun k:nat => Un (N + k)%nat) (min_ss Un N (cauchy_min Un H))). +intros. +rewrite <- H9; rewrite <- H10. +rewrite <- H9 in H8. +rewrite <- H10 in H7. +elim (H7 (eps / 5) H3); intros k2 H11. +elim (H8 (eps / 5) H3); intros k1 H12. +apply Rle_lt_trans with + (Rabs (Wn N - Un (N + k2)%nat) + Rabs (Un (N + k2)%nat - Vn N)). +replace (Wn N - Vn N) with + (Wn N - Un (N + k2)%nat + (Un (N + k2)%nat - Vn N)); + [ apply Rabs_triang | ring ]. +apply Rle_lt_trans with + (Rabs (Wn N - Un (N + k2)%nat) + Rabs (Un (N + k2)%nat - Un (N + k1)%nat) + + Rabs (Un (N + k1)%nat - Vn N)). +rewrite Rplus_assoc. +apply Rplus_le_compat_l. +replace (Un (N + k2)%nat - Vn N) with + (Un (N + k2)%nat - Un (N + k1)%nat + (Un (N + k1)%nat - Vn N)); + [ apply Rabs_triang | ring ]. +replace (3 * (eps / 5)) with (eps / 5 + eps / 5 + eps / 5); + [ repeat apply Rplus_lt_compat | ring ]. +assumption. +apply H6. +unfold ge in |- *. +apply le_trans with N. +unfold N in |- *; apply le_max_r. +apply le_plus_l. +unfold ge in |- *. +apply le_trans with N. +unfold N in |- *; apply le_max_r. +apply le_plus_l. +rewrite <- Rabs_Ropp. +replace (- (Un (N + k1)%nat - Vn N)) with (Vn N - Un (N + k1)%nat); + [ assumption | ring ]. +reflexivity. +reflexivity. +apply H5. +unfold ge in |- *; apply le_trans with (max N1 N2). +apply le_max_r. +unfold N in |- *; apply le_max_l. +pattern eps at 4 in |- *; replace eps with (5 * (eps / 5)). +ring. +unfold Rdiv in |- *; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m. +discrR. +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +assumption. +apply Rinv_0_lt_compat. +prove_sup0; try apply lt_O_Sn. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Rdefinitions.v b/theories/Reals/Rdefinitions.v new file mode 100644 index 00000000..33f494df --- /dev/null +++ b/theories/Reals/Rdefinitions.v @@ -0,0 +1,69 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) +(*i $Id: Rdefinitions.v,v 1.14.2.1 2004/07/16 19:31:12 herbelin Exp $ i*) + + +(*********************************************************) +(** Definitions for the axiomatization *) +(* *) +(*********************************************************) + +Require Export ZArith_base. + +Parameter R : Set. + +(* Declare Scope positive_scope with Key R *) +Delimit Scope R_scope with R. + +(* Automatically open scope R_scope for arguments of type R *) +Bind Scope R_scope with R. + +Parameter R0 : R. +Parameter R1 : R. +Parameter Rplus : R -> R -> R. +Parameter Rmult : R -> R -> R. +Parameter Ropp : R -> R. +Parameter Rinv : R -> R. +Parameter Rlt : R -> R -> Prop. +Parameter up : R -> Z. + +Infix "+" := Rplus : R_scope. +Infix "*" := Rmult : R_scope. +Notation "- x" := (Ropp x) : R_scope. +Notation "/ x" := (Rinv x) : R_scope. + +Infix "<" := Rlt : R_scope. + +(*i*******************************************************i*) + +(**********) +Definition Rgt (r1 r2:R) : Prop := (r2 < r1)%R. + +(**********) +Definition Rle (r1 r2:R) : Prop := (r1 < r2)%R \/ r1 = r2. + +(**********) +Definition Rge (r1 r2:R) : Prop := Rgt r1 r2 \/ r1 = r2. + +(**********) +Definition Rminus (r1 r2:R) : R := (r1 + - r2)%R. + +(**********) +Definition Rdiv (r1 r2:R) : R := (r1 * / r2)%R. + +Infix "-" := Rminus : R_scope. +Infix "/" := Rdiv : R_scope. + +Infix "<=" := Rle : R_scope. +Infix ">=" := Rge : R_scope. +Infix ">" := Rgt : R_scope. + +Notation "x <= y <= z" := ((x <= y)%R /\ (y <= z)%R) : R_scope. +Notation "x <= y < z" := ((x <= y)%R /\ (y < z)%R) : R_scope. +Notation "x < y < z" := ((x < y)%R /\ (y < z)%R) : R_scope. +Notation "x < y <= z" := ((x < y)%R /\ (y <= z)%R) : R_scope.
\ No newline at end of file diff --git a/theories/Reals/Rderiv.v b/theories/Reals/Rderiv.v new file mode 100644 index 00000000..81db80ab --- /dev/null +++ b/theories/Reals/Rderiv.v @@ -0,0 +1,431 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Rderiv.v,v 1.15.2.1 2004/07/16 19:31:12 herbelin Exp $ i*) + +(*********************************************************) +(** Definition of the derivative,continuity *) +(* *) +(*********************************************************) + +Require Import Rbase. +Require Import Rfunctions. +Require Import Rlimit. +Require Import Fourier. +Require Import Classical_Prop. +Require Import Classical_Pred_Type. +Require Import Omega. Open Local Scope R_scope. + +(*********) +Definition D_x (D:R -> Prop) (y x:R) : Prop := D x /\ y <> x. + +(*********) +Definition continue_in (f:R -> R) (D:R -> Prop) (x0:R) : Prop := + limit1_in f (D_x D x0) (f x0) x0. + +(*********) +Definition D_in (f d:R -> R) (D:R -> Prop) (x0:R) : Prop := + limit1_in (fun x:R => (f x - f x0) / (x - x0)) (D_x D x0) (d x0) x0. + +(*********) +Lemma cont_deriv : + forall (f d:R -> R) (D:R -> Prop) (x0:R), + D_in f d D x0 -> continue_in f D x0. +unfold continue_in in |- *; unfold D_in in |- *; unfold limit1_in in |- *; + unfold limit_in in |- *; unfold Rdiv in |- *; simpl in |- *; + intros; elim (H eps H0); clear H; intros; elim H; + clear H; intros; elim (Req_dec (d x0) 0); intro. +split with (Rmin 1 x); split. +elim (Rmin_Rgt 1 x 0); intros a b; apply (b (conj Rlt_0_1 H)). +intros; elim H3; clear H3; intros; + generalize (let (H1, H2) := Rmin_Rgt 1 x (R_dist x1 x0) in H1); + unfold Rgt in |- *; intro; elim (H5 H4); clear H5; + intros; generalize (H1 x1 (conj H3 H6)); clear H1; + intro; unfold D_x in H3; elim H3; intros. +rewrite H2 in H1; unfold R_dist in |- *; unfold R_dist in H1; + cut (Rabs (f x1 - f x0) < eps * Rabs (x1 - x0)). +intro; unfold R_dist in H5; + generalize (Rmult_lt_compat_l eps (Rabs (x1 - x0)) 1 H0 H5); + rewrite Rmult_1_r; intro; apply Rlt_trans with (r2 := eps * Rabs (x1 - x0)); + assumption. +rewrite (Rminus_0_r ((f x1 - f x0) * / (x1 - x0))) in H1; + rewrite Rabs_mult in H1; cut (x1 - x0 <> 0). +intro; rewrite (Rabs_Rinv (x1 - x0) H9) in H1; + generalize + (Rmult_lt_compat_l (Rabs (x1 - x0)) (Rabs (f x1 - f x0) * / Rabs (x1 - x0)) + eps (Rabs_pos_lt (x1 - x0) H9) H1); intro; rewrite Rmult_comm in H10; + rewrite Rmult_assoc in H10; rewrite Rinv_l in H10. +rewrite Rmult_1_r in H10; rewrite Rmult_comm; assumption. +apply Rabs_no_R0; auto. +apply Rminus_eq_contra; auto. +(**) + split with (Rmin (Rmin (/ 2) x) (eps * / Rabs (2 * d x0))); split. +cut (Rmin (/ 2) x > 0). +cut (eps * / Rabs (2 * d x0) > 0). +intros; elim (Rmin_Rgt (Rmin (/ 2) x) (eps * / Rabs (2 * d x0)) 0); + intros a b; apply (b (conj H4 H3)). +apply Rmult_gt_0_compat; auto. +unfold Rgt in |- *; apply Rinv_0_lt_compat; apply Rabs_pos_lt; + apply Rmult_integral_contrapositive; split. +discrR. +assumption. +elim (Rmin_Rgt (/ 2) x 0); intros a b; cut (0 < 2). +intro; generalize (Rinv_0_lt_compat 2 H3); intro; fold (/ 2 > 0) in H4; + apply (b (conj H4 H)). +fourier. +intros; elim H3; clear H3; intros; + generalize + (let (H1, H2) := + Rmin_Rgt (Rmin (/ 2) x) (eps * / Rabs (2 * d x0)) (R_dist x1 x0) in + H1); unfold Rgt in |- *; intro; elim (H5 H4); clear H5; + intros; generalize (let (H1, H2) := Rmin_Rgt (/ 2) x (R_dist x1 x0) in H1); + unfold Rgt in |- *; intro; elim (H7 H5); clear H7; + intros; clear H4 H5; generalize (H1 x1 (conj H3 H8)); + clear H1; intro; unfold D_x in H3; elim H3; intros; + generalize (sym_not_eq H5); clear H5; intro H5; + generalize (Rminus_eq_contra x1 x0 H5); intro; generalize H1; + pattern (d x0) at 1 in |- *; + rewrite <- (let (H1, H2) := Rmult_ne (d x0) in H2); + rewrite <- (Rinv_l (x1 - x0) H9); unfold R_dist in |- *; + unfold Rminus at 1 in |- *; rewrite (Rmult_comm (f x1 - f x0) (/ (x1 - x0))); + rewrite (Rmult_comm (/ (x1 - x0) * (x1 - x0)) (d x0)); + rewrite <- (Ropp_mult_distr_l_reverse (d x0) (/ (x1 - x0) * (x1 - x0))); + rewrite (Rmult_comm (- d x0) (/ (x1 - x0) * (x1 - x0))); + rewrite (Rmult_assoc (/ (x1 - x0)) (x1 - x0) (- d x0)); + rewrite <- + (Rmult_plus_distr_l (/ (x1 - x0)) (f x1 - f x0) ((x1 - x0) * - d x0)) + ; rewrite (Rabs_mult (/ (x1 - x0)) (f x1 - f x0 + (x1 - x0) * - d x0)); + clear H1; intro; + generalize + (Rmult_lt_compat_l (Rabs (x1 - x0)) + (Rabs (/ (x1 - x0)) * Rabs (f x1 - f x0 + (x1 - x0) * - d x0)) eps + (Rabs_pos_lt (x1 - x0) H9) H1); + rewrite <- + (Rmult_assoc (Rabs (x1 - x0)) (Rabs (/ (x1 - x0))) + (Rabs (f x1 - f x0 + (x1 - x0) * - d x0))); + rewrite (Rabs_Rinv (x1 - x0) H9); + rewrite (Rinv_r (Rabs (x1 - x0)) (Rabs_no_R0 (x1 - x0) H9)); + rewrite + (let (H1, H2) := Rmult_ne (Rabs (f x1 - f x0 + (x1 - x0) * - d x0)) in H2) + ; generalize (Rabs_triang_inv (f x1 - f x0) ((x1 - x0) * d x0)); + intro; rewrite (Rmult_comm (x1 - x0) (- d x0)); + rewrite (Ropp_mult_distr_l_reverse (d x0) (x1 - x0)); + fold (f x1 - f x0 - d x0 * (x1 - x0)) in |- *; + rewrite (Rmult_comm (x1 - x0) (d x0)) in H10; clear H1; + intro; + generalize + (Rle_lt_trans (Rabs (f x1 - f x0) - Rabs (d x0 * (x1 - x0))) + (Rabs (f x1 - f x0 - d x0 * (x1 - x0))) (Rabs (x1 - x0) * eps) H10 H1); + clear H1; intro; + generalize + (Rplus_lt_compat_l (Rabs (d x0 * (x1 - x0))) + (Rabs (f x1 - f x0) - Rabs (d x0 * (x1 - x0))) ( + Rabs (x1 - x0) * eps) H1); unfold Rminus at 2 in |- *; + rewrite (Rplus_comm (Rabs (f x1 - f x0)) (- Rabs (d x0 * (x1 - x0)))); + rewrite <- + (Rplus_assoc (Rabs (d x0 * (x1 - x0))) (- Rabs (d x0 * (x1 - x0))) + (Rabs (f x1 - f x0))); rewrite (Rplus_opp_r (Rabs (d x0 * (x1 - x0)))); + rewrite (let (H1, H2) := Rplus_ne (Rabs (f x1 - f x0)) in H2); + clear H1; intro; cut (Rabs (d x0 * (x1 - x0)) + Rabs (x1 - x0) * eps < eps). +intro; + apply + (Rlt_trans (Rabs (f x1 - f x0)) + (Rabs (d x0 * (x1 - x0)) + Rabs (x1 - x0) * eps) eps H1 H11). +clear H1 H5 H3 H10; generalize (Rabs_pos_lt (d x0) H2); intro; + unfold Rgt in H0; + generalize (Rmult_lt_compat_l eps (R_dist x1 x0) (/ 2) H0 H7); + clear H7; intro; + generalize + (Rmult_lt_compat_l (Rabs (d x0)) (R_dist x1 x0) ( + eps * / Rabs (2 * d x0)) H1 H6); clear H6; intro; + rewrite (Rmult_comm eps (R_dist x1 x0)) in H3; unfold R_dist in H3, H5; + rewrite <- (Rabs_mult (d x0) (x1 - x0)) in H5; + rewrite (Rabs_mult 2 (d x0)) in H5; cut (Rabs 2 <> 0). +intro; fold (Rabs (d x0) > 0) in H1; + rewrite + (Rinv_mult_distr (Rabs 2) (Rabs (d x0)) H6 + (Rlt_dichotomy_converse (Rabs (d x0)) 0 (or_intror (Rabs (d x0) < 0) H1))) + in H5; + rewrite (Rmult_comm (Rabs (d x0)) (eps * (/ Rabs 2 * / Rabs (d x0)))) in H5; + rewrite <- (Rmult_assoc eps (/ Rabs 2) (/ Rabs (d x0))) in H5; + rewrite (Rmult_assoc (eps * / Rabs 2) (/ Rabs (d x0)) (Rabs (d x0))) in H5; + rewrite + (Rinv_l (Rabs (d x0)) + (Rlt_dichotomy_converse (Rabs (d x0)) 0 (or_intror (Rabs (d x0) < 0) H1))) + in H5; rewrite (let (H1, H2) := Rmult_ne (eps * / Rabs 2) in H1) in H5; + cut (Rabs 2 = 2). +intro; rewrite H7 in H5; + generalize + (Rplus_lt_compat (Rabs (d x0 * (x1 - x0))) (eps * / 2) + (Rabs (x1 - x0) * eps) (eps * / 2) H5 H3); intro; + rewrite eps2 in H10; assumption. +unfold Rabs in |- *; case (Rcase_abs 2); auto. + intro; cut (0 < 2). +intro; generalize (Rlt_asym 0 2 H7); intro; elimtype False; auto. +fourier. +apply Rabs_no_R0. +discrR. +Qed. + + +(*********) +Lemma Dconst : + forall (D:R -> Prop) (y x0:R), D_in (fun x:R => y) (fun x:R => 0) D x0. +unfold D_in in |- *; intros; unfold limit1_in in |- *; + unfold limit_in in |- *; unfold Rdiv in |- *; intros; + simpl in |- *; split with eps; split; auto. +intros; rewrite (Rminus_diag_eq y y (refl_equal y)); rewrite Rmult_0_l; + unfold R_dist in |- *; rewrite (Rminus_diag_eq 0 0 (refl_equal 0)); + unfold Rabs in |- *; case (Rcase_abs 0); intro. +absurd (0 < 0); auto. +red in |- *; intro; apply (Rlt_irrefl 0 H1). +unfold Rgt in H0; assumption. +Qed. + +(*********) +Lemma Dx : + forall (D:R -> Prop) (x0:R), D_in (fun x:R => x) (fun x:R => 1) D x0. +unfold D_in in |- *; unfold Rdiv in |- *; intros; unfold limit1_in in |- *; + unfold limit_in in |- *; intros; simpl in |- *; split with eps; + split; auto. +intros; elim H0; clear H0; intros; unfold D_x in H0; elim H0; intros; + rewrite (Rinv_r (x - x0) (Rminus_eq_contra x x0 (sym_not_eq H3))); + unfold R_dist in |- *; rewrite (Rminus_diag_eq 1 1 (refl_equal 1)); + unfold Rabs in |- *; case (Rcase_abs 0); intro. +absurd (0 < 0); auto. +red in |- *; intro; apply (Rlt_irrefl 0 r). +unfold Rgt in H; assumption. +Qed. + +(*********) +Lemma Dadd : + forall (D:R -> Prop) (df dg f g:R -> R) (x0:R), + D_in f df D x0 -> + D_in g dg D x0 -> + D_in (fun x:R => f x + g x) (fun x:R => df x + dg x) D x0. +unfold D_in in |- *; intros; + generalize + (limit_plus (fun x:R => (f x - f x0) * / (x - x0)) + (fun x:R => (g x - g x0) * / (x - x0)) (D_x D x0) ( + df x0) (dg x0) x0 H H0); clear H H0; unfold limit1_in in |- *; + unfold limit_in in |- *; simpl in |- *; intros; elim (H eps H0); + clear H; intros; elim H; clear H; intros; split with x; + split; auto; intros; generalize (H1 x1 H2); clear H1; + intro; rewrite (Rmult_comm (f x1 - f x0) (/ (x1 - x0))) in H1; + rewrite (Rmult_comm (g x1 - g x0) (/ (x1 - x0))) in H1; + rewrite <- (Rmult_plus_distr_l (/ (x1 - x0)) (f x1 - f x0) (g x1 - g x0)) + in H1; + rewrite (Rmult_comm (/ (x1 - x0)) (f x1 - f x0 + (g x1 - g x0))) in H1; + cut (f x1 - f x0 + (g x1 - g x0) = f x1 + g x1 - (f x0 + g x0)). +intro; rewrite H3 in H1; assumption. +ring. +Qed. + +(*********) +Lemma Dmult : + forall (D:R -> Prop) (df dg f g:R -> R) (x0:R), + D_in f df D x0 -> + D_in g dg D x0 -> + D_in (fun x:R => f x * g x) (fun x:R => df x * g x + f x * dg x) D x0. +intros; unfold D_in in |- *; generalize H H0; intros; unfold D_in in H, H0; + generalize (cont_deriv f df D x0 H1); unfold continue_in in |- *; + intro; + generalize + (limit_mul (fun x:R => (g x - g x0) * / (x - x0)) ( + fun x:R => f x) (D_x D x0) (dg x0) (f x0) x0 H0 H3); + intro; cut (limit1_in (fun x:R => g x0) (D_x D x0) (g x0) x0). +intro; + generalize + (limit_mul (fun x:R => (f x - f x0) * / (x - x0)) ( + fun _:R => g x0) (D_x D x0) (df x0) (g x0) x0 H H5); + clear H H0 H1 H2 H3 H5; intro; + generalize + (limit_plus (fun x:R => (f x - f x0) * / (x - x0) * g x0) + (fun x:R => (g x - g x0) * / (x - x0) * f x) ( + D_x D x0) (df x0 * g x0) (dg x0 * f x0) x0 H H4); + clear H4 H; intro; unfold limit1_in in H; unfold limit_in in H; + simpl in H; unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; intros; elim (H eps H0); clear H; intros; + elim H; clear H; intros; split with x; split; auto; + intros; generalize (H1 x1 H2); clear H1; intro; + rewrite (Rmult_comm (f x1 - f x0) (/ (x1 - x0))) in H1; + rewrite (Rmult_comm (g x1 - g x0) (/ (x1 - x0))) in H1; + rewrite (Rmult_assoc (/ (x1 - x0)) (f x1 - f x0) (g x0)) in H1; + rewrite (Rmult_assoc (/ (x1 - x0)) (g x1 - g x0) (f x1)) in H1; + rewrite <- + (Rmult_plus_distr_l (/ (x1 - x0)) ((f x1 - f x0) * g x0) + ((g x1 - g x0) * f x1)) in H1; + rewrite + (Rmult_comm (/ (x1 - x0)) ((f x1 - f x0) * g x0 + (g x1 - g x0) * f x1)) + in H1; rewrite (Rmult_comm (dg x0) (f x0)) in H1; + cut + ((f x1 - f x0) * g x0 + (g x1 - g x0) * f x1 = f x1 * g x1 - f x0 * g x0). +intro; rewrite H3 in H1; assumption. +ring. +unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros; + split with eps; split; auto; intros; elim (R_dist_refl (g x0) (g x0)); + intros a b; rewrite (b (refl_equal (g x0))); unfold Rgt in H; + assumption. +Qed. + +(*********) +Lemma Dmult_const : + forall (D:R -> Prop) (f df:R -> R) (x0 a:R), + D_in f df D x0 -> D_in (fun x:R => a * f x) (fun x:R => a * df x) D x0. +intros; + generalize (Dmult D (fun _:R => 0) df (fun _:R => a) f x0 (Dconst D a x0) H); + unfold D_in in |- *; intros; rewrite (Rmult_0_l (f x0)) in H0; + rewrite (let (H1, H2) := Rplus_ne (a * df x0) in H2) in H0; + assumption. +Qed. + +(*********) +Lemma Dopp : + forall (D:R -> Prop) (f df:R -> R) (x0:R), + D_in f df D x0 -> D_in (fun x:R => - f x) (fun x:R => - df x) D x0. +intros; generalize (Dmult_const D f df x0 (-1) H); unfold D_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + intros; generalize (H0 eps H1); clear H0; intro; elim H0; + clear H0; intros; elim H0; clear H0; simpl in |- *; + intros; split with x; split; auto. +intros; generalize (H2 x1 H3); clear H2; intro; + rewrite Ropp_mult_distr_l_reverse in H2; + rewrite Ropp_mult_distr_l_reverse in H2; + rewrite Ropp_mult_distr_l_reverse in H2; + rewrite (let (H1, H2) := Rmult_ne (f x1) in H2) in H2; + rewrite (let (H1, H2) := Rmult_ne (f x0) in H2) in H2; + rewrite (let (H1, H2) := Rmult_ne (df x0) in H2) in H2; + assumption. +Qed. + +(*********) +Lemma Dminus : + forall (D:R -> Prop) (df dg f g:R -> R) (x0:R), + D_in f df D x0 -> + D_in g dg D x0 -> + D_in (fun x:R => f x - g x) (fun x:R => df x - dg x) D x0. +unfold Rminus in |- *; intros; generalize (Dopp D g dg x0 H0); intro; + apply (Dadd D df (fun x:R => - dg x) f (fun x:R => - g x) x0); + assumption. +Qed. + +(*********) +Lemma Dx_pow_n : + forall (n:nat) (D:R -> Prop) (x0:R), + D_in (fun x:R => x ^ n) (fun x:R => INR n * x ^ (n - 1)) D x0. +simple induction n; intros. +simpl in |- *; rewrite Rmult_0_l; apply Dconst. +intros; cut (n0 = (S n0 - 1)%nat); + [ intro a; rewrite <- a; clear a | simpl in |- *; apply minus_n_O ]. +generalize + (Dmult D (fun _:R => 1) (fun x:R => INR n0 * x ^ (n0 - 1)) ( + fun x:R => x) (fun x:R => x ^ n0) x0 (Dx D x0) ( + H D x0)); unfold D_in in |- *; unfold limit1_in in |- *; + unfold limit_in in |- *; simpl in |- *; intros; elim (H0 eps H1); + clear H0; intros; elim H0; clear H0; intros; split with x; + split; auto. +intros; generalize (H2 x1 H3); clear H2 H3; intro; + rewrite (let (H1, H2) := Rmult_ne (x0 ^ n0) in H2) in H2; + rewrite (tech_pow_Rmult x1 n0) in H2; rewrite (tech_pow_Rmult x0 n0) in H2; + rewrite (Rmult_comm (INR n0) (x0 ^ (n0 - 1))) in H2; + rewrite <- (Rmult_assoc x0 (x0 ^ (n0 - 1)) (INR n0)) in H2; + rewrite (tech_pow_Rmult x0 (n0 - 1)) in H2; elim (classic (n0 = 0%nat)); + intro cond. +rewrite cond in H2; rewrite cond; simpl in H2; simpl in |- *; + cut (1 + x0 * 1 * 0 = 1 * 1); + [ intro A; rewrite A in H2; assumption | ring ]. +cut (n0 <> 0%nat -> S (n0 - 1) = n0); [ intro | omega ]; + rewrite (H3 cond) in H2; rewrite (Rmult_comm (x0 ^ n0) (INR n0)) in H2; + rewrite (tech_pow_Rplus x0 n0 n0) in H2; assumption. +Qed. + +(*********) +Lemma Dcomp : + forall (Df Dg:R -> Prop) (df dg f g:R -> R) (x0:R), + D_in f df Df x0 -> + D_in g dg Dg (f x0) -> + D_in (fun x:R => g (f x)) (fun x:R => df x * dg (f x)) (Dgf Df Dg f) x0. +intros Df Dg df dg f g x0 H H0; generalize H H0; unfold D_in in |- *; + unfold Rdiv in |- *; intros; + generalize + (limit_comp f (fun x:R => (g x - g (f x0)) * / (x - f x0)) ( + D_x Df x0) (D_x Dg (f x0)) (f x0) (dg (f x0)) x0); + intro; generalize (cont_deriv f df Df x0 H); intro; + unfold continue_in in H4; generalize (H3 H4 H2); clear H3; + intro; + generalize + (limit_mul (fun x:R => (g (f x) - g (f x0)) * / (f x - f x0)) + (fun x:R => (f x - f x0) * / (x - x0)) + (Dgf (D_x Df x0) (D_x Dg (f x0)) f) (dg (f x0)) ( + df x0) x0 H3); intro; + cut + (limit1_in (fun x:R => (f x - f x0) * / (x - x0)) + (Dgf (D_x Df x0) (D_x Dg (f x0)) f) (df x0) x0). +intro; generalize (H5 H6); clear H5; intro; + generalize + (limit_mul (fun x:R => (f x - f x0) * / (x - x0)) ( + fun x:R => dg (f x0)) (D_x Df x0) (df x0) (dg (f x0)) x0 H1 + (limit_free (fun x:R => dg (f x0)) (D_x Df x0) x0 x0)); + intro; unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold limit1_in in H5, H7; unfold limit_in in H5, H7; + simpl in H5, H7; intros; elim (H5 eps H8); elim (H7 eps H8); + clear H5 H7; intros; elim H5; elim H7; clear H5 H7; + intros; split with (Rmin x x1); split. +elim (Rmin_Rgt x x1 0); intros a b; apply (b (conj H9 H5)); clear a b. +intros; elim H11; clear H11; intros; elim (Rmin_Rgt x x1 (R_dist x2 x0)); + intros a b; clear b; unfold Rgt in a; elim (a H12); + clear H5 a; intros; unfold D_x, Dgf in H11, H7, H10; + clear H12; elim (classic (f x2 = f x0)); intro. +elim H11; clear H11; intros; elim H11; clear H11; intros; + generalize (H10 x2 (conj (conj H11 H14) H5)); intro; + rewrite (Rminus_diag_eq (f x2) (f x0) H12) in H16; + rewrite (Rmult_0_l (/ (x2 - x0))) in H16; + rewrite (Rmult_0_l (dg (f x0))) in H16; rewrite H12; + rewrite (Rminus_diag_eq (g (f x0)) (g (f x0)) (refl_equal (g (f x0)))); + rewrite (Rmult_0_l (/ (x2 - x0))); assumption. +clear H10 H5; elim H11; clear H11; intros; elim H5; clear H5; intros; + cut + (((Df x2 /\ x0 <> x2) /\ Dg (f x2) /\ f x0 <> f x2) /\ R_dist x2 x0 < x1); + auto; intro; generalize (H7 x2 H14); intro; + generalize (Rminus_eq_contra (f x2) (f x0) H12); intro; + rewrite + (Rmult_assoc (g (f x2) - g (f x0)) (/ (f x2 - f x0)) + ((f x2 - f x0) * / (x2 - x0))) in H15; + rewrite <- (Rmult_assoc (/ (f x2 - f x0)) (f x2 - f x0) (/ (x2 - x0))) + in H15; rewrite (Rinv_l (f x2 - f x0) H16) in H15; + rewrite (let (H1, H2) := Rmult_ne (/ (x2 - x0)) in H2) in H15; + rewrite (Rmult_comm (df x0) (dg (f x0))); assumption. +clear H5 H3 H4 H2; unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold limit1_in in H1; unfold limit_in in H1; + simpl in H1; intros; elim (H1 eps H2); clear H1; intros; + elim H1; clear H1; intros; split with x; split; auto; + intros; unfold D_x, Dgf in H4, H3; elim H4; clear H4; + intros; elim H4; clear H4; intros; exact (H3 x1 (conj H4 H5)). +Qed. + +(*********) +Lemma D_pow_n : + forall (n:nat) (D:R -> Prop) (x0:R) (expr dexpr:R -> R), + D_in expr dexpr D x0 -> + D_in (fun x:R => expr x ^ n) + (fun x:R => INR n * expr x ^ (n - 1) * dexpr x) ( + Dgf D D expr) x0. +intros n D x0 expr dexpr H; + generalize + (Dcomp D D dexpr (fun x:R => INR n * x ^ (n - 1)) expr ( + fun x:R => x ^ n) x0 H (Dx_pow_n n D (expr x0))); + intro; unfold D_in in |- *; unfold limit1_in in |- *; + unfold limit_in in |- *; simpl in |- *; intros; unfold D_in in H0; + unfold limit1_in in H0; unfold limit_in in H0; simpl in H0; + elim (H0 eps H1); clear H0; intros; elim H0; clear H0; + intros; split with x; split; intros; auto. +cut + (dexpr x0 * (INR n * expr x0 ^ (n - 1)) = + INR n * expr x0 ^ (n - 1) * dexpr x0); + [ intro Rew; rewrite <- Rew; exact (H2 x1 H3) | ring ]. +Qed. diff --git a/theories/Reals/Reals.v b/theories/Reals/Reals.v new file mode 100644 index 00000000..5e4b3e7b --- /dev/null +++ b/theories/Reals/Reals.v @@ -0,0 +1,32 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Reals.v,v 1.24.2.1 2004/07/16 19:31:12 herbelin Exp $ i*) + +(* The library REALS is divided in 6 parts : + - Rbase: basic lemmas on R + equalities and inequalities + Ring and Field are instantiated on R + - Rfunctions: some useful functions (Rabsolu, Rmin, Rmax, fact...) + - SeqSeries: theory of sequences and series + - Rtrigo: theory of trigonometric functions + - Ranalysis: some topology and general results of real analysis (mean value theorem, intermediate value theorem,...) + - Integration: Newton and Riemann' integrals + + Tactics are: + - DiscrR: for goals like ``?1<>0`` + - Sup: for goals like ``?1<?2`` + - RCompute: for equalities with constants like ``10*10==100`` + - Reg: for goals like (continuity_pt ?1 ?2) or (derivable_pt ?1 ?2) *) + +Require Export Rbase. +Require Export Rfunctions. +Require Export SeqSeries. +Require Export Rtrigo. +Require Export Ranalysis. +Require Export Integration.
\ No newline at end of file diff --git a/theories/Reals/Rfunctions.v b/theories/Reals/Rfunctions.v new file mode 100644 index 00000000..cdff9fcb --- /dev/null +++ b/theories/Reals/Rfunctions.v @@ -0,0 +1,801 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Rfunctions.v,v 1.31.2.1 2004/07/16 19:31:12 herbelin Exp $ i*) + +(*i Some properties about pow and sum have been made with John Harrison i*) +(*i Some Lemmas (about pow and powerRZ) have been done by Laurent Thery i*) + +(********************************************************) +(** Definition of the sum functions *) +(* *) +(********************************************************) + +Require Import Rbase. +Require Export R_Ifp. +Require Export Rbasic_fun. +Require Export R_sqr. +Require Export SplitAbsolu. +Require Export SplitRmult. +Require Export ArithProp. +Require Import Omega. +Require Import Zpower. +Open Local Scope nat_scope. +Open Local Scope R_scope. + +(*******************************) +(** Lemmas about factorial *) +(*******************************) +(*********) +Lemma INR_fact_neq_0 : forall n:nat, INR (fact n) <> 0. +Proof. +intro; red in |- *; intro; apply (not_O_INR (fact n) (fact_neq_0 n)); + assumption. +Qed. + +(*********) +Lemma fact_simpl : forall n:nat, fact (S n) = (S n * fact n)%nat. +Proof. +intro; reflexivity. +Qed. + +(*********) +Lemma simpl_fact : + forall n:nat, / INR (fact (S n)) * / / INR (fact n) = / INR (S n). +Proof. +intro; rewrite (Rinv_involutive (INR (fact n)) (INR_fact_neq_0 n)); + unfold fact at 1 in |- *; cbv beta iota in |- *; fold fact in |- *; + rewrite (mult_INR (S n) (fact n)); + rewrite (Rinv_mult_distr (INR (S n)) (INR (fact n))). +rewrite (Rmult_assoc (/ INR (S n)) (/ INR (fact n)) (INR (fact n))); + rewrite (Rinv_l (INR (fact n)) (INR_fact_neq_0 n)); + apply (let (H1, H2) := Rmult_ne (/ INR (S n)) in H1). +apply not_O_INR; auto. +apply INR_fact_neq_0. +Qed. + +(*******************************) +(* Power *) +(*******************************) +(*********) +Fixpoint pow (r:R) (n:nat) {struct n} : R := + match n with + | O => 1 + | S n => r * pow r n + end. + +Infix "^" := pow : R_scope. + +Lemma pow_O : forall x:R, x ^ 0 = 1. +Proof. +reflexivity. +Qed. + +Lemma pow_1 : forall x:R, x ^ 1 = x. +Proof. +simpl in |- *; auto with real. +Qed. + +Lemma pow_add : forall (x:R) (n m:nat), x ^ (n + m) = x ^ n * x ^ m. +Proof. +intros x n; elim n; simpl in |- *; auto with real. +intros n0 H' m; rewrite H'; auto with real. +Qed. + +Lemma pow_nonzero : forall (x:R) (n:nat), x <> 0 -> x ^ n <> 0. +Proof. +intro; simple induction n; simpl in |- *. +intro; red in |- *; intro; apply R1_neq_R0; assumption. +intros; red in |- *; intro; elim (Rmult_integral x (x ^ n0) H1). +intro; auto. +apply H; assumption. +Qed. + +Hint Resolve pow_O pow_1 pow_add pow_nonzero: real. + +Lemma pow_RN_plus : + forall (x:R) (n m:nat), x <> 0 -> x ^ n = x ^ (n + m) * / x ^ m. +Proof. +intros x n; elim n; simpl in |- *; auto with real. +intros n0 H' m H'0. +rewrite Rmult_assoc; rewrite <- H'; auto. +Qed. + +Lemma pow_lt : forall (x:R) (n:nat), 0 < x -> 0 < x ^ n. +Proof. +intros x n; elim n; simpl in |- *; auto with real. +intros n0 H' H'0; replace 0 with (x * 0); auto with real. +Qed. +Hint Resolve pow_lt: real. + +Lemma Rlt_pow_R1 : forall (x:R) (n:nat), 1 < x -> (0 < n)%nat -> 1 < x ^ n. +Proof. +intros x n; elim n; simpl in |- *; auto with real. +intros H' H'0; elimtype False; omega. +intros n0; case n0. +simpl in |- *; rewrite Rmult_1_r; auto. +intros n1 H' H'0 H'1. +replace 1 with (1 * 1); auto with real. +apply Rlt_trans with (r2 := x * 1); auto with real. +apply Rmult_lt_compat_l; auto with real. +apply Rlt_trans with (r2 := 1); auto with real. +apply H'; auto with arith. +Qed. +Hint Resolve Rlt_pow_R1: real. + +Lemma Rlt_pow : forall (x:R) (n m:nat), 1 < x -> (n < m)%nat -> x ^ n < x ^ m. +Proof. +intros x n m H' H'0; replace m with (m - n + n)%nat. +rewrite pow_add. +pattern (x ^ n) at 1 in |- *; replace (x ^ n) with (1 * x ^ n); + auto with real. +apply Rminus_lt. +repeat rewrite (fun y:R => Rmult_comm y (x ^ n)); + rewrite <- Rmult_minus_distr_l. +replace 0 with (x ^ n * 0); auto with real. +apply Rmult_lt_compat_l; auto with real. +apply pow_lt; auto with real. +apply Rlt_trans with (r2 := 1); 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. + +(*********) +Lemma tech_pow_Rmult : forall (x:R) (n:nat), x * x ^ n = x ^ S n. +Proof. +simple induction n; simpl in |- *; trivial. +Qed. + +(*********) +Lemma tech_pow_Rplus : + forall (x:R) (a n:nat), x ^ a + INR n * x ^ a = INR (S n) * x ^ a. +Proof. +intros; pattern (x ^ a) at 1 in |- *; + rewrite <- (let (H1, H2) := Rmult_ne (x ^ a) in H1); + rewrite (Rmult_comm (INR n) (x ^ a)); + rewrite <- (Rmult_plus_distr_l (x ^ a) 1 (INR n)); + rewrite (Rplus_comm 1 (INR n)); rewrite <- (S_INR n); + apply Rmult_comm. +Qed. + +Lemma poly : forall (n:nat) (x:R), 0 < x -> 1 + INR n * x <= (1 + x) ^ n. +Proof. +intros; elim n. +simpl in |- *; cut (1 + 0 * x = 1). +intro; rewrite H0; unfold Rle in |- *; right; reflexivity. +ring. +intros; unfold pow in |- *; fold pow in |- *; + apply + (Rle_trans (1 + INR (S n0) * x) ((1 + x) * (1 + INR n0 * x)) + ((1 + x) * (1 + x) ^ n0)). +cut ((1 + x) * (1 + INR n0 * x) = 1 + INR (S n0) * x + INR n0 * (x * x)). +intro; rewrite H1; pattern (1 + INR (S n0) * x) at 1 in |- *; + rewrite <- (let (H1, H2) := Rplus_ne (1 + INR (S n0) * x) in H1); + apply Rplus_le_compat_l; elim n0; intros. +simpl in |- *; rewrite Rmult_0_l; unfold Rle in |- *; right; auto. +unfold Rle in |- *; left; generalize Rmult_gt_0_compat; unfold Rgt in |- *; + intro; fold (Rsqr x) in |- *; + apply (H3 (INR (S n1)) (Rsqr x) (lt_INR_0 (S n1) (lt_O_Sn n1))); + fold (x > 0) in H; + apply (Rlt_0_sqr x (Rlt_dichotomy_converse x 0 (or_intror (x < 0) H))). +rewrite (S_INR n0); ring. +unfold Rle in H0; elim H0; intro. +unfold Rle in |- *; left; apply Rmult_lt_compat_l. +rewrite Rplus_comm; apply (Rle_lt_0_plus_1 x (Rlt_le 0 x H)). +assumption. +rewrite H1; unfold Rle in |- *; right; trivial. +Qed. + +Lemma Power_monotonic : + forall (x:R) (m n:nat), + Rabs x > 1 -> (m <= n)%nat -> Rabs (x ^ m) <= Rabs (x ^ n). +Proof. +intros x m n H; induction n as [| n Hrecn]; intros; inversion H0. +unfold Rle in |- *; right; reflexivity. +unfold Rle in |- *; right; reflexivity. +apply (Rle_trans (Rabs (x ^ m)) (Rabs (x ^ n)) (Rabs (x ^ S n))). +apply Hrecn; assumption. +simpl in |- *; rewrite Rabs_mult. +pattern (Rabs (x ^ n)) at 1 in |- *. +rewrite <- Rmult_1_r. +rewrite (Rmult_comm (Rabs x) (Rabs (x ^ n))). +apply Rmult_le_compat_l. +apply Rabs_pos. +unfold Rgt in H. +apply Rlt_le; assumption. +Qed. + +Lemma RPow_abs : forall (x:R) (n:nat), Rabs x ^ n = Rabs (x ^ n). +Proof. +intro; simple induction n; simpl in |- *. +apply sym_eq; apply Rabs_pos_eq; apply Rlt_le; apply Rlt_0_1. +intros; rewrite H; apply sym_eq; apply Rabs_mult. +Qed. + + +Lemma Pow_x_infinity : + forall x:R, + Rabs x > 1 -> + forall b:R, + exists N : nat, (forall n:nat, (n >= N)%nat -> Rabs (x ^ n) >= b). +Proof. +intros; elim (archimed (b * / (Rabs x - 1))); intros; clear H1; + cut (exists N : nat, INR N >= b * / (Rabs x - 1)). +intro; elim H1; clear H1; intros; exists x0; intros; + apply (Rge_trans (Rabs (x ^ n)) (Rabs (x ^ x0)) b). +apply Rle_ge; apply Power_monotonic; assumption. +rewrite <- RPow_abs; cut (Rabs x = 1 + (Rabs x - 1)). +intro; rewrite H3; + apply (Rge_trans ((1 + (Rabs x - 1)) ^ x0) (1 + INR x0 * (Rabs x - 1)) b). +apply Rle_ge; apply poly; fold (Rabs x - 1 > 0) in |- *; apply Rgt_minus; + assumption. +apply (Rge_trans (1 + INR x0 * (Rabs x - 1)) (INR x0 * (Rabs x - 1)) b). +apply Rle_ge; apply Rlt_le; rewrite (Rplus_comm 1 (INR x0 * (Rabs x - 1))); + pattern (INR x0 * (Rabs x - 1)) at 1 in |- *; + rewrite <- (let (H1, H2) := Rplus_ne (INR x0 * (Rabs x - 1)) in H1); + apply Rplus_lt_compat_l; apply Rlt_0_1. +cut (b = b * / (Rabs x - 1) * (Rabs x - 1)). +intros; rewrite H4; apply Rmult_ge_compat_r. +apply Rge_minus; unfold Rge in |- *; left; assumption. +assumption. +rewrite Rmult_assoc; rewrite Rinv_l. +ring. +apply Rlt_dichotomy_converse; right; apply Rgt_minus; assumption. +ring. +cut ((0 <= up (b * / (Rabs x - 1)))%Z \/ (up (b * / (Rabs x - 1)) <= 0)%Z). +intros; elim H1; intro. +elim (IZN (up (b * / (Rabs x - 1))) H2); intros; exists x0; + apply + (Rge_trans (INR x0) (IZR (up (b * / (Rabs x - 1)))) (b * / (Rabs x - 1))). +rewrite INR_IZR_INZ; apply IZR_ge; omega. +unfold Rge in |- *; left; assumption. +exists 0%nat; + apply + (Rge_trans (INR 0) (IZR (up (b * / (Rabs x - 1)))) (b * / (Rabs x - 1))). +rewrite INR_IZR_INZ; apply IZR_ge; simpl in |- *; omega. +unfold Rge in |- *; left; assumption. +omega. +Qed. + +Lemma pow_ne_zero : forall n:nat, n <> 0%nat -> 0 ^ n = 0. +Proof. +simple induction n. +simpl in |- *; auto. +intros; elim H; reflexivity. +intros; simpl in |- *; apply Rmult_0_l. +Qed. + +Lemma Rinv_pow : forall (x:R) (n:nat), x <> 0 -> / x ^ n = (/ x) ^ n. +Proof. +intros; elim n; simpl in |- *. +apply Rinv_1. +intro m; intro; rewrite Rinv_mult_distr. +rewrite H0; reflexivity; assumption. +assumption. +apply pow_nonzero; assumption. +Qed. + +Lemma pow_lt_1_zero : + forall x:R, + Rabs x < 1 -> + forall y:R, + 0 < y -> + exists N : nat, (forall n:nat, (n >= N)%nat -> Rabs (x ^ n) < y). +Proof. +intros; elim (Req_dec x 0); intro. +exists 1%nat; rewrite H1; intros n GE; rewrite pow_ne_zero. +rewrite Rabs_R0; assumption. +inversion GE; auto. +cut (Rabs (/ x) > 1). +intros; elim (Pow_x_infinity (/ x) H2 (/ y + 1)); intros N. +exists N; intros; rewrite <- (Rinv_involutive y). +rewrite <- (Rinv_involutive (Rabs (x ^ n))). +apply Rinv_lt_contravar. +apply Rmult_lt_0_compat. +apply Rinv_0_lt_compat. +assumption. +apply Rinv_0_lt_compat. +apply Rabs_pos_lt. +apply pow_nonzero. +assumption. +rewrite <- Rabs_Rinv. +rewrite Rinv_pow. +apply (Rlt_le_trans (/ y) (/ y + 1) (Rabs ((/ x) ^ n))). +pattern (/ y) at 1 in |- *. +rewrite <- (let (H1, H2) := Rplus_ne (/ y) in H1). +apply Rplus_lt_compat_l. +apply Rlt_0_1. +apply Rge_le. +apply H3. +assumption. +assumption. +apply pow_nonzero. +assumption. +apply Rabs_no_R0. +apply pow_nonzero. +assumption. +apply Rlt_dichotomy_converse. +right; unfold Rgt in |- *; assumption. +rewrite <- (Rinv_involutive 1). +rewrite Rabs_Rinv. +unfold Rgt in |- *; apply Rinv_lt_contravar. +apply Rmult_lt_0_compat. +apply Rabs_pos_lt. +assumption. +rewrite Rinv_1; apply Rlt_0_1. +rewrite Rinv_1; assumption. +assumption. +red in |- *; intro; apply R1_neq_R0; assumption. +Qed. + +Lemma pow_R1 : forall (r:R) (n:nat), r ^ n = 1 -> Rabs r = 1 \/ n = 0%nat. +Proof. +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); [ intros Eq1 | idtac ]. +cut (Rabs r <> 0); [ intros Eq2 | apply Rabs_no_R0 ]; auto. +absurd (Rabs (/ r) ^ 0 < Rabs (/ r) ^ S n0); auto. +replace (Rabs (/ r) ^ S n0) with 1. +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 Rle_ge; 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. +red in |- *; intro; absurd (r ^ S n0 = 1); auto. +simpl in |- *; rewrite H; rewrite Rmult_0_l; auto with real. +generalize H'; case n; auto. +intros n0 H'0. +cut (r <> 0); [ intros Eq1 | auto with real ]. +cut (Rabs r <> 0); [ intros Eq2 | apply Rabs_no_R0 ]; auto. +absurd (Rabs r ^ 0 < Rabs r ^ S n0); auto with real arith. +repeat rewrite RPow_abs; rewrite H'0; simpl in |- *; auto with real. +red in |- *; intro; absurd (r ^ S n0 = 1); auto. +simpl in |- *; rewrite H; rewrite Rmult_0_l; auto with real. +Qed. + +Lemma pow_Rsqr : forall (x:R) (n:nat), x ^ (2 * n) = Rsqr x ^ n. +Proof. +intros; induction n as [| n Hrecn]. +reflexivity. +replace (2 * S n)%nat with (S (S (2 * n))). +replace (x ^ S (S (2 * n))) with (x * x * x ^ (2 * n)). +rewrite Hrecn; reflexivity. +simpl in |- *; ring. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; + ring. +Qed. + +Lemma pow_le : forall (a:R) (n:nat), 0 <= a -> 0 <= a ^ n. +Proof. +intros; induction n as [| n Hrecn]. +simpl in |- *; left; apply Rlt_0_1. +simpl in |- *; apply Rmult_le_pos; assumption. +Qed. + +(**********) +Lemma pow_1_even : forall n:nat, (-1) ^ (2 * n) = 1. +Proof. +intro; induction n as [| n Hrecn]. +reflexivity. +replace (2 * S n)%nat with (2 + 2 * n)%nat. +rewrite pow_add; rewrite Hrecn; simpl in |- *; ring. +replace (S n) with (n + 1)%nat; [ ring | ring ]. +Qed. + +(**********) +Lemma pow_1_odd : forall n:nat, (-1) ^ S (2 * n) = -1. +Proof. +intro; replace (S (2 * n)) with (2 * n + 1)%nat; [ idtac | ring ]. +rewrite pow_add; rewrite pow_1_even; simpl in |- *; ring. +Qed. + +(**********) +Lemma pow_1_abs : forall n:nat, Rabs ((-1) ^ n) = 1. +Proof. +intro; induction n as [| n Hrecn]. +simpl in |- *; apply Rabs_R1. +replace (S n) with (n + 1)%nat; [ rewrite pow_add | ring ]. +rewrite Rabs_mult. +rewrite Hrecn; rewrite Rmult_1_l; simpl in |- *; rewrite Rmult_1_r; + rewrite Rabs_Ropp; apply Rabs_R1. +Qed. + +Lemma pow_mult : forall (x:R) (n1 n2:nat), x ^ (n1 * n2) = (x ^ n1) ^ n2. +Proof. +intros; induction n2 as [| n2 Hrecn2]. +simpl in |- *; replace (n1 * 0)%nat with 0%nat; [ reflexivity | ring ]. +replace (n1 * S n2)%nat with (n1 * n2 + n1)%nat. +replace (S n2) with (n2 + 1)%nat; [ idtac | ring ]. +do 2 rewrite pow_add. +rewrite Hrecn2. +simpl in |- *. +ring. +apply INR_eq; rewrite plus_INR; do 2 rewrite mult_INR; rewrite S_INR; ring. +Qed. + +Lemma pow_incr : forall (x y:R) (n:nat), 0 <= x <= y -> x ^ n <= y ^ n. +Proof. +intros. +induction n as [| n Hrecn]. +right; reflexivity. +simpl in |- *. +elim H; intros. +apply Rle_trans with (y * x ^ n). +do 2 rewrite <- (Rmult_comm (x ^ n)). +apply Rmult_le_compat_l. +apply pow_le; assumption. +assumption. +apply Rmult_le_compat_l. +apply Rle_trans with x; assumption. +apply Hrecn. +Qed. + +Lemma pow_R1_Rle : forall (x:R) (k:nat), 1 <= x -> 1 <= x ^ k. +Proof. +intros. +induction k as [| k Hreck]. +right; reflexivity. +simpl in |- *. +apply Rle_trans with (x * 1). +rewrite Rmult_1_r; assumption. +apply Rmult_le_compat_l. +left; apply Rlt_le_trans with 1; [ apply Rlt_0_1 | assumption ]. +exact Hreck. +Qed. + +Lemma Rle_pow : + forall (x:R) (m n:nat), 1 <= x -> (m <= n)%nat -> x ^ m <= x ^ n. +Proof. +intros. +replace n with (n - m + m)%nat. +rewrite pow_add. +rewrite Rmult_comm. +pattern (x ^ m) at 1 in |- *; rewrite <- Rmult_1_r. +apply Rmult_le_compat_l. +apply pow_le; left; apply Rlt_le_trans with 1; [ apply Rlt_0_1 | assumption ]. +apply pow_R1_Rle; assumption. +rewrite plus_comm. +symmetry in |- *; apply le_plus_minus; assumption. +Qed. + +Lemma pow1 : forall n:nat, 1 ^ n = 1. +Proof. +intro; induction n as [| n Hrecn]. +reflexivity. +simpl in |- *; rewrite Hrecn; rewrite Rmult_1_r; reflexivity. +Qed. + +Lemma pow_Rabs : forall (x:R) (n:nat), x ^ n <= Rabs x ^ n. +Proof. +intros; induction n as [| n Hrecn]. +right; reflexivity. +simpl in |- *; case (Rcase_abs x); intro. +apply Rle_trans with (Rabs (x * x ^ n)). +apply RRle_abs. +rewrite Rabs_mult. +apply Rmult_le_compat_l. +apply Rabs_pos. +right; symmetry in |- *; apply RPow_abs. +pattern (Rabs x) at 1 in |- *; rewrite (Rabs_right x r); + apply Rmult_le_compat_l. +apply Rge_le; exact r. +apply Hrecn. +Qed. + +Lemma pow_maj_Rabs : forall (x y:R) (n:nat), Rabs y <= x -> y ^ n <= x ^ n. +Proof. +intros; cut (0 <= x). +intro; apply Rle_trans with (Rabs y ^ n). +apply pow_Rabs. +induction n as [| n Hrecn]. +right; reflexivity. +simpl in |- *; apply Rle_trans with (x * Rabs y ^ n). +do 2 rewrite <- (Rmult_comm (Rabs y ^ n)). +apply Rmult_le_compat_l. +apply pow_le; apply Rabs_pos. +assumption. +apply Rmult_le_compat_l. +apply H0. +apply Hrecn. +apply Rle_trans with (Rabs y); [ apply Rabs_pos | exact H ]. +Qed. + +(*******************************) +(** PowerRZ *) +(*******************************) +(*i Due to L.Thery i*) + +Ltac case_eq name := + generalize (refl_equal name); pattern name at -1 in |- *; case name. + +Definition powerRZ (x:R) (n:Z) := + match n with + | Z0 => 1 + | Zpos p => x ^ nat_of_P p + | Zneg p => / x ^ nat_of_P p + end. + +Infix Local "^Z" := powerRZ (at level 30, right associativity) : R_scope. + +Lemma Zpower_NR0 : + forall (x:Z) (n:nat), (0 <= x)%Z -> (0 <= Zpower_nat x n)%Z. +Proof. +induction n; unfold Zpower_nat in |- *; simpl in |- *; auto with zarith. +Qed. + +Lemma powerRZ_O : forall x:R, x ^Z 0 = 1. +Proof. +reflexivity. +Qed. + +Lemma powerRZ_1 : forall x:R, x ^Z Zsucc 0 = x. +Proof. +simpl in |- *; auto with real. +Qed. + +Lemma powerRZ_NOR : forall (x:R) (z:Z), x <> 0 -> x ^Z z <> 0. +Proof. +destruct z; simpl in |- *; auto with real. +Qed. + +Lemma powerRZ_add : + forall (x:R) (n m:Z), x <> 0 -> x ^Z (n + m) = x ^Z n * x ^Z m. +Proof. +intro x; destruct n as [| n1| n1]; destruct m as [| m1| m1]; simpl in |- *; + auto with real. +(* POS/POS *) +rewrite nat_of_P_plus_morphism; auto with real. +(* POS/NEG *) +case_eq ((n1 ?= m1)%positive 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 x (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. +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 n1 m1); auto with real. +rewrite (pow_RN_plus x (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)%nat in |- *. +apply nat_of_P_gt_Gt_compare_morphism; auto. +(* NEG/POS *) +case_eq ((n1 ?= m1)%positive 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 x (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. +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 x (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. +apply lt_le_weak. +change (nat_of_P n1 > nat_of_P m1)%nat in |- *. +apply nat_of_P_gt_Gt_compare_morphism; auto. +(* NEG/NEG *) +rewrite nat_of_P_plus_morphism; auto with real. +intros H'; rewrite pow_add; auto with real. +apply Rinv_mult_distr; auto. +apply pow_nonzero; auto. +apply pow_nonzero; auto. +Qed. +Hint Resolve powerRZ_O powerRZ_1 powerRZ_NOR powerRZ_add: real. + +Lemma Zpower_nat_powerRZ : + forall n m:nat, IZR (Zpower_nat (Z_of_nat n) m) = INR n ^Z Z_of_nat m. +Proof. +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 (Z_of_nat n) (S m1)) with + (Z_of_nat n * Zpower_nat (Z_of_nat n) m1)%Z. +rewrite mult_IZR; auto with real. +repeat rewrite <- INR_IZR_INZ; simpl in |- *. +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. + +Lemma powerRZ_lt : forall (x:R) (z:Z), 0 < x -> 0 < x ^Z z. +Proof. +intros x z; case z; simpl in |- *; auto with real. +Qed. +Hint Resolve powerRZ_lt: real. + +Lemma powerRZ_le : forall (x:R) (z:Z), 0 < x -> 0 <= x ^Z z. +Proof. +intros x z H'; apply Rlt_le; auto with real. +Qed. +Hint Resolve powerRZ_le: real. + +Lemma Zpower_nat_powerRZ_absolu : + forall n m:Z, (0 <= m)%Z -> IZR (Zpower_nat n (Zabs_nat m)) = IZR n ^Z m. +Proof. +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 <- mult_IZR; auto. +intros p H'; absurd (0 <= Zneg p)%Z; auto with zarith. +Qed. + +Lemma powerRZ_R1 : forall n:Z, 1 ^Z n = 1. +Proof. +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. + +(*******************************) +(* For easy interface *) +(*******************************) +(* decimal_exp r z is defined as r 10^z *) + +Definition decimal_exp (r:R) (z:Z) : R := (r * 10 ^Z z). + + +(*******************************) +(** Sum of n first naturals *) +(*******************************) +(*********) +Fixpoint sum_nat_f_O (f:nat -> nat) (n:nat) {struct n} : nat := + match n with + | O => f 0%nat + | S n' => (sum_nat_f_O f n' + f (S n'))%nat + end. + +(*********) +Definition sum_nat_f (s n:nat) (f:nat -> nat) : nat := + sum_nat_f_O (fun x:nat => f (x + s)%nat) (n - s). + +(*********) +Definition sum_nat_O (n:nat) : nat := sum_nat_f_O (fun x:nat => x) n. + +(*********) +Definition sum_nat (s n:nat) : nat := sum_nat_f s n (fun x:nat => x). + +(*******************************) +(** Sum *) +(*******************************) +(*********) +Fixpoint sum_f_R0 (f:nat -> R) (N:nat) {struct N} : R := + match N with + | O => f 0%nat + | S i => sum_f_R0 f i + f (S i) + end. + +(*********) +Definition sum_f (s n:nat) (f:nat -> R) : R := + sum_f_R0 (fun x:nat => f (x + s)%nat) (n - s). + +Lemma GP_finite : + forall (x:R) (n:nat), + sum_f_R0 (fun n:nat => x ^ n) n * (x - 1) = x ^ (n + 1) - 1. +Proof. +intros; induction n as [| n Hrecn]; simpl in |- *. +ring. +rewrite Rmult_plus_distr_r; rewrite Hrecn; cut ((n + 1)%nat = S n). +intro H; rewrite H; simpl in |- *; ring. +omega. +Qed. + +Lemma sum_f_R0_triangle : + forall (x:nat -> R) (n:nat), + Rabs (sum_f_R0 x n) <= sum_f_R0 (fun i:nat => Rabs (x i)) n. +Proof. +intro; simple induction n; simpl in |- *. +unfold Rle in |- *; right; reflexivity. +intro m; intro; + apply + (Rle_trans (Rabs (sum_f_R0 x m + x (S m))) + (Rabs (sum_f_R0 x m) + Rabs (x (S m))) + (sum_f_R0 (fun i:nat => Rabs (x i)) m + Rabs (x (S m)))). +apply Rabs_triang. +rewrite Rplus_comm; + rewrite (Rplus_comm (sum_f_R0 (fun i:nat => Rabs (x i)) m) (Rabs (x (S m)))); + apply Rplus_le_compat_l; assumption. +Qed. + +(*******************************) +(* Distance in R *) +(*******************************) + +(*********) +Definition R_dist (x y:R) : R := Rabs (x - y). + +(*********) +Lemma R_dist_pos : forall x y:R, R_dist x y >= 0. +Proof. +intros; unfold R_dist in |- *; unfold Rabs in |- *; case (Rcase_abs (x - y)); + intro l. +unfold Rge in |- *; left; apply (Ropp_gt_lt_0_contravar (x - y) l). +trivial. +Qed. + +(*********) +Lemma R_dist_sym : forall x y:R, R_dist x y = R_dist y x. +Proof. +unfold R_dist in |- *; intros; split_Rabs; ring. +generalize (Ropp_gt_lt_0_contravar (y - x) r); intro; + rewrite (Ropp_minus_distr y x) in H; generalize (Rlt_asym (x - y) 0 r0); + intro; unfold Rgt in H; elimtype False; auto. +generalize (minus_Rge y x r); intro; generalize (minus_Rge x y r0); intro; + generalize (Rge_antisym x y H0 H); intro; rewrite H1; + ring. +Qed. + +(*********) +Lemma R_dist_refl : forall x y:R, R_dist x y = 0 <-> x = y. +Proof. +unfold R_dist in |- *; intros; split_Rabs; split; intros. +rewrite (Ropp_minus_distr x y) in H; apply sym_eq; + apply (Rminus_diag_uniq y x H). +rewrite (Ropp_minus_distr x y); generalize (sym_eq H); intro; + apply (Rminus_diag_eq y x H0). +apply (Rminus_diag_uniq x y H). +apply (Rminus_diag_eq x y H). +Qed. + +Lemma R_dist_eq : forall x:R, R_dist x x = 0. +Proof. +unfold R_dist in |- *; intros; split_Rabs; intros; ring. +Qed. + +(***********) +Lemma R_dist_tri : forall x y z:R, R_dist x y <= R_dist x z + R_dist z y. +Proof. +intros; unfold R_dist in |- *; replace (x - y) with (x - z + (z - y)); + [ apply (Rabs_triang (x - z) (z - y)) | ring ]. +Qed. + +(*********) +Lemma R_dist_plus : + forall a b c d:R, R_dist (a + c) (b + d) <= R_dist a b + R_dist c d. +Proof. +intros; unfold R_dist in |- *; + replace (a + c - (b + d)) with (a - b + (c - d)). +exact (Rabs_triang (a - b) (c - d)). +ring. +Qed. + +(*******************************) +(** Infinit Sum *) +(*******************************) +(*********) +Definition infinit_sum (s:nat -> R) (l:R) : Prop := + forall eps:R, + eps > 0 -> + exists N : nat, + (forall n:nat, (n >= N)%nat -> R_dist (sum_f_R0 s n) l < eps). diff --git a/theories/Reals/Rgeom.v b/theories/Reals/Rgeom.v new file mode 100644 index 00000000..a01e7b52 --- /dev/null +++ b/theories/Reals/Rgeom.v @@ -0,0 +1,187 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Rgeom.v,v 1.13.2.1 2004/07/16 19:31:13 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rfunctions. +Require Import SeqSeries. +Require Import Rtrigo. +Require Import R_sqrt. Open Local Scope R_scope. + +Definition dist_euc (x0 y0 x1 y1:R) : R := + sqrt (Rsqr (x0 - x1) + Rsqr (y0 - y1)). + +Lemma distance_refl : forall x0 y0:R, dist_euc x0 y0 x0 y0 = 0. +intros x0 y0; unfold dist_euc in |- *; apply Rsqr_inj; + [ apply sqrt_positivity; apply Rplus_le_le_0_compat; + [ apply Rle_0_sqr | apply Rle_0_sqr ] + | right; reflexivity + | rewrite Rsqr_0; rewrite Rsqr_sqrt; + [ unfold Rsqr in |- *; ring + | apply Rplus_le_le_0_compat; [ apply Rle_0_sqr | apply Rle_0_sqr ] ] ]. +Qed. + +Lemma distance_symm : + forall x0 y0 x1 y1:R, dist_euc x0 y0 x1 y1 = dist_euc x1 y1 x0 y0. +intros x0 y0 x1 y1; unfold dist_euc in |- *; apply Rsqr_inj; + [ apply sqrt_positivity; apply Rplus_le_le_0_compat + | apply sqrt_positivity; apply Rplus_le_le_0_compat + | repeat rewrite Rsqr_sqrt; + [ unfold Rsqr in |- *; ring + | apply Rplus_le_le_0_compat + | apply Rplus_le_le_0_compat ] ]; apply Rle_0_sqr. +Qed. + +Lemma law_cosines : + forall x0 y0 x1 y1 x2 y2 ac:R, + let a := dist_euc x1 y1 x0 y0 in + let b := dist_euc x2 y2 x0 y0 in + let c := dist_euc x2 y2 x1 y1 in + a * c * cos ac = (x0 - x1) * (x2 - x1) + (y0 - y1) * (y2 - y1) -> + Rsqr b = Rsqr c + Rsqr a - 2 * (a * c * cos ac). +unfold dist_euc in |- *; intros; repeat rewrite Rsqr_sqrt; + [ rewrite H; unfold Rsqr in |- *; ring + | apply Rplus_le_le_0_compat + | apply Rplus_le_le_0_compat + | apply Rplus_le_le_0_compat ]; apply Rle_0_sqr. +Qed. + +Lemma triangle : + forall x0 y0 x1 y1 x2 y2:R, + dist_euc x0 y0 x1 y1 <= dist_euc x0 y0 x2 y2 + dist_euc x2 y2 x1 y1. +intros; unfold dist_euc in |- *; apply Rsqr_incr_0; + [ rewrite Rsqr_plus; repeat rewrite Rsqr_sqrt; + [ replace (Rsqr (x0 - x1)) with + (Rsqr (x0 - x2) + Rsqr (x2 - x1) + 2 * (x0 - x2) * (x2 - x1)); + [ replace (Rsqr (y0 - y1)) with + (Rsqr (y0 - y2) + Rsqr (y2 - y1) + 2 * (y0 - y2) * (y2 - y1)); + [ apply Rplus_le_reg_l with + (- Rsqr (x0 - x2) - Rsqr (x2 - x1) - Rsqr (y0 - y2) - + Rsqr (y2 - y1)); + replace + (- Rsqr (x0 - x2) - Rsqr (x2 - x1) - Rsqr (y0 - y2) - + Rsqr (y2 - y1) + + (Rsqr (x0 - x2) + Rsqr (x2 - x1) + 2 * (x0 - x2) * (x2 - x1) + + (Rsqr (y0 - y2) + Rsqr (y2 - y1) + 2 * (y0 - y2) * (y2 - y1)))) + with (2 * ((x0 - x2) * (x2 - x1) + (y0 - y2) * (y2 - y1))); + [ replace + (- Rsqr (x0 - x2) - Rsqr (x2 - x1) - Rsqr (y0 - y2) - + Rsqr (y2 - y1) + + (Rsqr (x0 - x2) + Rsqr (y0 - y2) + + (Rsqr (x2 - x1) + Rsqr (y2 - y1)) + + 2 * sqrt (Rsqr (x0 - x2) + Rsqr (y0 - y2)) * + sqrt (Rsqr (x2 - x1) + Rsqr (y2 - y1)))) with + (2 * + (sqrt (Rsqr (x0 - x2) + Rsqr (y0 - y2)) * + sqrt (Rsqr (x2 - x1) + Rsqr (y2 - y1)))); + [ apply Rmult_le_compat_l; + [ left; cut (0%nat <> 2%nat); + [ intros; generalize (lt_INR_0 2 (neq_O_lt 2 H)); + intro H0; assumption + | discriminate ] + | apply sqrt_cauchy ] + | ring ] + | ring ] + | ring_Rsqr ] + | ring_Rsqr ] + | apply Rplus_le_le_0_compat; apply Rle_0_sqr + | apply Rplus_le_le_0_compat; apply Rle_0_sqr + | apply Rplus_le_le_0_compat; apply Rle_0_sqr ] + | apply sqrt_positivity; apply Rplus_le_le_0_compat; apply Rle_0_sqr + | apply Rplus_le_le_0_compat; apply sqrt_positivity; + apply Rplus_le_le_0_compat; apply Rle_0_sqr ]. +Qed. + +(******************************************************************) +(** Translation *) +(******************************************************************) + +Definition xt (x tx:R) : R := x + tx. +Definition yt (y ty:R) : R := y + ty. + +Lemma translation_0 : forall x y:R, xt x 0 = x /\ yt y 0 = y. +intros x y; split; [ unfold xt in |- * | unfold yt in |- * ]; ring. +Qed. + +Lemma isometric_translation : + forall x1 x2 y1 y2 tx ty:R, + Rsqr (x1 - x2) + Rsqr (y1 - y2) = + Rsqr (xt x1 tx - xt x2 tx) + Rsqr (yt y1 ty - yt y2 ty). +intros; unfold Rsqr, xt, yt in |- *; ring. +Qed. + +(******************************************************************) +(** Rotation *) +(******************************************************************) + +Definition xr (x y theta:R) : R := x * cos theta + y * sin theta. +Definition yr (x y theta:R) : R := - x * sin theta + y * cos theta. + +Lemma rotation_0 : forall x y:R, xr x y 0 = x /\ yr x y 0 = y. +intros x y; unfold xr, yr in |- *; split; rewrite cos_0; rewrite sin_0; ring. +Qed. + +Lemma rotation_PI2 : + forall x y:R, xr x y (PI / 2) = y /\ yr x y (PI / 2) = - x. +intros x y; unfold xr, yr in |- *; split; rewrite cos_PI2; rewrite sin_PI2; + ring. +Qed. + +Lemma isometric_rotation_0 : + forall x1 y1 x2 y2 theta:R, + Rsqr (x1 - x2) + Rsqr (y1 - y2) = + Rsqr (xr x1 y1 theta - xr x2 y2 theta) + + Rsqr (yr x1 y1 theta - yr x2 y2 theta). +intros; unfold xr, yr in |- *; + replace + (x1 * cos theta + y1 * sin theta - (x2 * cos theta + y2 * sin theta)) with + (cos theta * (x1 - x2) + sin theta * (y1 - y2)); + [ replace + (- x1 * sin theta + y1 * cos theta - (- x2 * sin theta + y2 * cos theta)) + with (cos theta * (y1 - y2) + sin theta * (x2 - x1)); + [ repeat rewrite Rsqr_plus; repeat rewrite Rsqr_mult; repeat rewrite cos2; + ring; replace (x2 - x1) with (- (x1 - x2)); + [ rewrite <- Rsqr_neg; ring | ring ] + | ring ] + | ring ]. +Qed. + +Lemma isometric_rotation : + forall x1 y1 x2 y2 theta:R, + dist_euc x1 y1 x2 y2 = + dist_euc (xr x1 y1 theta) (yr x1 y1 theta) (xr x2 y2 theta) + (yr x2 y2 theta). +unfold dist_euc in |- *; intros; apply Rsqr_inj; + [ apply sqrt_positivity; apply Rplus_le_le_0_compat + | apply sqrt_positivity; apply Rplus_le_le_0_compat + | repeat rewrite Rsqr_sqrt; + [ apply isometric_rotation_0 + | apply Rplus_le_le_0_compat + | apply Rplus_le_le_0_compat ] ]; apply Rle_0_sqr. +Qed. + +(******************************************************************) +(** Similarity *) +(******************************************************************) + +Lemma isometric_rot_trans : + forall x1 y1 x2 y2 tx ty theta:R, + Rsqr (x1 - x2) + Rsqr (y1 - y2) = + Rsqr (xr (xt x1 tx) (yt y1 ty) theta - xr (xt x2 tx) (yt y2 ty) theta) + + Rsqr (yr (xt x1 tx) (yt y1 ty) theta - yr (xt x2 tx) (yt y2 ty) theta). +intros; rewrite <- isometric_rotation_0; apply isometric_translation. +Qed. + +Lemma isometric_trans_rot : + forall x1 y1 x2 y2 tx ty theta:R, + Rsqr (x1 - x2) + Rsqr (y1 - y2) = + Rsqr (xt (xr x1 y1 theta) tx - xt (xr x2 y2 theta) tx) + + Rsqr (yt (yr x1 y1 theta) ty - yt (yr x2 y2 theta) ty). +intros; rewrite <- isometric_translation; apply isometric_rotation_0. +Qed.
\ No newline at end of file diff --git a/theories/Reals/RiemannInt.v b/theories/Reals/RiemannInt.v new file mode 100644 index 00000000..51323ac4 --- /dev/null +++ b/theories/Reals/RiemannInt.v @@ -0,0 +1,3263 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: RiemannInt.v,v 1.18.2.1 2004/07/16 19:31:13 herbelin Exp $ i*) + +Require Import Rfunctions. +Require Import SeqSeries. +Require Import Ranalysis. +Require Import Rbase. +Require Import RiemannInt_SF. +Require Import Classical_Prop. +Require Import Classical_Pred_Type. +Require Import Max. Open Local Scope R_scope. + +Set Implicit Arguments. + +(********************************************) +(* Riemann's Integral *) +(********************************************) + +Definition Riemann_integrable (f:R -> R) (a b:R) : Type := + forall eps:posreal, + sigT + (fun phi:StepFun a b => + sigT + (fun psi:StepFun a b => + (forall t:R, + Rmin a b <= t <= Rmax a b -> Rabs (f t - phi t) <= psi t) /\ + Rabs (RiemannInt_SF psi) < eps)). + +Definition phi_sequence (un:nat -> posreal) (f:R -> R) + (a b:R) (pr:Riemann_integrable f a b) (n:nat) := + projT1 (pr (un n)). + +Lemma phi_sequence_prop : + forall (un:nat -> posreal) (f:R -> R) (a b:R) (pr:Riemann_integrable f a b) + (N:nat), + sigT + (fun psi:StepFun a b => + (forall t:R, + Rmin a b <= t <= Rmax a b -> + Rabs (f t - phi_sequence un pr N t) <= psi t) /\ + Rabs (RiemannInt_SF psi) < un N). +intros; apply (projT2 (pr (un N))). +Qed. + +Lemma RiemannInt_P1 : + forall (f:R -> R) (a b:R), + Riemann_integrable f a b -> Riemann_integrable f b a. +unfold Riemann_integrable in |- *; intros; elim (X eps); clear X; intros; + elim p; clear p; intros; apply existT with (mkStepFun (StepFun_P6 (pre x))); + apply existT with (mkStepFun (StepFun_P6 (pre x0))); + elim p; clear p; intros; split. +intros; apply (H t); elim H1; clear H1; intros; split; + [ apply Rle_trans with (Rmin b a); try assumption; right; + unfold Rmin in |- * + | apply Rle_trans with (Rmax b a); try assumption; right; + unfold Rmax in |- * ]; + (case (Rle_dec a b); case (Rle_dec b a); intros; + try reflexivity || apply Rle_antisym; + [ assumption | assumption | auto with real | auto with real ]). +generalize H0; unfold RiemannInt_SF in |- *; case (Rle_dec a b); + case (Rle_dec b a); intros; + (replace + (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre x0)))) + (subdivision (mkStepFun (StepFun_P6 (pre x0))))) with + (Int_SF (subdivision_val x0) (subdivision x0)); + [ idtac + | apply StepFun_P17 with (fe x0) a b; + [ apply StepFun_P1 + | apply StepFun_P2; + apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre x0)))) ] ]). +apply H1. +rewrite Rabs_Ropp; apply H1. +rewrite Rabs_Ropp in H1; apply H1. +apply H1. +Qed. + +Lemma RiemannInt_P2 : + forall (f:R -> R) (a b:R) (un:nat -> posreal) (vn wn:nat -> StepFun a b), + Un_cv un 0 -> + a <= b -> + (forall n:nat, + (forall t:R, Rmin a b <= t <= Rmax a b -> Rabs (f t - vn n t) <= wn n t) /\ + Rabs (RiemannInt_SF (wn n)) < un n) -> + sigT (fun l:R => Un_cv (fun N:nat => RiemannInt_SF (vn N)) l). +intros; apply R_complete; unfold Un_cv in H; unfold Cauchy_crit in |- *; + intros; assert (H3 : 0 < eps / 2). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +elim (H _ H3); intros N0 H4; exists N0; intros; unfold R_dist in |- *; + unfold R_dist in H4; elim (H1 n); elim (H1 m); intros; + replace (RiemannInt_SF (vn n) - RiemannInt_SF (vn m)) with + (RiemannInt_SF (vn n) + -1 * RiemannInt_SF (vn m)); + [ idtac | ring ]; rewrite <- StepFun_P30; + apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (vn n) (vn m)))))). +apply StepFun_P34; assumption. +apply Rle_lt_trans with + (RiemannInt_SF (mkStepFun (StepFun_P28 1 (wn n) (wn m)))). +apply StepFun_P37; try assumption. +intros; simpl in |- *; + apply Rle_trans with (Rabs (vn n x - f x) + Rabs (f x - vn m x)). +replace (vn n x + -1 * vn m x) with (vn n x - f x + (f x - vn m x)); + [ apply Rabs_triang | ring ]. +assert (H12 : Rmin a b = a). +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. +assert (H13 : Rmax a b = b). +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. +rewrite <- H12 in H11; pattern b at 2 in H11; rewrite <- H13 in H11; + rewrite Rmult_1_l; apply Rplus_le_compat. +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H9. +elim H11; intros; split; left; assumption. +apply H7. +elim H11; intros; split; left; assumption. +rewrite StepFun_P30; rewrite Rmult_1_l; apply Rlt_trans with (un n + un m). +apply Rle_lt_trans with + (Rabs (RiemannInt_SF (wn n)) + Rabs (RiemannInt_SF (wn m))). +apply Rplus_le_compat; apply RRle_abs. +apply Rplus_lt_compat; assumption. +apply Rle_lt_trans with (Rabs (un n) + Rabs (un m)). +apply Rplus_le_compat; apply RRle_abs. +replace (pos (un n)) with (un n - 0); [ idtac | ring ]; + replace (pos (un m)) with (un m - 0); [ idtac | ring ]; + rewrite (double_var eps); apply Rplus_lt_compat; apply H4; + assumption. +Qed. + +Lemma RiemannInt_P3 : + forall (f:R -> R) (a b:R) (un:nat -> posreal) (vn wn:nat -> StepFun a b), + Un_cv un 0 -> + (forall n:nat, + (forall t:R, Rmin a b <= t <= Rmax a b -> Rabs (f t - vn n t) <= wn n t) /\ + Rabs (RiemannInt_SF (wn n)) < un n) -> + sigT (fun l:R => Un_cv (fun N:nat => RiemannInt_SF (vn N)) l). +intros; case (Rle_dec a b); intro. +apply RiemannInt_P2 with f un wn; assumption. +assert (H1 : b <= a); auto with real. +set (vn' := fun n:nat => mkStepFun (StepFun_P6 (pre (vn n)))); + set (wn' := fun n:nat => mkStepFun (StepFun_P6 (pre (wn n)))); + assert + (H2 : + forall n:nat, + (forall t:R, + Rmin b a <= t <= Rmax b a -> Rabs (f t - vn' n t) <= wn' n t) /\ + Rabs (RiemannInt_SF (wn' n)) < un n). +intro; elim (H0 n0); intros; split. +intros; apply (H2 t); elim H4; clear H4; intros; split; + [ apply Rle_trans with (Rmin b a); try assumption; right; + unfold Rmin in |- * + | apply Rle_trans with (Rmax b a); try assumption; right; + unfold Rmax in |- * ]; + (case (Rle_dec a b); case (Rle_dec b a); intros; + try reflexivity || apply Rle_antisym; + [ assumption | assumption | auto with real | auto with real ]). +generalize H3; unfold RiemannInt_SF in |- *; case (Rle_dec a b); + case (Rle_dec b a); unfold wn' in |- *; intros; + (replace + (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre (wn n0))))) + (subdivision (mkStepFun (StepFun_P6 (pre (wn n0)))))) with + (Int_SF (subdivision_val (wn n0)) (subdivision (wn n0))); + [ idtac + | apply StepFun_P17 with (fe (wn n0)) a b; + [ apply StepFun_P1 + | apply StepFun_P2; + apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre (wn n0))))) ] ]). +apply H4. +rewrite Rabs_Ropp; apply H4. +rewrite Rabs_Ropp in H4; apply H4. +apply H4. +assert (H3 := RiemannInt_P2 _ _ _ _ H H1 H2); elim H3; intros; + apply existT with (- x); unfold Un_cv in |- *; unfold Un_cv in p; + intros; elim (p _ H4); intros; exists x0; intros; + generalize (H5 _ H6); unfold R_dist, RiemannInt_SF in |- *; + case (Rle_dec b a); case (Rle_dec a b); intros. +elim n; assumption. +unfold vn' in H7; + replace (Int_SF (subdivision_val (vn n0)) (subdivision (vn n0))) with + (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre (vn n0))))) + (subdivision (mkStepFun (StepFun_P6 (pre (vn n0)))))); + [ unfold Rminus in |- *; rewrite Ropp_involutive; rewrite <- Rabs_Ropp; + rewrite Ropp_plus_distr; rewrite Ropp_involutive; + apply H7 + | symmetry in |- *; apply StepFun_P17 with (fe (vn n0)) a b; + [ apply StepFun_P1 + | apply StepFun_P2; + apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre (vn n0))))) ] ]. +elim n1; assumption. +elim n2; assumption. +Qed. + +Lemma RiemannInt_exists : + forall (f:R -> R) (a b:R) (pr:Riemann_integrable f a b) + (un:nat -> posreal), + Un_cv un 0 -> + sigT + (fun l:R => Un_cv (fun N:nat => RiemannInt_SF (phi_sequence un pr N)) l). +intros f; intros; + apply RiemannInt_P3 with + f un (fun n:nat => projT1 (phi_sequence_prop un pr n)); + [ apply H | intro; apply (projT2 (phi_sequence_prop un pr n)) ]. +Qed. + +Lemma RiemannInt_P4 : + forall (f:R -> R) (a b l:R) (pr1 pr2:Riemann_integrable f a b) + (un vn:nat -> posreal), + Un_cv un 0 -> + Un_cv vn 0 -> + Un_cv (fun N:nat => RiemannInt_SF (phi_sequence un pr1 N)) l -> + Un_cv (fun N:nat => RiemannInt_SF (phi_sequence vn pr2 N)) l. +unfold Un_cv in |- *; unfold R_dist in |- *; intros f; intros; + assert (H3 : 0 < eps / 3). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +elim (H _ H3); clear H; intros N0 H; elim (H0 _ H3); clear H0; intros N1 H0; + elim (H1 _ H3); clear H1; intros N2 H1; set (N := max (max N0 N1) N2); + exists N; intros; + apply Rle_lt_trans with + (Rabs + (RiemannInt_SF (phi_sequence vn pr2 n) - + RiemannInt_SF (phi_sequence un pr1 n)) + + Rabs (RiemannInt_SF (phi_sequence un pr1 n) - l)). +replace (RiemannInt_SF (phi_sequence vn pr2 n) - l) with + (RiemannInt_SF (phi_sequence vn pr2 n) - + RiemannInt_SF (phi_sequence un pr1 n) + + (RiemannInt_SF (phi_sequence un pr1 n) - l)); [ apply Rabs_triang | ring ]. +replace eps with (2 * (eps / 3) + eps / 3). +apply Rplus_lt_compat. +elim (phi_sequence_prop vn pr2 n); intros psi_vn H5; + elim (phi_sequence_prop un pr1 n); intros psi_un H6; + replace + (RiemannInt_SF (phi_sequence vn pr2 n) - + RiemannInt_SF (phi_sequence un pr1 n)) with + (RiemannInt_SF (phi_sequence vn pr2 n) + + -1 * RiemannInt_SF (phi_sequence un pr1 n)); [ idtac | ring ]; + rewrite <- StepFun_P30. +case (Rle_dec a b); intro. +apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P32 + (mkStepFun + (StepFun_P28 (-1) (phi_sequence vn pr2 n) + (phi_sequence un pr1 n)))))). +apply StepFun_P34; assumption. +apply Rle_lt_trans with + (RiemannInt_SF (mkStepFun (StepFun_P28 1 psi_un psi_vn))). +apply StepFun_P37; try assumption; intros; simpl in |- *; rewrite Rmult_1_l; + apply Rle_trans with + (Rabs (phi_sequence vn pr2 n x - f x) + + Rabs (f x - phi_sequence un pr1 n x)). +replace (phi_sequence vn pr2 n x + -1 * phi_sequence un pr1 n x) with + (phi_sequence vn pr2 n x - f x + (f x - phi_sequence un pr1 n x)); + [ apply Rabs_triang | ring ]. +assert (H10 : Rmin a b = a). +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. +assert (H11 : Rmax a b = b). +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. +rewrite (Rplus_comm (psi_un x)); apply Rplus_le_compat. +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim H5; intros; apply H8. +rewrite H10; rewrite H11; elim H7; intros; split; left; assumption. +elim H6; intros; apply H8. +rewrite H10; rewrite H11; elim H7; intros; split; left; assumption. +rewrite StepFun_P30; rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat. +apply Rlt_trans with (pos (un n)). +elim H6; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_un)). +apply RRle_abs. +assumption. +replace (pos (un n)) with (Rabs (un n - 0)); + [ apply H; unfold ge in |- *; apply le_trans with N; try assumption; + unfold N in |- *; apply le_trans with (max N0 N1); + apply le_max_l + | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; + apply Rle_ge; left; apply (cond_pos (un n)) ]. +apply Rlt_trans with (pos (vn n)). +elim H5; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_vn)). +apply RRle_abs; assumption. +assumption. +replace (pos (vn n)) with (Rabs (vn n - 0)); + [ apply H0; unfold ge in |- *; apply le_trans with N; try assumption; + unfold N in |- *; apply le_trans with (max N0 N1); + [ apply le_max_r | apply le_max_l ] + | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; + apply Rle_ge; left; apply (cond_pos (vn n)) ]. +rewrite StepFun_P39; rewrite Rabs_Ropp; + apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P32 + (mkStepFun + (StepFun_P6 + (pre + (mkStepFun + (StepFun_P28 (-1) (phi_sequence vn pr2 n) + (phi_sequence un pr1 n))))))))). +apply StepFun_P34; try auto with real. +apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 1 psi_vn psi_un)))))). +apply StepFun_P37. +auto with real. +intros; simpl in |- *; rewrite Rmult_1_l; + apply Rle_trans with + (Rabs (phi_sequence vn pr2 n x - f x) + + Rabs (f x - phi_sequence un pr1 n x)). +replace (phi_sequence vn pr2 n x + -1 * phi_sequence un pr1 n x) with + (phi_sequence vn pr2 n x - f x + (f x - phi_sequence un pr1 n x)); + [ apply Rabs_triang | ring ]. +assert (H10 : Rmin a b = b). +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ elim n0; assumption | reflexivity ]. +assert (H11 : Rmax a b = a). +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ elim n0; assumption | reflexivity ]. +apply Rplus_le_compat. +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim H5; intros; apply H8. +rewrite H10; rewrite H11; elim H7; intros; split; left; assumption. +elim H6; intros; apply H8. +rewrite H10; rewrite H11; elim H7; intros; split; left; assumption. +rewrite <- + (Ropp_involutive + (RiemannInt_SF + (mkStepFun + (StepFun_P6 (pre (mkStepFun (StepFun_P28 1 psi_vn psi_un))))))) + ; rewrite <- StepFun_P39; rewrite StepFun_P30; rewrite Rmult_1_l; + rewrite double; rewrite Ropp_plus_distr; apply Rplus_lt_compat. +apply Rlt_trans with (pos (vn n)). +elim H5; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_vn)). +rewrite <- Rabs_Ropp; apply RRle_abs. +assumption. +replace (pos (vn n)) with (Rabs (vn n - 0)); + [ apply H0; unfold ge in |- *; apply le_trans with N; try assumption; + unfold N in |- *; apply le_trans with (max N0 N1); + [ apply le_max_r | apply le_max_l ] + | unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; + left; apply (cond_pos (vn n)) ]. +apply Rlt_trans with (pos (un n)). +elim H6; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_un)). +rewrite <- Rabs_Ropp; apply RRle_abs; assumption. +assumption. +replace (pos (un n)) with (Rabs (un n - 0)); + [ apply H; unfold ge in |- *; apply le_trans with N; try assumption; + unfold N in |- *; apply le_trans with (max N0 N1); + apply le_max_l + | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; + apply Rle_ge; left; apply (cond_pos (un n)) ]. +apply H1; unfold ge in |- *; apply le_trans with N; try assumption; + unfold N in |- *; apply le_max_r. +apply Rmult_eq_reg_l with 3; + [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l; + do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym; [ ring | discrR ] + | discrR ]. +Qed. + +Lemma RinvN_pos : forall n:nat, 0 < / (INR n + 1). +intro; apply Rinv_0_lt_compat; apply Rplus_le_lt_0_compat; + [ apply pos_INR | apply Rlt_0_1 ]. +Qed. + +Definition RinvN (N:nat) : posreal := mkposreal _ (RinvN_pos N). + +Lemma RinvN_cv : Un_cv RinvN 0. +unfold Un_cv in |- *; intros; assert (H0 := archimed (/ eps)); elim H0; + clear H0; intros; assert (H2 : (0 <= up (/ eps))%Z). +apply le_IZR; left; apply Rlt_trans with (/ eps); + [ apply Rinv_0_lt_compat; assumption | assumption ]. +elim (IZN _ H2); intros; exists x; intros; unfold R_dist in |- *; + simpl in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; assert (H5 : 0 < INR n + 1). +apply Rplus_le_lt_0_compat; [ apply pos_INR | apply Rlt_0_1 ]. +rewrite Rabs_right; + [ idtac + | left; change (0 < / (INR n + 1)) in |- *; apply Rinv_0_lt_compat; + assumption ]; apply Rle_lt_trans with (/ (INR x + 1)). +apply Rle_Rinv. +apply Rplus_le_lt_0_compat; [ apply pos_INR | apply Rlt_0_1 ]. +assumption. +do 2 rewrite <- (Rplus_comm 1); apply Rplus_le_compat_l; apply le_INR; + apply H4. +rewrite <- (Rinv_involutive eps). +apply Rinv_lt_contravar. +apply Rmult_lt_0_compat. +apply Rinv_0_lt_compat; assumption. +apply Rplus_le_lt_0_compat; [ apply pos_INR | apply Rlt_0_1 ]. +apply Rlt_trans with (INR x); + [ rewrite INR_IZR_INZ; rewrite <- H3; apply H0 + | pattern (INR x) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_lt_compat_l; apply Rlt_0_1 ]. +red in |- *; intro; rewrite H6 in H; elim (Rlt_irrefl _ H). +Qed. + +(**********) +Definition RiemannInt (f:R -> R) (a b:R) (pr:Riemann_integrable f a b) : R := + match RiemannInt_exists pr RinvN RinvN_cv with + | existT a' b' => a' + end. + +Lemma RiemannInt_P5 : + forall (f:R -> R) (a b:R) (pr1 pr2:Riemann_integrable f a b), + RiemannInt pr1 = RiemannInt pr2. +intros; unfold RiemannInt in |- *; + case (RiemannInt_exists pr1 RinvN RinvN_cv); + case (RiemannInt_exists pr2 RinvN RinvN_cv); intros; + eapply UL_sequence; + [ apply u0 + | apply RiemannInt_P4 with pr2 RinvN; apply RinvN_cv || assumption ]. +Qed. + +(**************************************) +(* C°([a,b]) is included in L1([a,b]) *) +(**************************************) + +Lemma maxN : + forall (a b:R) (del:posreal), + a < b -> + sigT (fun n:nat => a + INR n * del < b /\ b <= a + INR (S n) * del). +intros; set (I := fun n:nat => a + INR n * del < b); + assert (H0 : exists n : nat, I n). +exists 0%nat; unfold I in |- *; rewrite Rmult_0_l; rewrite Rplus_0_r; + assumption. +cut (Nbound I). +intro; assert (H2 := Nzorn H0 H1); elim H2; intros; exists x; elim p; intros; + split. +apply H3. +case (total_order_T (a + INR (S x) * del) b); intro. +elim s; intro. +assert (H5 := H4 (S x) a0); elim (le_Sn_n _ H5). +right; symmetry in |- *; assumption. +left; apply r. +assert (H1 : 0 <= (b - a) / del). +unfold Rdiv in |- *; apply Rmult_le_pos; + [ apply Rge_le; apply Rge_minus; apply Rle_ge; left; apply H + | left; apply Rinv_0_lt_compat; apply (cond_pos del) ]. +elim (archimed ((b - a) / del)); intros; + assert (H4 : (0 <= up ((b - a) / del))%Z). +apply le_IZR; simpl in |- *; left; apply Rle_lt_trans with ((b - a) / del); + assumption. +assert (H5 := IZN _ H4); elim H5; clear H5; intros N H5; + unfold Nbound in |- *; exists N; intros; unfold I in H6; + apply INR_le; rewrite H5 in H2; rewrite <- INR_IZR_INZ in H2; + left; apply Rle_lt_trans with ((b - a) / del); try assumption; + apply Rmult_le_reg_l with (pos del); + [ apply (cond_pos del) + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ del)); + rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite Rmult_comm; apply Rplus_le_reg_l with a; + replace (a + (b - a)) with b; [ left; assumption | ring ] + | assert (H7 := cond_pos del); red in |- *; intro; rewrite H8 in H7; + elim (Rlt_irrefl _ H7) ] ]. +Qed. + +Fixpoint SubEquiN (N:nat) (x y:R) (del:posreal) {struct N} : Rlist := + match N with + | O => cons y nil + | S p => cons x (SubEquiN p (x + del) y del) + end. + +Definition max_N (a b:R) (del:posreal) (h:a < b) : nat := + match maxN del h with + | existT N H0 => N + end. + +Definition SubEqui (a b:R) (del:posreal) (h:a < b) : Rlist := + SubEquiN (S (max_N del h)) a b del. + +Lemma Heine_cor1 : + forall (f:R -> R) (a b:R), + a < b -> + (forall x:R, a <= x <= b -> continuity_pt f x) -> + forall eps:posreal, + sigT + (fun delta:posreal => + delta <= b - a /\ + (forall x y:R, + a <= x <= b -> + a <= y <= b -> Rabs (x - y) < delta -> Rabs (f x - f y) < eps)). +intro f; intros; + set + (E := + fun l:R => + 0 < l <= b - a /\ + (forall x y:R, + a <= x <= b -> + a <= y <= b -> Rabs (x - y) < l -> Rabs (f x - f y) < eps)); + assert (H1 : bound E). +unfold bound in |- *; exists (b - a); unfold is_upper_bound in |- *; intros; + unfold E in H1; elim H1; clear H1; intros H1 _; elim H1; + intros; assumption. +assert (H2 : exists x : R, E x). +assert (H2 := Heine f (fun x:R => a <= x <= b) (compact_P3 a b) H0 eps); + elim H2; intros; exists (Rmin x (b - a)); unfold E in |- *; + split; + [ split; + [ unfold Rmin in |- *; case (Rle_dec x (b - a)); intro; + [ apply (cond_pos x) | apply Rlt_Rminus; assumption ] + | apply Rmin_r ] + | intros; apply H3; try assumption; apply Rlt_le_trans with (Rmin x (b - a)); + [ assumption | apply Rmin_l ] ]. +assert (H3 := completeness E H1 H2); elim H3; intros; cut (0 < x <= b - a). +intro; elim H4; clear H4; intros; apply existT with (mkposreal _ H4); split. +apply H5. +unfold is_lub in p; elim p; intros; unfold is_upper_bound in H6; + set (D := Rabs (x0 - y)); elim (classic (exists y : R, D < y /\ E y)); + intro. +elim H11; intros; elim H12; clear H12; intros; unfold E in H13; elim H13; + intros; apply H15; assumption. +assert (H12 := not_ex_all_not _ (fun y:R => D < y /\ E y) H11); + assert (H13 : is_upper_bound E D). +unfold is_upper_bound in |- *; intros; assert (H14 := H12 x1); + elim (not_and_or (D < x1) (E x1) H14); intro. +case (Rle_dec x1 D); intro. +assumption. +elim H15; auto with real. +elim H15; assumption. +assert (H14 := H7 _ H13); elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H14 H10)). +unfold is_lub in p; unfold is_upper_bound in p; elim p; clear p; intros; + split. +elim H2; intros; assert (H7 := H4 _ H6); unfold E in H6; elim H6; clear H6; + intros H6 _; elim H6; intros; apply Rlt_le_trans with x0; + assumption. +apply H5; intros; unfold E in H6; elim H6; clear H6; intros H6 _; elim H6; + intros; assumption. +Qed. + +Lemma Heine_cor2 : + forall (f:R -> R) (a b:R), + (forall x:R, a <= x <= b -> continuity_pt f x) -> + forall eps:posreal, + sigT + (fun delta:posreal => + forall x y:R, + a <= x <= b -> + a <= y <= b -> Rabs (x - y) < delta -> Rabs (f x - f y) < eps). +intro f; intros; case (total_order_T a b); intro. +elim s; intro. +assert (H0 := Heine_cor1 a0 H eps); elim H0; intros; apply existT with x; + elim p; intros; apply H2; assumption. +apply existT with (mkposreal _ Rlt_0_1); intros; assert (H3 : x = y); + [ elim H0; elim H1; intros; rewrite b0 in H3; rewrite b0 in H5; + apply Rle_antisym; apply Rle_trans with b; assumption + | rewrite H3; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + apply (cond_pos eps) ]. +apply existT with (mkposreal _ Rlt_0_1); intros; elim H0; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (Rle_trans _ _ _ H3 H4) r)). +Qed. + +Lemma SubEqui_P1 : + forall (a b:R) (del:posreal) (h:a < b), pos_Rl (SubEqui del h) 0 = a. +intros; unfold SubEqui in |- *; case (maxN del h); intros; reflexivity. +Qed. + +Lemma SubEqui_P2 : + forall (a b:R) (del:posreal) (h:a < b), + pos_Rl (SubEqui del h) (pred (Rlength (SubEqui del h))) = b. +intros; unfold SubEqui in |- *; case (maxN del h); intros; clear a0; + cut + (forall (x:nat) (a:R) (del:posreal), + pos_Rl (SubEquiN (S x) a b del) + (pred (Rlength (SubEquiN (S x) a b del))) = b); + [ intro; apply H + | simple induction x0; + [ intros; reflexivity + | intros; + change + (pos_Rl (SubEquiN (S n) (a0 + del0) b del0) + (pred (Rlength (SubEquiN (S n) (a0 + del0) b del0))) = b) + in |- *; apply H ] ]. +Qed. + +Lemma SubEqui_P3 : + forall (N:nat) (a b:R) (del:posreal), Rlength (SubEquiN N a b del) = S N. +simple induction N; intros; + [ reflexivity | simpl in |- *; rewrite H; reflexivity ]. +Qed. + +Lemma SubEqui_P4 : + forall (N:nat) (a b:R) (del:posreal) (i:nat), + (i < S N)%nat -> pos_Rl (SubEquiN (S N) a b del) i = a + INR i * del. +simple induction N; + [ intros; inversion H; [ simpl in |- *; ring | elim (le_Sn_O _ H1) ] + | intros; induction i as [| i Hreci]; + [ simpl in |- *; ring + | change + (pos_Rl (SubEquiN (S n) (a + del) b del) i = a + INR (S i) * del) + in |- *; rewrite H; [ rewrite S_INR; ring | apply lt_S_n; apply H0 ] ] ]. +Qed. + +Lemma SubEqui_P5 : + forall (a b:R) (del:posreal) (h:a < b), + Rlength (SubEqui del h) = S (S (max_N del h)). +intros; unfold SubEqui in |- *; apply SubEqui_P3. +Qed. + +Lemma SubEqui_P6 : + forall (a b:R) (del:posreal) (h:a < b) (i:nat), + (i < S (max_N del h))%nat -> pos_Rl (SubEqui del h) i = a + INR i * del. +intros; unfold SubEqui in |- *; apply SubEqui_P4; assumption. +Qed. + +Lemma SubEqui_P7 : + forall (a b:R) (del:posreal) (h:a < b), ordered_Rlist (SubEqui del h). +intros; unfold ordered_Rlist in |- *; intros; rewrite SubEqui_P5 in H; + simpl in H; inversion H. +rewrite (SubEqui_P6 del h (i:=(max_N del h))). +replace (S (max_N del h)) with (pred (Rlength (SubEqui del h))). +rewrite SubEqui_P2; unfold max_N in |- *; case (maxN del h); intros; left; + elim a0; intros; assumption. +rewrite SubEqui_P5; reflexivity. +apply lt_n_Sn. +repeat rewrite SubEqui_P6. +3: assumption. +2: apply le_lt_n_Sm; assumption. +apply Rplus_le_compat_l; rewrite S_INR; rewrite Rmult_plus_distr_r; + pattern (INR i * del) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_le_compat_l; rewrite Rmult_1_l; left; + apply (cond_pos del). +Qed. + +Lemma SubEqui_P8 : + forall (a b:R) (del:posreal) (h:a < b) (i:nat), + (i < Rlength (SubEqui del h))%nat -> a <= pos_Rl (SubEqui del h) i <= b. +intros; split. +pattern a at 1 in |- *; rewrite <- (SubEqui_P1 del h); apply RList_P5. +apply SubEqui_P7. +elim (RList_P3 (SubEqui del h) (pos_Rl (SubEqui del h) i)); intros; apply H1; + exists i; split; [ reflexivity | assumption ]. +pattern b at 2 in |- *; rewrite <- (SubEqui_P2 del h); apply RList_P7; + [ apply SubEqui_P7 + | elim (RList_P3 (SubEqui del h) (pos_Rl (SubEqui del h) i)); intros; + apply H1; exists i; split; [ reflexivity | assumption ] ]. +Qed. + +Lemma SubEqui_P9 : + forall (a b:R) (del:posreal) (f:R -> R) (h:a < b), + sigT + (fun g:StepFun a b => + g b = f b /\ + (forall i:nat, + (i < pred (Rlength (SubEqui del h)))%nat -> + constant_D_eq g + (co_interval (pos_Rl (SubEqui del h) i) + (pos_Rl (SubEqui del h) (S i))) + (f (pos_Rl (SubEqui del h) i)))). +intros; apply StepFun_P38; + [ apply SubEqui_P7 | apply SubEqui_P1 | apply SubEqui_P2 ]. +Qed. + +Lemma RiemannInt_P6 : + forall (f:R -> R) (a b:R), + a < b -> + (forall x:R, a <= x <= b -> continuity_pt f x) -> Riemann_integrable f a b. +intros; unfold Riemann_integrable in |- *; intro; + assert (H1 : 0 < eps / (2 * (b - a))). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos eps) + | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat; + [ prove_sup0 | apply Rlt_Rminus; assumption ] ]. +assert (H2 : Rmin a b = a). +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; left; assumption ]. +assert (H3 : Rmax a b = b). +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; left; assumption ]. +elim (Heine_cor2 H0 (mkposreal _ H1)); intros del H4; + elim (SubEqui_P9 del f H); intros phi [H5 H6]; split with phi; + split with (mkStepFun (StepFun_P4 a b (eps / (2 * (b - a))))); + split. +2: rewrite StepFun_P18; unfold Rdiv in |- *; rewrite Rinv_mult_distr. +2: do 2 rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +2: rewrite Rmult_1_r; rewrite Rabs_right. +2: apply Rmult_lt_reg_l with 2. +2: prove_sup0. +2: rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym. +2: rewrite Rmult_1_l; pattern (pos eps) at 1 in |- *; rewrite <- Rplus_0_r; + rewrite double; apply Rplus_lt_compat_l; apply (cond_pos eps). +2: discrR. +2: apply Rle_ge; left; apply Rmult_lt_0_compat. +2: apply (cond_pos eps). +2: apply Rinv_0_lt_compat; prove_sup0. +2: apply Rminus_eq_contra; red in |- *; intro; clear H6; rewrite H7 in H; + elim (Rlt_irrefl _ H). +2: discrR. +2: apply Rminus_eq_contra; red in |- *; intro; clear H6; rewrite H7 in H; + elim (Rlt_irrefl _ H). +intros; rewrite H2 in H7; rewrite H3 in H7; simpl in |- *; + unfold fct_cte in |- *; + cut + (forall t:R, + a <= t <= b -> + t = b \/ + (exists i : nat, + (i < pred (Rlength (SubEqui del H)))%nat /\ + co_interval (pos_Rl (SubEqui del H) i) (pos_Rl (SubEqui del H) (S i)) + t)). +intro; elim (H8 _ H7); intro. +rewrite H9; rewrite H5; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rabs_R0; left; assumption. +elim H9; clear H9; intros I [H9 H10]; assert (H11 := H6 I H9 t H10); + rewrite H11; left; apply H4. +assumption. +apply SubEqui_P8; apply lt_trans with (pred (Rlength (SubEqui del H))). +assumption. +apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H9; + elim (lt_n_O _ H9). +unfold co_interval in H10; elim H10; clear H10; intros; rewrite Rabs_right. +rewrite SubEqui_P5 in H9; simpl in H9; inversion H9. +apply Rplus_lt_reg_r with (pos_Rl (SubEqui del H) (max_N del H)). +replace + (pos_Rl (SubEqui del H) (max_N del H) + + (t - pos_Rl (SubEqui del H) (max_N del H))) with t; + [ idtac | ring ]; apply Rlt_le_trans with b. +rewrite H14 in H12; + assert (H13 : S (max_N del H) = pred (Rlength (SubEqui del H))). +rewrite SubEqui_P5; reflexivity. +rewrite H13 in H12; rewrite SubEqui_P2 in H12; apply H12. +rewrite SubEqui_P6. +2: apply lt_n_Sn. +unfold max_N in |- *; case (maxN del H); intros; elim a0; clear a0; + intros _ H13; replace (a + INR x * del + del) with (a + INR (S x) * del); + [ assumption | rewrite S_INR; ring ]. +apply Rplus_lt_reg_r with (pos_Rl (SubEqui del H) I); + replace (pos_Rl (SubEqui del H) I + (t - pos_Rl (SubEqui del H) I)) with t; + [ idtac | ring ]; + replace (pos_Rl (SubEqui del H) I + del) with (pos_Rl (SubEqui del H) (S I)). +assumption. +repeat rewrite SubEqui_P6. +rewrite S_INR; ring. +assumption. +apply le_lt_n_Sm; assumption. +apply Rge_minus; apply Rle_ge; assumption. +intros; clear H0 H1 H4 phi H5 H6 t H7; case (Req_dec t0 b); intro. +left; assumption. +right; set (I := fun j:nat => a + INR j * del <= t0); + assert (H1 : exists n : nat, I n). +exists 0%nat; unfold I in |- *; rewrite Rmult_0_l; rewrite Rplus_0_r; elim H8; + intros; assumption. +assert (H4 : Nbound I). +unfold Nbound in |- *; exists (S (max_N del H)); intros; unfold max_N in |- *; + case (maxN del H); intros; elim a0; clear a0; intros _ H5; + apply INR_le; apply Rmult_le_reg_l with (pos del). +apply (cond_pos del). +apply Rplus_le_reg_l with a; do 2 rewrite (Rmult_comm del); + apply Rle_trans with t0; unfold I in H4; try assumption; + apply Rle_trans with b; try assumption; elim H8; intros; + assumption. +elim (Nzorn H1 H4); intros N [H5 H6]; assert (H7 : (N < S (max_N del H))%nat). +unfold max_N in |- *; case (maxN del H); intros; apply INR_lt; + apply Rmult_lt_reg_l with (pos del). +apply (cond_pos del). +apply Rplus_lt_reg_r with a; do 2 rewrite (Rmult_comm del); + apply Rle_lt_trans with t0; unfold I in H5; try assumption; + elim a0; intros; apply Rlt_le_trans with b; try assumption; + elim H8; intros. +elim H11; intro. +assumption. +elim H0; assumption. +exists N; split. +rewrite SubEqui_P5; simpl in |- *; assumption. +unfold co_interval in |- *; split. +rewrite SubEqui_P6. +apply H5. +assumption. +inversion H7. +replace (S (max_N del H)) with (pred (Rlength (SubEqui del H))). +rewrite (SubEqui_P2 del H); elim H8; intros. +elim H11; intro. +assumption. +elim H0; assumption. +rewrite SubEqui_P5; reflexivity. +rewrite SubEqui_P6. +case (Rle_dec (a + INR (S N) * del) t0); intro. +assert (H11 := H6 (S N) r); elim (le_Sn_n _ H11). +auto with real. +apply le_lt_n_Sm; assumption. +Qed. + +Lemma RiemannInt_P7 : forall (f:R -> R) (a:R), Riemann_integrable f a a. +unfold Riemann_integrable in |- *; intro f; intros; + split with (mkStepFun (StepFun_P4 a a (f a))); + split with (mkStepFun (StepFun_P4 a a 0)); split. +intros; simpl in |- *; unfold fct_cte in |- *; replace t with a. +unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; right; + reflexivity. +generalize H; unfold Rmin, Rmax in |- *; case (Rle_dec a a); intros; elim H0; + intros; apply Rle_antisym; assumption. +rewrite StepFun_P18; rewrite Rmult_0_l; rewrite Rabs_R0; apply (cond_pos eps). +Qed. + +Lemma continuity_implies_RiemannInt : + forall (f:R -> R) (a b:R), + a <= b -> + (forall x:R, a <= x <= b -> continuity_pt f x) -> Riemann_integrable f a b. +intros; case (total_order_T a b); intro; + [ elim s; intro; + [ apply RiemannInt_P6; assumption | rewrite b0; apply RiemannInt_P7 ] + | elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)) ]. +Qed. + +Lemma RiemannInt_P8 : + forall (f:R -> R) (a b:R) (pr1:Riemann_integrable f a b) + (pr2:Riemann_integrable f b a), RiemannInt pr1 = - RiemannInt pr2. +intro f; intros; eapply UL_sequence. +unfold RiemannInt in |- *; case (RiemannInt_exists pr1 RinvN RinvN_cv); + intros; apply u. +unfold RiemannInt in |- *; case (RiemannInt_exists pr2 RinvN RinvN_cv); + intros; + cut + (exists psi1 : nat -> StepFun a b, + (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> + Rabs (f t - phi_sequence RinvN pr1 n t) <= psi1 n t) /\ + Rabs (RiemannInt_SF (psi1 n)) < RinvN n)). +cut + (exists psi2 : nat -> StepFun b a, + (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> + Rabs (f t - phi_sequence RinvN pr2 n t) <= psi2 n t) /\ + Rabs (RiemannInt_SF (psi2 n)) < RinvN n)). +intros; elim H; clear H; intros psi2 H; elim H0; clear H0; intros psi1 H0; + assert (H1 := RinvN_cv); unfold Un_cv in |- *; intros; + assert (H3 : 0 < eps / 3). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +unfold Un_cv in H1; elim (H1 _ H3); clear H1; intros N0 H1; + unfold R_dist in H1; simpl in H1; + assert (H4 : forall n:nat, (n >= N0)%nat -> RinvN n < eps / 3). +intros; assert (H5 := H1 _ H4); + replace (pos (RinvN n)) with (Rabs (/ (INR n + 1) - 0)); + [ assumption + | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; + left; apply (cond_pos (RinvN n)) ]. +clear H1; unfold Un_cv in u; elim (u _ H3); clear u; intros N1 H1; + exists (max N0 N1); intros; unfold R_dist in |- *; + apply Rle_lt_trans with + (Rabs + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + RiemannInt_SF (phi_sequence RinvN pr2 n)) + + Rabs (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)). +rewrite <- (Rabs_Ropp (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)); + replace (RiemannInt_SF (phi_sequence RinvN pr1 n) - - x) with + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + RiemannInt_SF (phi_sequence RinvN pr2 n) + + - (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)); + [ apply Rabs_triang | ring ]. +replace eps with (2 * (eps / 3) + eps / 3). +apply Rplus_lt_compat. +rewrite (StepFun_P39 (phi_sequence RinvN pr2 n)); + replace + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + - RiemannInt_SF (mkStepFun (StepFun_P6 (pre (phi_sequence RinvN pr2 n))))) + with + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + -1 * + RiemannInt_SF (mkStepFun (StepFun_P6 (pre (phi_sequence RinvN pr2 n))))); + [ idtac | ring ]; rewrite <- StepFun_P30. +case (Rle_dec a b); intro. +apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P32 + (mkStepFun + (StepFun_P28 (-1) (phi_sequence RinvN pr1 n) + (mkStepFun (StepFun_P6 (pre (phi_sequence RinvN pr2 n))))))))). +apply StepFun_P34; assumption. +apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P28 1 (psi1 n) (mkStepFun (StepFun_P6 (pre (psi2 n))))))). +apply StepFun_P37; try assumption. +intros; simpl in |- *; rewrite Rmult_1_l; + apply Rle_trans with + (Rabs (phi_sequence RinvN pr1 n x0 - f x0) + + Rabs (f x0 - phi_sequence RinvN pr2 n x0)). +replace (phi_sequence RinvN pr1 n x0 + -1 * phi_sequence RinvN pr2 n x0) with + (phi_sequence RinvN pr1 n x0 - f x0 + (f x0 - phi_sequence RinvN pr2 n x0)); + [ apply Rabs_triang | ring ]. +assert (H7 : Rmin a b = a). +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. +assert (H8 : Rmax a b = b). +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. +apply Rplus_le_compat. +elim (H0 n); intros; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H9; + rewrite H7; rewrite H8. +elim H6; intros; split; left; assumption. +elim (H n); intros; apply H9; rewrite H7; rewrite H8. +elim H6; intros; split; left; assumption. +rewrite StepFun_P30; rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat. +elim (H0 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))); + [ apply RRle_abs + | apply Rlt_trans with (pos (RinvN n)); + [ assumption + | apply H4; unfold ge in |- *; apply le_trans with (max N0 N1); + [ apply le_max_l | assumption ] ] ]. +elim (H n); intros; + rewrite <- + (Ropp_involutive (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (psi2 n)))))) + ; rewrite <- StepFun_P39; + apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))); + [ rewrite <- Rabs_Ropp; apply RRle_abs + | apply Rlt_trans with (pos (RinvN n)); + [ assumption + | apply H4; unfold ge in |- *; apply le_trans with (max N0 N1); + [ apply le_max_l | assumption ] ] ]. +assert (Hyp : b <= a). +auto with real. +rewrite StepFun_P39; rewrite Rabs_Ropp; + apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P32 + (mkStepFun + (StepFun_P6 + (StepFun_P28 (-1) (phi_sequence RinvN pr1 n) + (mkStepFun (StepFun_P6 (pre (phi_sequence RinvN pr2 n)))))))))). +apply StepFun_P34; assumption. +apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P28 1 (mkStepFun (StepFun_P6 (pre (psi1 n)))) (psi2 n)))). +apply StepFun_P37; try assumption. +intros; simpl in |- *; rewrite Rmult_1_l; + apply Rle_trans with + (Rabs (phi_sequence RinvN pr1 n x0 - f x0) + + Rabs (f x0 - phi_sequence RinvN pr2 n x0)). +replace (phi_sequence RinvN pr1 n x0 + -1 * phi_sequence RinvN pr2 n x0) with + (phi_sequence RinvN pr1 n x0 - f x0 + (f x0 - phi_sequence RinvN pr2 n x0)); + [ apply Rabs_triang | ring ]. +assert (H7 : Rmin a b = b). +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ elim n0; assumption | reflexivity ]. +assert (H8 : Rmax a b = a). +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ elim n0; assumption | reflexivity ]. +apply Rplus_le_compat. +elim (H0 n); intros; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H9; + rewrite H7; rewrite H8. +elim H6; intros; split; left; assumption. +elim (H n); intros; apply H9; rewrite H7; rewrite H8; elim H6; intros; split; + left; assumption. +rewrite StepFun_P30; rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat. +elim (H0 n); intros; + rewrite <- + (Ropp_involutive (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (psi1 n)))))) + ; rewrite <- StepFun_P39; + apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))); + [ rewrite <- Rabs_Ropp; apply RRle_abs + | apply Rlt_trans with (pos (RinvN n)); + [ assumption + | apply H4; unfold ge in |- *; apply le_trans with (max N0 N1); + [ apply le_max_l | assumption ] ] ]. +elim (H n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))); + [ apply RRle_abs + | apply Rlt_trans with (pos (RinvN n)); + [ assumption + | apply H4; unfold ge in |- *; apply le_trans with (max N0 N1); + [ apply le_max_l | assumption ] ] ]. +unfold R_dist in H1; apply H1; unfold ge in |- *; + apply le_trans with (max N0 N1); [ apply le_max_r | assumption ]. +apply Rmult_eq_reg_l with 3; + [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l; + do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym; [ ring | discrR ] + | discrR ]. +split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr2 n)); intro; + rewrite Rmin_comm; rewrite RmaxSym; + apply (projT2 (phi_sequence_prop RinvN pr2 n)). +split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr1 n)). +Qed. + +Lemma RiemannInt_P9 : + forall (f:R -> R) (a:R) (pr:Riemann_integrable f a a), RiemannInt pr = 0. +intros; assert (H := RiemannInt_P8 pr pr); apply Rmult_eq_reg_l with 2; + [ rewrite Rmult_0_r; rewrite double; pattern (RiemannInt pr) at 2 in |- *; + rewrite H; apply Rplus_opp_r + | discrR ]. +Qed. + +Lemma Req_EM_T : forall r1 r2:R, {r1 = r2} + {r1 <> r2}. +intros; elim (total_order_T r1 r2); intros; + [ elim a; intro; + [ right; red in |- *; intro; rewrite H in a0; elim (Rlt_irrefl r2 a0) + | left; assumption ] + | right; red in |- *; intro; rewrite H in b; elim (Rlt_irrefl r2 b) ]. +Qed. + +(* L1([a,b]) is a vectorial space *) +Lemma RiemannInt_P10 : + forall (f g:R -> R) (a b l:R), + Riemann_integrable f a b -> + Riemann_integrable g a b -> + Riemann_integrable (fun x:R => f x + l * g x) a b. +unfold Riemann_integrable in |- *; intros f g; intros; case (Req_EM_T l 0); + intro. +elim (X eps); intros; split with x; elim p; intros; split with x0; elim p0; + intros; split; try assumption; rewrite e; intros; + rewrite Rmult_0_l; rewrite Rplus_0_r; apply H; assumption. +assert (H : 0 < eps / 2). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ]. +assert (H0 : 0 < eps / (2 * Rabs l)). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos eps) + | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat; + [ prove_sup0 | apply Rabs_pos_lt; assumption ] ]. +elim (X (mkposreal _ H)); intros; elim (X0 (mkposreal _ H0)); intros; + split with (mkStepFun (StepFun_P28 l x x0)); elim p0; + elim p; intros; split with (mkStepFun (StepFun_P28 (Rabs l) x1 x2)); + elim p1; elim p2; clear p1 p2 p0 p X X0; intros; split. +intros; simpl in |- *; + apply Rle_trans with (Rabs (f t - x t) + Rabs (l * (g t - x0 t))). +replace (f t + l * g t - (x t + l * x0 t)) with + (f t - x t + l * (g t - x0 t)); [ apply Rabs_triang | ring ]. +apply Rplus_le_compat; + [ apply H3; assumption + | rewrite Rabs_mult; apply Rmult_le_compat_l; + [ apply Rabs_pos | apply H1; assumption ] ]. +rewrite StepFun_P30; + apply Rle_lt_trans with + (Rabs (RiemannInt_SF x1) + Rabs (Rabs l * RiemannInt_SF x2)). +apply Rabs_triang. +rewrite (double_var eps); apply Rplus_lt_compat. +apply H4. +rewrite Rabs_mult; rewrite Rabs_Rabsolu; apply Rmult_lt_reg_l with (/ Rabs l). +apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym; + [ rewrite Rmult_1_l; + replace (/ Rabs l * (eps / 2)) with (eps / (2 * Rabs l)); + [ apply H2 + | unfold Rdiv in |- *; rewrite Rinv_mult_distr; + [ ring | discrR | apply Rabs_no_R0; assumption ] ] + | apply Rabs_no_R0; assumption ]. +Qed. + +Lemma RiemannInt_P11 : + forall (f:R -> R) (a b l:R) (un:nat -> posreal) + (phi1 phi2 psi1 psi2:nat -> StepFun a b), + Un_cv un 0 -> + (forall n:nat, + (forall t:R, + Rmin a b <= t <= Rmax a b -> Rabs (f t - phi1 n t) <= psi1 n t) /\ + Rabs (RiemannInt_SF (psi1 n)) < un n) -> + (forall n:nat, + (forall t:R, + Rmin a b <= t <= Rmax a b -> Rabs (f t - phi2 n t) <= psi2 n t) /\ + Rabs (RiemannInt_SF (psi2 n)) < un n) -> + Un_cv (fun N:nat => RiemannInt_SF (phi1 N)) l -> + Un_cv (fun N:nat => RiemannInt_SF (phi2 N)) l. +unfold Un_cv in |- *; intro f; intros; intros. +case (Rle_dec a b); intro Hyp. +assert (H4 : 0 < eps / 3). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +elim (H _ H4); clear H; intros N0 H. +elim (H2 _ H4); clear H2; intros N1 H2. +set (N := max N0 N1); exists N; intros; unfold R_dist in |- *. +apply Rle_lt_trans with + (Rabs (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) + + Rabs (RiemannInt_SF (phi1 n) - l)). +replace (RiemannInt_SF (phi2 n) - l) with + (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n) + + (RiemannInt_SF (phi1 n) - l)); [ apply Rabs_triang | ring ]. +replace eps with (2 * (eps / 3) + eps / 3). +apply Rplus_lt_compat. +replace (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) with + (RiemannInt_SF (phi2 n) + -1 * RiemannInt_SF (phi1 n)); + [ idtac | ring ]. +rewrite <- StepFun_P30. +apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (phi2 n) (phi1 n)))))). +apply StepFun_P34; assumption. +apply Rle_lt_trans with + (RiemannInt_SF (mkStepFun (StepFun_P28 1 (psi1 n) (psi2 n)))). +apply StepFun_P37; try assumption; intros; simpl in |- *; rewrite Rmult_1_l. +apply Rle_trans with (Rabs (phi2 n x - f x) + Rabs (f x - phi1 n x)). +replace (phi2 n x + -1 * phi1 n x) with (phi2 n x - f x + (f x - phi1 n x)); + [ apply Rabs_triang | ring ]. +rewrite (Rplus_comm (psi1 n x)); apply Rplus_le_compat. +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim (H1 n); intros; apply H7. +assert (H10 : Rmin a b = a). +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. +assert (H11 : Rmax a b = b). +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. +rewrite H10; rewrite H11; elim H6; intros; split; left; assumption. +elim (H0 n); intros; apply H7; assert (H10 : Rmin a b = a). +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. +assert (H11 : Rmax a b = b). +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. +rewrite H10; rewrite H11; elim H6; intros; split; left; assumption. +rewrite StepFun_P30; rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat. +apply Rlt_trans with (pos (un n)). +elim (H0 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))). +apply RRle_abs. +assumption. +replace (pos (un n)) with (R_dist (un n) 0). +apply H; unfold ge in |- *; apply le_trans with N; try assumption. +unfold N in |- *; apply le_max_l. +unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; apply Rabs_right. +apply Rle_ge; left; apply (cond_pos (un n)). +apply Rlt_trans with (pos (un n)). +elim (H1 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))). +apply RRle_abs; assumption. +assumption. +replace (pos (un n)) with (R_dist (un n) 0). +apply H; unfold ge in |- *; apply le_trans with N; try assumption; + unfold N in |- *; apply le_max_l. +unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; + left; apply (cond_pos (un n)). +unfold R_dist in H2; apply H2; unfold ge in |- *; apply le_trans with N; + try assumption; unfold N in |- *; apply le_max_r. +apply Rmult_eq_reg_l with 3; + [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l; + do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym; [ ring | discrR ] + | discrR ]. +assert (H4 : 0 < eps / 3). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +elim (H _ H4); clear H; intros N0 H. +elim (H2 _ H4); clear H2; intros N1 H2. +set (N := max N0 N1); exists N; intros; unfold R_dist in |- *. +apply Rle_lt_trans with + (Rabs (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) + + Rabs (RiemannInt_SF (phi1 n) - l)). +replace (RiemannInt_SF (phi2 n) - l) with + (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n) + + (RiemannInt_SF (phi1 n) - l)); [ apply Rabs_triang | ring ]. +assert (Hyp_b : b <= a). +auto with real. +replace eps with (2 * (eps / 3) + eps / 3). +apply Rplus_lt_compat. +replace (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) with + (RiemannInt_SF (phi2 n) + -1 * RiemannInt_SF (phi1 n)); + [ idtac | ring ]. +rewrite <- StepFun_P30. +rewrite StepFun_P39. +rewrite Rabs_Ropp. +apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P32 + (mkStepFun + (StepFun_P6 + (pre (mkStepFun (StepFun_P28 (-1) (phi2 n) (phi1 n))))))))). +apply StepFun_P34; try assumption. +apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P6 (pre (mkStepFun (StepFun_P28 1 (psi1 n) (psi2 n))))))). +apply StepFun_P37; try assumption. +intros; simpl in |- *; rewrite Rmult_1_l. +apply Rle_trans with (Rabs (phi2 n x - f x) + Rabs (f x - phi1 n x)). +replace (phi2 n x + -1 * phi1 n x) with (phi2 n x - f x + (f x - phi1 n x)); + [ apply Rabs_triang | ring ]. +rewrite (Rplus_comm (psi1 n x)); apply Rplus_le_compat. +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim (H1 n); intros; apply H7. +assert (H10 : Rmin a b = b). +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ elim Hyp; assumption | reflexivity ]. +assert (H11 : Rmax a b = a). +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ elim Hyp; assumption | reflexivity ]. +rewrite H10; rewrite H11; elim H6; intros; split; left; assumption. +elim (H0 n); intros; apply H7; assert (H10 : Rmin a b = b). +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ elim Hyp; assumption | reflexivity ]. +assert (H11 : Rmax a b = a). +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ elim Hyp; assumption | reflexivity ]. +rewrite H10; rewrite H11; elim H6; intros; split; left; assumption. +rewrite <- + (Ropp_involutive + (RiemannInt_SF + (mkStepFun + (StepFun_P6 (pre (mkStepFun (StepFun_P28 1 (psi1 n) (psi2 n)))))))) + . +rewrite <- StepFun_P39. +rewrite StepFun_P30. +rewrite Rmult_1_l; rewrite double. +rewrite Ropp_plus_distr; apply Rplus_lt_compat. +apply Rlt_trans with (pos (un n)). +elim (H0 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))). +rewrite <- Rabs_Ropp; apply RRle_abs. +assumption. +replace (pos (un n)) with (R_dist (un n) 0). +apply H; unfold ge in |- *; apply le_trans with N; try assumption. +unfold N in |- *; apply le_max_l. +unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; apply Rabs_right. +apply Rle_ge; left; apply (cond_pos (un n)). +apply Rlt_trans with (pos (un n)). +elim (H1 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))). +rewrite <- Rabs_Ropp; apply RRle_abs; assumption. +assumption. +replace (pos (un n)) with (R_dist (un n) 0). +apply H; unfold ge in |- *; apply le_trans with N; try assumption; + unfold N in |- *; apply le_max_l. +unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; + left; apply (cond_pos (un n)). +unfold R_dist in H2; apply H2; unfold ge in |- *; apply le_trans with N; + try assumption; unfold N in |- *; apply le_max_r. +apply Rmult_eq_reg_l with 3; + [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l; + do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym; [ ring | discrR ] + | discrR ]. +Qed. + +Lemma RiemannInt_P12 : + forall (f g:R -> R) (a b l:R) (pr1:Riemann_integrable f a b) + (pr2:Riemann_integrable g a b) + (pr3:Riemann_integrable (fun x:R => f x + l * g x) a b), + a <= b -> RiemannInt pr3 = RiemannInt pr1 + l * RiemannInt pr2. +intro f; intros; case (Req_dec l 0); intro. +pattern l at 2 in |- *; rewrite H0; rewrite Rmult_0_l; rewrite Rplus_0_r; + unfold RiemannInt in |- *; case (RiemannInt_exists pr3 RinvN RinvN_cv); + case (RiemannInt_exists pr1 RinvN RinvN_cv); intros; + eapply UL_sequence; + [ apply u0 + | set (psi1 := fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); + set (psi2 := fun n:nat => projT1 (phi_sequence_prop RinvN pr3 n)); + apply RiemannInt_P11 with f RinvN (phi_sequence RinvN pr1) psi1 psi2; + [ apply RinvN_cv + | intro; apply (projT2 (phi_sequence_prop RinvN pr1 n)) + | intro; + assert + (H1 : + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> + Rabs (f t + l * g t - phi_sequence RinvN pr3 n t) <= psi2 n t) /\ + Rabs (RiemannInt_SF (psi2 n)) < RinvN n); + [ apply (projT2 (phi_sequence_prop RinvN pr3 n)) + | elim H1; intros; split; try assumption; intros; + replace (f t) with (f t + l * g t); + [ apply H2; assumption | rewrite H0; ring ] ] + | assumption ] ]. +eapply UL_sequence. +unfold RiemannInt in |- *; case (RiemannInt_exists pr3 RinvN RinvN_cv); + intros; apply u. +unfold Un_cv in |- *; intros; unfold RiemannInt in |- *; + case (RiemannInt_exists pr1 RinvN RinvN_cv); + case (RiemannInt_exists pr2 RinvN RinvN_cv); unfold Un_cv in |- *; + intros; assert (H2 : 0 < eps / 5). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +elim (u0 _ H2); clear u0; intros N0 H3; assert (H4 := RinvN_cv); + unfold Un_cv in H4; elim (H4 _ H2); clear H4 H2; intros N1 H4; + assert (H5 : 0 < eps / (5 * Rabs l)). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption + | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat; + [ prove_sup0 | apply Rabs_pos_lt; assumption ] ]. +elim (u _ H5); clear u; intros N2 H6; assert (H7 := RinvN_cv); + unfold Un_cv in H7; elim (H7 _ H5); clear H7 H5; intros N3 H5; + unfold R_dist in H3, H4, H5, H6; set (N := max (max N0 N1) (max N2 N3)). +assert (H7 : forall n:nat, (n >= N1)%nat -> RinvN n < eps / 5). +intros; replace (pos (RinvN n)) with (Rabs (RinvN n - 0)); + [ unfold RinvN in |- *; apply H4; assumption + | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; + left; apply (cond_pos (RinvN n)) ]. +clear H4; assert (H4 := H7); clear H7; + assert (H7 : forall n:nat, (n >= N3)%nat -> RinvN n < eps / (5 * Rabs l)). +intros; replace (pos (RinvN n)) with (Rabs (RinvN n - 0)); + [ unfold RinvN in |- *; apply H5; assumption + | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; + left; apply (cond_pos (RinvN n)) ]. +clear H5; assert (H5 := H7); clear H7; exists N; intros; + unfold R_dist in |- *. +apply Rle_lt_trans with + (Rabs + (RiemannInt_SF (phi_sequence RinvN pr3 n) - + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + l * RiemannInt_SF (phi_sequence RinvN pr2 n))) + + Rabs (RiemannInt_SF (phi_sequence RinvN pr1 n) - x0) + + Rabs l * Rabs (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)). +apply Rle_trans with + (Rabs + (RiemannInt_SF (phi_sequence RinvN pr3 n) - + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + l * RiemannInt_SF (phi_sequence RinvN pr2 n))) + + Rabs + (RiemannInt_SF (phi_sequence RinvN pr1 n) - x0 + + l * (RiemannInt_SF (phi_sequence RinvN pr2 n) - x))). +replace (RiemannInt_SF (phi_sequence RinvN pr3 n) - (x0 + l * x)) with + (RiemannInt_SF (phi_sequence RinvN pr3 n) - + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + l * RiemannInt_SF (phi_sequence RinvN pr2 n)) + + (RiemannInt_SF (phi_sequence RinvN pr1 n) - x0 + + l * (RiemannInt_SF (phi_sequence RinvN pr2 n) - x))); + [ apply Rabs_triang | ring ]. +rewrite Rplus_assoc; apply Rplus_le_compat_l; rewrite <- Rabs_mult; + replace + (RiemannInt_SF (phi_sequence RinvN pr1 n) - x0 + + l * (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)) with + (RiemannInt_SF (phi_sequence RinvN pr1 n) - x0 + + l * (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)); + [ apply Rabs_triang | ring ]. +replace eps with (3 * (eps / 5) + eps / 5 + eps / 5). +repeat apply Rplus_lt_compat. +assert + (H7 : + exists psi1 : nat -> StepFun a b, + (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> + Rabs (f t - phi_sequence RinvN pr1 n t) <= psi1 n t) /\ + Rabs (RiemannInt_SF (psi1 n)) < RinvN n)). +split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr1 n0)). +assert + (H8 : + exists psi2 : nat -> StepFun a b, + (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> + Rabs (g t - phi_sequence RinvN pr2 n t) <= psi2 n t) /\ + Rabs (RiemannInt_SF (psi2 n)) < RinvN n)). +split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr2 n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr2 n0)). +assert + (H9 : + exists psi3 : nat -> StepFun a b, + (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> + Rabs (f t + l * g t - phi_sequence RinvN pr3 n t) <= psi3 n t) /\ + Rabs (RiemannInt_SF (psi3 n)) < RinvN n)). +split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr3 n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr3 n0)). +elim H7; clear H7; intros psi1 H7; elim H8; clear H8; intros psi2 H8; elim H9; + clear H9; intros psi3 H9; + replace + (RiemannInt_SF (phi_sequence RinvN pr3 n) - + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + l * RiemannInt_SF (phi_sequence RinvN pr2 n))) with + (RiemannInt_SF (phi_sequence RinvN pr3 n) + + -1 * + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + l * RiemannInt_SF (phi_sequence RinvN pr2 n))); + [ idtac | ring ]; do 2 rewrite <- StepFun_P30; assert (H10 : Rmin a b = a). +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. +assert (H11 : Rmax a b = b). +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. +rewrite H10 in H7; rewrite H10 in H8; rewrite H10 in H9; rewrite H11 in H7; + rewrite H11 in H8; rewrite H11 in H9; + apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P32 + (mkStepFun + (StepFun_P28 (-1) (phi_sequence RinvN pr3 n) + (mkStepFun + (StepFun_P28 l (phi_sequence RinvN pr1 n) + (phi_sequence RinvN pr2 n)))))))). +apply StepFun_P34; assumption. +apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P28 1 (psi3 n) + (mkStepFun (StepFun_P28 (Rabs l) (psi1 n) (psi2 n)))))). +apply StepFun_P37; try assumption. +intros; simpl in |- *; rewrite Rmult_1_l. +apply Rle_trans with + (Rabs (phi_sequence RinvN pr3 n x1 - (f x1 + l * g x1)) + + Rabs + (f x1 + l * g x1 + + -1 * (phi_sequence RinvN pr1 n x1 + l * phi_sequence RinvN pr2 n x1))). +replace + (phi_sequence RinvN pr3 n x1 + + -1 * (phi_sequence RinvN pr1 n x1 + l * phi_sequence RinvN pr2 n x1)) with + (phi_sequence RinvN pr3 n x1 - (f x1 + l * g x1) + + (f x1 + l * g x1 + + -1 * (phi_sequence RinvN pr1 n x1 + l * phi_sequence RinvN pr2 n x1))); + [ apply Rabs_triang | ring ]. +rewrite Rplus_assoc; apply Rplus_le_compat. +elim (H9 n); intros; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; + apply H13. +elim H12; intros; split; left; assumption. +apply Rle_trans with + (Rabs (f x1 - phi_sequence RinvN pr1 n x1) + + Rabs l * Rabs (g x1 - phi_sequence RinvN pr2 n x1)). +rewrite <- Rabs_mult; + replace + (f x1 + + (l * g x1 + + -1 * (phi_sequence RinvN pr1 n x1 + l * phi_sequence RinvN pr2 n x1))) + with + (f x1 - phi_sequence RinvN pr1 n x1 + + l * (g x1 - phi_sequence RinvN pr2 n x1)); [ apply Rabs_triang | ring ]. +apply Rplus_le_compat. +elim (H7 n); intros; apply H13. +elim H12; intros; split; left; assumption. +apply Rmult_le_compat_l; + [ apply Rabs_pos + | elim (H8 n); intros; apply H13; elim H12; intros; split; left; assumption ]. +do 2 rewrite StepFun_P30; rewrite Rmult_1_l; + replace (3 * (eps / 5)) with (eps / 5 + (eps / 5 + eps / 5)); + [ repeat apply Rplus_lt_compat | ring ]. +apply Rlt_trans with (pos (RinvN n)); + [ apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi3 n))); + [ apply RRle_abs | elim (H9 n); intros; assumption ] + | apply H4; unfold ge in |- *; apply le_trans with N; + [ apply le_trans with (max N0 N1); + [ apply le_max_r | unfold N in |- *; apply le_max_l ] + | assumption ] ]. +apply Rlt_trans with (pos (RinvN n)); + [ apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))); + [ apply RRle_abs | elim (H7 n); intros; assumption ] + | apply H4; unfold ge in |- *; apply le_trans with N; + [ apply le_trans with (max N0 N1); + [ apply le_max_r | unfold N in |- *; apply le_max_l ] + | assumption ] ]. +apply Rmult_lt_reg_l with (/ Rabs l). +apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; replace (/ Rabs l * (eps / 5)) with (eps / (5 * Rabs l)). +apply Rlt_trans with (pos (RinvN n)); + [ apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))); + [ apply RRle_abs | elim (H8 n); intros; assumption ] + | apply H5; unfold ge in |- *; apply le_trans with N; + [ apply le_trans with (max N2 N3); + [ apply le_max_r | unfold N in |- *; apply le_max_r ] + | assumption ] ]. +unfold Rdiv in |- *; rewrite Rinv_mult_distr; + [ ring | discrR | apply Rabs_no_R0; assumption ]. +apply Rabs_no_R0; assumption. +apply H3; unfold ge in |- *; apply le_trans with (max N0 N1); + [ apply le_max_l + | apply le_trans with N; [ unfold N in |- *; apply le_max_l | assumption ] ]. +apply Rmult_lt_reg_l with (/ Rabs l). +apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; replace (/ Rabs l * (eps / 5)) with (eps / (5 * Rabs l)). +apply H6; unfold ge in |- *; apply le_trans with (max N2 N3); + [ apply le_max_l + | apply le_trans with N; [ unfold N in |- *; apply le_max_r | assumption ] ]. +unfold Rdiv in |- *; rewrite Rinv_mult_distr; + [ ring | discrR | apply Rabs_no_R0; assumption ]. +apply Rabs_no_R0; assumption. +apply Rmult_eq_reg_l with 5; + [ unfold Rdiv in |- *; do 2 rewrite Rmult_plus_distr_l; + do 3 rewrite (Rmult_comm 5); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym; [ ring | discrR ] + | discrR ]. +Qed. + +Lemma RiemannInt_P13 : + forall (f g:R -> R) (a b l:R) (pr1:Riemann_integrable f a b) + (pr2:Riemann_integrable g a b) + (pr3:Riemann_integrable (fun x:R => f x + l * g x) a b), + RiemannInt pr3 = RiemannInt pr1 + l * RiemannInt pr2. +intros; case (Rle_dec a b); intro; + [ apply RiemannInt_P12; assumption + | assert (H : b <= a); + [ auto with real + | replace (RiemannInt pr3) with (- RiemannInt (RiemannInt_P1 pr3)); + [ idtac | symmetry in |- *; apply RiemannInt_P8 ]; + replace (RiemannInt pr2) with (- RiemannInt (RiemannInt_P1 pr2)); + [ idtac | symmetry in |- *; apply RiemannInt_P8 ]; + replace (RiemannInt pr1) with (- RiemannInt (RiemannInt_P1 pr1)); + [ idtac | symmetry in |- *; apply RiemannInt_P8 ]; + rewrite + (RiemannInt_P12 (RiemannInt_P1 pr1) (RiemannInt_P1 pr2) + (RiemannInt_P1 pr3) H); ring ] ]. +Qed. + +Lemma RiemannInt_P14 : forall a b c:R, Riemann_integrable (fct_cte c) a b. +unfold Riemann_integrable in |- *; intros; + split with (mkStepFun (StepFun_P4 a b c)); + split with (mkStepFun (StepFun_P4 a b 0)); split; + [ intros; simpl in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rabs_R0; unfold fct_cte in |- *; right; + reflexivity + | rewrite StepFun_P18; rewrite Rmult_0_l; rewrite Rabs_R0; + apply (cond_pos eps) ]. +Qed. + +Lemma RiemannInt_P15 : + forall (a b c:R) (pr:Riemann_integrable (fct_cte c) a b), + RiemannInt pr = c * (b - a). +intros; unfold RiemannInt in |- *; case (RiemannInt_exists pr RinvN RinvN_cv); + intros; eapply UL_sequence. +apply u. +set (phi1 := fun N:nat => phi_sequence RinvN pr N); + change (Un_cv (fun N:nat => RiemannInt_SF (phi1 N)) (c * (b - a))) in |- *; + set (f := fct_cte c); + assert + (H1 : + exists psi1 : nat -> StepFun a b, + (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> + Rabs (f t - phi_sequence RinvN pr n t) <= psi1 n t) /\ + Rabs (RiemannInt_SF (psi1 n)) < RinvN n)). +split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr n)). +elim H1; clear H1; intros psi1 H1; + set (phi2 := fun n:nat => mkStepFun (StepFun_P4 a b c)); + set (psi2 := fun n:nat => mkStepFun (StepFun_P4 a b 0)); + apply RiemannInt_P11 with f RinvN phi2 psi2 psi1; + try assumption. +apply RinvN_cv. +intro; split. +intros; unfold f in |- *; simpl in |- *; unfold Rminus in |- *; + rewrite Rplus_opp_r; rewrite Rabs_R0; unfold fct_cte in |- *; + right; reflexivity. +unfold psi2 in |- *; rewrite StepFun_P18; rewrite Rmult_0_l; rewrite Rabs_R0; + apply (cond_pos (RinvN n)). +unfold Un_cv in |- *; intros; split with 0%nat; intros; unfold R_dist in |- *; + unfold phi2 in |- *; rewrite StepFun_P18; unfold Rminus in |- *; + rewrite Rplus_opp_r; rewrite Rabs_R0; apply H. +Qed. + +Lemma RiemannInt_P16 : + forall (f:R -> R) (a b:R), + Riemann_integrable f a b -> Riemann_integrable (fun x:R => Rabs (f x)) a b. +unfold Riemann_integrable in |- *; intro f; intros; elim (X eps); clear X; + intros phi [psi [H H0]]; split with (mkStepFun (StepFun_P32 phi)); + split with psi; split; try assumption; intros; simpl in |- *; + apply Rle_trans with (Rabs (f t - phi t)); + [ apply Rabs_triang_inv2 | apply H; assumption ]. +Qed. + +Lemma Rle_cv_lim : + forall (Un Vn:nat -> R) (l1 l2:R), + (forall n:nat, Un n <= Vn n) -> Un_cv Un l1 -> Un_cv Vn l2 -> l1 <= l2. +intros; case (Rle_dec l1 l2); intro. +assumption. +assert (H2 : l2 < l1). +auto with real. +clear n; assert (H3 : 0 < (l1 - l2) / 2). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply Rlt_Rminus; assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +elim (H1 _ H3); elim (H0 _ H3); clear H0 H1; unfold R_dist in |- *; intros; + set (N := max x x0); cut (Vn N < Un N). +intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (H N) H4)). +apply Rlt_trans with ((l1 + l2) / 2). +apply Rplus_lt_reg_r with (- l2); + replace (- l2 + (l1 + l2) / 2) with ((l1 - l2) / 2). +rewrite Rplus_comm; apply Rle_lt_trans with (Rabs (Vn N - l2)). +apply RRle_abs. +apply H1; unfold ge in |- *; unfold N in |- *; apply le_max_r. +apply Rmult_eq_reg_l with 2; + [ unfold Rdiv in |- *; do 2 rewrite (Rmult_comm 2); + rewrite (Rmult_plus_distr_r (- l2) ((l1 + l2) * / 2) 2); + repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym; + [ ring | discrR ] + | discrR ]. +apply Ropp_lt_cancel; apply Rplus_lt_reg_r with l1; + replace (l1 + - ((l1 + l2) / 2)) with ((l1 - l2) / 2). +apply Rle_lt_trans with (Rabs (Un N - l1)). +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs. +apply H0; unfold ge in |- *; unfold N in |- *; apply le_max_l. +apply Rmult_eq_reg_l with 2; + [ unfold Rdiv in |- *; do 2 rewrite (Rmult_comm 2); + rewrite (Rmult_plus_distr_r l1 (- ((l1 + l2) * / 2)) 2); + rewrite <- Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym; [ ring | discrR ] + | discrR ]. +Qed. + +Lemma RiemannInt_P17 : + forall (f:R -> R) (a b:R) (pr1:Riemann_integrable f a b) + (pr2:Riemann_integrable (fun x:R => Rabs (f x)) a b), + a <= b -> Rabs (RiemannInt pr1) <= RiemannInt pr2. +intro f; intros; unfold RiemannInt in |- *; + case (RiemannInt_exists pr1 RinvN RinvN_cv); + case (RiemannInt_exists pr2 RinvN RinvN_cv); intros; + set (phi1 := phi_sequence RinvN pr1); + set (phi2 := fun N:nat => mkStepFun (StepFun_P32 (phi1 N))); + apply Rle_cv_lim with + (fun N:nat => Rabs (RiemannInt_SF (phi1 N))) + (fun N:nat => RiemannInt_SF (phi2 N)). +intro; unfold phi2 in |- *; apply StepFun_P34; assumption. +fold phi1 in u0; + apply (continuity_seq Rabs (fun N:nat => RiemannInt_SF (phi1 N)) x0); + try assumption. +apply Rcontinuity_abs. +set (phi3 := phi_sequence RinvN pr2); + assert + (H0 : + exists psi3 : nat -> StepFun a b, + (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> + Rabs (Rabs (f t) - phi3 n t) <= psi3 n t) /\ + Rabs (RiemannInt_SF (psi3 n)) < RinvN n)). +split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr2 n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr2 n)). +assert + (H1 : + exists psi2 : nat -> StepFun a b, + (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> + Rabs (Rabs (f t) - phi2 n t) <= psi2 n t) /\ + Rabs (RiemannInt_SF (psi2 n)) < RinvN n)). +assert + (H1 : + exists psi2 : nat -> StepFun a b, + (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> Rabs (f t - phi1 n t) <= psi2 n t) /\ + Rabs (RiemannInt_SF (psi2 n)) < RinvN n)). +split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr1 n)). +elim H1; clear H1; intros psi2 H1; split with psi2; intros; elim (H1 n); + clear H1; intros; split; try assumption. +intros; unfold phi2 in |- *; simpl in |- *; + apply Rle_trans with (Rabs (f t - phi1 n t)). +apply Rabs_triang_inv2. +apply H1; assumption. +elim H0; clear H0; intros psi3 H0; elim H1; clear H1; intros psi2 H1; + apply RiemannInt_P11 with (fun x:R => Rabs (f x)) RinvN phi3 psi3 psi2; + try assumption; apply RinvN_cv. +Qed. + +Lemma RiemannInt_P18 : + forall (f g:R -> R) (a b:R) (pr1:Riemann_integrable f a b) + (pr2:Riemann_integrable g a b), + a <= b -> + (forall x:R, a < x < b -> f x = g x) -> RiemannInt pr1 = RiemannInt pr2. +intro f; intros; unfold RiemannInt in |- *; + case (RiemannInt_exists pr1 RinvN RinvN_cv); + case (RiemannInt_exists pr2 RinvN RinvN_cv); intros; + eapply UL_sequence. +apply u0. +set (phi1 := fun N:nat => phi_sequence RinvN pr1 N); + change (Un_cv (fun N:nat => RiemannInt_SF (phi1 N)) x) in |- *; + assert + (H1 : + exists psi1 : nat -> StepFun a b, + (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> + Rabs (f t - phi1 n t) <= psi1 n t) /\ + Rabs (RiemannInt_SF (psi1 n)) < RinvN n)). +split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr1 n)). +elim H1; clear H1; intros psi1 H1; + set (phi2 := fun N:nat => phi_sequence RinvN pr2 N). +set + (phi2_aux := + fun (N:nat) (x:R) => + match Req_EM_T x a with + | left _ => f a + | right _ => + match Req_EM_T x b with + | left _ => f b + | right _ => phi2 N x + end + end). +cut (forall N:nat, IsStepFun (phi2_aux N) a b). +intro; set (phi2_m := fun N:nat => mkStepFun (X N)). +assert + (H2 : + exists psi2 : nat -> StepFun a b, + (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> Rabs (g t - phi2 n t) <= psi2 n t) /\ + Rabs (RiemannInt_SF (psi2 n)) < RinvN n)). +split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr2 n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr2 n)). +elim H2; clear H2; intros psi2 H2; + apply RiemannInt_P11 with f RinvN phi2_m psi2 psi1; + try assumption. +apply RinvN_cv. +intro; elim (H2 n); intros; split; try assumption. +intros; unfold phi2_m in |- *; simpl in |- *; unfold phi2_aux in |- *; + case (Req_EM_T t a); case (Req_EM_T t b); intros. +rewrite e0; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + apply Rle_trans with (Rabs (g t - phi2 n t)). +apply Rabs_pos. +pattern a at 3 in |- *; rewrite <- e0; apply H3; assumption. +rewrite e; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + apply Rle_trans with (Rabs (g t - phi2 n t)). +apply Rabs_pos. +pattern a at 3 in |- *; rewrite <- e; apply H3; assumption. +rewrite e; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + apply Rle_trans with (Rabs (g t - phi2 n t)). +apply Rabs_pos. +pattern b at 3 in |- *; rewrite <- e; apply H3; assumption. +replace (f t) with (g t). +apply H3; assumption. +symmetry in |- *; apply H0; elim H5; clear H5; intros. +assert (H7 : Rmin a b = a). +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n2; assumption ]. +assert (H8 : Rmax a b = b). +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n2; assumption ]. +rewrite H7 in H5; rewrite H8 in H6; split. +elim H5; intro; [ assumption | elim n1; symmetry in |- *; assumption ]. +elim H6; intro; [ assumption | elim n0; assumption ]. +cut (forall N:nat, RiemannInt_SF (phi2_m N) = RiemannInt_SF (phi2 N)). +intro; unfold Un_cv in |- *; intros; elim (u _ H4); intros; exists x1; intros; + rewrite (H3 n); apply H5; assumption. +intro; apply Rle_antisym. +apply StepFun_P37; try assumption. +intros; unfold phi2_m in |- *; simpl in |- *; unfold phi2_aux in |- *; + case (Req_EM_T x1 a); case (Req_EM_T x1 b); intros. +elim H3; intros; rewrite e0 in H4; elim (Rlt_irrefl _ H4). +elim H3; intros; rewrite e in H4; elim (Rlt_irrefl _ H4). +elim H3; intros; rewrite e in H5; elim (Rlt_irrefl _ H5). +right; reflexivity. +apply StepFun_P37; try assumption. +intros; unfold phi2_m in |- *; simpl in |- *; unfold phi2_aux in |- *; + case (Req_EM_T x1 a); case (Req_EM_T x1 b); intros. +elim H3; intros; rewrite e0 in H4; elim (Rlt_irrefl _ H4). +elim H3; intros; rewrite e in H4; elim (Rlt_irrefl _ H4). +elim H3; intros; rewrite e in H5; elim (Rlt_irrefl _ H5). +right; reflexivity. +intro; assert (H2 := pre (phi2 N)); unfold IsStepFun in H2; + unfold is_subdivision in H2; elim H2; clear H2; intros l [lf H2]; + split with l; split with lf; unfold adapted_couple in H2; + decompose [and] H2; clear H2; unfold adapted_couple in |- *; + repeat split; try assumption. +intros; assert (H9 := H8 i H2); unfold constant_D_eq, open_interval in H9; + unfold constant_D_eq, open_interval in |- *; intros; + rewrite <- (H9 x1 H7); assert (H10 : a <= pos_Rl l i). +replace a with (Rmin a b). +rewrite <- H5; elim (RList_P6 l); intros; apply H10. +assumption. +apply le_O_n. +apply lt_trans with (pred (Rlength l)); [ assumption | apply lt_pred_n_n ]. +apply neq_O_lt; intro; rewrite <- H12 in H6; discriminate. +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +assert (H11 : pos_Rl l (S i) <= b). +replace b with (Rmax a b). +rewrite <- H4; elim (RList_P6 l); intros; apply H11. +assumption. +apply lt_le_S; assumption. +apply lt_pred_n_n; apply neq_O_lt; intro; rewrite <- H13 in H6; discriminate. +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +elim H7; clear H7; intros; unfold phi2_aux in |- *; case (Req_EM_T x1 a); + case (Req_EM_T x1 b); intros. +rewrite e in H12; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H11 H12)). +rewrite e in H7; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H10 H7)). +rewrite e in H12; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H11 H12)). +reflexivity. +Qed. + +Lemma RiemannInt_P19 : + forall (f g:R -> R) (a b:R) (pr1:Riemann_integrable f a b) + (pr2:Riemann_integrable g a b), + a <= b -> + (forall x:R, a < x < b -> f x <= g x) -> RiemannInt pr1 <= RiemannInt pr2. +intro f; intros; apply Rplus_le_reg_l with (- RiemannInt pr1); + rewrite Rplus_opp_l; rewrite Rplus_comm; + apply Rle_trans with (Rabs (RiemannInt (RiemannInt_P10 (-1) pr2 pr1))). +apply Rabs_pos. +replace (RiemannInt pr2 + - RiemannInt pr1) with + (RiemannInt (RiemannInt_P16 (RiemannInt_P10 (-1) pr2 pr1))). +apply + (RiemannInt_P17 (RiemannInt_P10 (-1) pr2 pr1) + (RiemannInt_P16 (RiemannInt_P10 (-1) pr2 pr1))); + assumption. +replace (RiemannInt pr2 + - RiemannInt pr1) with + (RiemannInt (RiemannInt_P10 (-1) pr2 pr1)). +apply RiemannInt_P18; try assumption. +intros; apply Rabs_right. +apply Rle_ge; apply Rplus_le_reg_l with (f x); rewrite Rplus_0_r; + replace (f x + (g x + -1 * f x)) with (g x); [ apply H0; assumption | ring ]. +rewrite (RiemannInt_P12 pr2 pr1 (RiemannInt_P10 (-1) pr2 pr1)); + [ ring | assumption ]. +Qed. + +Lemma FTC_P1 : + forall (f:R -> R) (a b:R), + a <= b -> + (forall x:R, a <= x <= b -> continuity_pt f x) -> + forall x:R, a <= x -> x <= b -> Riemann_integrable f a x. +intros; apply continuity_implies_RiemannInt; + [ assumption + | intros; apply H0; elim H3; intros; split; + assumption || apply Rle_trans with x; assumption ]. +Qed. + +Definition primitive (f:R -> R) (a b:R) (h:a <= b) + (pr:forall x:R, a <= x -> x <= b -> Riemann_integrable f a x) + (x:R) : R := + match Rle_dec a x with + | left r => + match Rle_dec x b with + | left r0 => RiemannInt (pr x r r0) + | right _ => f b * (x - b) + RiemannInt (pr b h (Rle_refl b)) + end + | right _ => f a * (x - a) + end. + +Lemma RiemannInt_P20 : + forall (f:R -> R) (a b:R) (h:a <= b) + (pr:forall x:R, a <= x -> x <= b -> Riemann_integrable f a x) + (pr0:Riemann_integrable f a b), + RiemannInt pr0 = primitive h pr b - primitive h pr a. +intros; replace (primitive h pr a) with 0. +replace (RiemannInt pr0) with (primitive h pr b). +ring. +unfold primitive in |- *; case (Rle_dec a b); case (Rle_dec b b); intros; + [ apply RiemannInt_P5 + | elim n; right; reflexivity + | elim n; assumption + | elim n0; assumption ]. +symmetry in |- *; unfold primitive in |- *; case (Rle_dec a a); + case (Rle_dec a b); intros; + [ apply RiemannInt_P9 + | elim n; assumption + | elim n; right; reflexivity + | elim n0; right; reflexivity ]. +Qed. + +Lemma RiemannInt_P21 : + forall (f:R -> R) (a b c:R), + a <= b -> + b <= c -> + Riemann_integrable f a b -> + Riemann_integrable f b c -> Riemann_integrable f a c. +unfold Riemann_integrable in |- *; intros f a b c Hyp1 Hyp2 X X0 eps. +assert (H : 0 < eps / 2). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ]. +elim (X (mkposreal _ H)); clear X; intros phi1 [psi1 H1]; + elim (X0 (mkposreal _ H)); clear X0; intros phi2 [psi2 H2]. +set + (phi3 := + fun x:R => + match Rle_dec a x with + | left _ => + match Rle_dec x b with + | left _ => phi1 x + | right _ => phi2 x + end + | right _ => 0 + end). +set + (psi3 := + fun x:R => + match Rle_dec a x with + | left _ => + match Rle_dec x b with + | left _ => psi1 x + | right _ => psi2 x + end + | right _ => 0 + end). +cut (IsStepFun phi3 a c). +intro; cut (IsStepFun psi3 a b). +intro; cut (IsStepFun psi3 b c). +intro; cut (IsStepFun psi3 a c). +intro; split with (mkStepFun X); split with (mkStepFun X2); simpl in |- *; + split. +intros; unfold phi3, psi3 in |- *; case (Rle_dec t b); case (Rle_dec a t); + intros. +elim H1; intros; apply H3. +replace (Rmin a b) with a. +replace (Rmax a b) with b. +split; assumption. +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +elim n; replace a with (Rmin a c). +elim H0; intros; assumption. +unfold Rmin in |- *; case (Rle_dec a c); intro; + [ reflexivity | elim n0; apply Rle_trans with b; assumption ]. +elim H2; intros; apply H3. +replace (Rmax b c) with (Rmax a c). +elim H0; intros; split; try assumption. +replace (Rmin b c) with b. +auto with real. +unfold Rmin in |- *; case (Rle_dec b c); intro; + [ reflexivity | elim n0; assumption ]. +unfold Rmax in |- *; case (Rle_dec a c); case (Rle_dec b c); intros; + try (elim n0; assumption || elim n0; apply Rle_trans with b; assumption). +reflexivity. +elim n; replace a with (Rmin a c). +elim H0; intros; assumption. +unfold Rmin in |- *; case (Rle_dec a c); intro; + [ reflexivity | elim n1; apply Rle_trans with b; assumption ]. +rewrite <- (StepFun_P43 X0 X1 X2). +apply Rle_lt_trans with + (Rabs (RiemannInt_SF (mkStepFun X0)) + Rabs (RiemannInt_SF (mkStepFun X1))). +apply Rabs_triang. +rewrite (double_var eps); + replace (RiemannInt_SF (mkStepFun X0)) with (RiemannInt_SF psi1). +replace (RiemannInt_SF (mkStepFun X1)) with (RiemannInt_SF psi2). +apply Rplus_lt_compat. +elim H1; intros; assumption. +elim H2; intros; assumption. +apply Rle_antisym. +apply StepFun_P37; try assumption. +simpl in |- *; intros; unfold psi3 in |- *; elim H0; clear H0; intros; + case (Rle_dec a x); case (Rle_dec x b); intros; + [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H0)) + | right; reflexivity + | elim n; apply Rle_trans with b; [ assumption | left; assumption ] + | elim n0; apply Rle_trans with b; [ assumption | left; assumption ] ]. +apply StepFun_P37; try assumption. +simpl in |- *; intros; unfold psi3 in |- *; elim H0; clear H0; intros; + case (Rle_dec a x); case (Rle_dec x b); intros; + [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H0)) + | right; reflexivity + | elim n; apply Rle_trans with b; [ assumption | left; assumption ] + | elim n0; apply Rle_trans with b; [ assumption | left; assumption ] ]. +apply Rle_antisym. +apply StepFun_P37; try assumption. +simpl in |- *; intros; unfold psi3 in |- *; elim H0; clear H0; intros; + case (Rle_dec a x); case (Rle_dec x b); intros; + [ right; reflexivity + | elim n; left; assumption + | elim n; left; assumption + | elim n0; left; assumption ]. +apply StepFun_P37; try assumption. +simpl in |- *; intros; unfold psi3 in |- *; elim H0; clear H0; intros; + case (Rle_dec a x); case (Rle_dec x b); intros; + [ right; reflexivity + | elim n; left; assumption + | elim n; left; assumption + | elim n0; left; assumption ]. +apply StepFun_P46 with b; assumption. +assert (H3 := pre psi2); unfold IsStepFun in H3; unfold is_subdivision in H3; + elim H3; clear H3; intros l1 [lf1 H3]; split with l1; + split with lf1; unfold adapted_couple in H3; decompose [and] H3; + clear H3; unfold adapted_couple in |- *; repeat split; + try assumption. +intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *; + unfold constant_D_eq, open_interval in H9; intros; + rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : b < x). +apply Rle_lt_trans with (pos_Rl l1 i). +replace b with (Rmin b c). +rewrite <- H5; elim (RList_P6 l1); intros; apply H10; try assumption. +apply le_O_n. +apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n; + apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6; + discriminate. +unfold Rmin in |- *; case (Rle_dec b c); intro; + [ reflexivity | elim n; assumption ]. +elim H7; intros; assumption. +case (Rle_dec a x); case (Rle_dec x b); intros; + [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H10)) + | reflexivity + | elim n; apply Rle_trans with b; [ assumption | left; assumption ] + | elim n0; apply Rle_trans with b; [ assumption | left; assumption ] ]. +assert (H3 := pre psi1); unfold IsStepFun in H3; unfold is_subdivision in H3; + elim H3; clear H3; intros l1 [lf1 H3]; split with l1; + split with lf1; unfold adapted_couple in H3; decompose [and] H3; + clear H3; unfold adapted_couple in |- *; repeat split; + try assumption. +intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *; + unfold constant_D_eq, open_interval in H9; intros; + rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : x <= b). +apply Rle_trans with (pos_Rl l1 (S i)). +elim H7; intros; left; assumption. +replace b with (Rmax a b). +rewrite <- H4; elim (RList_P6 l1); intros; apply H10; try assumption. +apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6; + discriminate. +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +assert (H11 : a <= x). +apply Rle_trans with (pos_Rl l1 i). +replace a with (Rmin a b). +rewrite <- H5; elim (RList_P6 l1); intros; apply H11; try assumption. +apply le_O_n. +apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n; + apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H6; + discriminate. +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +left; elim H7; intros; assumption. +case (Rle_dec a x); case (Rle_dec x b); intros; reflexivity || elim n; + assumption. +apply StepFun_P46 with b. +assert (H3 := pre phi1); unfold IsStepFun in H3; unfold is_subdivision in H3; + elim H3; clear H3; intros l1 [lf1 H3]; split with l1; + split with lf1; unfold adapted_couple in H3; decompose [and] H3; + clear H3; unfold adapted_couple in |- *; repeat split; + try assumption. +intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *; + unfold constant_D_eq, open_interval in H9; intros; + rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : x <= b). +apply Rle_trans with (pos_Rl l1 (S i)). +elim H7; intros; left; assumption. +replace b with (Rmax a b). +rewrite <- H4; elim (RList_P6 l1); intros; apply H10; try assumption. +apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6; + discriminate. +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +assert (H11 : a <= x). +apply Rle_trans with (pos_Rl l1 i). +replace a with (Rmin a b). +rewrite <- H5; elim (RList_P6 l1); intros; apply H11; try assumption. +apply le_O_n. +apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n; + apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H6; + discriminate. +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +left; elim H7; intros; assumption. +unfold phi3 in |- *; case (Rle_dec a x); case (Rle_dec x b); intros; + reflexivity || elim n; assumption. +assert (H3 := pre phi2); unfold IsStepFun in H3; unfold is_subdivision in H3; + elim H3; clear H3; intros l1 [lf1 H3]; split with l1; + split with lf1; unfold adapted_couple in H3; decompose [and] H3; + clear H3; unfold adapted_couple in |- *; repeat split; + try assumption. +intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *; + unfold constant_D_eq, open_interval in H9; intros; + rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : b < x). +apply Rle_lt_trans with (pos_Rl l1 i). +replace b with (Rmin b c). +rewrite <- H5; elim (RList_P6 l1); intros; apply H10; try assumption. +apply le_O_n. +apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n; + apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6; + discriminate. +unfold Rmin in |- *; case (Rle_dec b c); intro; + [ reflexivity | elim n; assumption ]. +elim H7; intros; assumption. +unfold phi3 in |- *; case (Rle_dec a x); case (Rle_dec x b); intros; + [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H10)) + | reflexivity + | elim n; apply Rle_trans with b; [ assumption | left; assumption ] + | elim n0; apply Rle_trans with b; [ assumption | left; assumption ] ]. +Qed. + +Lemma RiemannInt_P22 : + forall (f:R -> R) (a b c:R), + Riemann_integrable f a b -> a <= c <= b -> Riemann_integrable f a c. +unfold Riemann_integrable in |- *; intros; elim (X eps); clear X; + intros phi [psi H0]; elim H; elim H0; clear H H0; + intros; assert (H3 : IsStepFun phi a c). +apply StepFun_P44 with b. +apply (pre phi). +split; assumption. +assert (H4 : IsStepFun psi a c). +apply StepFun_P44 with b. +apply (pre psi). +split; assumption. +split with (mkStepFun H3); split with (mkStepFun H4); split. +simpl in |- *; intros; apply H. +replace (Rmin a b) with (Rmin a c). +elim H5; intros; split; try assumption. +apply Rle_trans with (Rmax a c); try assumption. +replace (Rmax a b) with b. +replace (Rmax a c) with c. +assumption. +unfold Rmax in |- *; case (Rle_dec a c); intro; + [ reflexivity | elim n; assumption ]. +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; apply Rle_trans with c; assumption ]. +unfold Rmin in |- *; case (Rle_dec a c); case (Rle_dec a b); intros; + [ reflexivity + | elim n; apply Rle_trans with c; assumption + | elim n; assumption + | elim n0; assumption ]. +rewrite Rabs_right. +assert (H5 : IsStepFun psi c b). +apply StepFun_P46 with a. +apply StepFun_P6; assumption. +apply (pre psi). +replace (RiemannInt_SF (mkStepFun H4)) with + (RiemannInt_SF psi - RiemannInt_SF (mkStepFun H5)). +apply Rle_lt_trans with (RiemannInt_SF psi). +unfold Rminus in |- *; pattern (RiemannInt_SF psi) at 2 in |- *; + rewrite <- Rplus_0_r; apply Rplus_le_compat_l; rewrite <- Ropp_0; + apply Ropp_ge_le_contravar; apply Rle_ge; + replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 c b 0))). +apply StepFun_P37; try assumption. +intros; simpl in |- *; unfold fct_cte in |- *; + apply Rle_trans with (Rabs (f x - phi x)). +apply Rabs_pos. +apply H. +replace (Rmin a b) with a. +replace (Rmax a b) with b. +elim H6; intros; split; left. +apply Rle_lt_trans with c; assumption. +assumption. +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; apply Rle_trans with c; assumption ]. +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; apply Rle_trans with c; assumption ]. +rewrite StepFun_P18; ring. +apply Rle_lt_trans with (Rabs (RiemannInt_SF psi)). +apply RRle_abs. +assumption. +assert (H6 : IsStepFun psi a b). +apply (pre psi). +replace (RiemannInt_SF psi) with (RiemannInt_SF (mkStepFun H6)). +rewrite <- (StepFun_P43 H4 H5 H6); ring. +unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro. +eapply StepFun_P17. +apply StepFun_P1. +simpl in |- *; apply StepFun_P1. +apply Ropp_eq_compat; eapply StepFun_P17. +apply StepFun_P1. +simpl in |- *; apply StepFun_P1. +apply Rle_ge; replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 a c 0))). +apply StepFun_P37; try assumption. +intros; simpl in |- *; unfold fct_cte in |- *; + apply Rle_trans with (Rabs (f x - phi x)). +apply Rabs_pos. +apply H. +replace (Rmin a b) with a. +replace (Rmax a b) with b. +elim H5; intros; split; left. +assumption. +apply Rlt_le_trans with c; assumption. +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; apply Rle_trans with c; assumption ]. +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; apply Rle_trans with c; assumption ]. +rewrite StepFun_P18; ring. +Qed. + +Lemma RiemannInt_P23 : + forall (f:R -> R) (a b c:R), + Riemann_integrable f a b -> a <= c <= b -> Riemann_integrable f c b. +unfold Riemann_integrable in |- *; intros; elim (X eps); clear X; + intros phi [psi H0]; elim H; elim H0; clear H H0; + intros; assert (H3 : IsStepFun phi c b). +apply StepFun_P45 with a. +apply (pre phi). +split; assumption. +assert (H4 : IsStepFun psi c b). +apply StepFun_P45 with a. +apply (pre psi). +split; assumption. +split with (mkStepFun H3); split with (mkStepFun H4); split. +simpl in |- *; intros; apply H. +replace (Rmax a b) with (Rmax c b). +elim H5; intros; split; try assumption. +apply Rle_trans with (Rmin c b); try assumption. +replace (Rmin a b) with a. +replace (Rmin c b) with c. +assumption. +unfold Rmin in |- *; case (Rle_dec c b); intro; + [ reflexivity | elim n; assumption ]. +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; apply Rle_trans with c; assumption ]. +unfold Rmax in |- *; case (Rle_dec c b); case (Rle_dec a b); intros; + [ reflexivity + | elim n; apply Rle_trans with c; assumption + | elim n; assumption + | elim n0; assumption ]. +rewrite Rabs_right. +assert (H5 : IsStepFun psi a c). +apply StepFun_P46 with b. +apply (pre psi). +apply StepFun_P6; assumption. +replace (RiemannInt_SF (mkStepFun H4)) with + (RiemannInt_SF psi - RiemannInt_SF (mkStepFun H5)). +apply Rle_lt_trans with (RiemannInt_SF psi). +unfold Rminus in |- *; pattern (RiemannInt_SF psi) at 2 in |- *; + rewrite <- Rplus_0_r; apply Rplus_le_compat_l; rewrite <- Ropp_0; + apply Ropp_ge_le_contravar; apply Rle_ge; + replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 a c 0))). +apply StepFun_P37; try assumption. +intros; simpl in |- *; unfold fct_cte in |- *; + apply Rle_trans with (Rabs (f x - phi x)). +apply Rabs_pos. +apply H. +replace (Rmin a b) with a. +replace (Rmax a b) with b. +elim H6; intros; split; left. +assumption. +apply Rlt_le_trans with c; assumption. +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; apply Rle_trans with c; assumption ]. +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; apply Rle_trans with c; assumption ]. +rewrite StepFun_P18; ring. +apply Rle_lt_trans with (Rabs (RiemannInt_SF psi)). +apply RRle_abs. +assumption. +assert (H6 : IsStepFun psi a b). +apply (pre psi). +replace (RiemannInt_SF psi) with (RiemannInt_SF (mkStepFun H6)). +rewrite <- (StepFun_P43 H5 H4 H6); ring. +unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro. +eapply StepFun_P17. +apply StepFun_P1. +simpl in |- *; apply StepFun_P1. +apply Ropp_eq_compat; eapply StepFun_P17. +apply StepFun_P1. +simpl in |- *; apply StepFun_P1. +apply Rle_ge; replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 c b 0))). +apply StepFun_P37; try assumption. +intros; simpl in |- *; unfold fct_cte in |- *; + apply Rle_trans with (Rabs (f x - phi x)). +apply Rabs_pos. +apply H. +replace (Rmin a b) with a. +replace (Rmax a b) with b. +elim H5; intros; split; left. +apply Rle_lt_trans with c; assumption. +assumption. +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; apply Rle_trans with c; assumption ]. +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; apply Rle_trans with c; assumption ]. +rewrite StepFun_P18; ring. +Qed. + +Lemma RiemannInt_P24 : + forall (f:R -> R) (a b c:R), + Riemann_integrable f a b -> + Riemann_integrable f b c -> Riemann_integrable f a c. +intros; case (Rle_dec a b); case (Rle_dec b c); intros. +apply RiemannInt_P21 with b; assumption. +case (Rle_dec a c); intro. +apply RiemannInt_P22 with b; try assumption. +split; [ assumption | auto with real ]. +apply RiemannInt_P1; apply RiemannInt_P22 with b. +apply RiemannInt_P1; assumption. +split; auto with real. +case (Rle_dec a c); intro. +apply RiemannInt_P23 with b; try assumption. +split; auto with real. +apply RiemannInt_P1; apply RiemannInt_P23 with b. +apply RiemannInt_P1; assumption. +split; [ assumption | auto with real ]. +apply RiemannInt_P1; apply RiemannInt_P21 with b; + auto with real || apply RiemannInt_P1; assumption. +Qed. + +Lemma RiemannInt_P25 : + forall (f:R -> R) (a b c:R) (pr1:Riemann_integrable f a b) + (pr2:Riemann_integrable f b c) (pr3:Riemann_integrable f a c), + a <= b -> b <= c -> RiemannInt pr1 + RiemannInt pr2 = RiemannInt pr3. +intros f a b c pr1 pr2 pr3 Hyp1 Hyp2; unfold RiemannInt in |- *; + case (RiemannInt_exists pr1 RinvN RinvN_cv); + case (RiemannInt_exists pr2 RinvN RinvN_cv); + case (RiemannInt_exists pr3 RinvN RinvN_cv); intros; + symmetry in |- *; eapply UL_sequence. +apply u. +unfold Un_cv in |- *; intros; assert (H0 : 0 < eps / 3). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +elim (u1 _ H0); clear u1; intros N1 H1; elim (u0 _ H0); clear u0; + intros N2 H2; + cut + (Un_cv + (fun n:nat => + RiemannInt_SF (phi_sequence RinvN pr3 n) - + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + RiemannInt_SF (phi_sequence RinvN pr2 n))) 0). +intro; elim (H3 _ H0); clear H3; intros N3 H3; + set (N0 := max (max N1 N2) N3); exists N0; intros; + unfold R_dist in |- *; + apply Rle_lt_trans with + (Rabs + (RiemannInt_SF (phi_sequence RinvN pr3 n) - + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + RiemannInt_SF (phi_sequence RinvN pr2 n))) + + Rabs + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + RiemannInt_SF (phi_sequence RinvN pr2 n) - (x1 + x0))). +replace (RiemannInt_SF (phi_sequence RinvN pr3 n) - (x1 + x0)) with + (RiemannInt_SF (phi_sequence RinvN pr3 n) - + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + RiemannInt_SF (phi_sequence RinvN pr2 n)) + + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + RiemannInt_SF (phi_sequence RinvN pr2 n) - (x1 + x0))); + [ apply Rabs_triang | ring ]. +replace eps with (eps / 3 + eps / 3 + eps / 3). +rewrite Rplus_assoc; apply Rplus_lt_compat. +unfold R_dist in H3; cut (n >= N3)%nat. +intro; assert (H6 := H3 _ H5); unfold Rminus in H6; rewrite Ropp_0 in H6; + rewrite Rplus_0_r in H6; apply H6. +unfold ge in |- *; apply le_trans with N0; + [ unfold N0 in |- *; apply le_max_r | assumption ]. +apply Rle_lt_trans with + (Rabs (RiemannInt_SF (phi_sequence RinvN pr1 n) - x1) + + Rabs (RiemannInt_SF (phi_sequence RinvN pr2 n) - x0)). +replace + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + RiemannInt_SF (phi_sequence RinvN pr2 n) - (x1 + x0)) with + (RiemannInt_SF (phi_sequence RinvN pr1 n) - x1 + + (RiemannInt_SF (phi_sequence RinvN pr2 n) - x0)); + [ apply Rabs_triang | ring ]. +apply Rplus_lt_compat. +unfold R_dist in H1; apply H1. +unfold ge in |- *; apply le_trans with N0; + [ apply le_trans with (max N1 N2); + [ apply le_max_l | unfold N0 in |- *; apply le_max_l ] + | assumption ]. +unfold R_dist in H2; apply H2. +unfold ge in |- *; apply le_trans with N0; + [ apply le_trans with (max N1 N2); + [ apply le_max_r | unfold N0 in |- *; apply le_max_l ] + | assumption ]. +apply Rmult_eq_reg_l with 3; + [ unfold Rdiv in |- *; repeat rewrite Rmult_plus_distr_l; + do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym; [ ring | discrR ] + | discrR ]. +clear x u x0 x1 eps H H0 N1 H1 N2 H2; + assert + (H1 : + exists psi1 : nat -> StepFun a b, + (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> + Rabs (f t - phi_sequence RinvN pr1 n t) <= psi1 n t) /\ + Rabs (RiemannInt_SF (psi1 n)) < RinvN n)). +split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr1 n)). +assert + (H2 : + exists psi2 : nat -> StepFun b c, + (forall n:nat, + (forall t:R, + Rmin b c <= t /\ t <= Rmax b c -> + Rabs (f t - phi_sequence RinvN pr2 n t) <= psi2 n t) /\ + Rabs (RiemannInt_SF (psi2 n)) < RinvN n)). +split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr2 n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr2 n)). +assert + (H3 : + exists psi3 : nat -> StepFun a c, + (forall n:nat, + (forall t:R, + Rmin a c <= t /\ t <= Rmax a c -> + Rabs (f t - phi_sequence RinvN pr3 n t) <= psi3 n t) /\ + Rabs (RiemannInt_SF (psi3 n)) < RinvN n)). +split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr3 n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr3 n)). +elim H1; clear H1; intros psi1 H1; elim H2; clear H2; intros psi2 H2; elim H3; + clear H3; intros psi3 H3; assert (H := RinvN_cv); + unfold Un_cv in |- *; intros; assert (H4 : 0 < eps / 3). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +elim (H _ H4); clear H; intros N0 H; + assert (H5 : forall n:nat, (n >= N0)%nat -> RinvN n < eps / 3). +intros; + replace (pos (RinvN n)) with + (R_dist (mkposreal (/ (INR n + 1)) (RinvN_pos n)) 0). +apply H; assumption. +unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; + left; apply (cond_pos (RinvN n)). +exists N0; intros; elim (H1 n); elim (H2 n); elim (H3 n); clear H1 H2 H3; + intros; unfold R_dist in |- *; unfold Rminus in |- *; + rewrite Ropp_0; rewrite Rplus_0_r; set (phi1 := phi_sequence RinvN pr1 n); + fold phi1 in H8; set (phi2 := phi_sequence RinvN pr2 n); + fold phi2 in H3; set (phi3 := phi_sequence RinvN pr3 n); + fold phi2 in H1; assert (H10 : IsStepFun phi3 a b). +apply StepFun_P44 with c. +apply (pre phi3). +split; assumption. +assert (H11 : IsStepFun (psi3 n) a b). +apply StepFun_P44 with c. +apply (pre (psi3 n)). +split; assumption. +assert (H12 : IsStepFun phi3 b c). +apply StepFun_P45 with a. +apply (pre phi3). +split; assumption. +assert (H13 : IsStepFun (psi3 n) b c). +apply StepFun_P45 with a. +apply (pre (psi3 n)). +split; assumption. +replace (RiemannInt_SF phi3) with + (RiemannInt_SF (mkStepFun H10) + RiemannInt_SF (mkStepFun H12)). +apply Rle_lt_trans with + (Rabs (RiemannInt_SF (mkStepFun H10) - RiemannInt_SF phi1) + + Rabs (RiemannInt_SF (mkStepFun H12) - RiemannInt_SF phi2)). +replace + (RiemannInt_SF (mkStepFun H10) + RiemannInt_SF (mkStepFun H12) + + - (RiemannInt_SF phi1 + RiemannInt_SF phi2)) with + (RiemannInt_SF (mkStepFun H10) - RiemannInt_SF phi1 + + (RiemannInt_SF (mkStepFun H12) - RiemannInt_SF phi2)); + [ apply Rabs_triang | ring ]. +replace (RiemannInt_SF (mkStepFun H10) - RiemannInt_SF phi1) with + (RiemannInt_SF (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1))). +replace (RiemannInt_SF (mkStepFun H12) - RiemannInt_SF phi2) with + (RiemannInt_SF (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2))). +apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1)))) + + RiemannInt_SF + (mkStepFun + (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2))))). +apply Rle_trans with + (Rabs (RiemannInt_SF (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1))) + + RiemannInt_SF + (mkStepFun + (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2))))). +apply Rplus_le_compat_l. +apply StepFun_P34; try assumption. +do 2 + rewrite <- + (Rplus_comm + (RiemannInt_SF + (mkStepFun + (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2)))))) + ; apply Rplus_le_compat_l; apply StepFun_P34; try assumption. +apply Rle_lt_trans with + (RiemannInt_SF (mkStepFun (StepFun_P28 1 (mkStepFun H11) (psi1 n))) + + RiemannInt_SF (mkStepFun (StepFun_P28 1 (mkStepFun H13) (psi2 n)))). +apply Rle_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1)))) + + RiemannInt_SF (mkStepFun (StepFun_P28 1 (mkStepFun H13) (psi2 n)))). +apply Rplus_le_compat_l; apply StepFun_P37; try assumption. +intros; simpl in |- *; rewrite Rmult_1_l; + apply Rle_trans with (Rabs (f x - phi3 x) + Rabs (f x - phi2 x)). +rewrite <- (Rabs_Ropp (f x - phi3 x)); rewrite Ropp_minus_distr; + replace (phi3 x + -1 * phi2 x) with (phi3 x - f x + (f x - phi2 x)); + [ apply Rabs_triang | ring ]. +apply Rplus_le_compat. +fold phi3 in H1; apply H1. +elim H14; intros; split. +replace (Rmin a c) with a. +apply Rle_trans with b; try assumption. +left; assumption. +unfold Rmin in |- *; case (Rle_dec a c); intro; + [ reflexivity | elim n0; apply Rle_trans with b; assumption ]. +replace (Rmax a c) with c. +left; assumption. +unfold Rmax in |- *; case (Rle_dec a c); intro; + [ reflexivity | elim n0; apply Rle_trans with b; assumption ]. +apply H3. +elim H14; intros; split. +replace (Rmin b c) with b. +left; assumption. +unfold Rmin in |- *; case (Rle_dec b c); intro; + [ reflexivity | elim n0; assumption ]. +replace (Rmax b c) with c. +left; assumption. +unfold Rmax in |- *; case (Rle_dec b c); intro; + [ reflexivity | elim n0; assumption ]. +do 2 + rewrite <- + (Rplus_comm + (RiemannInt_SF (mkStepFun (StepFun_P28 1 (mkStepFun H13) (psi2 n))))) + ; apply Rplus_le_compat_l; apply StepFun_P37; try assumption. +intros; simpl in |- *; rewrite Rmult_1_l; + apply Rle_trans with (Rabs (f x - phi3 x) + Rabs (f x - phi1 x)). +rewrite <- (Rabs_Ropp (f x - phi3 x)); rewrite Ropp_minus_distr; + replace (phi3 x + -1 * phi1 x) with (phi3 x - f x + (f x - phi1 x)); + [ apply Rabs_triang | ring ]. +apply Rplus_le_compat. +apply H1. +elim H14; intros; split. +replace (Rmin a c) with a. +left; assumption. +unfold Rmin in |- *; case (Rle_dec a c); intro; + [ reflexivity | elim n0; apply Rle_trans with b; assumption ]. +replace (Rmax a c) with c. +apply Rle_trans with b. +left; assumption. +assumption. +unfold Rmax in |- *; case (Rle_dec a c); intro; + [ reflexivity | elim n0; apply Rle_trans with b; assumption ]. +apply H8. +elim H14; intros; split. +replace (Rmin a b) with a. +left; assumption. +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. +replace (Rmax a b) with b. +left; assumption. +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. +do 2 rewrite StepFun_P30. +do 2 rewrite Rmult_1_l; + replace + (RiemannInt_SF (mkStepFun H11) + RiemannInt_SF (psi1 n) + + (RiemannInt_SF (mkStepFun H13) + RiemannInt_SF (psi2 n))) with + (RiemannInt_SF (psi3 n) + RiemannInt_SF (psi1 n) + RiemannInt_SF (psi2 n)). +replace eps with (eps / 3 + eps / 3 + eps / 3). +repeat rewrite Rplus_assoc; repeat apply Rplus_lt_compat. +apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi3 n))). +apply RRle_abs. +apply Rlt_trans with (pos (RinvN n)). +assumption. +apply H5; assumption. +apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))). +apply RRle_abs. +apply Rlt_trans with (pos (RinvN n)). +assumption. +apply H5; assumption. +apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))). +apply RRle_abs. +apply Rlt_trans with (pos (RinvN n)). +assumption. +apply H5; assumption. +apply Rmult_eq_reg_l with 3; + [ unfold Rdiv in |- *; repeat rewrite Rmult_plus_distr_l; + do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym; [ ring | discrR ] + | discrR ]. +replace (RiemannInt_SF (psi3 n)) with + (RiemannInt_SF (mkStepFun (pre (psi3 n)))). +rewrite <- (StepFun_P43 H11 H13 (pre (psi3 n))); ring. +reflexivity. +rewrite StepFun_P30; ring. +rewrite StepFun_P30; ring. +apply (StepFun_P43 H10 H12 (pre phi3)). +Qed. + +Lemma RiemannInt_P26 : + forall (f:R -> R) (a b c:R) (pr1:Riemann_integrable f a b) + (pr2:Riemann_integrable f b c) (pr3:Riemann_integrable f a c), + RiemannInt pr1 + RiemannInt pr2 = RiemannInt pr3. +intros; case (Rle_dec a b); case (Rle_dec b c); intros. +apply RiemannInt_P25; assumption. +case (Rle_dec a c); intro. +assert (H : c <= b). +auto with real. +rewrite <- (RiemannInt_P25 pr3 (RiemannInt_P1 pr2) pr1 r0 H); + rewrite (RiemannInt_P8 pr2 (RiemannInt_P1 pr2)); ring. +assert (H : c <= a). +auto with real. +rewrite (RiemannInt_P8 pr2 (RiemannInt_P1 pr2)); + rewrite <- (RiemannInt_P25 (RiemannInt_P1 pr3) pr1 (RiemannInt_P1 pr2) H r); + rewrite (RiemannInt_P8 pr3 (RiemannInt_P1 pr3)); ring. +assert (H : b <= a). +auto with real. +case (Rle_dec a c); intro. +rewrite <- (RiemannInt_P25 (RiemannInt_P1 pr1) pr3 pr2 H r0); + rewrite (RiemannInt_P8 pr1 (RiemannInt_P1 pr1)); ring. +assert (H0 : c <= a). +auto with real. +rewrite (RiemannInt_P8 pr1 (RiemannInt_P1 pr1)); + rewrite <- (RiemannInt_P25 pr2 (RiemannInt_P1 pr3) (RiemannInt_P1 pr1) r H0); + rewrite (RiemannInt_P8 pr3 (RiemannInt_P1 pr3)); ring. +rewrite (RiemannInt_P8 pr1 (RiemannInt_P1 pr1)); + rewrite (RiemannInt_P8 pr2 (RiemannInt_P1 pr2)); + rewrite (RiemannInt_P8 pr3 (RiemannInt_P1 pr3)); + rewrite <- + (RiemannInt_P25 (RiemannInt_P1 pr2) (RiemannInt_P1 pr1) (RiemannInt_P1 pr3)) + ; [ ring | auto with real | auto with real ]. +Qed. + +Lemma RiemannInt_P27 : + forall (f:R -> R) (a b x:R) (h:a <= b) + (C0:forall x:R, a <= x <= b -> continuity_pt f x), + a < x < b -> derivable_pt_lim (primitive h (FTC_P1 h C0)) x (f x). +intro f; intros; elim H; clear H; intros; assert (H1 : continuity_pt f x). +apply C0; split; left; assumption. +unfold derivable_pt_lim in |- *; intros; assert (Hyp : 0 < eps / 2). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +elim (H1 _ Hyp); unfold dist, D_x, no_cond in |- *; simpl in |- *; + unfold R_dist in |- *; intros; set (del := Rmin x0 (Rmin (b - x) (x - a))); + assert (H4 : 0 < del). +unfold del in |- *; unfold Rmin in |- *; case (Rle_dec (b - x) (x - a)); + intro. +case (Rle_dec x0 (b - x)); intro; + [ elim H3; intros; assumption | apply Rlt_Rminus; assumption ]. +case (Rle_dec x0 (x - a)); intro; + [ elim H3; intros; assumption | apply Rlt_Rminus; assumption ]. +split with (mkposreal _ H4); intros; + assert (H7 : Riemann_integrable f x (x + h0)). +case (Rle_dec x (x + h0)); intro. +apply continuity_implies_RiemannInt; try assumption. +intros; apply C0; elim H7; intros; split. +apply Rle_trans with x; [ left; assumption | assumption ]. +apply Rle_trans with (x + h0). +assumption. +left; apply Rlt_le_trans with (x + del). +apply Rplus_lt_compat_l; apply Rle_lt_trans with (Rabs h0); + [ apply RRle_abs | apply H6 ]. +unfold del in |- *; apply Rle_trans with (x + Rmin (b - x) (x - a)). +apply Rplus_le_compat_l; apply Rmin_r. +pattern b at 2 in |- *; replace b with (x + (b - x)); + [ apply Rplus_le_compat_l; apply Rmin_l | ring ]. +apply RiemannInt_P1; apply continuity_implies_RiemannInt; auto with real. +intros; apply C0; elim H7; intros; split. +apply Rle_trans with (x + h0). +left; apply Rle_lt_trans with (x - del). +unfold del in |- *; apply Rle_trans with (x - Rmin (b - x) (x - a)). +pattern a at 1 in |- *; replace a with (x + (a - x)); [ idtac | ring ]. +unfold Rminus in |- *; apply Rplus_le_compat_l; apply Ropp_le_cancel. +rewrite Ropp_involutive; rewrite Ropp_plus_distr; rewrite Ropp_involutive; + rewrite (Rplus_comm x); apply Rmin_r. +unfold Rminus in |- *; apply Rplus_le_compat_l; apply Ropp_le_cancel. +do 2 rewrite Ropp_involutive; apply Rmin_r. +unfold Rminus in |- *; apply Rplus_lt_compat_l; apply Ropp_lt_cancel. +rewrite Ropp_involutive; apply Rle_lt_trans with (Rabs h0); + [ rewrite <- Rabs_Ropp; apply RRle_abs | apply H6 ]. +assumption. +apply Rle_trans with x; [ assumption | left; assumption ]. +replace (primitive h (FTC_P1 h C0) (x + h0) - primitive h (FTC_P1 h C0) x) + with (RiemannInt H7). +replace (f x) with (RiemannInt (RiemannInt_P14 x (x + h0) (f x)) / h0). +replace + (RiemannInt H7 / h0 - RiemannInt (RiemannInt_P14 x (x + h0) (f x)) / h0) + with ((RiemannInt H7 - RiemannInt (RiemannInt_P14 x (x + h0) (f x))) / h0). +replace (RiemannInt H7 - RiemannInt (RiemannInt_P14 x (x + h0) (f x))) with + (RiemannInt (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))). +unfold Rdiv in |- *; rewrite Rabs_mult; case (Rle_dec x (x + h0)); intro. +apply Rle_lt_trans with + (RiemannInt + (RiemannInt_P16 + (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))) * + Rabs (/ h0)). +do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. +apply Rabs_pos. +apply + (RiemannInt_P17 (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x))) + (RiemannInt_P16 + (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x))))); + assumption. +apply Rle_lt_trans with + (RiemannInt (RiemannInt_P14 x (x + h0) (eps / 2)) * Rabs (/ h0)). +do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. +apply Rabs_pos. +apply RiemannInt_P19; try assumption. +intros; replace (f x1 + -1 * fct_cte (f x) x1) with (f x1 - f x). +unfold fct_cte in |- *; case (Req_dec x x1); intro. +rewrite H9; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; left; + assumption. +elim H3; intros; left; apply H11. +repeat split. +assumption. +rewrite Rabs_right. +apply Rplus_lt_reg_r with x; replace (x + (x1 - x)) with x1; [ idtac | ring ]. +apply Rlt_le_trans with (x + h0). +elim H8; intros; assumption. +apply Rplus_le_compat_l; apply Rle_trans with del. +left; apply Rle_lt_trans with (Rabs h0); [ apply RRle_abs | assumption ]. +unfold del in |- *; apply Rmin_l. +apply Rge_minus; apply Rle_ge; left; elim H8; intros; assumption. +unfold fct_cte in |- *; ring. +rewrite RiemannInt_P15. +rewrite Rmult_assoc; replace ((x + h0 - x) * Rabs (/ h0)) with 1. +rewrite Rmult_1_r; unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; pattern eps at 1 in |- *; rewrite <- Rplus_0_r; + rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. +rewrite Rabs_right. +replace (x + h0 - x) with h0; [ idtac | ring ]. +apply Rinv_r_sym. +assumption. +apply Rle_ge; left; apply Rinv_0_lt_compat. +elim r; intro. +apply Rplus_lt_reg_r with x; rewrite Rplus_0_r; assumption. +elim H5; symmetry in |- *; apply Rplus_eq_reg_l with x; rewrite Rplus_0_r; + assumption. +apply Rle_lt_trans with + (RiemannInt + (RiemannInt_P16 + (RiemannInt_P1 + (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x))))) * + Rabs (/ h0)). +do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. +apply Rabs_pos. +replace + (RiemannInt (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))) with + (- + RiemannInt + (RiemannInt_P1 (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x))))). +rewrite Rabs_Ropp; + apply + (RiemannInt_P17 + (RiemannInt_P1 + (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))) + (RiemannInt_P16 + (RiemannInt_P1 + (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))))); + auto with real. +symmetry in |- *; apply RiemannInt_P8. +apply Rle_lt_trans with + (RiemannInt (RiemannInt_P14 (x + h0) x (eps / 2)) * Rabs (/ h0)). +do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. +apply Rabs_pos. +apply RiemannInt_P19. +auto with real. +intros; replace (f x1 + -1 * fct_cte (f x) x1) with (f x1 - f x). +unfold fct_cte in |- *; case (Req_dec x x1); intro. +rewrite H9; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; left; + assumption. +elim H3; intros; left; apply H11. +repeat split. +assumption. +rewrite Rabs_left. +apply Rplus_lt_reg_r with (x1 - x0); replace (x1 - x0 + x0) with x1; + [ idtac | ring ]. +replace (x1 - x0 + - (x1 - x)) with (x - x0); [ idtac | ring ]. +apply Rle_lt_trans with (x + h0). +unfold Rminus in |- *; apply Rplus_le_compat_l; apply Ropp_le_cancel. +rewrite Ropp_involutive; apply Rle_trans with (Rabs h0). +rewrite <- Rabs_Ropp; apply RRle_abs. +apply Rle_trans with del; + [ left; assumption | unfold del in |- *; apply Rmin_l ]. +elim H8; intros; assumption. +apply Rplus_lt_reg_r with x; rewrite Rplus_0_r; + replace (x + (x1 - x)) with x1; [ elim H8; intros; assumption | ring ]. +unfold fct_cte in |- *; ring. +rewrite RiemannInt_P15. +rewrite Rmult_assoc; replace ((x - (x + h0)) * Rabs (/ h0)) with 1. +rewrite Rmult_1_r; unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; pattern eps at 1 in |- *; rewrite <- Rplus_0_r; + rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. +rewrite Rabs_left. +replace (x - (x + h0)) with (- h0); [ idtac | ring ]. +rewrite Ropp_mult_distr_l_reverse; rewrite Ropp_mult_distr_r_reverse; + rewrite Ropp_involutive; apply Rinv_r_sym. +assumption. +apply Rinv_lt_0_compat. +assert (H8 : x + h0 < x). +auto with real. +apply Rplus_lt_reg_r with x; rewrite Rplus_0_r; assumption. +rewrite + (RiemannInt_P13 H7 (RiemannInt_P14 x (x + h0) (f x)) + (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))) + . +ring. +unfold Rdiv, Rminus in |- *; rewrite Rmult_plus_distr_r; ring. +rewrite RiemannInt_P15; apply Rmult_eq_reg_l with h0; + [ unfold Rdiv in |- *; rewrite (Rmult_comm h0); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym; [ ring | assumption ] + | assumption ]. +cut (a <= x + h0). +cut (x + h0 <= b). +intros; unfold primitive in |- *. +case (Rle_dec a (x + h0)); case (Rle_dec (x + h0) b); case (Rle_dec a x); + case (Rle_dec x b); intros; try (elim n; assumption || left; assumption). +rewrite <- (RiemannInt_P26 (FTC_P1 h C0 r0 r) H7 (FTC_P1 h C0 r2 r1)); ring. +apply Rplus_le_reg_l with (- x); replace (- x + (x + h0)) with h0; + [ idtac | ring ]. +rewrite Rplus_comm; apply Rle_trans with (Rabs h0). +apply RRle_abs. +apply Rle_trans with del; + [ left; assumption + | unfold del in |- *; apply Rle_trans with (Rmin (b - x) (x - a)); + [ apply Rmin_r | apply Rmin_l ] ]. +apply Ropp_le_cancel; apply Rplus_le_reg_l with x; + replace (x + - (x + h0)) with (- h0); [ idtac | ring ]. +apply Rle_trans with (Rabs h0); + [ rewrite <- Rabs_Ropp; apply RRle_abs + | apply Rle_trans with del; + [ left; assumption + | unfold del in |- *; apply Rle_trans with (Rmin (b - x) (x - a)); + apply Rmin_r ] ]. +Qed. + +Lemma RiemannInt_P28 : + forall (f:R -> R) (a b x:R) (h:a <= b) + (C0:forall x:R, a <= x <= b -> continuity_pt f x), + a <= x <= b -> derivable_pt_lim (primitive h (FTC_P1 h C0)) x (f x). +intro f; intros; elim h; intro. +elim H; clear H; intros; elim H; intro. +elim H1; intro. +apply RiemannInt_P27; split; assumption. +set + (f_b := fun x:R => f b * (x - b) + RiemannInt (FTC_P1 h C0 h (Rle_refl b))); + rewrite H3. +assert (H4 : derivable_pt_lim f_b b (f b)). +unfold f_b in |- *; pattern (f b) at 2 in |- *; replace (f b) with (f b + 0). +change + (derivable_pt_lim + ((fct_cte (f b) * (id - fct_cte b))%F + + fct_cte (RiemannInt (FTC_P1 h C0 h (Rle_refl b)))) b ( + f b + 0)) in |- *. +apply derivable_pt_lim_plus. +pattern (f b) at 2 in |- *; + replace (f b) with (0 * (id - fct_cte b)%F b + fct_cte (f b) b * 1). +apply derivable_pt_lim_mult. +apply derivable_pt_lim_const. +replace 1 with (1 - 0); [ idtac | ring ]. +apply derivable_pt_lim_minus. +apply derivable_pt_lim_id. +apply derivable_pt_lim_const. +unfold fct_cte in |- *; ring. +apply derivable_pt_lim_const. +ring. +unfold derivable_pt_lim in |- *; intros; elim (H4 _ H5); intros; + assert (H7 : continuity_pt f b). +apply C0; split; [ left; assumption | right; reflexivity ]. +assert (H8 : 0 < eps / 2). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +elim (H7 _ H8); unfold D_x, no_cond, dist in |- *; simpl in |- *; + unfold R_dist in |- *; intros; set (del := Rmin x0 (Rmin x1 (b - a))); + assert (H10 : 0 < del). +unfold del in |- *; unfold Rmin in |- *; case (Rle_dec x1 (b - a)); intros. +case (Rle_dec x0 x1); intro; + [ apply (cond_pos x0) | elim H9; intros; assumption ]. +case (Rle_dec x0 (b - a)); intro; + [ apply (cond_pos x0) | apply Rlt_Rminus; assumption ]. +split with (mkposreal _ H10); intros; case (Rcase_abs h0); intro. +assert (H14 : b + h0 < b). +pattern b at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; + assumption. +assert (H13 : Riemann_integrable f (b + h0) b). +apply continuity_implies_RiemannInt. +left; assumption. +intros; apply C0; elim H13; intros; split; try assumption. +apply Rle_trans with (b + h0); try assumption. +apply Rplus_le_reg_l with (- a - h0). +replace (- a - h0 + a) with (- h0); [ idtac | ring ]. +replace (- a - h0 + (b + h0)) with (b - a); [ idtac | ring ]. +apply Rle_trans with del. +apply Rle_trans with (Rabs h0). +rewrite <- Rabs_Ropp; apply RRle_abs. +left; assumption. +unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r. +replace (primitive h (FTC_P1 h C0) (b + h0) - primitive h (FTC_P1 h C0) b) + with (- RiemannInt H13). +replace (f b) with (- RiemannInt (RiemannInt_P14 (b + h0) b (f b)) / h0). +rewrite <- Rabs_Ropp; unfold Rminus in |- *; unfold Rdiv in |- *; + rewrite Ropp_mult_distr_l_reverse; rewrite Ropp_plus_distr; + repeat rewrite Ropp_involutive; + replace + (RiemannInt H13 * / h0 + + - RiemannInt (RiemannInt_P14 (b + h0) b (f b)) * / h0) with + ((RiemannInt H13 - RiemannInt (RiemannInt_P14 (b + h0) b (f b))) / h0). +replace (RiemannInt H13 - RiemannInt (RiemannInt_P14 (b + h0) b (f b))) with + (RiemannInt (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b)))). +unfold Rdiv in |- *; rewrite Rabs_mult; + apply Rle_lt_trans with + (RiemannInt + (RiemannInt_P16 + (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b)))) * + Rabs (/ h0)). +do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. +apply Rabs_pos. +apply + (RiemannInt_P17 (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b))) + (RiemannInt_P16 + (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b))))); + left; assumption. +apply Rle_lt_trans with + (RiemannInt (RiemannInt_P14 (b + h0) b (eps / 2)) * Rabs (/ h0)). +do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. +apply Rabs_pos. +apply RiemannInt_P19. +left; assumption. +intros; replace (f x2 + -1 * fct_cte (f b) x2) with (f x2 - f b). +unfold fct_cte in |- *; case (Req_dec b x2); intro. +rewrite H16; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + left; assumption. +elim H9; intros; left; apply H18. +repeat split. +assumption. +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; rewrite Rabs_right. +apply Rplus_lt_reg_r with (x2 - x1); + replace (x2 - x1 + (b - x2)) with (b - x1); [ idtac | ring ]. +replace (x2 - x1 + x1) with x2; [ idtac | ring ]. +apply Rlt_le_trans with (b + h0). +2: elim H15; intros; left; assumption. +unfold Rminus in |- *; apply Rplus_lt_compat_l; apply Ropp_lt_cancel; + rewrite Ropp_involutive; apply Rle_lt_trans with (Rabs h0). +rewrite <- Rabs_Ropp; apply RRle_abs. +apply Rlt_le_trans with del; + [ assumption + | unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); + [ apply Rmin_r | apply Rmin_l ] ]. +apply Rle_ge; left; apply Rlt_Rminus; elim H15; intros; assumption. +unfold fct_cte in |- *; ring. +rewrite RiemannInt_P15. +rewrite Rmult_assoc; replace ((b - (b + h0)) * Rabs (/ h0)) with 1. +rewrite Rmult_1_r; unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; pattern eps at 1 in |- *; rewrite <- Rplus_0_r; + rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. +rewrite Rabs_left. +apply Rmult_eq_reg_l with h0; + [ do 2 rewrite (Rmult_comm h0); rewrite Rmult_assoc; + rewrite Ropp_mult_distr_l_reverse; rewrite <- Rinv_l_sym; + [ ring | assumption ] + | assumption ]. +apply Rinv_lt_0_compat; assumption. +rewrite + (RiemannInt_P13 H13 (RiemannInt_P14 (b + h0) b (f b)) + (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b)))) + ; ring. +unfold Rdiv, Rminus in |- *; rewrite Rmult_plus_distr_r; ring. +rewrite RiemannInt_P15. +rewrite <- Ropp_mult_distr_l_reverse; apply Rmult_eq_reg_l with h0; + [ repeat rewrite (Rmult_comm h0); unfold Rdiv in |- *; + repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym; + [ ring | assumption ] + | assumption ]. +cut (a <= b + h0). +cut (b + h0 <= b). +intros; unfold primitive in |- *; case (Rle_dec a (b + h0)); + case (Rle_dec (b + h0) b); case (Rle_dec a b); case (Rle_dec b b); + intros; try (elim n; right; reflexivity) || (elim n; left; assumption). +rewrite <- (RiemannInt_P26 (FTC_P1 h C0 r3 r2) H13 (FTC_P1 h C0 r1 r0)); ring. +elim n; assumption. +left; assumption. +apply Rplus_le_reg_l with (- a - h0). +replace (- a - h0 + a) with (- h0); [ idtac | ring ]. +replace (- a - h0 + (b + h0)) with (b - a); [ idtac | ring ]. +apply Rle_trans with del. +apply Rle_trans with (Rabs h0). +rewrite <- Rabs_Ropp; apply RRle_abs. +left; assumption. +unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r. +cut (primitive h (FTC_P1 h C0) b = f_b b). +intro; cut (primitive h (FTC_P1 h C0) (b + h0) = f_b (b + h0)). +intro; rewrite H13; rewrite H14; apply H6. +assumption. +apply Rlt_le_trans with del; + [ assumption | unfold del in |- *; apply Rmin_l ]. +assert (H14 : b < b + h0). +pattern b at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l. +assert (H14 := Rge_le _ _ r); elim H14; intro. +assumption. +elim H11; symmetry in |- *; assumption. +unfold primitive in |- *; case (Rle_dec a (b + h0)); + case (Rle_dec (b + h0) b); intros; + [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 H14)) + | unfold f_b in |- *; reflexivity + | elim n; left; apply Rlt_trans with b; assumption + | elim n0; left; apply Rlt_trans with b; assumption ]. +unfold f_b in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rmult_0_r; rewrite Rplus_0_l; unfold primitive in |- *; + case (Rle_dec a b); case (Rle_dec b b); intros; + [ apply RiemannInt_P5 + | elim n; right; reflexivity + | elim n; left; assumption + | elim n; right; reflexivity ]. +(*****) +set (f_a := fun x:R => f a * (x - a)); rewrite <- H2; + assert (H3 : derivable_pt_lim f_a a (f a)). +unfold f_a in |- *; + change (derivable_pt_lim (fct_cte (f a) * (id - fct_cte a)%F) a (f a)) + in |- *; pattern (f a) at 2 in |- *; + replace (f a) with (0 * (id - fct_cte a)%F a + fct_cte (f a) a * 1). +apply derivable_pt_lim_mult. +apply derivable_pt_lim_const. +replace 1 with (1 - 0); [ idtac | ring ]. +apply derivable_pt_lim_minus. +apply derivable_pt_lim_id. +apply derivable_pt_lim_const. +unfold fct_cte in |- *; ring. +unfold derivable_pt_lim in |- *; intros; elim (H3 _ H4); intros. +assert (H6 : continuity_pt f a). +apply C0; split; [ right; reflexivity | left; assumption ]. +assert (H7 : 0 < eps / 2). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +elim (H6 _ H7); unfold D_x, no_cond, dist in |- *; simpl in |- *; + unfold R_dist in |- *; intros. +set (del := Rmin x0 (Rmin x1 (b - a))). +assert (H9 : 0 < del). +unfold del in |- *; unfold Rmin in |- *. +case (Rle_dec x1 (b - a)); intros. +case (Rle_dec x0 x1); intro. +apply (cond_pos x0). +elim H8; intros; assumption. +case (Rle_dec x0 (b - a)); intro. +apply (cond_pos x0). +apply Rlt_Rminus; assumption. +split with (mkposreal _ H9). +intros; case (Rcase_abs h0); intro. +assert (H12 : a + h0 < a). +pattern a at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; + assumption. +unfold primitive in |- *. +case (Rle_dec a (a + h0)); case (Rle_dec (a + h0) b); case (Rle_dec a a); + case (Rle_dec a b); intros; + try (elim n; left; assumption) || (elim n; right; reflexivity). +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H12)). +elim n; left; apply Rlt_trans with a; assumption. +rewrite RiemannInt_P9; replace 0 with (f_a a). +replace (f a * (a + h0 - a)) with (f_a (a + h0)). +apply H5; try assumption. +apply Rlt_le_trans with del; + [ assumption | unfold del in |- *; apply Rmin_l ]. +unfold f_a in |- *; ring. +unfold f_a in |- *; ring. +elim n; left; apply Rlt_trans with a; assumption. +assert (H12 : a < a + h0). +pattern a at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l. +assert (H12 := Rge_le _ _ r); elim H12; intro. +assumption. +elim H10; symmetry in |- *; assumption. +assert (H13 : Riemann_integrable f a (a + h0)). +apply continuity_implies_RiemannInt. +left; assumption. +intros; apply C0; elim H13; intros; split; try assumption. +apply Rle_trans with (a + h0); try assumption. +apply Rplus_le_reg_l with (- b - h0). +replace (- b - h0 + b) with (- h0); [ idtac | ring ]. +replace (- b - h0 + (a + h0)) with (a - b); [ idtac | ring ]. +apply Ropp_le_cancel; rewrite Ropp_involutive; rewrite Ropp_minus_distr; + apply Rle_trans with del. +apply Rle_trans with (Rabs h0); [ apply RRle_abs | left; assumption ]. +unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r. +replace (primitive h (FTC_P1 h C0) (a + h0) - primitive h (FTC_P1 h C0) a) + with (RiemannInt H13). +replace (f a) with (RiemannInt (RiemannInt_P14 a (a + h0) (f a)) / h0). +replace + (RiemannInt H13 / h0 - RiemannInt (RiemannInt_P14 a (a + h0) (f a)) / h0) + with ((RiemannInt H13 - RiemannInt (RiemannInt_P14 a (a + h0) (f a))) / h0). +replace (RiemannInt H13 - RiemannInt (RiemannInt_P14 a (a + h0) (f a))) with + (RiemannInt (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a)))). +unfold Rdiv in |- *; rewrite Rabs_mult; + apply Rle_lt_trans with + (RiemannInt + (RiemannInt_P16 + (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a)))) * + Rabs (/ h0)). +do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. +apply Rabs_pos. +apply + (RiemannInt_P17 (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a))) + (RiemannInt_P16 + (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a))))); + left; assumption. +apply Rle_lt_trans with + (RiemannInt (RiemannInt_P14 a (a + h0) (eps / 2)) * Rabs (/ h0)). +do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. +apply Rabs_pos. +apply RiemannInt_P19. +left; assumption. +intros; replace (f x2 + -1 * fct_cte (f a) x2) with (f x2 - f a). +unfold fct_cte in |- *; case (Req_dec a x2); intro. +rewrite H15; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + left; assumption. +elim H8; intros; left; apply H17; repeat split. +assumption. +rewrite Rabs_right. +apply Rplus_lt_reg_r with a; replace (a + (x2 - a)) with x2; [ idtac | ring ]. +apply Rlt_le_trans with (a + h0). +elim H14; intros; assumption. +apply Rplus_le_compat_l; left; apply Rle_lt_trans with (Rabs h0). +apply RRle_abs. +apply Rlt_le_trans with del; + [ assumption + | unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); + [ apply Rmin_r | apply Rmin_l ] ]. +apply Rle_ge; left; apply Rlt_Rminus; elim H14; intros; assumption. +unfold fct_cte in |- *; ring. +rewrite RiemannInt_P15. +rewrite Rmult_assoc; replace ((a + h0 - a) * Rabs (/ h0)) with 1. +rewrite Rmult_1_r; unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; pattern eps at 1 in |- *; rewrite <- Rplus_0_r; + rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. +rewrite Rabs_right. +rewrite Rplus_comm; unfold Rminus in |- *; rewrite Rplus_assoc; + rewrite Rplus_opp_r; rewrite Rplus_0_r; rewrite <- Rinv_r_sym; + [ reflexivity | assumption ]. +apply Rle_ge; left; apply Rinv_0_lt_compat; assert (H14 := Rge_le _ _ r); + elim H14; intro. +assumption. +elim H10; symmetry in |- *; assumption. +rewrite + (RiemannInt_P13 H13 (RiemannInt_P14 a (a + h0) (f a)) + (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a)))) + ; ring. +unfold Rdiv, Rminus in |- *; rewrite Rmult_plus_distr_r; ring. +rewrite RiemannInt_P15. +rewrite Rplus_comm; unfold Rminus in |- *; rewrite Rplus_assoc; + rewrite Rplus_opp_r; rewrite Rplus_0_r; unfold Rdiv in |- *; + rewrite Rmult_assoc; rewrite <- Rinv_r_sym; [ ring | assumption ]. +cut (a <= a + h0). +cut (a + h0 <= b). +intros; unfold primitive in |- *; case (Rle_dec a (a + h0)); + case (Rle_dec (a + h0) b); case (Rle_dec a a); case (Rle_dec a b); + intros; try (elim n; right; reflexivity) || (elim n; left; assumption). +rewrite RiemannInt_P9; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; apply RiemannInt_P5. +elim n; assumption. +elim n; assumption. +2: left; assumption. +apply Rplus_le_reg_l with (- a); replace (- a + (a + h0)) with h0; + [ idtac | ring ]. +rewrite Rplus_comm; apply Rle_trans with del; + [ apply Rle_trans with (Rabs h0); [ apply RRle_abs | left; assumption ] + | unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r ]. +(*****) +assert (H1 : x = a). +rewrite <- H0 in H; elim H; intros; apply Rle_antisym; assumption. +set (f_a := fun x:R => f a * (x - a)). +assert (H2 : derivable_pt_lim f_a a (f a)). +unfold f_a in |- *; + change (derivable_pt_lim (fct_cte (f a) * (id - fct_cte a)%F) a (f a)) + in |- *; pattern (f a) at 2 in |- *; + replace (f a) with (0 * (id - fct_cte a)%F a + fct_cte (f a) a * 1). +apply derivable_pt_lim_mult. +apply derivable_pt_lim_const. +replace 1 with (1 - 0); [ idtac | ring ]. +apply derivable_pt_lim_minus. +apply derivable_pt_lim_id. +apply derivable_pt_lim_const. +unfold fct_cte in |- *; ring. +set + (f_b := fun x:R => f b * (x - b) + RiemannInt (FTC_P1 h C0 h (Rle_refl b))). +assert (H3 : derivable_pt_lim f_b b (f b)). +unfold f_b in |- *; pattern (f b) at 2 in |- *; replace (f b) with (f b + 0). +change + (derivable_pt_lim + ((fct_cte (f b) * (id - fct_cte b))%F + + fct_cte (RiemannInt (FTC_P1 h C0 h (Rle_refl b)))) b ( + f b + 0)) in |- *. +apply derivable_pt_lim_plus. +pattern (f b) at 2 in |- *; + replace (f b) with (0 * (id - fct_cte b)%F b + fct_cte (f b) b * 1). +apply derivable_pt_lim_mult. +apply derivable_pt_lim_const. +replace 1 with (1 - 0); [ idtac | ring ]. +apply derivable_pt_lim_minus. +apply derivable_pt_lim_id. +apply derivable_pt_lim_const. +unfold fct_cte in |- *; ring. +apply derivable_pt_lim_const. +ring. +unfold derivable_pt_lim in |- *; intros; elim (H2 _ H4); intros; + elim (H3 _ H4); intros; set (del := Rmin x0 x1). +assert (H7 : 0 < del). +unfold del in |- *; unfold Rmin in |- *; case (Rle_dec x0 x1); intro. +apply (cond_pos x0). +apply (cond_pos x1). +split with (mkposreal _ H7); intros; case (Rcase_abs h0); intro. +assert (H10 : a + h0 < a). +pattern a at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; + assumption. +rewrite H1; unfold primitive in |- *; case (Rle_dec a (a + h0)); + case (Rle_dec (a + h0) b); case (Rle_dec a a); case (Rle_dec a b); + intros; try (elim n; right; assumption || reflexivity). +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H10)). +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r2 H10)). +rewrite RiemannInt_P9; replace 0 with (f_a a). +replace (f a * (a + h0 - a)) with (f_a (a + h0)). +apply H5; try assumption. +apply Rlt_le_trans with del; try assumption. +unfold del in |- *; apply Rmin_l. +unfold f_a in |- *; ring. +unfold f_a in |- *; ring. +elim n; rewrite <- H0; left; assumption. +assert (H10 : a < a + h0). +pattern a at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l. +assert (H10 := Rge_le _ _ r); elim H10; intro. +assumption. +elim H8; symmetry in |- *; assumption. +rewrite H0 in H1; rewrite H1; unfold primitive in |- *; + case (Rle_dec a (b + h0)); case (Rle_dec (b + h0) b); + case (Rle_dec a b); case (Rle_dec b b); intros; + try (elim n; right; assumption || reflexivity). +rewrite H0 in H10; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r2 H10)). +repeat rewrite RiemannInt_P9. +replace (RiemannInt (FTC_P1 h C0 r1 r0)) with (f_b b). +fold (f_b (b + h0)) in |- *. +apply H6; try assumption. +apply Rlt_le_trans with del; try assumption. +unfold del in |- *; apply Rmin_r. +unfold f_b in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rmult_0_r; rewrite Rplus_0_l; apply RiemannInt_P5. +elim n; rewrite <- H0; left; assumption. +elim n0; rewrite <- H0; left; assumption. +Qed. + +Lemma RiemannInt_P29 : + forall (f:R -> R) a b (h:a <= b) + (C0:forall x:R, a <= x <= b -> continuity_pt f x), + antiderivative f (primitive h (FTC_P1 h C0)) a b. +intro f; intros; unfold antiderivative in |- *; split; try assumption; intros; + assert (H0 := RiemannInt_P28 h C0 H); + assert (H1 : derivable_pt (primitive h (FTC_P1 h C0)) x); + [ unfold derivable_pt in |- *; split with (f x); apply H0 + | split with H1; symmetry in |- *; apply derive_pt_eq_0; apply H0 ]. +Qed. + +Lemma RiemannInt_P30 : + forall (f:R -> R) (a b:R), + a <= b -> + (forall x:R, a <= x <= b -> continuity_pt f x) -> + sigT (fun g:R -> R => antiderivative f g a b). +intros; split with (primitive H (FTC_P1 H H0)); apply RiemannInt_P29. +Qed. + +Record C1_fun : Type := mkC1 + {c1 :> R -> R; diff0 : derivable c1; cont1 : continuity (derive c1 diff0)}. + +Lemma RiemannInt_P31 : + forall (f:C1_fun) (a b:R), + a <= b -> antiderivative (derive f (diff0 f)) f a b. +intro f; intros; unfold antiderivative in |- *; split; try assumption; intros; + split with (diff0 f x); reflexivity. +Qed. + +Lemma RiemannInt_P32 : + forall (f:C1_fun) (a b:R), Riemann_integrable (derive f (diff0 f)) a b. +intro f; intros; case (Rle_dec a b); intro; + [ apply continuity_implies_RiemannInt; try assumption; intros; + apply (cont1 f) + | assert (H : b <= a); + [ auto with real + | apply RiemannInt_P1; apply continuity_implies_RiemannInt; + try assumption; intros; apply (cont1 f) ] ]. +Qed. + +Lemma RiemannInt_P33 : + forall (f:C1_fun) (a b:R) (pr:Riemann_integrable (derive f (diff0 f)) a b), + a <= b -> RiemannInt pr = f b - f a. +intro f; intros; + assert + (H0 : forall x:R, a <= x <= b -> continuity_pt (derive f (diff0 f)) x). +intros; apply (cont1 f). +rewrite (RiemannInt_P20 H (FTC_P1 H H0) pr); + assert (H1 := RiemannInt_P29 H H0); assert (H2 := RiemannInt_P31 f H); + elim (antiderivative_Ucte (derive f (diff0 f)) _ _ _ _ H1 H2); + intros C H3; repeat rewrite H3; + [ ring + | split; [ right; reflexivity | assumption ] + | split; [ assumption | right; reflexivity ] ]. +Qed. + +Lemma FTC_Riemann : + forall (f:C1_fun) (a b:R) (pr:Riemann_integrable (derive f (diff0 f)) a b), + RiemannInt pr = f b - f a. +intro f; intros; case (Rle_dec a b); intro; + [ apply RiemannInt_P33; assumption + | assert (H : b <= a); + [ auto with real + | assert (H0 := RiemannInt_P1 pr); rewrite (RiemannInt_P8 pr H0); + rewrite (RiemannInt_P33 _ H0 H); ring ] ]. +Qed. diff --git a/theories/Reals/RiemannInt_SF.v b/theories/Reals/RiemannInt_SF.v new file mode 100644 index 00000000..0ae8f9f2 --- /dev/null +++ b/theories/Reals/RiemannInt_SF.v @@ -0,0 +1,2632 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: RiemannInt_SF.v,v 1.16.2.1 2004/07/16 19:31:13 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rfunctions. +Require Import Ranalysis. +Require Import Classical_Prop. +Open Local Scope R_scope. + +Set Implicit Arguments. + +(**************************************************) +(* Each bounded subset of N has a maximal element *) +(**************************************************) + +Definition Nbound (I:nat -> Prop) : Prop := + exists n : nat, (forall i:nat, I i -> (i <= n)%nat). + +Lemma IZN_var : forall z:Z, (0 <= z)%Z -> {n : nat | z = Z_of_nat n}. +intros; apply Z_of_nat_complete_inf; assumption. +Qed. + +Lemma Nzorn : + forall I:nat -> Prop, + (exists n : nat, I n) -> + Nbound I -> sigT (fun n:nat => I n /\ (forall i:nat, I i -> (i <= n)%nat)). +intros I H H0; set (E := fun x:R => exists i : nat, I i /\ INR i = x); + assert (H1 : bound E). +unfold Nbound in H0; elim H0; intros N H1; unfold bound in |- *; + exists (INR N); unfold is_upper_bound in |- *; intros; + unfold E in H2; elim H2; intros; elim H3; intros; + rewrite <- H5; apply le_INR; apply H1; assumption. +assert (H2 : exists x : R, E x). +elim H; intros; exists (INR x); unfold E in |- *; exists x; split; + [ assumption | reflexivity ]. +assert (H3 := completeness E H1 H2); elim H3; intros; unfold is_lub in p; + elim p; clear p; intros; unfold is_upper_bound in H4, H5; + assert (H6 : 0 <= x). +elim H2; intros; unfold E in H6; elim H6; intros; elim H7; intros; + apply Rle_trans with x0; + [ rewrite <- H9; change (INR 0 <= INR x1) in |- *; apply le_INR; + apply le_O_n + | apply H4; assumption ]. +assert (H7 := archimed x); elim H7; clear H7; intros; + assert (H9 : x <= IZR (up x) - 1). +apply H5; intros; assert (H10 := H4 _ H9); unfold E in H9; elim H9; intros; + elim H11; intros; rewrite <- H13; apply Rplus_le_reg_l with 1; + replace (1 + (IZR (up x) - 1)) with (IZR (up x)); + [ idtac | ring ]; replace (1 + INR x1) with (INR (S x1)); + [ idtac | rewrite S_INR; ring ]. +assert (H14 : (0 <= up x)%Z). +apply le_IZR; apply Rle_trans with x; [ apply H6 | left; assumption ]. +assert (H15 := IZN _ H14); elim H15; clear H15; intros; rewrite H15; + rewrite <- INR_IZR_INZ; apply le_INR; apply lt_le_S; + apply INR_lt; rewrite H13; apply Rle_lt_trans with x; + [ assumption | rewrite INR_IZR_INZ; rewrite <- H15; assumption ]. +assert (H10 : x = IZR (up x) - 1). +apply Rle_antisym; + [ assumption + | apply Rplus_le_reg_l with (- x + 1); + replace (- x + 1 + (IZR (up x) - 1)) with (IZR (up x) - x); + [ idtac | ring ]; replace (- x + 1 + x) with 1; + [ assumption | ring ] ]. +assert (H11 : (0 <= up x)%Z). +apply le_IZR; apply Rle_trans with x; [ apply H6 | left; assumption ]. +assert (H12 := IZN_var H11); elim H12; clear H12; intros; assert (H13 : E x). +elim (classic (E x)); intro; try assumption. +cut (forall y:R, E y -> y <= x - 1). +intro; assert (H14 := H5 _ H13); cut (x - 1 < x). +intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H14 H15)). +apply Rminus_lt; replace (x - 1 - x) with (-1); [ idtac | ring ]; + rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; apply Rlt_0_1. +intros; assert (H14 := H4 _ H13); elim H14; intro; unfold E in H13; elim H13; + intros; elim H16; intros; apply Rplus_le_reg_l with 1. +replace (1 + (x - 1)) with x; [ idtac | ring ]; rewrite <- H18; + replace (1 + INR x1) with (INR (S x1)); [ idtac | rewrite S_INR; ring ]. +cut (x = INR (pred x0)). +intro; rewrite H19; apply le_INR; apply lt_le_S; apply INR_lt; rewrite H18; + rewrite <- H19; assumption. +rewrite H10; rewrite p; rewrite <- INR_IZR_INZ; replace 1 with (INR 1); + [ idtac | reflexivity ]; rewrite <- minus_INR. +replace (x0 - 1)%nat with (pred x0); + [ reflexivity + | case x0; [ reflexivity | intro; simpl in |- *; apply minus_n_O ] ]. +induction x0 as [| x0 Hrecx0]; + [ rewrite p in H7; rewrite <- INR_IZR_INZ in H7; simpl in H7; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H6 H7)) + | apply le_n_S; apply le_O_n ]. +rewrite H15 in H13; elim H12; assumption. +split with (pred x0); unfold E in H13; elim H13; intros; elim H12; intros; + rewrite H10 in H15; rewrite p in H15; rewrite <- INR_IZR_INZ in H15; + assert (H16 : INR x0 = INR x1 + 1). +rewrite H15; ring. +rewrite <- S_INR in H16; assert (H17 := INR_eq _ _ H16); rewrite H17; + simpl in |- *; split. +assumption. +intros; apply INR_le; rewrite H15; rewrite <- H15; elim H12; intros; + rewrite H20; apply H4; unfold E in |- *; exists i; + split; [ assumption | reflexivity ]. +Qed. + +(*******************************************) +(* Step functions *) +(*******************************************) + +Definition open_interval (a b x:R) : Prop := a < x < b. +Definition co_interval (a b x:R) : Prop := a <= x < b. + +Definition adapted_couple (f:R -> R) (a b:R) (l lf:Rlist) : Prop := + ordered_Rlist l /\ + pos_Rl l 0 = Rmin a b /\ + pos_Rl l (pred (Rlength l)) = Rmax a b /\ + Rlength l = S (Rlength lf) /\ + (forall i:nat, + (i < pred (Rlength l))%nat -> + constant_D_eq f (open_interval (pos_Rl l i) (pos_Rl l (S i))) + (pos_Rl lf i)). + +Definition adapted_couple_opt (f:R -> R) (a b:R) (l lf:Rlist) := + adapted_couple f a b l lf /\ + (forall i:nat, + (i < pred (Rlength lf))%nat -> + pos_Rl lf i <> pos_Rl lf (S i) \/ f (pos_Rl l (S i)) <> pos_Rl lf i) /\ + (forall i:nat, (i < pred (Rlength l))%nat -> pos_Rl l i <> pos_Rl l (S i)). + +Definition is_subdivision (f:R -> R) (a b:R) (l:Rlist) : Type := + sigT (fun l0:Rlist => adapted_couple f a b l l0). + +Definition IsStepFun (f:R -> R) (a b:R) : Type := + sigT (fun l:Rlist => is_subdivision f a b l). + +(* Class of step functions *) +Record StepFun (a b:R) : Type := mkStepFun + {fe :> R -> R; pre : IsStepFun fe a b}. + +Definition subdivision (a b:R) (f:StepFun a b) : Rlist := projT1 (pre f). + +Definition subdivision_val (a b:R) (f:StepFun a b) : Rlist := + match projT2 (pre f) with + | existT a b => a + end. + +Fixpoint Int_SF (l k:Rlist) {struct l} : R := + match l with + | nil => 0 + | cons a l' => + match k with + | nil => 0 + | cons x nil => 0 + | cons x (cons y k') => a * (y - x) + Int_SF l' (cons y k') + end + end. + +(* Integral of step functions *) +Definition RiemannInt_SF (a b:R) (f:StepFun a b) : R := + match Rle_dec a b with + | left _ => Int_SF (subdivision_val f) (subdivision f) + | right _ => - Int_SF (subdivision_val f) (subdivision f) + end. + +(********************************) +(* Properties of step functions *) +(********************************) + +Lemma StepFun_P1 : + forall (a b:R) (f:StepFun a b), + adapted_couple f a b (subdivision f) (subdivision_val f). +intros a b f; unfold subdivision_val in |- *; case (projT2 (pre f)); intros; + apply a0. +Qed. + +Lemma StepFun_P2 : + forall (a b:R) (f:R -> R) (l lf:Rlist), + adapted_couple f a b l lf -> adapted_couple f b a l lf. +unfold adapted_couple in |- *; intros; decompose [and] H; clear H; + repeat split; try assumption. +rewrite H2; unfold Rmin in |- *; case (Rle_dec a b); intro; + case (Rle_dec b a); intro; try reflexivity. +apply Rle_antisym; assumption. +apply Rle_antisym; auto with real. +rewrite H1; unfold Rmax in |- *; case (Rle_dec a b); intro; + case (Rle_dec b a); intro; try reflexivity. +apply Rle_antisym; assumption. +apply Rle_antisym; auto with real. +Qed. + +Lemma StepFun_P3 : + forall a b c:R, + a <= b -> + adapted_couple (fct_cte c) a b (cons a (cons b nil)) (cons c nil). +intros; unfold adapted_couple in |- *; repeat split. +unfold ordered_Rlist in |- *; intros; simpl in H0; inversion H0; + [ simpl in |- *; assumption | elim (le_Sn_O _ H2) ]. +simpl in |- *; unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +simpl in |- *; unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +unfold constant_D_eq, open_interval in |- *; intros; simpl in H0; + inversion H0; [ reflexivity | elim (le_Sn_O _ H3) ]. +Qed. + +Lemma StepFun_P4 : forall a b c:R, IsStepFun (fct_cte c) a b. +intros; unfold IsStepFun in |- *; case (Rle_dec a b); intro. +apply existT with (cons a (cons b nil)); unfold is_subdivision in |- *; + apply existT with (cons c nil); apply (StepFun_P3 c r). +apply existT with (cons b (cons a nil)); unfold is_subdivision in |- *; + apply existT with (cons c nil); apply StepFun_P2; + apply StepFun_P3; auto with real. +Qed. + +Lemma StepFun_P5 : + forall (a b:R) (f:R -> R) (l:Rlist), + is_subdivision f a b l -> is_subdivision f b a l. +unfold is_subdivision in |- *; intros; elim X; intros; exists x; + unfold adapted_couple in p; decompose [and] p; clear p; + unfold adapted_couple in |- *; repeat split; try assumption. +rewrite H1; unfold Rmin in |- *; case (Rle_dec a b); intro; + case (Rle_dec b a); intro; try reflexivity. +apply Rle_antisym; assumption. +apply Rle_antisym; auto with real. +rewrite H0; unfold Rmax in |- *; case (Rle_dec a b); intro; + case (Rle_dec b a); intro; try reflexivity. +apply Rle_antisym; assumption. +apply Rle_antisym; auto with real. +Qed. + +Lemma StepFun_P6 : + forall (f:R -> R) (a b:R), IsStepFun f a b -> IsStepFun f b a. +unfold IsStepFun in |- *; intros; elim X; intros; apply existT with x; + apply StepFun_P5; assumption. +Qed. + +Lemma StepFun_P7 : + forall (a b r1 r2 r3:R) (f:R -> R) (l lf:Rlist), + a <= b -> + adapted_couple f a b (cons r1 (cons r2 l)) (cons r3 lf) -> + adapted_couple f r2 b (cons r2 l) lf. +unfold adapted_couple in |- *; intros; decompose [and] H0; clear H0; + assert (H5 : Rmax a b = b). +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +assert (H7 : r2 <= b). +rewrite H5 in H2; rewrite <- H2; apply RList_P7; + [ assumption | simpl in |- *; right; left; reflexivity ]. +repeat split. +apply RList_P4 with r1; assumption. +rewrite H5 in H2; unfold Rmin in |- *; case (Rle_dec r2 b); intro; + [ reflexivity | elim n; assumption ]. +unfold Rmax in |- *; case (Rle_dec r2 b); intro; + [ rewrite H5 in H2; rewrite <- H2; reflexivity | elim n; assumption ]. +simpl in H4; simpl in |- *; apply INR_eq; apply Rplus_eq_reg_l with 1; + do 2 rewrite (Rplus_comm 1); do 2 rewrite <- S_INR; + rewrite H4; reflexivity. +intros; unfold constant_D_eq, open_interval in |- *; intros; + unfold constant_D_eq, open_interval in H6; + assert (H9 : (S i < pred (Rlength (cons r1 (cons r2 l))))%nat). +simpl in |- *; simpl in H0; apply lt_n_S; assumption. +assert (H10 := H6 _ H9); apply H10; assumption. +Qed. + +Lemma StepFun_P8 : + forall (f:R -> R) (l1 lf1:Rlist) (a b:R), + adapted_couple f a b l1 lf1 -> a = b -> Int_SF lf1 l1 = 0. +simple induction l1. +intros; induction lf1 as [| r lf1 Hreclf1]; reflexivity. +simple induction r0. +intros; induction lf1 as [| r1 lf1 Hreclf1]. +reflexivity. +unfold adapted_couple in H0; decompose [and] H0; clear H0; simpl in H5; + discriminate. +intros; induction lf1 as [| r3 lf1 Hreclf1]. +reflexivity. +simpl in |- *; cut (r = r1). +intro; rewrite H3; rewrite (H0 lf1 r b). +ring. +rewrite H3; apply StepFun_P7 with a r r3; [ right; assumption | assumption ]. +clear H H0 Hreclf1 r0; unfold adapted_couple in H1; decompose [and] H1; + intros; simpl in H4; rewrite H4; unfold Rmin in |- *; + case (Rle_dec a b); intro; [ assumption | reflexivity ]. +unfold adapted_couple in H1; decompose [and] H1; intros; apply Rle_antisym. +apply (H3 0%nat); simpl in |- *; apply lt_O_Sn. +simpl in H5; rewrite H2 in H5; rewrite H5; replace (Rmin b b) with (Rmax a b); + [ rewrite <- H4; apply RList_P7; + [ assumption | simpl in |- *; right; left; reflexivity ] + | unfold Rmin, Rmax in |- *; case (Rle_dec b b); case (Rle_dec a b); intros; + try assumption || reflexivity ]. +Qed. + +Lemma StepFun_P9 : + forall (a b:R) (f:R -> R) (l lf:Rlist), + adapted_couple f a b l lf -> a <> b -> (2 <= Rlength l)%nat. +intros; unfold adapted_couple in H; decompose [and] H; clear H; + induction l as [| r l Hrecl]; + [ simpl in H4; discriminate + | induction l as [| r0 l Hrecl0]; + [ simpl in H3; simpl in H2; generalize H3; generalize H2; + unfold Rmin, Rmax in |- *; case (Rle_dec a b); + intros; elim H0; rewrite <- H5; rewrite <- H7; + reflexivity + | simpl in |- *; do 2 apply le_n_S; apply le_O_n ] ]. +Qed. + +Lemma StepFun_P10 : + forall (f:R -> R) (l lf:Rlist) (a b:R), + a <= b -> + adapted_couple f a b l lf -> + exists l' : Rlist, + (exists lf' : Rlist, adapted_couple_opt f a b l' lf'). +simple induction l. +intros; unfold adapted_couple in H0; decompose [and] H0; simpl in H4; + discriminate. +intros; case (Req_dec a b); intro. +exists (cons a nil); exists nil; unfold adapted_couple_opt in |- *; + unfold adapted_couple in |- *; unfold ordered_Rlist in |- *; + repeat split; try (intros; simpl in H3; elim (lt_n_O _ H3)). +simpl in |- *; rewrite <- H2; unfold Rmin in |- *; case (Rle_dec a a); intro; + reflexivity. +simpl in |- *; rewrite <- H2; unfold Rmax in |- *; case (Rle_dec a a); intro; + reflexivity. +elim (RList_P20 _ (StepFun_P9 H1 H2)); intros t1 [t2 [t3 H3]]; + induction lf as [| r1 lf Hreclf]. +unfold adapted_couple in H1; decompose [and] H1; rewrite H3 in H7; + simpl in H7; discriminate. +clear Hreclf; assert (H4 : adapted_couple f t2 b r0 lf). +rewrite H3 in H1; assert (H4 := RList_P21 _ _ H3); simpl in H4; rewrite H4; + eapply StepFun_P7; [ apply H0 | apply H1 ]. +cut (t2 <= b). +intro; assert (H6 := H _ _ _ H5 H4); case (Req_dec t1 t2); intro Hyp_eq. +replace a with t2. +apply H6. +rewrite <- Hyp_eq; rewrite H3 in H1; unfold adapted_couple in H1; + decompose [and] H1; clear H1; simpl in H9; rewrite H9; + unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +elim H6; clear H6; intros l' [lf' H6]; case (Req_dec t2 b); intro. +exists (cons a (cons b nil)); exists (cons r1 nil); + unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *; + repeat split. +unfold ordered_Rlist in |- *; intros; simpl in H8; inversion H8; + [ simpl in |- *; assumption | elim (le_Sn_O _ H10) ]. +simpl in |- *; unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +simpl in |- *; unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +intros; simpl in H8; inversion H8. +unfold constant_D_eq, open_interval in |- *; intros; simpl in |- *; + simpl in H9; rewrite H3 in H1; unfold adapted_couple in H1; + decompose [and] H1; apply (H16 0%nat). +simpl in |- *; apply lt_O_Sn. +unfold open_interval in |- *; simpl in |- *; rewrite H7; simpl in H13; + rewrite H13; unfold Rmin in |- *; case (Rle_dec a b); + intro; [ assumption | elim n; assumption ]. +elim (le_Sn_O _ H10). +intros; simpl in H8; elim (lt_n_O _ H8). +intros; simpl in H8; inversion H8; + [ simpl in |- *; assumption | elim (le_Sn_O _ H10) ]. +assert (Hyp_min : Rmin t2 b = t2). +unfold Rmin in |- *; case (Rle_dec t2 b); intro; + [ reflexivity | elim n; assumption ]. +unfold adapted_couple in H6; elim H6; clear H6; intros; + elim (RList_P20 _ (StepFun_P9 H6 H7)); intros s1 [s2 [s3 H9]]; + induction lf' as [| r2 lf' Hreclf']. +unfold adapted_couple in H6; decompose [and] H6; rewrite H9 in H13; + simpl in H13; discriminate. +clear Hreclf'; case (Req_dec r1 r2); intro. +case (Req_dec (f t2) r1); intro. +exists (cons t1 (cons s2 s3)); exists (cons r1 lf'); rewrite H3 in H1; + rewrite H9 in H6; unfold adapted_couple in H6, H1; + decompose [and] H1; decompose [and] H6; clear H1 H6; + unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *; + repeat split. +unfold ordered_Rlist in |- *; intros; simpl in H1; + induction i as [| i Hreci]. +simpl in |- *; apply Rle_trans with s1. +replace s1 with t2. +apply (H12 0%nat). +simpl in |- *; apply lt_O_Sn. +simpl in H19; rewrite H19; symmetry in |- *; apply Hyp_min. +apply (H16 0%nat); simpl in |- *; apply lt_O_Sn. +change (pos_Rl (cons s2 s3) i <= pos_Rl (cons s2 s3) (S i)) in |- *; + apply (H16 (S i)); simpl in |- *; assumption. +simpl in |- *; simpl in H14; rewrite H14; reflexivity. +simpl in |- *; simpl in H18; rewrite H18; unfold Rmax in |- *; + case (Rle_dec a b); case (Rle_dec t2 b); intros; reflexivity || elim n; + assumption. +simpl in |- *; simpl in H20; apply H20. +intros; simpl in H1; unfold constant_D_eq, open_interval in |- *; intros; + induction i as [| i Hreci]. +simpl in |- *; simpl in H6; case (total_order_T x t2); intro. +elim s; intro. +apply (H17 0%nat); + [ simpl in |- *; apply lt_O_Sn + | unfold open_interval in |- *; simpl in |- *; elim H6; intros; split; + assumption ]. +rewrite b0; assumption. +rewrite H10; apply (H22 0%nat); + [ simpl in |- *; apply lt_O_Sn + | unfold open_interval in |- *; simpl in |- *; replace s1 with t2; + [ elim H6; intros; split; assumption + | simpl in H19; rewrite H19; rewrite Hyp_min; reflexivity ] ]. +simpl in |- *; simpl in H6; apply (H22 (S i)); + [ simpl in |- *; assumption + | unfold open_interval in |- *; simpl in |- *; apply H6 ]. +intros; simpl in H1; rewrite H10; + change + (pos_Rl (cons r2 lf') i <> pos_Rl (cons r2 lf') (S i) \/ + f (pos_Rl (cons s1 (cons s2 s3)) (S i)) <> pos_Rl (cons r2 lf') i) + in |- *; rewrite <- H9; elim H8; intros; apply H6; + simpl in |- *; apply H1. +intros; induction i as [| i Hreci]. +simpl in |- *; red in |- *; intro; elim Hyp_eq; apply Rle_antisym. +apply (H12 0%nat); simpl in |- *; apply lt_O_Sn. +rewrite <- Hyp_min; rewrite H6; simpl in H19; rewrite <- H19; + apply (H16 0%nat); simpl in |- *; apply lt_O_Sn. +elim H8; intros; rewrite H9 in H21; apply (H21 (S i)); simpl in |- *; + simpl in H1; apply H1. +exists (cons t1 l'); exists (cons r1 (cons r2 lf')); rewrite H9 in H6; + rewrite H3 in H1; unfold adapted_couple in H1, H6; + decompose [and] H6; decompose [and] H1; clear H6 H1; + unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *; + repeat split. +rewrite H9; unfold ordered_Rlist in |- *; intros; simpl in H1; + induction i as [| i Hreci]. +simpl in |- *; replace s1 with t2. +apply (H16 0%nat); simpl in |- *; apply lt_O_Sn. +simpl in H14; rewrite H14; rewrite Hyp_min; reflexivity. +change + (pos_Rl (cons s1 (cons s2 s3)) i <= pos_Rl (cons s1 (cons s2 s3)) (S i)) + in |- *; apply (H12 i); simpl in |- *; apply lt_S_n; + assumption. +simpl in |- *; simpl in H19; apply H19. +rewrite H9; simpl in |- *; simpl in H13; rewrite H13; unfold Rmax in |- *; + case (Rle_dec t2 b); case (Rle_dec a b); intros; reflexivity || elim n; + assumption. +rewrite H9; simpl in |- *; simpl in H15; rewrite H15; reflexivity. +intros; simpl in H1; unfold constant_D_eq, open_interval in |- *; intros; + induction i as [| i Hreci]. +simpl in |- *; rewrite H9 in H6; simpl in H6; apply (H22 0%nat). +simpl in |- *; apply lt_O_Sn. +unfold open_interval in |- *; simpl in |- *. +replace t2 with s1. +assumption. +simpl in H14; rewrite H14; rewrite Hyp_min; reflexivity. +change (f x = pos_Rl (cons r2 lf') i) in |- *; clear Hreci; apply (H17 i). +simpl in |- *; rewrite H9 in H1; simpl in H1; apply lt_S_n; apply H1. +rewrite H9 in H6; unfold open_interval in |- *; apply H6. +intros; simpl in H1; induction i as [| i Hreci]. +simpl in |- *; rewrite H9; right; simpl in |- *; replace s1 with t2. +assumption. +simpl in H14; rewrite H14; rewrite Hyp_min; reflexivity. +elim H8; intros; apply (H6 i). +simpl in |- *; apply lt_S_n; apply H1. +intros; rewrite H9; induction i as [| i Hreci]. +simpl in |- *; red in |- *; intro; elim Hyp_eq; apply Rle_antisym. +apply (H16 0%nat); simpl in |- *; apply lt_O_Sn. +rewrite <- Hyp_min; rewrite H6; simpl in H14; rewrite <- H14; right; + reflexivity. +elim H8; intros; rewrite <- H9; apply (H21 i); rewrite H9; rewrite H9 in H1; + simpl in |- *; simpl in H1; apply lt_S_n; apply H1. +exists (cons t1 l'); exists (cons r1 (cons r2 lf')); rewrite H9 in H6; + rewrite H3 in H1; unfold adapted_couple in H1, H6; + decompose [and] H6; decompose [and] H1; clear H6 H1; + unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *; + repeat split. +rewrite H9; unfold ordered_Rlist in |- *; intros; simpl in H1; + induction i as [| i Hreci]. +simpl in |- *; replace s1 with t2. +apply (H15 0%nat); simpl in |- *; apply lt_O_Sn. +simpl in H13; rewrite H13; rewrite Hyp_min; reflexivity. +change + (pos_Rl (cons s1 (cons s2 s3)) i <= pos_Rl (cons s1 (cons s2 s3)) (S i)) + in |- *; apply (H11 i); simpl in |- *; apply lt_S_n; + assumption. +simpl in |- *; simpl in H18; apply H18. +rewrite H9; simpl in |- *; simpl in H12; rewrite H12; unfold Rmax in |- *; + case (Rle_dec t2 b); case (Rle_dec a b); intros; reflexivity || elim n; + assumption. +rewrite H9; simpl in |- *; simpl in H14; rewrite H14; reflexivity. +intros; simpl in H1; unfold constant_D_eq, open_interval in |- *; intros; + induction i as [| i Hreci]. +simpl in |- *; rewrite H9 in H6; simpl in H6; apply (H21 0%nat). +simpl in |- *; apply lt_O_Sn. +unfold open_interval in |- *; simpl in |- *; replace t2 with s1. +assumption. +simpl in H13; rewrite H13; rewrite Hyp_min; reflexivity. +change (f x = pos_Rl (cons r2 lf') i) in |- *; clear Hreci; apply (H16 i). +simpl in |- *; rewrite H9 in H1; simpl in H1; apply lt_S_n; apply H1. +rewrite H9 in H6; unfold open_interval in |- *; apply H6. +intros; simpl in H1; induction i as [| i Hreci]. +simpl in |- *; left; assumption. +elim H8; intros; apply (H6 i). +simpl in |- *; apply lt_S_n; apply H1. +intros; rewrite H9; induction i as [| i Hreci]. +simpl in |- *; red in |- *; intro; elim Hyp_eq; apply Rle_antisym. +apply (H15 0%nat); simpl in |- *; apply lt_O_Sn. +rewrite <- Hyp_min; rewrite H6; simpl in H13; rewrite <- H13; right; + reflexivity. +elim H8; intros; rewrite <- H9; apply (H20 i); rewrite H9; rewrite H9 in H1; + simpl in |- *; simpl in H1; apply lt_S_n; apply H1. +rewrite H3 in H1; clear H4; unfold adapted_couple in H1; decompose [and] H1; + clear H1; clear H H7 H9; cut (Rmax a b = b); + [ intro; rewrite H in H5; rewrite <- H5; apply RList_P7; + [ assumption | simpl in |- *; right; left; reflexivity ] + | unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ] ]. +Qed. + +Lemma StepFun_P11 : + forall (a b r r1 r3 s1 s2 r4:R) (r2 lf1 s3 lf2:Rlist) + (f:R -> R), + a < b -> + adapted_couple f a b (cons r (cons r1 r2)) (cons r3 lf1) -> + adapted_couple_opt f a b (cons s1 (cons s2 s3)) (cons r4 lf2) -> r1 <= s2. +intros; unfold adapted_couple_opt in H1; elim H1; clear H1; intros; + unfold adapted_couple in H0, H1; decompose [and] H0; + decompose [and] H1; clear H0 H1; assert (H12 : r = s1). +simpl in H10; simpl in H5; rewrite H10; rewrite H5; reflexivity. +assert (H14 := H3 0%nat (lt_O_Sn _)); simpl in H14; elim H14; intro. +assert (H15 := H7 0%nat (lt_O_Sn _)); simpl in H15; elim H15; intro. +rewrite <- H12 in H1; case (Rle_dec r1 s2); intro; try assumption. +assert (H16 : s2 < r1); auto with real. +induction s3 as [| r0 s3 Hrecs3]. +simpl in H9; rewrite H9 in H16; cut (r1 <= Rmax a b). +intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H17 H16)). +rewrite <- H4; apply RList_P7; + [ assumption | simpl in |- *; right; left; reflexivity ]. +clear Hrecs3; induction lf2 as [| r5 lf2 Hreclf2]. +simpl in H11; discriminate. +clear Hreclf2; assert (H17 : r3 = r4). +set (x := (r + s2) / 2); assert (H17 := H8 0%nat (lt_O_Sn _)); + assert (H18 := H13 0%nat (lt_O_Sn _)); + unfold constant_D_eq, open_interval in H17, H18; simpl in H17; + simpl in H18; rewrite <- (H17 x). +rewrite <- (H18 x). +reflexivity. +rewrite <- H12; unfold x in |- *; split. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite (Rplus_comm r); rewrite double; + apply Rplus_lt_compat_l; assumption + | discrR ] ]. +unfold x in |- *; split. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. +apply Rlt_trans with s2; + [ apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); + rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite (Rplus_comm r); rewrite double; + apply Rplus_lt_compat_l; assumption + | discrR ] ] + | assumption ]. +assert (H18 : f s2 = r3). +apply (H8 0%nat); + [ simpl in |- *; apply lt_O_Sn + | unfold open_interval in |- *; simpl in |- *; split; assumption ]. +assert (H19 : r3 = r5). +assert (H19 := H7 1%nat); simpl in H19; + assert (H20 := H19 (lt_n_S _ _ (lt_O_Sn _))); elim H20; + intro. +set (x := (s2 + Rmin r1 r0) / 2); assert (H22 := H8 0%nat); + assert (H23 := H13 1%nat); simpl in H22; simpl in H23; + rewrite <- (H22 (lt_O_Sn _) x). +rewrite <- (H23 (lt_n_S _ _ (lt_O_Sn _)) x). +reflexivity. +unfold open_interval in |- *; simpl in |- *; unfold x in |- *; split. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; + unfold Rmin in |- *; case (Rle_dec r1 r0); intro; + assumption + | discrR ] ]. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; + apply Rlt_le_trans with (r0 + Rmin r1 r0); + [ do 2 rewrite <- (Rplus_comm (Rmin r1 r0)); apply Rplus_lt_compat_l; + assumption + | apply Rplus_le_compat_l; apply Rmin_r ] + | discrR ] ]. +unfold open_interval in |- *; simpl in |- *; unfold x in |- *; split. +apply Rlt_trans with s2; + [ assumption + | apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); + rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; + unfold Rmin in |- *; case (Rle_dec r1 r0); + intro; assumption + | discrR ] ] ]. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; + apply Rlt_le_trans with (r1 + Rmin r1 r0); + [ do 2 rewrite <- (Rplus_comm (Rmin r1 r0)); apply Rplus_lt_compat_l; + assumption + | apply Rplus_le_compat_l; apply Rmin_l ] + | discrR ] ]. +elim H2; clear H2; intros; assert (H23 := H22 1%nat); simpl in H23; + assert (H24 := H23 (lt_n_S _ _ (lt_O_Sn _))); elim H24; + assumption. +elim H2; intros; assert (H22 := H20 0%nat); simpl in H22; + assert (H23 := H22 (lt_O_Sn _)); elim H23; intro; + [ elim H24; rewrite <- H17; rewrite <- H19; reflexivity + | elim H24; rewrite <- H17; assumption ]. +elim H2; clear H2; intros; assert (H17 := H16 0%nat); simpl in H17; + elim (H17 (lt_O_Sn _)); assumption. +rewrite <- H0; rewrite H12; apply (H7 0%nat); simpl in |- *; apply lt_O_Sn. +Qed. + +Lemma StepFun_P12 : + forall (a b:R) (f:R -> R) (l lf:Rlist), + adapted_couple_opt f a b l lf -> adapted_couple_opt f b a l lf. +unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *; intros; + decompose [and] H; clear H; repeat split; try assumption. +rewrite H0; unfold Rmin in |- *; case (Rle_dec a b); intro; + case (Rle_dec b a); intro; try reflexivity. +apply Rle_antisym; assumption. +apply Rle_antisym; auto with real. +rewrite H3; unfold Rmax in |- *; case (Rle_dec a b); intro; + case (Rle_dec b a); intro; try reflexivity. +apply Rle_antisym; assumption. +apply Rle_antisym; auto with real. +Qed. + +Lemma StepFun_P13 : + forall (a b r r1 r3 s1 s2 r4:R) (r2 lf1 s3 lf2:Rlist) + (f:R -> R), + a <> b -> + adapted_couple f a b (cons r (cons r1 r2)) (cons r3 lf1) -> + adapted_couple_opt f a b (cons s1 (cons s2 s3)) (cons r4 lf2) -> r1 <= s2. +intros; case (total_order_T a b); intro. +elim s; intro. +eapply StepFun_P11; [ apply a0 | apply H0 | apply H1 ]. +elim H; assumption. +eapply StepFun_P11; + [ apply r0 | apply StepFun_P2; apply H0 | apply StepFun_P12; apply H1 ]. +Qed. + +Lemma StepFun_P14 : + forall (f:R -> R) (l1 l2 lf1 lf2:Rlist) (a b:R), + a <= b -> + adapted_couple f a b l1 lf1 -> + adapted_couple_opt f a b l2 lf2 -> Int_SF lf1 l1 = Int_SF lf2 l2. +simple induction l1. +intros l2 lf1 lf2 a b Hyp H H0; unfold adapted_couple in H; decompose [and] H; + clear H H0 H2 H3 H1 H6; simpl in H4; discriminate. +simple induction r0. +intros; case (Req_dec a b); intro. +unfold adapted_couple_opt in H2; elim H2; intros; rewrite (StepFun_P8 H4 H3); + rewrite (StepFun_P8 H1 H3); reflexivity. +assert (H4 := StepFun_P9 H1 H3); simpl in H4; + elim (le_Sn_O _ (le_S_n _ _ H4)). +intros; clear H; unfold adapted_couple_opt in H3; elim H3; clear H3; intros; + case (Req_dec a b); intro. +rewrite (StepFun_P8 H2 H4); rewrite (StepFun_P8 H H4); reflexivity. +assert (Hyp_min : Rmin a b = a). +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +assert (Hyp_max : Rmax a b = b). +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +elim (RList_P20 _ (StepFun_P9 H H4)); intros s1 [s2 [s3 H5]]; rewrite H5 in H; + rewrite H5; induction lf1 as [| r3 lf1 Hreclf1]. +unfold adapted_couple in H2; decompose [and] H2; + clear H H2 H4 H5 H3 H6 H8 H7 H11; simpl in H9; discriminate. +clear Hreclf1; induction lf2 as [| r4 lf2 Hreclf2]. +unfold adapted_couple in H; decompose [and] H; + clear H H2 H4 H5 H3 H6 H8 H7 H11; simpl in H9; discriminate. +clear Hreclf2; assert (H6 : r = s1). +unfold adapted_couple in H, H2; decompose [and] H; decompose [and] H2; + clear H H2; simpl in H13; simpl in H8; rewrite H13; + rewrite H8; reflexivity. +assert (H7 : r3 = r4 \/ r = r1). +case (Req_dec r r1); intro. +right; assumption. +left; cut (r1 <= s2). +intro; unfold adapted_couple in H2, H; decompose [and] H; decompose [and] H2; + clear H H2; set (x := (r + r1) / 2); assert (H18 := H14 0%nat); + assert (H20 := H19 0%nat); unfold constant_D_eq, open_interval in H18, H20; + simpl in H18; simpl in H20; rewrite <- (H18 (lt_O_Sn _) x). +rewrite <- (H20 (lt_O_Sn _) x). +reflexivity. +assert (H21 := H13 0%nat (lt_O_Sn _)); simpl in H21; elim H21; intro; + [ idtac | elim H7; assumption ]; unfold x in |- *; + split. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; apply H + | discrR ] ]. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite <- (Rplus_comm r1); rewrite double; + apply Rplus_lt_compat_l; apply H + | discrR ] ]. +rewrite <- H6; assert (H21 := H13 0%nat (lt_O_Sn _)); simpl in H21; elim H21; + intro; [ idtac | elim H7; assumption ]; unfold x in |- *; + split. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; apply H + | discrR ] ]. +apply Rlt_le_trans with r1; + [ apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); + rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite <- (Rplus_comm r1); rewrite double; + apply Rplus_lt_compat_l; apply H + | discrR ] ] + | assumption ]. +eapply StepFun_P13. +apply H4. +apply H2. +unfold adapted_couple_opt in |- *; split. +apply H. +rewrite H5 in H3; apply H3. +assert (H8 : r1 <= s2). +eapply StepFun_P13. +apply H4. +apply H2. +unfold adapted_couple_opt in |- *; split. +apply H. +rewrite H5 in H3; apply H3. +elim H7; intro. +simpl in |- *; elim H8; intro. +replace (r4 * (s2 - s1)) with (r3 * (r1 - r) + r3 * (s2 - r1)); + [ idtac | rewrite H9; rewrite H6; ring ]. +rewrite Rplus_assoc; apply Rplus_eq_compat_l; + change + (Int_SF lf1 (cons r1 r2) = Int_SF (cons r3 lf2) (cons r1 (cons s2 s3))) + in |- *; apply H0 with r1 b. +unfold adapted_couple in H2; decompose [and] H2; clear H2; + replace b with (Rmax a b). +rewrite <- H12; apply RList_P7; + [ assumption | simpl in |- *; right; left; reflexivity ]. +eapply StepFun_P7. +apply H1. +apply H2. +unfold adapted_couple_opt in |- *; split. +apply StepFun_P7 with a a r3. +apply H1. +unfold adapted_couple in H2, H; decompose [and] H2; decompose [and] H; + clear H H2; assert (H20 : r = a). +simpl in H13; rewrite H13; apply Hyp_min. +unfold adapted_couple in |- *; repeat split. +unfold ordered_Rlist in |- *; intros; simpl in H; induction i as [| i Hreci]. +simpl in |- *; rewrite <- H20; apply (H11 0%nat). +simpl in |- *; apply lt_O_Sn. +induction i as [| i Hreci0]. +simpl in |- *; assumption. +change (pos_Rl (cons s2 s3) i <= pos_Rl (cons s2 s3) (S i)) in |- *; + apply (H15 (S i)); simpl in |- *; apply lt_S_n; assumption. +simpl in |- *; symmetry in |- *; apply Hyp_min. +rewrite <- H17; reflexivity. +simpl in H19; simpl in |- *; rewrite H19; reflexivity. +intros; simpl in H; unfold constant_D_eq, open_interval in |- *; intros; + induction i as [| i Hreci]. +simpl in |- *; apply (H16 0%nat). +simpl in |- *; apply lt_O_Sn. +simpl in H2; rewrite <- H20 in H2; unfold open_interval in |- *; + simpl in |- *; apply H2. +clear Hreci; induction i as [| i Hreci]. +simpl in |- *; simpl in H2; rewrite H9; apply (H21 0%nat). +simpl in |- *; apply lt_O_Sn. +unfold open_interval in |- *; simpl in |- *; elim H2; intros; split. +apply Rle_lt_trans with r1; try assumption; rewrite <- H6; apply (H11 0%nat); + simpl in |- *; apply lt_O_Sn. +assumption. +clear Hreci; simpl in |- *; apply (H21 (S i)). +simpl in |- *; apply lt_S_n; assumption. +unfold open_interval in |- *; apply H2. +elim H3; clear H3; intros; split. +rewrite H9; + change + (forall i:nat, + (i < pred (Rlength (cons r4 lf2)))%nat -> + pos_Rl (cons r4 lf2) i <> pos_Rl (cons r4 lf2) (S i) \/ + f (pos_Rl (cons s1 (cons s2 s3)) (S i)) <> pos_Rl (cons r4 lf2) i) + in |- *; rewrite <- H5; apply H3. +rewrite H5 in H11; intros; simpl in H12; induction i as [| i Hreci]. +simpl in |- *; red in |- *; intro; rewrite H13 in H10; + elim (Rlt_irrefl _ H10). +clear Hreci; apply (H11 (S i)); simpl in |- *; apply H12. +rewrite H9; rewrite H10; rewrite H6; apply Rplus_eq_compat_l; rewrite <- H10; + apply H0 with r1 b. +unfold adapted_couple in H2; decompose [and] H2; clear H2; + replace b with (Rmax a b). +rewrite <- H12; apply RList_P7; + [ assumption | simpl in |- *; right; left; reflexivity ]. +eapply StepFun_P7. +apply H1. +apply H2. +unfold adapted_couple_opt in |- *; split. +apply StepFun_P7 with a a r3. +apply H1. +unfold adapted_couple in H2, H; decompose [and] H2; decompose [and] H; + clear H H2; assert (H20 : r = a). +simpl in H13; rewrite H13; apply Hyp_min. +unfold adapted_couple in |- *; repeat split. +unfold ordered_Rlist in |- *; intros; simpl in H; induction i as [| i Hreci]. +simpl in |- *; rewrite <- H20; apply (H11 0%nat); simpl in |- *; + apply lt_O_Sn. +rewrite H10; apply (H15 (S i)); simpl in |- *; assumption. +simpl in |- *; symmetry in |- *; apply Hyp_min. +rewrite <- H17; rewrite H10; reflexivity. +simpl in H19; simpl in |- *; apply H19. +intros; simpl in H; unfold constant_D_eq, open_interval in |- *; intros; + induction i as [| i Hreci]. +simpl in |- *; apply (H16 0%nat). +simpl in |- *; apply lt_O_Sn. +simpl in H2; rewrite <- H20 in H2; unfold open_interval in |- *; + simpl in |- *; apply H2. +clear Hreci; simpl in |- *; apply (H21 (S i)). +simpl in |- *; assumption. +rewrite <- H10; unfold open_interval in |- *; apply H2. +elim H3; clear H3; intros; split. +rewrite H5 in H3; intros; apply (H3 (S i)). +simpl in |- *; replace (Rlength lf2) with (S (pred (Rlength lf2))). +apply lt_n_S; apply H12. +symmetry in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *; + intro; rewrite <- H13 in H12; elim (lt_n_O _ H12). +intros; simpl in H12; rewrite H10; rewrite H5 in H11; apply (H11 (S i)); + simpl in |- *; apply lt_n_S; apply H12. +simpl in |- *; rewrite H9; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rmult_0_r; rewrite Rplus_0_l; + change + (Int_SF lf1 (cons r1 r2) = Int_SF (cons r4 lf2) (cons s1 (cons s2 s3))) + in |- *; eapply H0. +apply H1. +2: rewrite H5 in H3; unfold adapted_couple_opt in |- *; split; assumption. +assert (H10 : r = a). +unfold adapted_couple in H2; decompose [and] H2; clear H2; simpl in H12; + rewrite H12; apply Hyp_min. +rewrite <- H9; rewrite H10; apply StepFun_P7 with a r r3; + [ apply H1 + | pattern a at 2 in |- *; rewrite <- H10; pattern r at 2 in |- *; rewrite H9; + apply H2 ]. +Qed. + +Lemma StepFun_P15 : + forall (f:R -> R) (l1 l2 lf1 lf2:Rlist) (a b:R), + adapted_couple f a b l1 lf1 -> + adapted_couple_opt f a b l2 lf2 -> Int_SF lf1 l1 = Int_SF lf2 l2. +intros; case (Rle_dec a b); intro; + [ apply (StepFun_P14 r H H0) + | assert (H1 : b <= a); + [ auto with real + | eapply StepFun_P14; + [ apply H1 | apply StepFun_P2; apply H | apply StepFun_P12; apply H0 ] ] ]. +Qed. + +Lemma StepFun_P16 : + forall (f:R -> R) (l lf:Rlist) (a b:R), + adapted_couple f a b l lf -> + exists l' : Rlist, + (exists lf' : Rlist, adapted_couple_opt f a b l' lf'). +intros; case (Rle_dec a b); intro; + [ apply (StepFun_P10 r H) + | assert (H1 : b <= a); + [ auto with real + | assert (H2 := StepFun_P10 H1 (StepFun_P2 H)); elim H2; + intros l' [lf' H3]; exists l'; exists lf'; apply StepFun_P12; + assumption ] ]. +Qed. + +Lemma StepFun_P17 : + forall (f:R -> R) (l1 l2 lf1 lf2:Rlist) (a b:R), + adapted_couple f a b l1 lf1 -> + adapted_couple f a b l2 lf2 -> Int_SF lf1 l1 = Int_SF lf2 l2. +intros; elim (StepFun_P16 H); intros l' [lf' H1]; rewrite (StepFun_P15 H H1); + rewrite (StepFun_P15 H0 H1); reflexivity. +Qed. + +Lemma StepFun_P18 : + forall a b c:R, RiemannInt_SF (mkStepFun (StepFun_P4 a b c)) = c * (b - a). +intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro. +replace + (Int_SF (subdivision_val (mkStepFun (StepFun_P4 a b c))) + (subdivision (mkStepFun (StepFun_P4 a b c)))) with + (Int_SF (cons c nil) (cons a (cons b nil))); + [ simpl in |- *; ring + | apply StepFun_P17 with (fct_cte c) a b; + [ apply StepFun_P3; assumption + | apply (StepFun_P1 (mkStepFun (StepFun_P4 a b c))) ] ]. +replace + (Int_SF (subdivision_val (mkStepFun (StepFun_P4 a b c))) + (subdivision (mkStepFun (StepFun_P4 a b c)))) with + (Int_SF (cons c nil) (cons b (cons a nil))); + [ simpl in |- *; ring + | apply StepFun_P17 with (fct_cte c) a b; + [ apply StepFun_P2; apply StepFun_P3; auto with real + | apply (StepFun_P1 (mkStepFun (StepFun_P4 a b c))) ] ]. +Qed. + +Lemma StepFun_P19 : + forall (l1:Rlist) (f g:R -> R) (l:R), + Int_SF (FF l1 (fun x:R => f x + l * g x)) l1 = + Int_SF (FF l1 f) l1 + l * Int_SF (FF l1 g) l1. +intros; induction l1 as [| r l1 Hrecl1]; + [ simpl in |- *; ring + | induction l1 as [| r0 l1 Hrecl0]; simpl in |- *; + [ ring | simpl in Hrecl1; rewrite Hrecl1; ring ] ]. +Qed. + +Lemma StepFun_P20 : + forall (l:Rlist) (f:R -> R), + (0 < Rlength l)%nat -> Rlength l = S (Rlength (FF l f)). +intros l f H; induction l; + [ elim (lt_irrefl _ H) + | simpl in |- *; rewrite RList_P18; rewrite RList_P14; reflexivity ]. +Qed. + +Lemma StepFun_P21 : + forall (a b:R) (f:R -> R) (l:Rlist), + is_subdivision f a b l -> adapted_couple f a b l (FF l f). +intros; unfold adapted_couple in |- *; unfold is_subdivision in X; + unfold adapted_couple in X; elim X; clear X; intros; + decompose [and] p; clear p; repeat split; try assumption. +apply StepFun_P20; rewrite H2; apply lt_O_Sn. +intros; assert (H5 := H4 _ H3); unfold constant_D_eq, open_interval in H5; + unfold constant_D_eq, open_interval in |- *; intros; + induction l as [| r l Hrecl]. +discriminate. +unfold FF in |- *; rewrite RList_P12. +simpl in |- *; + change (f x0 = f (pos_Rl (mid_Rlist (cons r l) r) (S i))) in |- *; + rewrite RList_P13; try assumption; rewrite (H5 x0 H6); + rewrite H5. +reflexivity. +split. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; elim H6; + intros; apply Rlt_trans with x0; assumption + | discrR ] ]. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; + rewrite (Rplus_comm (pos_Rl (cons r l) i)); + apply Rplus_lt_compat_l; elim H6; intros; apply Rlt_trans with x0; + assumption + | discrR ] ]. +rewrite RList_P14; simpl in H3; apply H3. +Qed. + +Lemma StepFun_P22 : + forall (a b:R) (f g:R -> R) (lf lg:Rlist), + a <= b -> + is_subdivision f a b lf -> + is_subdivision g a b lg -> is_subdivision f a b (cons_ORlist lf lg). +unfold is_subdivision in |- *; intros a b f g lf lg Hyp X X0; elim X; elim X0; + clear X X0; intros lg0 p lf0 p0; assert (Hyp_min : Rmin a b = a). +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +assert (Hyp_max : Rmax a b = b). +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +apply existT with (FF (cons_ORlist lf lg) f); unfold adapted_couple in p, p0; + decompose [and] p; decompose [and] p0; clear p p0; + rewrite Hyp_min in H6; rewrite Hyp_min in H1; rewrite Hyp_max in H0; + rewrite Hyp_max in H5; unfold adapted_couple in |- *; + repeat split. +apply RList_P2; assumption. +rewrite Hyp_min; symmetry in |- *; apply Rle_antisym. +induction lf as [| r lf Hreclf]. +simpl in |- *; right; symmetry in |- *; assumption. +assert + (H10 : + In (pos_Rl (cons_ORlist (cons r lf) lg) 0) (cons_ORlist (cons r lf) lg)). +elim + (RList_P3 (cons_ORlist (cons r lf) lg) + (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros _ H10; + apply H10; exists 0%nat; split; + [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_O_Sn ]. +elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) 0)); + intros H12 _; assert (H13 := H12 H10); elim H13; intro. +elim (RList_P3 (cons r lf) (pos_Rl (cons_ORlist (cons r lf) lg) 0)); + intros H11 _; assert (H14 := H11 H8); elim H14; intros; + elim H15; clear H15; intros; rewrite H15; rewrite <- H6; + elim (RList_P6 (cons r lf)); intros; apply H17; + [ assumption | apply le_O_n | assumption ]. +elim (RList_P3 lg (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros H11 _; + assert (H14 := H11 H8); elim H14; intros; elim H15; + clear H15; intros; rewrite H15; rewrite <- H1; elim (RList_P6 lg); + intros; apply H17; [ assumption | apply le_O_n | assumption ]. +induction lf as [| r lf Hreclf]. +simpl in |- *; right; assumption. +assert (H8 : In a (cons_ORlist (cons r lf) lg)). +elim (RList_P9 (cons r lf) lg a); intros; apply H10; left; + elim (RList_P3 (cons r lf) a); intros; apply H12; + exists 0%nat; split; + [ symmetry in |- *; assumption | simpl in |- *; apply lt_O_Sn ]. +apply RList_P5; [ apply RList_P2; assumption | assumption ]. +rewrite Hyp_max; apply Rle_antisym. +induction lf as [| r lf Hreclf]. +simpl in |- *; right; assumption. +assert + (H8 : + In + (pos_Rl (cons_ORlist (cons r lf) lg) + (pred (Rlength (cons_ORlist (cons r lf) lg)))) + (cons_ORlist (cons r lf) lg)). +elim + (RList_P3 (cons_ORlist (cons r lf) lg) + (pos_Rl (cons_ORlist (cons r lf) lg) + (pred (Rlength (cons_ORlist (cons r lf) lg))))); + intros _ H10; apply H10; + exists (pred (Rlength (cons_ORlist (cons r lf) lg))); + split; [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_n_Sn ]. +elim + (RList_P9 (cons r lf) lg + (pos_Rl (cons_ORlist (cons r lf) lg) + (pred (Rlength (cons_ORlist (cons r lf) lg))))); + intros H10 _. +assert (H11 := H10 H8); elim H11; intro. +elim + (RList_P3 (cons r lf) + (pos_Rl (cons_ORlist (cons r lf) lg) + (pred (Rlength (cons_ORlist (cons r lf) lg))))); + intros H13 _; assert (H14 := H13 H12); elim H14; intros; + elim H15; clear H15; intros; rewrite H15; rewrite <- H5; + elim (RList_P6 (cons r lf)); intros; apply H17; + [ assumption + | simpl in |- *; simpl in H14; apply lt_n_Sm_le; assumption + | simpl in |- *; apply lt_n_Sn ]. +elim + (RList_P3 lg + (pos_Rl (cons_ORlist (cons r lf) lg) + (pred (Rlength (cons_ORlist (cons r lf) lg))))); + intros H13 _; assert (H14 := H13 H12); elim H14; intros; + elim H15; clear H15; intros. +rewrite H15; assert (H17 : Rlength lg = S (pred (Rlength lg))). +apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; + rewrite <- H17 in H16; elim (lt_n_O _ H16). +rewrite <- H0; elim (RList_P6 lg); intros; apply H18; + [ assumption + | rewrite H17 in H16; apply lt_n_Sm_le; assumption + | apply lt_pred_n_n; rewrite H17; apply lt_O_Sn ]. +induction lf as [| r lf Hreclf]. +simpl in |- *; right; symmetry in |- *; assumption. +assert (H8 : In b (cons_ORlist (cons r lf) lg)). +elim (RList_P9 (cons r lf) lg b); intros; apply H10; left; + elim (RList_P3 (cons r lf) b); intros; apply H12; + exists (pred (Rlength (cons r lf))); split; + [ symmetry in |- *; assumption | simpl in |- *; apply lt_n_Sn ]. +apply RList_P7; [ apply RList_P2; assumption | assumption ]. +apply StepFun_P20; rewrite RList_P11; rewrite H2; rewrite H7; simpl in |- *; + apply lt_O_Sn. +intros; unfold constant_D_eq, open_interval in |- *; intros; + cut + (exists l : R, + constant_D_eq f + (open_interval (pos_Rl (cons_ORlist lf lg) i) + (pos_Rl (cons_ORlist lf lg) (S i))) l). +intros; elim H11; clear H11; intros; assert (H12 := H11); + assert + (Hyp_cons : + exists r : R, (exists r0 : Rlist, cons_ORlist lf lg = cons r r0)). +apply RList_P19; red in |- *; intro; rewrite H13 in H8; elim (lt_n_O _ H8). +elim Hyp_cons; clear Hyp_cons; intros r [r0 Hyp_cons]; rewrite Hyp_cons; + unfold FF in |- *; rewrite RList_P12. +change (f x = f (pos_Rl (mid_Rlist (cons r r0) r) (S i))) in |- *; + rewrite <- Hyp_cons; rewrite RList_P13. +assert (H13 := RList_P2 _ _ H _ H8); elim H13; intro. +unfold constant_D_eq, open_interval in H11, H12; rewrite (H11 x H10); + assert + (H15 : + pos_Rl (cons_ORlist lf lg) i < + (pos_Rl (cons_ORlist lf lg) i + pos_Rl (cons_ORlist lf lg) (S i)) / 2 < + pos_Rl (cons_ORlist lf lg) (S i)). +split. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; + rewrite (Rplus_comm (pos_Rl (cons_ORlist lf lg) i)); + apply Rplus_lt_compat_l; assumption + | discrR ] ]. +rewrite (H11 _ H15); reflexivity. +elim H10; intros; rewrite H14 in H15; + elim (Rlt_irrefl _ (Rlt_trans _ _ _ H16 H15)). +apply H8. +rewrite RList_P14; rewrite Hyp_cons in H8; simpl in H8; apply H8. +assert (H11 : a < b). +apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i). +rewrite <- H6; rewrite <- (RList_P15 lf lg). +elim (RList_P6 (cons_ORlist lf lg)); intros; apply H11. +apply RList_P2; assumption. +apply le_O_n. +apply lt_trans with (pred (Rlength (cons_ORlist lf lg))); + [ assumption + | apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; + rewrite <- H13 in H8; elim (lt_n_O _ H8) ]. +assumption. +assumption. +rewrite H1; assumption. +apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)). +elim H10; intros; apply Rlt_trans with x; assumption. +rewrite <- H5; rewrite <- (RList_P16 lf lg); try assumption. +elim (RList_P6 (cons_ORlist lf lg)); intros; apply H11. +apply RList_P2; assumption. +apply lt_n_Sm_le; apply lt_n_S; assumption. +apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H8; + elim (lt_n_O _ H8). +rewrite H0; assumption. +set + (I := + fun j:nat => + pos_Rl lf j <= pos_Rl (cons_ORlist lf lg) i /\ (j < Rlength lf)%nat); + assert (H12 : Nbound I). +unfold Nbound in |- *; exists (Rlength lf); intros; unfold I in H12; elim H12; + intros; apply lt_le_weak; assumption. +assert (H13 : exists n : nat, I n). +exists 0%nat; unfold I in |- *; split. +apply Rle_trans with (pos_Rl (cons_ORlist lf lg) 0). +right; symmetry in |- *. +apply RList_P15; try assumption; rewrite H1; assumption. +elim (RList_P6 (cons_ORlist lf lg)); intros; apply H13. +apply RList_P2; assumption. +apply le_O_n. +apply lt_trans with (pred (Rlength (cons_ORlist lf lg))). +assumption. +apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H15 in H8; + elim (lt_n_O _ H8). +apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H5; + rewrite <- H6 in H11; rewrite <- H5 in H11; elim (Rlt_irrefl _ H11). +assert (H14 := Nzorn H13 H12); elim H14; clear H14; intros x0 H14; + exists (pos_Rl lf0 x0); unfold constant_D_eq, open_interval in |- *; + intros; assert (H16 := H9 x0); assert (H17 : (x0 < pred (Rlength lf))%nat). +elim H14; clear H14; intros; unfold I in H14; elim H14; clear H14; intros; + apply lt_S_n; replace (S (pred (Rlength lf))) with (Rlength lf). +inversion H18. +2: apply lt_n_S; assumption. +cut (x0 = pred (Rlength lf)). +intro; rewrite H19 in H14; rewrite H5 in H14; + cut (pos_Rl (cons_ORlist lf lg) i < b). +intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H14 H21)). +apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)). +elim H10; intros; apply Rlt_trans with x; assumption. +rewrite <- H5; + apply Rle_trans with + (pos_Rl (cons_ORlist lf lg) (pred (Rlength (cons_ORlist lf lg)))). +elim (RList_P6 (cons_ORlist lf lg)); intros; apply H21. +apply RList_P2; assumption. +apply lt_n_Sm_le; apply lt_n_S; assumption. +apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H23 in H8; + elim (lt_n_O _ H8). +right; apply RList_P16; try assumption; rewrite H0; assumption. +rewrite <- H20; reflexivity. +apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; + rewrite <- H19 in H18; elim (lt_n_O _ H18). +assert (H18 := H16 H17); unfold constant_D_eq, open_interval in H18; + rewrite (H18 x1). +reflexivity. +elim H15; clear H15; intros; elim H14; clear H14; intros; unfold I in H14; + elim H14; clear H14; intros; split. +apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i); assumption. +apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)); try assumption. +assert (H22 : (S x0 < Rlength lf)%nat). +replace (Rlength lf) with (S (pred (Rlength lf))); + [ apply lt_n_S; assumption + | symmetry in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *; + intro; rewrite <- H22 in H21; elim (lt_n_O _ H21) ]. +elim (Rle_dec (pos_Rl lf (S x0)) (pos_Rl (cons_ORlist lf lg) i)); intro. +assert (H23 : (S x0 <= x0)%nat). +apply H20; unfold I in |- *; split; assumption. +elim (le_Sn_n _ H23). +assert (H23 : pos_Rl (cons_ORlist lf lg) i < pos_Rl lf (S x0)). +auto with real. +clear b0; apply RList_P17; try assumption. +apply RList_P2; assumption. +elim (RList_P9 lf lg (pos_Rl lf (S x0))); intros; apply H25; left; + elim (RList_P3 lf (pos_Rl lf (S x0))); intros; apply H27; + exists (S x0); split; [ reflexivity | apply H22 ]. +Qed. + +Lemma StepFun_P23 : + forall (a b:R) (f g:R -> R) (lf lg:Rlist), + is_subdivision f a b lf -> + is_subdivision g a b lg -> is_subdivision f a b (cons_ORlist lf lg). +intros; case (Rle_dec a b); intro; + [ apply StepFun_P22 with g; assumption + | apply StepFun_P5; apply StepFun_P22 with g; + [ auto with real + | apply StepFun_P5; assumption + | apply StepFun_P5; assumption ] ]. +Qed. + +Lemma StepFun_P24 : + forall (a b:R) (f g:R -> R) (lf lg:Rlist), + a <= b -> + is_subdivision f a b lf -> + is_subdivision g a b lg -> is_subdivision g a b (cons_ORlist lf lg). +unfold is_subdivision in |- *; intros a b f g lf lg Hyp X X0; elim X; elim X0; + clear X X0; intros lg0 p lf0 p0; assert (Hyp_min : Rmin a b = a). +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +assert (Hyp_max : Rmax a b = b). +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +apply existT with (FF (cons_ORlist lf lg) g); unfold adapted_couple in p, p0; + decompose [and] p; decompose [and] p0; clear p p0; + rewrite Hyp_min in H1; rewrite Hyp_min in H6; rewrite Hyp_max in H0; + rewrite Hyp_max in H5; unfold adapted_couple in |- *; + repeat split. +apply RList_P2; assumption. +rewrite Hyp_min; symmetry in |- *; apply Rle_antisym. +induction lf as [| r lf Hreclf]. +simpl in |- *; right; symmetry in |- *; assumption. +assert + (H10 : + In (pos_Rl (cons_ORlist (cons r lf) lg) 0) (cons_ORlist (cons r lf) lg)). +elim + (RList_P3 (cons_ORlist (cons r lf) lg) + (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros _ H10; + apply H10; exists 0%nat; split; + [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_O_Sn ]. +elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) 0)); + intros H12 _; assert (H13 := H12 H10); elim H13; intro. +elim (RList_P3 (cons r lf) (pos_Rl (cons_ORlist (cons r lf) lg) 0)); + intros H11 _; assert (H14 := H11 H8); elim H14; intros; + elim H15; clear H15; intros; rewrite H15; rewrite <- H6; + elim (RList_P6 (cons r lf)); intros; apply H17; + [ assumption | apply le_O_n | assumption ]. +elim (RList_P3 lg (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros H11 _; + assert (H14 := H11 H8); elim H14; intros; elim H15; + clear H15; intros; rewrite H15; rewrite <- H1; elim (RList_P6 lg); + intros; apply H17; [ assumption | apply le_O_n | assumption ]. +induction lf as [| r lf Hreclf]. +simpl in |- *; right; assumption. +assert (H8 : In a (cons_ORlist (cons r lf) lg)). +elim (RList_P9 (cons r lf) lg a); intros; apply H10; left; + elim (RList_P3 (cons r lf) a); intros; apply H12; + exists 0%nat; split; + [ symmetry in |- *; assumption | simpl in |- *; apply lt_O_Sn ]. +apply RList_P5; [ apply RList_P2; assumption | assumption ]. +rewrite Hyp_max; apply Rle_antisym. +induction lf as [| r lf Hreclf]. +simpl in |- *; right; assumption. +assert + (H8 : + In + (pos_Rl (cons_ORlist (cons r lf) lg) + (pred (Rlength (cons_ORlist (cons r lf) lg)))) + (cons_ORlist (cons r lf) lg)). +elim + (RList_P3 (cons_ORlist (cons r lf) lg) + (pos_Rl (cons_ORlist (cons r lf) lg) + (pred (Rlength (cons_ORlist (cons r lf) lg))))); + intros _ H10; apply H10; + exists (pred (Rlength (cons_ORlist (cons r lf) lg))); + split; [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_n_Sn ]. +elim + (RList_P9 (cons r lf) lg + (pos_Rl (cons_ORlist (cons r lf) lg) + (pred (Rlength (cons_ORlist (cons r lf) lg))))); + intros H10 _; assert (H11 := H10 H8); elim H11; intro. +elim + (RList_P3 (cons r lf) + (pos_Rl (cons_ORlist (cons r lf) lg) + (pred (Rlength (cons_ORlist (cons r lf) lg))))); + intros H13 _; assert (H14 := H13 H12); elim H14; intros; + elim H15; clear H15; intros; rewrite H15; rewrite <- H5; + elim (RList_P6 (cons r lf)); intros; apply H17; + [ assumption + | simpl in |- *; simpl in H14; apply lt_n_Sm_le; assumption + | simpl in |- *; apply lt_n_Sn ]. +elim + (RList_P3 lg + (pos_Rl (cons_ORlist (cons r lf) lg) + (pred (Rlength (cons_ORlist (cons r lf) lg))))); + intros H13 _; assert (H14 := H13 H12); elim H14; intros; + elim H15; clear H15; intros; rewrite H15; + assert (H17 : Rlength lg = S (pred (Rlength lg))). +apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; + rewrite <- H17 in H16; elim (lt_n_O _ H16). +rewrite <- H0; elim (RList_P6 lg); intros; apply H18; + [ assumption + | rewrite H17 in H16; apply lt_n_Sm_le; assumption + | apply lt_pred_n_n; rewrite H17; apply lt_O_Sn ]. +induction lf as [| r lf Hreclf]. +simpl in |- *; right; symmetry in |- *; assumption. +assert (H8 : In b (cons_ORlist (cons r lf) lg)). +elim (RList_P9 (cons r lf) lg b); intros; apply H10; left; + elim (RList_P3 (cons r lf) b); intros; apply H12; + exists (pred (Rlength (cons r lf))); split; + [ symmetry in |- *; assumption | simpl in |- *; apply lt_n_Sn ]. +apply RList_P7; [ apply RList_P2; assumption | assumption ]. +apply StepFun_P20; rewrite RList_P11; rewrite H7; rewrite H2; simpl in |- *; + apply lt_O_Sn. +unfold constant_D_eq, open_interval in |- *; intros; + cut + (exists l : R, + constant_D_eq g + (open_interval (pos_Rl (cons_ORlist lf lg) i) + (pos_Rl (cons_ORlist lf lg) (S i))) l). +intros; elim H11; clear H11; intros; assert (H12 := H11); + assert + (Hyp_cons : + exists r : R, (exists r0 : Rlist, cons_ORlist lf lg = cons r r0)). +apply RList_P19; red in |- *; intro; rewrite H13 in H8; elim (lt_n_O _ H8). +elim Hyp_cons; clear Hyp_cons; intros r [r0 Hyp_cons]; rewrite Hyp_cons; + unfold FF in |- *; rewrite RList_P12. +change (g x = g (pos_Rl (mid_Rlist (cons r r0) r) (S i))) in |- *; + rewrite <- Hyp_cons; rewrite RList_P13. +assert (H13 := RList_P2 _ _ H _ H8); elim H13; intro. +unfold constant_D_eq, open_interval in H11, H12; rewrite (H11 x H10); + assert + (H15 : + pos_Rl (cons_ORlist lf lg) i < + (pos_Rl (cons_ORlist lf lg) i + pos_Rl (cons_ORlist lf lg) (S i)) / 2 < + pos_Rl (cons_ORlist lf lg) (S i)). +split. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; + rewrite (Rplus_comm (pos_Rl (cons_ORlist lf lg) i)); + apply Rplus_lt_compat_l; assumption + | discrR ] ]. +rewrite (H11 _ H15); reflexivity. +elim H10; intros; rewrite H14 in H15; + elim (Rlt_irrefl _ (Rlt_trans _ _ _ H16 H15)). +apply H8. +rewrite RList_P14; rewrite Hyp_cons in H8; simpl in H8; apply H8. +assert (H11 : a < b). +apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i). +rewrite <- H6; rewrite <- (RList_P15 lf lg); try assumption. +elim (RList_P6 (cons_ORlist lf lg)); intros; apply H11. +apply RList_P2; assumption. +apply le_O_n. +apply lt_trans with (pred (Rlength (cons_ORlist lf lg))); + [ assumption + | apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; + rewrite <- H13 in H8; elim (lt_n_O _ H8) ]. +rewrite H1; assumption. +apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)). +elim H10; intros; apply Rlt_trans with x; assumption. +rewrite <- H5; rewrite <- (RList_P16 lf lg); try assumption. +elim (RList_P6 (cons_ORlist lf lg)); intros; apply H11. +apply RList_P2; assumption. +apply lt_n_Sm_le; apply lt_n_S; assumption. +apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H8; + elim (lt_n_O _ H8). +rewrite H0; assumption. +set + (I := + fun j:nat => + pos_Rl lg j <= pos_Rl (cons_ORlist lf lg) i /\ (j < Rlength lg)%nat); + assert (H12 : Nbound I). +unfold Nbound in |- *; exists (Rlength lg); intros; unfold I in H12; elim H12; + intros; apply lt_le_weak; assumption. +assert (H13 : exists n : nat, I n). +exists 0%nat; unfold I in |- *; split. +apply Rle_trans with (pos_Rl (cons_ORlist lf lg) 0). +right; symmetry in |- *; rewrite H1; rewrite <- H6; apply RList_P15; + try assumption; rewrite H1; assumption. +elim (RList_P6 (cons_ORlist lf lg)); intros; apply H13; + [ apply RList_P2; assumption + | apply le_O_n + | apply lt_trans with (pred (Rlength (cons_ORlist lf lg))); + [ assumption + | apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; + rewrite <- H15 in H8; elim (lt_n_O _ H8) ] ]. +apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H0; + rewrite <- H1 in H11; rewrite <- H0 in H11; elim (Rlt_irrefl _ H11). +assert (H14 := Nzorn H13 H12); elim H14; clear H14; intros x0 H14; + exists (pos_Rl lg0 x0); unfold constant_D_eq, open_interval in |- *; + intros; assert (H16 := H4 x0); assert (H17 : (x0 < pred (Rlength lg))%nat). +elim H14; clear H14; intros; unfold I in H14; elim H14; clear H14; intros; + apply lt_S_n; replace (S (pred (Rlength lg))) with (Rlength lg). +inversion H18. +2: apply lt_n_S; assumption. +cut (x0 = pred (Rlength lg)). +intro; rewrite H19 in H14; rewrite H0 in H14; + cut (pos_Rl (cons_ORlist lf lg) i < b). +intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H14 H21)). +apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)). +elim H10; intros; apply Rlt_trans with x; assumption. +rewrite <- H0; + apply Rle_trans with + (pos_Rl (cons_ORlist lf lg) (pred (Rlength (cons_ORlist lf lg)))). +elim (RList_P6 (cons_ORlist lf lg)); intros; apply H21. +apply RList_P2; assumption. +apply lt_n_Sm_le; apply lt_n_S; assumption. +apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H23 in H8; + elim (lt_n_O _ H8). +right; rewrite H0; rewrite <- H5; apply RList_P16; try assumption. +rewrite H0; assumption. +rewrite <- H20; reflexivity. +apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; + rewrite <- H19 in H18; elim (lt_n_O _ H18). +assert (H18 := H16 H17); unfold constant_D_eq, open_interval in H18; + rewrite (H18 x1). +reflexivity. +elim H15; clear H15; intros; elim H14; clear H14; intros; unfold I in H14; + elim H14; clear H14; intros; split. +apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i); assumption. +apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)); try assumption. +assert (H22 : (S x0 < Rlength lg)%nat). +replace (Rlength lg) with (S (pred (Rlength lg))). +apply lt_n_S; assumption. +symmetry in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *; + intro; rewrite <- H22 in H21; elim (lt_n_O _ H21). +elim (Rle_dec (pos_Rl lg (S x0)) (pos_Rl (cons_ORlist lf lg) i)); intro. +assert (H23 : (S x0 <= x0)%nat); + [ apply H20; unfold I in |- *; split; assumption | elim (le_Sn_n _ H23) ]. +assert (H23 : pos_Rl (cons_ORlist lf lg) i < pos_Rl lg (S x0)). +auto with real. +clear b0; apply RList_P17; try assumption; + [ apply RList_P2; assumption + | elim (RList_P9 lf lg (pos_Rl lg (S x0))); intros; apply H25; right; + elim (RList_P3 lg (pos_Rl lg (S x0))); intros; + apply H27; exists (S x0); split; [ reflexivity | apply H22 ] ]. +Qed. + +Lemma StepFun_P25 : + forall (a b:R) (f g:R -> R) (lf lg:Rlist), + is_subdivision f a b lf -> + is_subdivision g a b lg -> is_subdivision g a b (cons_ORlist lf lg). +intros a b f g lf lg H H0; case (Rle_dec a b); intro; + [ apply StepFun_P24 with f; assumption + | apply StepFun_P5; apply StepFun_P24 with f; + [ auto with real + | apply StepFun_P5; assumption + | apply StepFun_P5; assumption ] ]. +Qed. + +Lemma StepFun_P26 : + forall (a b l:R) (f g:R -> R) (l1:Rlist), + is_subdivision f a b l1 -> + is_subdivision g a b l1 -> + is_subdivision (fun x:R => f x + l * g x) a b l1. +intros a b l f g l1; unfold is_subdivision in |- *; intros; elim X; elim X0; + intros; clear X X0; unfold adapted_couple in p, p0; + decompose [and] p; decompose [and] p0; clear p p0; + apply existT with (FF l1 (fun x:R => f x + l * g x)); + unfold adapted_couple in |- *; repeat split; try assumption. +apply StepFun_P20; apply neq_O_lt; red in |- *; intro; rewrite <- H8 in H7; + discriminate. +intros; unfold constant_D_eq, open_interval in |- *; + unfold constant_D_eq, open_interval in H9, H4; intros; + rewrite (H9 _ H8 _ H10); rewrite (H4 _ H8 _ H10); + assert (H11 : l1 <> nil). +red in |- *; intro; rewrite H11 in H8; elim (lt_n_O _ H8). +assert (H12 := RList_P19 _ H11); elim H12; clear H12; intros r [r0 H12]; + rewrite H12; unfold FF in |- *; + change + (pos_Rl x0 i + l * pos_Rl x i = + pos_Rl + (app_Rlist (mid_Rlist (cons r r0) r) (fun x2:R => f x2 + l * g x2)) + (S i)) in |- *; rewrite RList_P12. +rewrite RList_P13. +rewrite <- H12; rewrite (H9 _ H8); try rewrite (H4 _ H8); + reflexivity || + (elim H10; clear H10; intros; split; + [ apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); + rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; + apply Rlt_trans with x1; assumption + | discrR ] ] + | apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); + rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; + rewrite (Rplus_comm (pos_Rl l1 i)); apply Rplus_lt_compat_l; + apply Rlt_trans with x1; assumption + | discrR ] ] ]). +rewrite <- H12; assumption. +rewrite RList_P14; simpl in |- *; rewrite H12 in H8; simpl in H8; + apply lt_n_S; apply H8. +Qed. + +Lemma StepFun_P27 : + forall (a b l:R) (f g:R -> R) (lf lg:Rlist), + is_subdivision f a b lf -> + is_subdivision g a b lg -> + is_subdivision (fun x:R => f x + l * g x) a b (cons_ORlist lf lg). +intros a b l f g lf lg H H0; apply StepFun_P26; + [ apply StepFun_P23 with g; assumption + | apply StepFun_P25 with f; assumption ]. +Qed. + +(* The set of step functions on [a,b] is a vectorial space *) +Lemma StepFun_P28 : + forall (a b l:R) (f g:StepFun a b), IsStepFun (fun x:R => f x + l * g x) a b. +intros a b l f g; unfold IsStepFun in |- *; assert (H := pre f); + assert (H0 := pre g); unfold IsStepFun in H, H0; elim H; + elim H0; intros; apply existT with (cons_ORlist x0 x); + apply StepFun_P27; assumption. +Qed. + +Lemma StepFun_P29 : + forall (a b:R) (f:StepFun a b), is_subdivision f a b (subdivision f). +intros a b f; unfold is_subdivision in |- *; + apply existT with (subdivision_val f); apply StepFun_P1. +Qed. + +Lemma StepFun_P30 : + forall (a b l:R) (f g:StepFun a b), + RiemannInt_SF (mkStepFun (StepFun_P28 l f g)) = + RiemannInt_SF f + l * RiemannInt_SF g. +intros a b l f g; unfold RiemannInt_SF in |- *; case (Rle_dec a b); + (intro; + replace + (Int_SF (subdivision_val (mkStepFun (StepFun_P28 l f g))) + (subdivision (mkStepFun (StepFun_P28 l f g)))) with + (Int_SF + (FF (cons_ORlist (subdivision f) (subdivision g)) + (fun x:R => f x + l * g x)) + (cons_ORlist (subdivision f) (subdivision g))); + [ rewrite StepFun_P19; + replace + (Int_SF (FF (cons_ORlist (subdivision f) (subdivision g)) f) + (cons_ORlist (subdivision f) (subdivision g))) with + (Int_SF (subdivision_val f) (subdivision f)); + [ replace + (Int_SF (FF (cons_ORlist (subdivision f) (subdivision g)) g) + (cons_ORlist (subdivision f) (subdivision g))) with + (Int_SF (subdivision_val g) (subdivision g)); + [ ring + | apply StepFun_P17 with (fe g) a b; + [ apply StepFun_P1 + | apply StepFun_P21; apply StepFun_P25 with (fe f); + apply StepFun_P29 ] ] + | apply StepFun_P17 with (fe f) a b; + [ apply StepFun_P1 + | apply StepFun_P21; apply StepFun_P23 with (fe g); + apply StepFun_P29 ] ] + | apply StepFun_P17 with (fun x:R => f x + l * g x) a b; + [ apply StepFun_P21; apply StepFun_P27; apply StepFun_P29 + | apply (StepFun_P1 (mkStepFun (StepFun_P28 l f g))) ] ]). +Qed. + +Lemma StepFun_P31 : + forall (a b:R) (f:R -> R) (l lf:Rlist), + adapted_couple f a b l lf -> + adapted_couple (fun x:R => Rabs (f x)) a b l (app_Rlist lf Rabs). +unfold adapted_couple in |- *; intros; decompose [and] H; clear H; + repeat split; try assumption. +symmetry in |- *; rewrite H3; rewrite RList_P18; reflexivity. +intros; unfold constant_D_eq, open_interval in |- *; + unfold constant_D_eq, open_interval in H5; intros; + rewrite (H5 _ H _ H4); rewrite RList_P12; + [ reflexivity | rewrite H3 in H; simpl in H; apply H ]. +Qed. + +Lemma StepFun_P32 : + forall (a b:R) (f:StepFun a b), IsStepFun (fun x:R => Rabs (f x)) a b. +intros a b f; unfold IsStepFun in |- *; apply existT with (subdivision f); + unfold is_subdivision in |- *; + apply existT with (app_Rlist (subdivision_val f) Rabs); + apply StepFun_P31; apply StepFun_P1. +Qed. + +Lemma StepFun_P33 : + forall l2 l1:Rlist, + ordered_Rlist l1 -> Rabs (Int_SF l2 l1) <= Int_SF (app_Rlist l2 Rabs) l1. +simple induction l2; intros. +simpl in |- *; rewrite Rabs_R0; right; reflexivity. +simpl in |- *; induction l1 as [| r1 l1 Hrecl1]. +rewrite Rabs_R0; right; reflexivity. +induction l1 as [| r2 l1 Hrecl0]. +rewrite Rabs_R0; right; reflexivity. +apply Rle_trans with (Rabs (r * (r2 - r1)) + Rabs (Int_SF r0 (cons r2 l1))). +apply Rabs_triang. +rewrite Rabs_mult; rewrite (Rabs_right (r2 - r1)); + [ apply Rplus_le_compat_l; apply H; apply RList_P4 with r1; assumption + | apply Rge_minus; apply Rle_ge; apply (H0 0%nat); simpl in |- *; + apply lt_O_Sn ]. +Qed. + +Lemma StepFun_P34 : + forall (a b:R) (f:StepFun a b), + a <= b -> + Rabs (RiemannInt_SF f) <= RiemannInt_SF (mkStepFun (StepFun_P32 f)). +intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro. +replace + (Int_SF (subdivision_val (mkStepFun (StepFun_P32 f))) + (subdivision (mkStepFun (StepFun_P32 f)))) with + (Int_SF (app_Rlist (subdivision_val f) Rabs) (subdivision f)). +apply StepFun_P33; assert (H0 := StepFun_P29 f); unfold is_subdivision in H0; + elim H0; intros; unfold adapted_couple in p; decompose [and] p; + assumption. +apply StepFun_P17 with (fun x:R => Rabs (f x)) a b; + [ apply StepFun_P31; apply StepFun_P1 + | apply (StepFun_P1 (mkStepFun (StepFun_P32 f))) ]. +elim n; assumption. +Qed. + +Lemma StepFun_P35 : + forall (l:Rlist) (a b:R) (f g:R -> R), + ordered_Rlist l -> + pos_Rl l 0 = a -> + pos_Rl l (pred (Rlength l)) = b -> + (forall x:R, a < x < b -> f x <= g x) -> + Int_SF (FF l f) l <= Int_SF (FF l g) l. +simple induction l; intros. +right; reflexivity. +simpl in |- *; induction r0 as [| r0 r1 Hrecr0]. +right; reflexivity. +simpl in |- *; apply Rplus_le_compat. +case (Req_dec r r0); intro. +rewrite H4; right; ring. +do 2 rewrite <- (Rmult_comm (r0 - r)); apply Rmult_le_compat_l. +apply Rge_le; apply Rge_minus; apply Rle_ge; apply (H0 0%nat); simpl in |- *; + apply lt_O_Sn. +apply H3; split. +apply Rmult_lt_reg_l with 2. +prove_sup0. +unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym. +assert (H5 : r = a). +apply H1. +rewrite H5; rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l. +assert (H6 := H0 0%nat (lt_O_Sn _)). +simpl in H6. +elim H6; intro. +rewrite H5 in H7; apply H7. +elim H4; assumption. +discrR. +apply Rmult_lt_reg_l with 2. +prove_sup0. +unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym. +rewrite Rmult_1_l; rewrite double; assert (H5 : r0 <= b). +replace b with + (pos_Rl (cons r (cons r0 r1)) (pred (Rlength (cons r (cons r0 r1))))). +replace r0 with (pos_Rl (cons r (cons r0 r1)) 1). +elim (RList_P6 (cons r (cons r0 r1))); intros; apply H5. +assumption. +simpl in |- *; apply le_n_S. +apply le_O_n. +simpl in |- *; apply lt_n_Sn. +reflexivity. +apply Rle_lt_trans with (r + b). +apply Rplus_le_compat_l; assumption. +rewrite (Rplus_comm r); apply Rplus_lt_compat_l. +apply Rlt_le_trans with r0. +assert (H6 := H0 0%nat (lt_O_Sn _)). +simpl in H6. +elim H6; intro. +apply H7. +elim H4; assumption. +assumption. +discrR. +simpl in H; apply H with r0 b. +apply RList_P4 with r; assumption. +reflexivity. +rewrite <- H2; reflexivity. +intros; apply H3; elim H4; intros; split; try assumption. +apply Rle_lt_trans with r0; try assumption. +rewrite <- H1. +simpl in |- *; apply (H0 0%nat); simpl in |- *; apply lt_O_Sn. +Qed. + +Lemma StepFun_P36 : + forall (a b:R) (f g:StepFun a b) (l:Rlist), + a <= b -> + is_subdivision f a b l -> + is_subdivision g a b l -> + (forall x:R, a < x < b -> f x <= g x) -> + RiemannInt_SF f <= RiemannInt_SF g. +intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro. +replace (Int_SF (subdivision_val f) (subdivision f)) with (Int_SF (FF l f) l). +replace (Int_SF (subdivision_val g) (subdivision g)) with (Int_SF (FF l g) l). +unfold is_subdivision in X; elim X; clear X; intros; + unfold adapted_couple in p; decompose [and] p; clear p; + assert (H5 : Rmin a b = a); + [ unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ] + | assert (H7 : Rmax a b = b); + [ unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ] + | rewrite H5 in H3; rewrite H7 in H2; eapply StepFun_P35 with a b; + assumption ] ]. +apply StepFun_P17 with (fe g) a b; + [ apply StepFun_P21; assumption | apply StepFun_P1 ]. +apply StepFun_P17 with (fe f) a b; + [ apply StepFun_P21; assumption | apply StepFun_P1 ]. +elim n; assumption. +Qed. + +Lemma StepFun_P37 : + forall (a b:R) (f g:StepFun a b), + a <= b -> + (forall x:R, a < x < b -> f x <= g x) -> + RiemannInt_SF f <= RiemannInt_SF g. +intros; eapply StepFun_P36; try assumption. +eapply StepFun_P25; apply StepFun_P29. +eapply StepFun_P23; apply StepFun_P29. +Qed. + +Lemma StepFun_P38 : + forall (l:Rlist) (a b:R) (f:R -> R), + ordered_Rlist l -> + pos_Rl l 0 = a -> + pos_Rl l (pred (Rlength l)) = b -> + sigT + (fun g:StepFun a b => + g b = f b /\ + (forall i:nat, + (i < pred (Rlength l))%nat -> + constant_D_eq g (co_interval (pos_Rl l i) (pos_Rl l (S i))) + (f (pos_Rl l i)))). +intros l a b f; generalize a; clear a; induction l. +intros a H H0 H1; simpl in H0; simpl in H1; + exists (mkStepFun (StepFun_P4 a b (f b))); split. +reflexivity. +intros; elim (lt_n_O _ H2). +intros; destruct l as [| r1 l]. +simpl in H1; simpl in H0; exists (mkStepFun (StepFun_P4 a b (f b))); split. +reflexivity. +intros i H2; elim (lt_n_O _ H2). +intros; assert (H2 : ordered_Rlist (cons r1 l)). +apply RList_P4 with r; assumption. +assert (H3 : pos_Rl (cons r1 l) 0 = r1). +reflexivity. +assert (H4 : pos_Rl (cons r1 l) (pred (Rlength (cons r1 l))) = b). +rewrite <- H1; reflexivity. +elim (IHl r1 H2 H3 H4); intros g [H5 H6]. +set + (g' := + fun x:R => match Rle_dec r1 x with + | left _ => g x + | right _ => f a + end). +assert (H7 : r1 <= b). +rewrite <- H4; apply RList_P7; [ assumption | left; reflexivity ]. +assert (H8 : IsStepFun g' a b). +unfold IsStepFun in |- *; assert (H8 := pre g); unfold IsStepFun in H8; + elim H8; intros lg H9; unfold is_subdivision in H9; + elim H9; clear H9; intros lg2 H9; split with (cons a lg); + unfold is_subdivision in |- *; split with (cons (f a) lg2); + unfold adapted_couple in H9; decompose [and] H9; clear H9; + unfold adapted_couple in |- *; repeat split. +unfold ordered_Rlist in |- *; intros; simpl in H9; + induction i as [| i Hreci]. +simpl in |- *; rewrite H12; replace (Rmin r1 b) with r1. +simpl in H0; rewrite <- H0; apply (H 0%nat); simpl in |- *; apply lt_O_Sn. +unfold Rmin in |- *; case (Rle_dec r1 b); intro; + [ reflexivity | elim n; assumption ]. +apply (H10 i); apply lt_S_n. +replace (S (pred (Rlength lg))) with (Rlength lg). +apply H9. +apply S_pred with 0%nat; apply neq_O_lt; intro; rewrite <- H14 in H9; + elim (lt_n_O _ H9). +simpl in |- *; assert (H14 : a <= b). +rewrite <- H1; simpl in H0; rewrite <- H0; apply RList_P7; + [ assumption | left; reflexivity ]. +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +assert (H14 : a <= b). +rewrite <- H1; simpl in H0; rewrite <- H0; apply RList_P7; + [ assumption | left; reflexivity ]. +replace (Rmax a b) with (Rmax r1 b). +rewrite <- H11; induction lg as [| r0 lg Hreclg]. +simpl in H13; discriminate. +reflexivity. +unfold Rmax in |- *; case (Rle_dec a b); case (Rle_dec r1 b); intros; + reflexivity || elim n; assumption. +simpl in |- *; rewrite H13; reflexivity. +intros; simpl in H9; induction i as [| i Hreci]. +unfold constant_D_eq, open_interval in |- *; simpl in |- *; intros; + assert (H16 : Rmin r1 b = r1). +unfold Rmin in |- *; case (Rle_dec r1 b); intro; + [ reflexivity | elim n; assumption ]. +rewrite H16 in H12; rewrite H12 in H14; elim H14; clear H14; intros _ H14; + unfold g' in |- *; case (Rle_dec r1 x); intro r3. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H14)). +reflexivity. +change + (constant_D_eq g' (open_interval (pos_Rl lg i) (pos_Rl lg (S i))) + (pos_Rl lg2 i)) in |- *; clear Hreci; assert (H16 := H15 i); + assert (H17 : (i < pred (Rlength lg))%nat). +apply lt_S_n. +replace (S (pred (Rlength lg))) with (Rlength lg). +assumption. +apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; + rewrite <- H14 in H9; elim (lt_n_O _ H9). +assert (H18 := H16 H17); unfold constant_D_eq, open_interval in H18; + unfold constant_D_eq, open_interval in |- *; intros; + assert (H19 := H18 _ H14); rewrite <- H19; unfold g' in |- *; + case (Rle_dec r1 x); intro. +reflexivity. +elim n; replace r1 with (Rmin r1 b). +rewrite <- H12; elim H14; clear H14; intros H14 _; left; + apply Rle_lt_trans with (pos_Rl lg i); try assumption. +apply RList_P5. +assumption. +elim (RList_P3 lg (pos_Rl lg i)); intros; apply H21; exists i; split. +reflexivity. +apply lt_trans with (pred (Rlength lg)); try assumption. +apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H22 in H17; + elim (lt_n_O _ H17). +unfold Rmin in |- *; case (Rle_dec r1 b); intro; + [ reflexivity | elim n0; assumption ]. +exists (mkStepFun H8); split. +simpl in |- *; unfold g' in |- *; case (Rle_dec r1 b); intro. +assumption. +elim n; assumption. +intros; simpl in H9; induction i as [| i Hreci]. +unfold constant_D_eq, co_interval in |- *; simpl in |- *; intros; simpl in H0; + rewrite H0; elim H10; clear H10; intros; unfold g' in |- *; + case (Rle_dec r1 x); intro r3. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H11)). +reflexivity. +clear Hreci; + change + (constant_D_eq (mkStepFun H8) + (co_interval (pos_Rl (cons r1 l) i) (pos_Rl (cons r1 l) (S i))) + (f (pos_Rl (cons r1 l) i))) in |- *; assert (H10 := H6 i); + assert (H11 : (i < pred (Rlength (cons r1 l)))%nat). +simpl in |- *; apply lt_S_n; assumption. +assert (H12 := H10 H11); unfold constant_D_eq, co_interval in H12; + unfold constant_D_eq, co_interval in |- *; intros; + rewrite <- (H12 _ H13); simpl in |- *; unfold g' in |- *; + case (Rle_dec r1 x); intro. +reflexivity. +elim n; elim H13; clear H13; intros; + apply Rle_trans with (pos_Rl (cons r1 l) i); try assumption; + change (pos_Rl (cons r1 l) 0 <= pos_Rl (cons r1 l) i) in |- *; + elim (RList_P6 (cons r1 l)); intros; apply H15; + [ assumption + | apply le_O_n + | simpl in |- *; apply lt_trans with (Rlength l); + [ apply lt_S_n; assumption | apply lt_n_Sn ] ]. +Qed. + +Lemma StepFun_P39 : + forall (a b:R) (f:StepFun a b), + RiemannInt_SF f = - RiemannInt_SF (mkStepFun (StepFun_P6 (pre f))). +intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); case (Rle_dec b a); + intros. +assert (H : adapted_couple f a b (subdivision f) (subdivision_val f)); + [ apply StepFun_P1 + | assert + (H0 : + adapted_couple (mkStepFun (StepFun_P6 (pre f))) b a + (subdivision (mkStepFun (StepFun_P6 (pre f)))) + (subdivision_val (mkStepFun (StepFun_P6 (pre f))))); + [ apply StepFun_P1 + | assert (H1 : a = b); + [ apply Rle_antisym; assumption + | rewrite (StepFun_P8 H H1); assert (H2 : b = a); + [ symmetry in |- *; apply H1 | rewrite (StepFun_P8 H0 H2); ring ] ] ] ]. +rewrite Ropp_involutive; eapply StepFun_P17; + [ apply StepFun_P1 + | apply StepFun_P2; set (H := StepFun_P6 (pre f)); unfold IsStepFun in H; + elim H; intros; unfold is_subdivision in |- *; + elim p; intros; apply p0 ]. +apply Ropp_eq_compat; eapply StepFun_P17; + [ apply StepFun_P1 + | apply StepFun_P2; set (H := StepFun_P6 (pre f)); unfold IsStepFun in H; + elim H; intros; unfold is_subdivision in |- *; + elim p; intros; apply p0 ]. +assert (H : a < b); + [ auto with real + | assert (H0 : b < a); + [ auto with real | elim (Rlt_irrefl _ (Rlt_trans _ _ _ H H0)) ] ]. +Qed. + +Lemma StepFun_P40 : + forall (f:R -> R) (a b c:R) (l1 l2 lf1 lf2:Rlist), + a < b -> + b < c -> + adapted_couple f a b l1 lf1 -> + adapted_couple f b c l2 lf2 -> + adapted_couple f a c (cons_Rlist l1 l2) (FF (cons_Rlist l1 l2) f). +intros f a b c l1 l2 lf1 lf2 H H0 H1 H2; unfold adapted_couple in H1, H2; + unfold adapted_couple in |- *; decompose [and] H1; + decompose [and] H2; clear H1 H2; repeat split. +apply RList_P25; try assumption. +rewrite H10; rewrite H4; unfold Rmin, Rmax in |- *; case (Rle_dec a b); + case (Rle_dec b c); intros; + (right; reflexivity) || (elim n; left; assumption). +rewrite RList_P22. +rewrite H5; unfold Rmin, Rmax in |- *; case (Rle_dec a b); case (Rle_dec a c); + intros; + [ reflexivity + | elim n; apply Rle_trans with b; left; assumption + | elim n; left; assumption + | elim n0; left; assumption ]. +red in |- *; intro; rewrite H1 in H6; discriminate. +rewrite RList_P24. +rewrite H9; unfold Rmin, Rmax in |- *; case (Rle_dec b c); case (Rle_dec a c); + intros; + [ reflexivity + | elim n; apply Rle_trans with b; left; assumption + | elim n; left; assumption + | elim n0; left; assumption ]. +red in |- *; intro; rewrite H1 in H11; discriminate. +apply StepFun_P20. +rewrite RList_P23; apply neq_O_lt; red in |- *; intro. +assert (H2 : (Rlength l1 + Rlength l2)%nat = 0%nat). +symmetry in |- *; apply H1. +elim (plus_is_O _ _ H2); intros; rewrite H12 in H6; discriminate. +unfold constant_D_eq, open_interval in |- *; intros; + elim (le_or_lt (S (S i)) (Rlength l1)); intro. +assert (H14 : pos_Rl (cons_Rlist l1 l2) i = pos_Rl l1 i). +apply RList_P26; apply lt_S_n; apply le_lt_n_Sm; apply le_S_n; + apply le_trans with (Rlength l1); [ assumption | apply le_n_Sn ]. +assert (H15 : pos_Rl (cons_Rlist l1 l2) (S i) = pos_Rl l1 (S i)). +apply RList_P26; apply lt_S_n; apply le_lt_n_Sm; assumption. +rewrite H14 in H2; rewrite H15 in H2; assert (H16 : (2 <= Rlength l1)%nat). +apply le_trans with (S (S i)); + [ repeat apply le_n_S; apply le_O_n | assumption ]. +elim (RList_P20 _ H16); intros r1 [r2 [r3 H17]]; rewrite H17; + change + (f x = pos_Rl (app_Rlist (mid_Rlist (cons_Rlist (cons r2 r3) l2) r1) f) i) + in |- *; rewrite RList_P12. +induction i as [| i Hreci]. +simpl in |- *; assert (H18 := H8 0%nat); + unfold constant_D_eq, open_interval in H18; + assert (H19 : (0 < pred (Rlength l1))%nat). +rewrite H17; simpl in |- *; apply lt_O_Sn. +assert (H20 := H18 H19); repeat rewrite H20. +reflexivity. +assert (H21 : r1 <= r2). +rewrite H17 in H3; apply (H3 0%nat). +simpl in |- *; apply lt_O_Sn. +elim H21; intro. +split. +rewrite H17; simpl in |- *; apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. +rewrite H17; simpl in |- *; apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite (Rplus_comm r1); rewrite double; + apply Rplus_lt_compat_l; assumption + | discrR ] ]. +elim H2; intros; rewrite H17 in H23; rewrite H17 in H24; simpl in H24; + simpl in H23; rewrite H22 in H23; + elim (Rlt_irrefl _ (Rlt_trans _ _ _ H23 H24)). +assumption. +clear Hreci; rewrite RList_P13. +rewrite H17 in H14; rewrite H17 in H15; + change + (pos_Rl (cons_Rlist (cons r2 r3) l2) i = + pos_Rl (cons r1 (cons r2 r3)) (S i)) in H14; rewrite H14; + change + (pos_Rl (cons_Rlist (cons r2 r3) l2) (S i) = + pos_Rl (cons r1 (cons r2 r3)) (S (S i))) in H15; + rewrite H15; assert (H18 := H8 (S i)); + unfold constant_D_eq, open_interval in H18; + assert (H19 : (S i < pred (Rlength l1))%nat). +apply lt_pred; apply lt_S_n; apply le_lt_n_Sm; assumption. +assert (H20 := H18 H19); repeat rewrite H20. +reflexivity. +rewrite <- H17; assert (H21 : pos_Rl l1 (S i) <= pos_Rl l1 (S (S i))). +apply (H3 (S i)); apply lt_pred; apply lt_S_n; apply le_lt_n_Sm; assumption. +elim H21; intro. +split. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite (Rplus_comm (pos_Rl l1 (S i))); + rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. +elim H2; intros; rewrite H22 in H23; + elim (Rlt_irrefl _ (Rlt_trans _ _ _ H23 H24)). +assumption. +simpl in |- *; rewrite H17 in H1; simpl in H1; apply lt_S_n; assumption. +rewrite RList_P14; rewrite H17 in H1; simpl in H1; apply H1. +inversion H12. +assert (H16 : pos_Rl (cons_Rlist l1 l2) (S i) = b). +rewrite RList_P29. +rewrite H15; rewrite <- minus_n_n; rewrite H10; unfold Rmin in |- *; + case (Rle_dec b c); intro; [ reflexivity | elim n; left; assumption ]. +rewrite H15; apply le_n. +induction l1 as [| r l1 Hrecl1]. +simpl in H15; discriminate. +clear Hrecl1; simpl in H1; simpl in |- *; apply lt_n_S; assumption. +assert (H17 : pos_Rl (cons_Rlist l1 l2) i = b). +rewrite RList_P26. +replace i with (pred (Rlength l1)); + [ rewrite H4; unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; left; assumption ] + | rewrite H15; reflexivity ]. +rewrite H15; apply lt_n_Sn. +rewrite H16 in H2; rewrite H17 in H2; elim H2; intros; + elim (Rlt_irrefl _ (Rlt_trans _ _ _ H14 H18)). +assert (H16 : pos_Rl (cons_Rlist l1 l2) i = pos_Rl l2 (i - Rlength l1)). +apply RList_P29. +apply le_S_n; assumption. +apply lt_le_trans with (pred (Rlength (cons_Rlist l1 l2))); + [ assumption | apply le_pred_n ]. +assert + (H17 : pos_Rl (cons_Rlist l1 l2) (S i) = pos_Rl l2 (S (i - Rlength l1))). +replace (S (i - Rlength l1)) with (S i - Rlength l1)%nat. +apply RList_P29. +apply le_S_n; apply le_trans with (S i); [ assumption | apply le_n_Sn ]. +induction l1 as [| r l1 Hrecl1]. +simpl in H6; discriminate. +clear Hrecl1; simpl in H1; simpl in |- *; apply lt_n_S; assumption. +symmetry in |- *; apply minus_Sn_m; apply le_S_n; assumption. +assert (H18 : (2 <= Rlength l1)%nat). +clear f c l2 lf2 H0 H3 H8 H7 H10 H9 H11 H13 i H1 x H2 H12 m H14 H15 H16 H17; + induction l1 as [| r l1 Hrecl1]. +discriminate. +clear Hrecl1; induction l1 as [| r0 l1 Hrecl1]. +simpl in H5; simpl in H4; assert (H0 : Rmin a b < Rmax a b). +unfold Rmin, Rmax in |- *; case (Rle_dec a b); intro; + [ assumption | elim n; left; assumption ]. +rewrite <- H5 in H0; rewrite <- H4 in H0; elim (Rlt_irrefl _ H0). +clear Hrecl1; simpl in |- *; repeat apply le_n_S; apply le_O_n. +elim (RList_P20 _ H18); intros r1 [r2 [r3 H19]]; rewrite H19; + change + (f x = pos_Rl (app_Rlist (mid_Rlist (cons_Rlist (cons r2 r3) l2) r1) f) i) + in |- *; rewrite RList_P12. +induction i as [| i Hreci]. +assert (H20 := le_S_n _ _ H15); assert (H21 := le_trans _ _ _ H18 H20); + elim (le_Sn_O _ H21). +clear Hreci; rewrite RList_P13. +rewrite H19 in H16; rewrite H19 in H17; + change + (pos_Rl (cons_Rlist (cons r2 r3) l2) i = + pos_Rl l2 (S i - Rlength (cons r1 (cons r2 r3)))) + in H16; rewrite H16; + change + (pos_Rl (cons_Rlist (cons r2 r3) l2) (S i) = + pos_Rl l2 (S (S i - Rlength (cons r1 (cons r2 r3))))) + in H17; rewrite H17; assert (H20 := H13 (S i - Rlength l1)%nat); + unfold constant_D_eq, open_interval in H20; + assert (H21 : (S i - Rlength l1 < pred (Rlength l2))%nat). +apply lt_pred; rewrite minus_Sn_m. +apply plus_lt_reg_l with (Rlength l1); rewrite <- le_plus_minus. +rewrite H19 in H1; simpl in H1; rewrite H19; simpl in |- *; + rewrite RList_P23 in H1; apply lt_n_S; assumption. +apply le_trans with (S i); [ apply le_S_n; assumption | apply le_n_Sn ]. +apply le_S_n; assumption. +assert (H22 := H20 H21); repeat rewrite H22. +reflexivity. +rewrite <- H19; + assert + (H23 : pos_Rl l2 (S i - Rlength l1) <= pos_Rl l2 (S (S i - Rlength l1))). +apply H7; apply lt_pred. +rewrite minus_Sn_m. +apply plus_lt_reg_l with (Rlength l1); rewrite <- le_plus_minus. +rewrite H19 in H1; simpl in H1; rewrite H19; simpl in |- *; + rewrite RList_P23 in H1; apply lt_n_S; assumption. +apply le_trans with (S i); [ apply le_S_n; assumption | apply le_n_Sn ]. +apply le_S_n; assumption. +elim H23; intro. +split. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite (Rplus_comm (pos_Rl l2 (S i - Rlength l1))); + rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. +rewrite <- H19 in H16; rewrite <- H19 in H17; elim H2; intros; + rewrite H19 in H25; rewrite H19 in H26; simpl in H25; + simpl in H16; rewrite H16 in H25; simpl in H26; simpl in H17; + rewrite H17 in H26; simpl in H24; rewrite H24 in H25; + elim (Rlt_irrefl _ (Rlt_trans _ _ _ H25 H26)). +assert (H23 : pos_Rl (cons_Rlist l1 l2) (S i) = pos_Rl l2 (S i - Rlength l1)). +rewrite H19; simpl in |- *; simpl in H16; apply H16. +assert + (H24 : + pos_Rl (cons_Rlist l1 l2) (S (S i)) = pos_Rl l2 (S (S i - Rlength l1))). +rewrite H19; simpl in |- *; simpl in H17; apply H17. +rewrite <- H23; rewrite <- H24; assumption. +simpl in |- *; rewrite H19 in H1; simpl in H1; apply lt_S_n; assumption. +rewrite RList_P14; rewrite H19 in H1; simpl in H1; simpl in |- *; apply H1. +Qed. + +Lemma StepFun_P41 : + forall (f:R -> R) (a b c:R), + a <= b -> b <= c -> IsStepFun f a b -> IsStepFun f b c -> IsStepFun f a c. +unfold IsStepFun in |- *; unfold is_subdivision in |- *; intros; elim X; + clear X; intros l1 [lf1 H1]; elim X0; clear X0; intros l2 [lf2 H2]; + case (total_order_T a b); intro. +elim s; intro. +case (total_order_T b c); intro. +elim s0; intro. +split with (cons_Rlist l1 l2); split with (FF (cons_Rlist l1 l2) f); + apply StepFun_P40 with b lf1 lf2; assumption. +split with l1; split with lf1; rewrite b0 in H1; assumption. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 r)). +split with l2; split with lf2; rewrite <- b0 in H2; assumption. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). +Qed. + +Lemma StepFun_P42 : + forall (l1 l2:Rlist) (f:R -> R), + pos_Rl l1 (pred (Rlength l1)) = pos_Rl l2 0 -> + Int_SF (FF (cons_Rlist l1 l2) f) (cons_Rlist l1 l2) = + Int_SF (FF l1 f) l1 + Int_SF (FF l2 f) l2. +intros l1 l2 f; induction l1 as [| r l1 IHl1]; intros H; + [ simpl in |- *; ring + | destruct l1 as [| r0 r1]; + [ simpl in H; simpl in |- *; destruct l2 as [| r0 r1]; + [ simpl in |- *; ring | simpl in |- *; simpl in H; rewrite H; ring ] + | simpl in |- *; rewrite Rplus_assoc; apply Rplus_eq_compat_l; apply IHl1; + rewrite <- H; reflexivity ] ]. +Qed. + +Lemma StepFun_P43 : + forall (f:R -> R) (a b c:R) (pr1:IsStepFun f a b) + (pr2:IsStepFun f b c) (pr3:IsStepFun f a c), + RiemannInt_SF (mkStepFun pr1) + RiemannInt_SF (mkStepFun pr2) = + RiemannInt_SF (mkStepFun pr3). +intros f; intros; + assert + (H1 : + sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f a b l l0))). +apply pr1. +assert + (H2 : + sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f b c l l0))). +apply pr2. +assert + (H3 : + sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f a c l l0))). +apply pr3. +elim H1; clear H1; intros l1 [lf1 H1]; elim H2; clear H2; intros l2 [lf2 H2]; + elim H3; clear H3; intros l3 [lf3 H3]. +replace (RiemannInt_SF (mkStepFun pr1)) with + match Rle_dec a b with + | left _ => Int_SF lf1 l1 + | right _ => - Int_SF lf1 l1 + end. +replace (RiemannInt_SF (mkStepFun pr2)) with + match Rle_dec b c with + | left _ => Int_SF lf2 l2 + | right _ => - Int_SF lf2 l2 + end. +replace (RiemannInt_SF (mkStepFun pr3)) with + match Rle_dec a c with + | left _ => Int_SF lf3 l3 + | right _ => - Int_SF lf3 l3 + end. +case (Rle_dec a b); case (Rle_dec b c); case (Rle_dec a c); intros. +elim r1; intro. +elim r0; intro. +replace (Int_SF lf3 l3) with + (Int_SF (FF (cons_Rlist l1 l2) f) (cons_Rlist l1 l2)). +replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1). +replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2). +symmetry in |- *; apply StepFun_P42. +unfold adapted_couple in H1, H2; decompose [and] H1; decompose [and] H2; + clear H1 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin in |- *; + case (Rle_dec a b); case (Rle_dec b c); intros; reflexivity || elim n; + assumption. +eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf2; apply H2; + assumption + | assumption ]. +eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1 + | assumption ]. +eapply StepFun_P17; [ apply (StepFun_P40 H H0 H1 H2) | apply H3 ]. +replace (Int_SF lf2 l2) with 0. +rewrite Rplus_0_r; eapply StepFun_P17; + [ apply H1 | rewrite <- H0 in H3; apply H3 ]. +symmetry in |- *; eapply StepFun_P8; [ apply H2 | assumption ]. +replace (Int_SF lf1 l1) with 0. +rewrite Rplus_0_l; eapply StepFun_P17; + [ apply H2 | rewrite H in H3; apply H3 ]. +symmetry in |- *; eapply StepFun_P8; [ apply H1 | assumption ]. +elim n; apply Rle_trans with b; assumption. +apply Rplus_eq_reg_l with (Int_SF lf2 l2); + replace (Int_SF lf2 l2 + (Int_SF lf1 l1 + - Int_SF lf2 l2)) with + (Int_SF lf1 l1); [ idtac | ring ]. +assert (H : c < b). +auto with real. +elim r; intro. +rewrite Rplus_comm; + replace (Int_SF lf1 l1) with + (Int_SF (FF (cons_Rlist l3 l2) f) (cons_Rlist l3 l2)). +replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3). +replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2). +apply StepFun_P42. +unfold adapted_couple in H2, H3; decompose [and] H2; decompose [and] H3; + clear H3 H2; rewrite H10; rewrite H6; unfold Rmax, Rmin in |- *; + case (Rle_dec a c); case (Rle_dec b c); intros; + [ elim n; assumption + | reflexivity + | elim n0; assumption + | elim n1; assumption ]. +eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf2; apply H2 + | assumption ]. +eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf3; apply H3 + | assumption ]. +eapply StepFun_P17; + [ apply (StepFun_P40 H0 H H3 (StepFun_P2 H2)) | apply H1 ]. +replace (Int_SF lf3 l3) with 0. +rewrite Rplus_0_r; eapply StepFun_P17; + [ apply H1 | apply StepFun_P2; rewrite <- H0 in H2; apply H2 ]. +symmetry in |- *; eapply StepFun_P8; [ apply H3 | assumption ]. +replace (Int_SF lf2 l2) with (Int_SF lf3 l3 + Int_SF lf1 l1). +ring. +elim r; intro. +replace (Int_SF lf2 l2) with + (Int_SF (FF (cons_Rlist l3 l1) f) (cons_Rlist l3 l1)). +replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3). +replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1). +symmetry in |- *; apply StepFun_P42. +unfold adapted_couple in H1, H3; decompose [and] H1; decompose [and] H3; + clear H3 H1; rewrite H9; rewrite H5; unfold Rmax, Rmin in |- *; + case (Rle_dec a c); case (Rle_dec a b); intros; + [ elim n; assumption + | elim n1; assumption + | reflexivity + | elim n1; assumption ]. +eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1 + | assumption ]. +eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf3; apply H3 + | assumption ]. +eapply StepFun_P17. +assert (H0 : c < a). +auto with real. +apply (StepFun_P40 H0 H (StepFun_P2 H3) H1). +apply StepFun_P2; apply H2. +replace (Int_SF lf1 l1) with 0. +rewrite Rplus_0_r; eapply StepFun_P17; + [ apply H3 | rewrite <- H in H2; apply H2 ]. +symmetry in |- *; eapply StepFun_P8; [ apply H1 | assumption ]. +assert (H : b < a). +auto with real. +replace (Int_SF lf2 l2) with (Int_SF lf3 l3 + Int_SF lf1 l1). +ring. +rewrite Rplus_comm; elim r; intro. +replace (Int_SF lf2 l2) with + (Int_SF (FF (cons_Rlist l1 l3) f) (cons_Rlist l1 l3)). +replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3). +replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1). +symmetry in |- *; apply StepFun_P42. +unfold adapted_couple in H1, H3; decompose [and] H1; decompose [and] H3; + clear H3 H1; rewrite H11; rewrite H5; unfold Rmax, Rmin in |- *; + case (Rle_dec a c); case (Rle_dec a b); intros; + [ elim n; assumption + | reflexivity + | elim n0; assumption + | elim n1; assumption ]. +eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1 + | assumption ]. +eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf3; apply H3 + | assumption ]. +eapply StepFun_P17. +apply (StepFun_P40 H H0 (StepFun_P2 H1) H3). +apply H2. +replace (Int_SF lf3 l3) with 0. +rewrite Rplus_0_r; eapply StepFun_P17; + [ apply H1 | rewrite <- H0 in H2; apply StepFun_P2; apply H2 ]. +symmetry in |- *; eapply StepFun_P8; [ apply H3 | assumption ]. +assert (H : c < a). +auto with real. +replace (Int_SF lf1 l1) with (Int_SF lf2 l2 + Int_SF lf3 l3). +ring. +elim r; intro. +replace (Int_SF lf1 l1) with + (Int_SF (FF (cons_Rlist l2 l3) f) (cons_Rlist l2 l3)). +replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3). +replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2). +symmetry in |- *; apply StepFun_P42. +unfold adapted_couple in H2, H3; decompose [and] H2; decompose [and] H3; + clear H3 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin in |- *; + case (Rle_dec a c); case (Rle_dec b c); intros; + [ elim n; assumption + | elim n1; assumption + | reflexivity + | elim n1; assumption ]. +eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf2; apply H2 + | assumption ]. +eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf3; apply H3 + | assumption ]. +eapply StepFun_P17. +apply (StepFun_P40 H0 H H2 (StepFun_P2 H3)). +apply StepFun_P2; apply H1. +replace (Int_SF lf2 l2) with 0. +rewrite Rplus_0_l; eapply StepFun_P17; + [ apply H3 | rewrite H0 in H1; apply H1 ]. +symmetry in |- *; eapply StepFun_P8; [ apply H2 | assumption ]. +elim n; apply Rle_trans with a; try assumption. +auto with real. +assert (H : c < b). +auto with real. +assert (H0 : b < a). +auto with real. +replace (Int_SF lf3 l3) with (Int_SF lf2 l2 + Int_SF lf1 l1). +ring. +replace (Int_SF lf3 l3) with + (Int_SF (FF (cons_Rlist l2 l1) f) (cons_Rlist l2 l1)). +replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1). +replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2). +symmetry in |- *; apply StepFun_P42. +unfold adapted_couple in H2, H1; decompose [and] H2; decompose [and] H1; + clear H1 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin in |- *; + case (Rle_dec a b); case (Rle_dec b c); intros; + [ elim n1; assumption + | elim n1; assumption + | elim n0; assumption + | reflexivity ]. +eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf2; apply H2 + | assumption ]. +eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1 + | assumption ]. +eapply StepFun_P17. +apply (StepFun_P40 H H0 (StepFun_P2 H2) (StepFun_P2 H1)). +apply StepFun_P2; apply H3. +unfold RiemannInt_SF in |- *; case (Rle_dec a c); intro. +eapply StepFun_P17. +apply H3. +change + (adapted_couple (mkStepFun pr3) a c (subdivision (mkStepFun pr3)) + (subdivision_val (mkStepFun pr3))) in |- *; apply StepFun_P1. +apply Ropp_eq_compat; eapply StepFun_P17. +apply H3. +change + (adapted_couple (mkStepFun pr3) a c (subdivision (mkStepFun pr3)) + (subdivision_val (mkStepFun pr3))) in |- *; apply StepFun_P1. +unfold RiemannInt_SF in |- *; case (Rle_dec b c); intro. +eapply StepFun_P17. +apply H2. +change + (adapted_couple (mkStepFun pr2) b c (subdivision (mkStepFun pr2)) + (subdivision_val (mkStepFun pr2))) in |- *; apply StepFun_P1. +apply Ropp_eq_compat; eapply StepFun_P17. +apply H2. +change + (adapted_couple (mkStepFun pr2) b c (subdivision (mkStepFun pr2)) + (subdivision_val (mkStepFun pr2))) in |- *; apply StepFun_P1. +unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro. +eapply StepFun_P17. +apply H1. +change + (adapted_couple (mkStepFun pr1) a b (subdivision (mkStepFun pr1)) + (subdivision_val (mkStepFun pr1))) in |- *; apply StepFun_P1. +apply Ropp_eq_compat; eapply StepFun_P17. +apply H1. +change + (adapted_couple (mkStepFun pr1) a b (subdivision (mkStepFun pr1)) + (subdivision_val (mkStepFun pr1))) in |- *; apply StepFun_P1. +Qed. + +Lemma StepFun_P44 : + forall (f:R -> R) (a b c:R), + IsStepFun f a b -> a <= c <= b -> IsStepFun f a c. +intros f; intros; assert (H0 : a <= b). +elim H; intros; apply Rle_trans with c; assumption. +elim H; clear H; intros; unfold IsStepFun in X; unfold is_subdivision in X; + elim X; clear X; intros l1 [lf1 H2]; + cut + (forall (l1 lf1:Rlist) (a b c:R) (f:R -> R), + adapted_couple f a b l1 lf1 -> + a <= c <= b -> + sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f a c l l0))). +intros; unfold IsStepFun in |- *; unfold is_subdivision in |- *; eapply X. +apply H2. +split; assumption. +clear f a b c H0 H H1 H2 l1 lf1; simple induction l1. +intros; unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4; + discriminate. +simple induction r0. +intros; assert (H1 : a = b). +unfold adapted_couple in H; decompose [and] H; clear H; simpl in H3; + simpl in H2; assert (H7 : a <= b). +elim H0; intros; apply Rle_trans with c; assumption. +replace a with (Rmin a b). +pattern b at 2 in |- *; replace b with (Rmax a b). +rewrite <- H2; rewrite H3; reflexivity. +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +split with (cons r nil); split with lf1; assert (H2 : c = b). +rewrite H1 in H0; elim H0; intros; apply Rle_antisym; assumption. +rewrite H2; assumption. +intros; clear X; induction lf1 as [| r3 lf1 Hreclf1]. +unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4; + discriminate. +clear Hreclf1; assert (H1 : {c <= r1} + {r1 < c}). +case (Rle_dec c r1); intro; [ left; assumption | right; auto with real ]. +elim H1; intro. +split with (cons r (cons c nil)); split with (cons r3 nil); + unfold adapted_couple in H; decompose [and] H; clear H; + assert (H6 : r = a). +simpl in H4; rewrite H4; unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity + | elim n; elim H0; intros; apply Rle_trans with c; assumption ]. +elim H0; clear H0; intros; unfold adapted_couple in |- *; repeat split. +rewrite H6; unfold ordered_Rlist in |- *; intros; simpl in H8; inversion H8; + [ simpl in |- *; assumption | elim (le_Sn_O _ H10) ]. +simpl in |- *; unfold Rmin in |- *; case (Rle_dec a c); intro; + [ assumption | elim n; assumption ]. +simpl in |- *; unfold Rmax in |- *; case (Rle_dec a c); intro; + [ reflexivity | elim n; assumption ]. +unfold constant_D_eq, open_interval in |- *; intros; simpl in H8; + inversion H8. +simpl in |- *; assert (H10 := H7 0%nat); + assert (H12 : (0 < pred (Rlength (cons r (cons r1 r2))))%nat). +simpl in |- *; apply lt_O_Sn. +apply (H10 H12); unfold open_interval in |- *; simpl in |- *; + rewrite H11 in H9; simpl in H9; elim H9; clear H9; + intros; split; try assumption. +apply Rlt_le_trans with c; assumption. +elim (le_Sn_O _ H11). +cut (adapted_couple f r1 b (cons r1 r2) lf1). +cut (r1 <= c <= b). +intros. +elim (X0 _ _ _ _ _ H3 H2); intros l1' [lf1' H4]; split with (cons r l1'); + split with (cons r3 lf1'); unfold adapted_couple in H, H4; + decompose [and] H; decompose [and] H4; clear H H4 X0; + assert (H14 : a <= b). +elim H0; intros; apply Rle_trans with c; assumption. +assert (H16 : r = a). +simpl in H7; rewrite H7; unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +induction l1' as [| r4 l1' Hrecl1']. +simpl in H13; discriminate. +clear Hrecl1'; unfold adapted_couple in |- *; repeat split. +unfold ordered_Rlist in |- *; intros; simpl in H; induction i as [| i Hreci]. +simpl in |- *; replace r4 with r1. +apply (H5 0%nat). +simpl in |- *; apply lt_O_Sn. +simpl in H12; rewrite H12; unfold Rmin in |- *; case (Rle_dec r1 c); intro; + [ reflexivity | elim n; left; assumption ]. +apply (H9 i); simpl in |- *; apply lt_S_n; assumption. +simpl in |- *; unfold Rmin in |- *; case (Rle_dec a c); intro; + [ assumption | elim n; elim H0; intros; assumption ]. +replace (Rmax a c) with (Rmax r1 c). +rewrite <- H11; reflexivity. +unfold Rmax in |- *; case (Rle_dec r1 c); case (Rle_dec a c); intros; + [ reflexivity + | elim n; elim H0; intros; assumption + | elim n; left; assumption + | elim n0; left; assumption ]. +simpl in |- *; simpl in H13; rewrite H13; reflexivity. +intros; simpl in H; unfold constant_D_eq, open_interval in |- *; intros; + induction i as [| i Hreci]. +simpl in |- *; assert (H17 := H10 0%nat); + assert (H18 : (0 < pred (Rlength (cons r (cons r1 r2))))%nat). +simpl in |- *; apply lt_O_Sn. +apply (H17 H18); unfold open_interval in |- *; simpl in |- *; simpl in H4; + elim H4; clear H4; intros; split; try assumption; + replace r1 with r4. +assumption. +simpl in H12; rewrite H12; unfold Rmin in |- *; case (Rle_dec r1 c); intro; + [ reflexivity | elim n; left; assumption ]. +clear Hreci; simpl in |- *; apply H15. +simpl in |- *; apply lt_S_n; assumption. +unfold open_interval in |- *; apply H4. +split. +left; assumption. +elim H0; intros; assumption. +eapply StepFun_P7; + [ elim H0; intros; apply Rle_trans with c; [ apply H2 | apply H3 ] + | apply H ]. +Qed. + +Lemma StepFun_P45 : + forall (f:R -> R) (a b c:R), + IsStepFun f a b -> a <= c <= b -> IsStepFun f c b. +intros f; intros; assert (H0 : a <= b). +elim H; intros; apply Rle_trans with c; assumption. +elim H; clear H; intros; unfold IsStepFun in X; unfold is_subdivision in X; + elim X; clear X; intros l1 [lf1 H2]; + cut + (forall (l1 lf1:Rlist) (a b c:R) (f:R -> R), + adapted_couple f a b l1 lf1 -> + a <= c <= b -> + sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f c b l l0))). +intros; unfold IsStepFun in |- *; unfold is_subdivision in |- *; eapply X; + [ apply H2 | split; assumption ]. +clear f a b c H0 H H1 H2 l1 lf1; simple induction l1. +intros; unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4; + discriminate. +simple induction r0. +intros; assert (H1 : a = b). +unfold adapted_couple in H; decompose [and] H; clear H; simpl in H3; + simpl in H2; assert (H7 : a <= b). +elim H0; intros; apply Rle_trans with c; assumption. +replace a with (Rmin a b). +pattern b at 2 in |- *; replace b with (Rmax a b). +rewrite <- H2; rewrite H3; reflexivity. +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +split with (cons r nil); split with lf1; assert (H2 : c = b). +rewrite H1 in H0; elim H0; intros; apply Rle_antisym; assumption. +rewrite <- H2 in H1; rewrite <- H1; assumption. +intros; clear X; induction lf1 as [| r3 lf1 Hreclf1]. +unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4; + discriminate. +clear Hreclf1; assert (H1 : {c <= r1} + {r1 < c}). +case (Rle_dec c r1); intro; [ left; assumption | right; auto with real ]. +elim H1; intro. +split with (cons c (cons r1 r2)); split with (cons r3 lf1); + unfold adapted_couple in H; decompose [and] H; clear H; + unfold adapted_couple in |- *; repeat split. +unfold ordered_Rlist in |- *; intros; simpl in H; induction i as [| i Hreci]. +simpl in |- *; assumption. +clear Hreci; apply (H2 (S i)); simpl in |- *; assumption. +simpl in |- *; unfold Rmin in |- *; case (Rle_dec c b); intro; + [ reflexivity | elim n; elim H0; intros; assumption ]. +replace (Rmax c b) with (Rmax a b). +rewrite <- H3; reflexivity. +unfold Rmax in |- *; case (Rle_dec a b); case (Rle_dec c b); intros; + [ reflexivity + | elim n; elim H0; intros; assumption + | elim n; elim H0; intros; apply Rle_trans with c; assumption + | elim n0; elim H0; intros; apply Rle_trans with c; assumption ]. +simpl in |- *; simpl in H5; apply H5. +intros; simpl in H; induction i as [| i Hreci]. +unfold constant_D_eq, open_interval in |- *; intros; simpl in |- *; + apply (H7 0%nat). +simpl in |- *; apply lt_O_Sn. +unfold open_interval in |- *; simpl in |- *; simpl in H6; elim H6; clear H6; + intros; split; try assumption; apply Rle_lt_trans with c; + try assumption; replace r with a. +elim H0; intros; assumption. +simpl in H4; rewrite H4; unfold Rmin in |- *; case (Rle_dec a b); intros; + [ reflexivity + | elim n; elim H0; intros; apply Rle_trans with c; assumption ]. +clear Hreci; apply (H7 (S i)); simpl in |- *; assumption. +cut (adapted_couple f r1 b (cons r1 r2) lf1). +cut (r1 <= c <= b). +intros; elim (X0 _ _ _ _ _ H3 H2); intros l1' [lf1' H4]; split with l1'; + split with lf1'; assumption. +split; [ left; assumption | elim H0; intros; assumption ]. +eapply StepFun_P7; + [ elim H0; intros; apply Rle_trans with c; [ apply H2 | apply H3 ] + | apply H ]. +Qed. + +Lemma StepFun_P46 : + forall (f:R -> R) (a b c:R), + IsStepFun f a b -> IsStepFun f b c -> IsStepFun f a c. +intros f; intros; case (Rle_dec a b); case (Rle_dec b c); intros. +apply StepFun_P41 with b; assumption. +case (Rle_dec a c); intro. +apply StepFun_P44 with b; try assumption. +split; [ assumption | auto with real ]. +apply StepFun_P6; apply StepFun_P44 with b. +apply StepFun_P6; assumption. +split; auto with real. +case (Rle_dec a c); intro. +apply StepFun_P45 with b; try assumption. +split; auto with real. +apply StepFun_P6; apply StepFun_P45 with b. +apply StepFun_P6; assumption. +split; [ assumption | auto with real ]. +apply StepFun_P6; apply StepFun_P41 with b; + auto with real || apply StepFun_P6; assumption. +Qed. diff --git a/theories/Reals/Rlimit.v b/theories/Reals/Rlimit.v new file mode 100644 index 00000000..0fbb17c6 --- /dev/null +++ b/theories/Reals/Rlimit.v @@ -0,0 +1,557 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Rlimit.v,v 1.23.2.1 2004/07/16 19:31:13 herbelin Exp $ i*) + +(*********************************************************) +(* Definition of the limit *) +(* *) +(*********************************************************) + +Require Import Rbase. +Require Import Rfunctions. +Require Import Classical_Prop. +Require Import Fourier. Open Local Scope R_scope. + +(*******************************) +(* Calculus *) +(*******************************) +(*********) +Lemma eps2_Rgt_R0 : forall eps:R, eps > 0 -> eps * / 2 > 0. +intros; fourier. +Qed. + +(*********) +Lemma eps2 : forall eps:R, eps * / 2 + eps * / 2 = eps. +intro esp. +assert (H := double_var esp). +unfold Rdiv in H. +symmetry in |- *; exact H. +Qed. + +(*********) +Lemma eps4 : forall eps:R, eps * / (2 + 2) + eps * / (2 + 2) = eps * / 2. +intro eps. +replace (2 + 2) with 4. +pattern eps at 3 in |- *; rewrite double_var. +rewrite (Rmult_plus_distr_r (eps / 2) (eps / 2) (/ 2)). +unfold Rdiv in |- *. +repeat rewrite Rmult_assoc. +rewrite <- Rinv_mult_distr. +reflexivity. +discrR. +discrR. +ring. +Qed. + +(*********) +Lemma Rlt_eps2_eps : forall eps:R, eps > 0 -> eps * / 2 < eps. +intros. +pattern eps at 2 in |- *; rewrite <- Rmult_1_r. +repeat rewrite (Rmult_comm eps). +apply Rmult_lt_compat_r. +exact H. +apply Rmult_lt_reg_l with 2. +fourier. +rewrite Rmult_1_r; rewrite <- Rinv_r_sym. +fourier. +discrR. +Qed. + +(*********) +Lemma Rlt_eps4_eps : forall eps:R, eps > 0 -> eps * / (2 + 2) < eps. +intros. +replace (2 + 2) with 4. +pattern eps at 2 in |- *; rewrite <- Rmult_1_r. +repeat rewrite (Rmult_comm eps). +apply Rmult_lt_compat_r. +exact H. +apply Rmult_lt_reg_l with 4. +replace 4 with 4. +apply Rmult_lt_0_compat; fourier. +ring. +rewrite Rmult_1_r; rewrite <- Rinv_r_sym. +fourier. +discrR. +ring. +Qed. + +(*********) +Lemma prop_eps : forall r:R, (forall eps:R, eps > 0 -> r < eps) -> r <= 0. +intros; elim (Rtotal_order r 0); intro. +apply Rlt_le; assumption. +elim H0; intro. +apply Req_le; assumption. +clear H0; generalize (H r H1); intro; generalize (Rlt_irrefl r); intro; + elimtype False; auto. +Qed. + +(*********) +Definition mul_factor (l l':R) := / (1 + (Rabs l + Rabs l')). + +(*********) +Lemma mul_factor_wd : forall l l':R, 1 + (Rabs l + Rabs l') <> 0. +intros; rewrite (Rplus_comm 1 (Rabs l + Rabs l')); apply tech_Rplus. +cut (Rabs (l + l') <= Rabs l + Rabs l'). +cut (0 <= Rabs (l + l')). +exact (Rle_trans _ _ _). +exact (Rabs_pos (l + l')). +exact (Rabs_triang _ _). +exact Rlt_0_1. +Qed. + +(*********) +Lemma mul_factor_gt : forall eps l l':R, eps > 0 -> eps * mul_factor l l' > 0. +intros; unfold Rgt in |- *; rewrite <- (Rmult_0_r eps); + apply Rmult_lt_compat_l. +assumption. +unfold mul_factor in |- *; apply Rinv_0_lt_compat; + cut (1 <= 1 + (Rabs l + Rabs l')). +cut (0 < 1). +exact (Rlt_le_trans _ _ _). +exact Rlt_0_1. +replace (1 <= 1 + (Rabs l + Rabs l')) with (1 + 0 <= 1 + (Rabs l + Rabs l')). +apply Rplus_le_compat_l. +cut (Rabs (l + l') <= Rabs l + Rabs l'). +cut (0 <= Rabs (l + l')). +exact (Rle_trans _ _ _). +exact (Rabs_pos _). +exact (Rabs_triang _ _). +rewrite (proj1 (Rplus_ne 1)); trivial. +Qed. + +(*********) +Lemma mul_factor_gt_f : + forall eps l l':R, eps > 0 -> Rmin 1 (eps * mul_factor l l') > 0. +intros; apply Rmin_Rgt_r; split. +exact Rlt_0_1. +exact (mul_factor_gt eps l l' H). +Qed. + + +(*******************************) +(* Metric space *) +(*******************************) + +(*********) +Record Metric_Space : Type := + {Base : Type; + dist : Base -> Base -> R; + dist_pos : forall x y:Base, dist x y >= 0; + dist_sym : forall x y:Base, dist x y = dist y x; + dist_refl : forall x y:Base, dist x y = 0 <-> x = y; + dist_tri : forall x y z:Base, dist x y <= dist x z + dist z y}. + +(*******************************) +(* Limit in Metric space *) +(*******************************) + +(*********) +Definition limit_in (X X':Metric_Space) (f:Base X -> Base X') + (D:Base X -> Prop) (x0:Base X) (l:Base X') := + forall eps:R, + eps > 0 -> + exists alp : R, + alp > 0 /\ + (forall x:Base X, D x /\ dist X x x0 < alp -> dist X' (f x) l < eps). + +(*******************************) +(* R is a metric space *) +(*******************************) + +(*********) +Definition R_met : Metric_Space := + Build_Metric_Space R R_dist R_dist_pos R_dist_sym R_dist_refl R_dist_tri. + +(*******************************) +(* Limit 1 arg *) +(*******************************) +(*********) +Definition Dgf (Df Dg:R -> Prop) (f:R -> R) (x:R) := Df x /\ Dg (f x). + +(*********) +Definition limit1_in (f:R -> R) (D:R -> Prop) (l x0:R) : Prop := + limit_in R_met R_met f D x0 l. + +(*********) +Lemma tech_limit : + forall (f:R -> R) (D:R -> Prop) (l x0:R), + D x0 -> limit1_in f D l x0 -> l = f x0. +intros f D l x0 H H0. +case (Rabs_pos (f x0 - l)); intros H1. +absurd (dist R_met (f x0) l < dist R_met (f x0) l). +apply Rlt_irrefl. +case (H0 (dist R_met (f x0) l)); auto. +intros alpha1 [H2 H3]; apply H3; auto; split; auto. +case (dist_refl R_met x0 x0); intros Hr1 Hr2; rewrite Hr2; auto. +case (dist_refl R_met (f x0) l); intros Hr1 Hr2; apply sym_eq; auto. +Qed. + +(*********) +Lemma tech_limit_contr : + forall (f:R -> R) (D:R -> Prop) (l x0:R), + D x0 -> l <> f x0 -> ~ limit1_in f D l x0. +intros; generalize (tech_limit f D l x0); tauto. +Qed. + +(*********) +Lemma lim_x : forall (D:R -> Prop) (x0:R), limit1_in (fun x:R => x) D x0 x0. +unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros; + split with eps; split; auto; intros; elim H0; intros; + auto. +Qed. + +(*********) +Lemma limit_plus : + forall (f g:R -> R) (D:R -> Prop) (l l' x0:R), + limit1_in f D l x0 -> + limit1_in g D l' x0 -> limit1_in (fun x:R => f x + g x) D (l + l') x0. +intros; unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; + intros; elim (H (eps * / 2) (eps2_Rgt_R0 eps H1)); + elim (H0 (eps * / 2) (eps2_Rgt_R0 eps H1)); simpl in |- *; + clear H H0; intros; elim H; elim H0; clear H H0; intros; + split with (Rmin x1 x); split. +exact (Rmin_Rgt_r x1 x 0 (conj H H2)). +intros; elim H4; clear H4; intros; + cut (R_dist (f x2) l + R_dist (g x2) l' < eps). + cut (R_dist (f x2 + g x2) (l + l') <= R_dist (f x2) l + R_dist (g x2) l'). +exact (Rle_lt_trans _ _ _). +exact (R_dist_plus _ _ _ _). +elim (Rmin_Rgt_l x1 x (R_dist x2 x0) H5); clear H5; intros. +generalize (H3 x2 (conj H4 H6)); generalize (H0 x2 (conj H4 H5)); intros; + replace eps with (eps * / 2 + eps * / 2). +exact (Rplus_lt_compat _ _ _ _ H7 H8). +exact (eps2 eps). +Qed. + +(*********) +Lemma limit_Ropp : + forall (f:R -> R) (D:R -> Prop) (l x0:R), + limit1_in f D l x0 -> limit1_in (fun x:R => - f x) D (- l) x0. +unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros; + elim (H eps H0); clear H; intros; elim H; clear H; + intros; split with x; split; auto; intros; generalize (H1 x1 H2); + clear H1; intro; unfold R_dist in |- *; unfold Rminus in |- *; + rewrite (Ropp_involutive l); rewrite (Rplus_comm (- f x1) l); + fold (l - f x1) in |- *; fold (R_dist l (f x1)) in |- *; + rewrite R_dist_sym; assumption. +Qed. + +(*********) +Lemma limit_minus : + forall (f g:R -> R) (D:R -> Prop) (l l' x0:R), + limit1_in f D l x0 -> + limit1_in g D l' x0 -> limit1_in (fun x:R => f x - g x) D (l - l') x0. +intros; unfold Rminus in |- *; generalize (limit_Ropp g D l' x0 H0); intro; + exact (limit_plus f (fun x:R => - g x) D l (- l') x0 H H1). +Qed. + +(*********) +Lemma limit_free : + forall (f:R -> R) (D:R -> Prop) (x x0:R), + limit1_in (fun h:R => f x) D (f x) x0. +unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros; + split with eps; split; auto; intros; elim (R_dist_refl (f x) (f x)); + intros a b; rewrite (b (refl_equal (f x))); unfold Rgt in H; + assumption. +Qed. + +(*********) +Lemma limit_mul : + forall (f g:R -> R) (D:R -> Prop) (l l' x0:R), + limit1_in f D l x0 -> + limit1_in g D l' x0 -> limit1_in (fun x:R => f x * g x) D (l * l') x0. +intros; unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; + intros; + elim (H (Rmin 1 (eps * mul_factor l l')) (mul_factor_gt_f eps l l' H1)); + elim (H0 (eps * mul_factor l l') (mul_factor_gt eps l l' H1)); + clear H H0; simpl in |- *; intros; elim H; elim H0; + clear H H0; intros; split with (Rmin x1 x); split. +exact (Rmin_Rgt_r x1 x 0 (conj H H2)). +intros; elim H4; clear H4; intros; unfold R_dist in |- *; + replace (f x2 * g x2 - l * l') with (f x2 * (g x2 - l') + l' * (f x2 - l)). +cut (Rabs (f x2 * (g x2 - l')) + Rabs (l' * (f x2 - l)) < eps). +cut + (Rabs (f x2 * (g x2 - l') + l' * (f x2 - l)) <= + Rabs (f x2 * (g x2 - l')) + Rabs (l' * (f x2 - l))). +exact (Rle_lt_trans _ _ _). +exact (Rabs_triang _ _). +rewrite (Rabs_mult (f x2) (g x2 - l')); rewrite (Rabs_mult l' (f x2 - l)); + cut + ((1 + Rabs l) * (eps * mul_factor l l') + Rabs l' * (eps * mul_factor l l') <= + eps). +cut + (Rabs (f x2) * Rabs (g x2 - l') + Rabs l' * Rabs (f x2 - l) < + (1 + Rabs l) * (eps * mul_factor l l') + Rabs l' * (eps * mul_factor l l')). +exact (Rlt_le_trans _ _ _). +elim (Rmin_Rgt_l x1 x (R_dist x2 x0) H5); clear H5; intros; + generalize (H0 x2 (conj H4 H5)); intro; generalize (Rmin_Rgt_l _ _ _ H7); + intro; elim H8; intros; clear H0 H8; apply Rplus_lt_le_compat. +apply Rmult_ge_0_gt_0_lt_compat. +apply Rle_ge. +exact (Rabs_pos (g x2 - l')). +rewrite (Rplus_comm 1 (Rabs l)); unfold Rgt in |- *; apply Rle_lt_0_plus_1; + exact (Rabs_pos l). +unfold R_dist in H9; + apply (Rplus_lt_reg_r (- Rabs l) (Rabs (f x2)) (1 + Rabs l)). +rewrite <- (Rplus_assoc (- Rabs l) 1 (Rabs l)); + rewrite (Rplus_comm (- Rabs l) 1); + rewrite (Rplus_assoc 1 (- Rabs l) (Rabs l)); rewrite (Rplus_opp_l (Rabs l)); + rewrite (proj1 (Rplus_ne 1)); rewrite (Rplus_comm (- Rabs l) (Rabs (f x2))); + generalize H9; cut (Rabs (f x2) - Rabs l <= Rabs (f x2 - l)). +exact (Rle_lt_trans _ _ _). +exact (Rabs_triang_inv _ _). +generalize (H3 x2 (conj H4 H6)); trivial. +apply Rmult_le_compat_l. +exact (Rabs_pos l'). +unfold Rle in |- *; left; assumption. +rewrite (Rmult_comm (1 + Rabs l) (eps * mul_factor l l')); + rewrite (Rmult_comm (Rabs l') (eps * mul_factor l l')); + rewrite <- + (Rmult_plus_distr_l (eps * mul_factor l l') (1 + Rabs l) (Rabs l')) + ; rewrite (Rmult_assoc eps (mul_factor l l') (1 + Rabs l + Rabs l')); + rewrite (Rplus_assoc 1 (Rabs l) (Rabs l')); unfold mul_factor in |- *; + rewrite (Rinv_l (1 + (Rabs l + Rabs l')) (mul_factor_wd l l')); + rewrite (proj1 (Rmult_ne eps)); apply Req_le; trivial. +ring. +Qed. + +(*********) +Definition adhDa (D:R -> Prop) (a:R) : Prop := + forall alp:R, alp > 0 -> exists x : R, D x /\ R_dist x a < alp. + +(*********) +Lemma single_limit : + forall (f:R -> R) (D:R -> Prop) (l l' x0:R), + adhDa D x0 -> limit1_in f D l x0 -> limit1_in f D l' x0 -> l = l'. +unfold limit1_in in |- *; unfold limit_in in |- *; intros. +cut (forall eps:R, eps > 0 -> dist R_met l l' < 2 * eps). +clear H0 H1; unfold dist in |- *; unfold R_met in |- *; unfold R_dist in |- *; + unfold Rabs in |- *; case (Rcase_abs (l - l')); intros. +cut (forall eps:R, eps > 0 -> - (l - l') < eps). +intro; generalize (prop_eps (- (l - l')) H1); intro; + generalize (Ropp_gt_lt_0_contravar (l - l') r); intro; + unfold Rgt in H3; generalize (Rgt_not_le (- (l - l')) 0 H3); + intro; elimtype False; auto. +intros; cut (eps * / 2 > 0). +intro; generalize (H0 (eps * / 2) H2); rewrite (Rmult_comm eps (/ 2)); + rewrite <- (Rmult_assoc 2 (/ 2) eps); rewrite (Rinv_r 2). +elim (Rmult_ne eps); intros a b; rewrite b; clear a b; trivial. +apply (Rlt_dichotomy_converse 2 0); right; generalize Rlt_0_1; intro; + unfold Rgt in |- *; generalize (Rplus_lt_compat_l 1 0 1 H3); + intro; elim (Rplus_ne 1); intros a b; rewrite a in H4; + clear a b; apply (Rlt_trans 0 1 2 H3 H4). +unfold Rgt in |- *; unfold Rgt in H1; rewrite (Rmult_comm eps (/ 2)); + rewrite <- (Rmult_0_r (/ 2)); apply (Rmult_lt_compat_l (/ 2) 0 eps); + auto. +apply (Rinv_0_lt_compat 2); cut (1 < 2). +intro; apply (Rlt_trans 0 1 2 Rlt_0_1 H2). +generalize (Rplus_lt_compat_l 1 0 1 Rlt_0_1); elim (Rplus_ne 1); intros a b; + rewrite a; clear a b; trivial. +(**) +cut (forall eps:R, eps > 0 -> l - l' < eps). +intro; generalize (prop_eps (l - l') H1); intro; elim (Rle_le_eq (l - l') 0); + intros a b; clear b; apply (Rminus_diag_uniq l l'); + apply a; split. +assumption. +apply (Rge_le (l - l') 0 r). +intros; cut (eps * / 2 > 0). +intro; generalize (H0 (eps * / 2) H2); rewrite (Rmult_comm eps (/ 2)); + rewrite <- (Rmult_assoc 2 (/ 2) eps); rewrite (Rinv_r 2). +elim (Rmult_ne eps); intros a b; rewrite b; clear a b; trivial. +apply (Rlt_dichotomy_converse 2 0); right; generalize Rlt_0_1; intro; + unfold Rgt in |- *; generalize (Rplus_lt_compat_l 1 0 1 H3); + intro; elim (Rplus_ne 1); intros a b; rewrite a in H4; + clear a b; apply (Rlt_trans 0 1 2 H3 H4). +unfold Rgt in |- *; unfold Rgt in H1; rewrite (Rmult_comm eps (/ 2)); + rewrite <- (Rmult_0_r (/ 2)); apply (Rmult_lt_compat_l (/ 2) 0 eps); + auto. +apply (Rinv_0_lt_compat 2); cut (1 < 2). +intro; apply (Rlt_trans 0 1 2 Rlt_0_1 H2). +generalize (Rplus_lt_compat_l 1 0 1 Rlt_0_1); elim (Rplus_ne 1); intros a b; + rewrite a; clear a b; trivial. +(**) +intros; unfold adhDa in H; elim (H0 eps H2); intros; elim (H1 eps H2); intros; + clear H0 H1; elim H3; elim H4; clear H3 H4; intros; + simpl in |- *; simpl in H1, H4; generalize (Rmin_Rgt x x1 0); + intro; elim H5; intros; clear H5; elim (H (Rmin x x1) (H7 (conj H3 H0))); + intros; elim H5; intros; clear H5 H H6 H7; + generalize (Rmin_Rgt x x1 (R_dist x2 x0)); intro; + elim H; intros; clear H H6; unfold Rgt in H5; elim (H5 H9); + intros; clear H5 H9; generalize (H1 x2 (conj H8 H6)); + generalize (H4 x2 (conj H8 H)); clear H8 H H6 H1 H4 H0 H3; + intros; + generalize + (Rplus_lt_compat (R_dist (f x2) l) eps (R_dist (f x2) l') eps H H0); + unfold R_dist in |- *; intros; rewrite (Rabs_minus_sym (f x2) l) in H1; + rewrite (Rmult_comm 2 eps); rewrite (Rmult_plus_distr_l eps 1 1); + elim (Rmult_ne eps); intros a b; rewrite a; clear a b; + generalize (R_dist_tri l l' (f x2)); unfold R_dist in |- *; + intros; + apply + (Rle_lt_trans (Rabs (l - l')) (Rabs (l - f x2) + Rabs (f x2 - l')) + (eps + eps) H3 H1). +Qed. + +(*********) +Lemma limit_comp : + forall (f g:R -> R) (Df Dg:R -> Prop) (l l' x0:R), + limit1_in f Df l x0 -> + limit1_in g Dg l' l -> limit1_in (fun x:R => g (f x)) (Dgf Df Dg f) l' x0. +unfold limit1_in, limit_in, Dgf in |- *; simpl in |- *. +intros f g Df Dg l l' x0 Hf Hg eps eps_pos. +elim (Hg eps eps_pos). +intros alpg lg. +elim (Hf alpg). +2: tauto. +intros alpf lf. +exists alpf. +intuition. +Qed. + +(*********) + +Lemma limit_inv : + forall (f:R -> R) (D:R -> Prop) (l x0:R), + limit1_in f D l x0 -> l <> 0 -> limit1_in (fun x:R => / f x) D (/ l) x0. +unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; + unfold R_dist in |- *; intros; elim (H (Rabs l / 2)). +intros delta1 H2; elim (H (eps * (Rsqr l / 2))). +intros delta2 H3; elim H2; elim H3; intros; exists (Rmin delta1 delta2); + split. +unfold Rmin in |- *; case (Rle_dec delta1 delta2); intro; assumption. +intro; generalize (H5 x); clear H5; intro H5; generalize (H7 x); clear H7; + intro H7; intro H10; elim H10; intros; cut (D x /\ Rabs (x - x0) < delta1). +cut (D x /\ Rabs (x - x0) < delta2). +intros; generalize (H5 H11); clear H5; intro H5; generalize (H7 H12); + clear H7; intro H7; generalize (Rabs_triang_inv l (f x)); + intro; rewrite Rabs_minus_sym in H7; + generalize + (Rle_lt_trans (Rabs l - Rabs (f x)) (Rabs (l - f x)) (Rabs l / 2) H13 H7); + intro; + generalize + (Rplus_lt_compat_l (Rabs (f x) - Rabs l / 2) (Rabs l - Rabs (f x)) + (Rabs l / 2) H14); + replace (Rabs (f x) - Rabs l / 2 + (Rabs l - Rabs (f x))) with (Rabs l / 2). +unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_l; + rewrite Rplus_0_r; intro; cut (f x <> 0). +intro; replace (/ f x + - / l) with ((l - f x) * / (l * f x)). +rewrite Rabs_mult; rewrite Rabs_Rinv. +cut (/ Rabs (l * f x) < 2 / Rsqr l). +intro; rewrite Rabs_minus_sym in H5; cut (0 <= / Rabs (l * f x)). +intro; + generalize + (Rmult_le_0_lt_compat (Rabs (l - f x)) (eps * (Rsqr l / 2)) + (/ Rabs (l * f x)) (2 / Rsqr l) (Rabs_pos (l - f x)) H18 H5 H17); + replace (eps * (Rsqr l / 2) * (2 / Rsqr l)) with eps. +intro; assumption. +unfold Rdiv in |- *; unfold Rsqr in |- *; rewrite Rinv_mult_distr. +repeat rewrite Rmult_assoc. +rewrite (Rmult_comm l). +repeat rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +rewrite (Rmult_comm l). +repeat rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; reflexivity. +discrR. +exact H0. +exact H0. +exact H0. +exact H0. +left; apply Rinv_0_lt_compat; apply Rabs_pos_lt; apply prod_neq_R0; + assumption. +rewrite Rmult_comm; rewrite Rabs_mult; rewrite Rinv_mult_distr. +rewrite (Rsqr_abs l); unfold Rsqr in |- *; unfold Rdiv in |- *; + rewrite Rinv_mult_distr. +repeat rewrite <- Rmult_assoc; apply Rmult_lt_compat_r. +apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. +apply Rmult_lt_reg_l with (Rabs (f x) * Rabs l * / 2). +repeat apply Rmult_lt_0_compat. +apply Rabs_pos_lt; assumption. +apply Rabs_pos_lt; assumption. +apply Rinv_0_lt_compat; cut (0%nat <> 2%nat); + [ intro H17; generalize (lt_INR_0 2 (neq_O_lt 2 H17)); unfold INR in |- *; + intro H18; assumption + | discriminate ]. +replace (Rabs (f x) * Rabs l * / 2 * / Rabs (f x)) with (Rabs l / 2). +replace (Rabs (f x) * Rabs l * / 2 * (2 * / Rabs l)) with (Rabs (f x)). +assumption. +repeat rewrite Rmult_assoc. +rewrite (Rmult_comm (Rabs l)). +repeat rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; reflexivity. +discrR. +apply Rabs_no_R0. +assumption. +unfold Rdiv in |- *. +repeat rewrite Rmult_assoc. +rewrite (Rmult_comm (Rabs (f x))). +repeat rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +reflexivity. +apply Rabs_no_R0; assumption. +apply Rabs_no_R0; assumption. +apply Rabs_no_R0; assumption. +apply Rabs_no_R0; assumption. +apply Rabs_no_R0; assumption. +apply prod_neq_R0; assumption. +rewrite (Rinv_mult_distr _ _ H0 H16). +unfold Rminus in |- *; rewrite Rmult_plus_distr_r. +rewrite <- Rmult_assoc. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_l. +rewrite Ropp_mult_distr_l_reverse. +rewrite (Rmult_comm (f x)). +rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +reflexivity. +assumption. +assumption. +red in |- *; intro; rewrite H16 in H15; rewrite Rabs_R0 in H15; + cut (0 < Rabs l / 2). +intro; elim (Rlt_irrefl 0 (Rlt_trans 0 (Rabs l / 2) 0 H17 H15)). +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +apply Rabs_pos_lt; assumption. +apply Rinv_0_lt_compat; cut (0%nat <> 2%nat); + [ intro H17; generalize (lt_INR_0 2 (neq_O_lt 2 H17)); unfold INR in |- *; + intro; assumption + | discriminate ]. +pattern (Rabs l) at 3 in |- *; rewrite double_var. +ring. +split; + [ assumption + | apply Rlt_le_trans with (Rmin delta1 delta2); + [ assumption | apply Rmin_r ] ]. +split; + [ assumption + | apply Rlt_le_trans with (Rmin delta1 delta2); + [ assumption | apply Rmin_l ] ]. +change (0 < eps * (Rsqr l / 2)) in |- *; unfold Rdiv in |- *; + repeat rewrite Rmult_assoc; repeat apply Rmult_lt_0_compat. +assumption. +apply Rsqr_pos_lt; assumption. +apply Rinv_0_lt_compat; cut (0%nat <> 2%nat); + [ intro H3; generalize (lt_INR_0 2 (neq_O_lt 2 H3)); unfold INR in |- *; + intro; assumption + | discriminate ]. +change (0 < Rabs l / 2) in |- *; unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply Rabs_pos_lt; assumption + | apply Rinv_0_lt_compat; cut (0%nat <> 2%nat); + [ intro H3; generalize (lt_INR_0 2 (neq_O_lt 2 H3)); unfold INR in |- *; + intro; assumption + | discriminate ] ]. +Qed. diff --git a/theories/Reals/Rpower.v b/theories/Reals/Rpower.v new file mode 100644 index 00000000..7575d929 --- /dev/null +++ b/theories/Reals/Rpower.v @@ -0,0 +1,661 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Rpower.v,v 1.17.2.1 2004/07/16 19:31:13 herbelin Exp $ i*) +(*i Due to L.Thery i*) + +(************************************************************) +(* Definitions of log and Rpower : R->R->R; main properties *) +(************************************************************) + +Require Import Rbase. +Require Import Rfunctions. +Require Import SeqSeries. +Require Import Rtrigo. +Require Import Ranalysis1. +Require Import Exp_prop. +Require Import Rsqrt_def. +Require Import R_sqrt. +Require Import MVT. +Require Import Ranalysis4. Open Local Scope R_scope. + +Lemma P_Rmin : forall (P:R -> Prop) (x y:R), P x -> P y -> P (Rmin x y). +intros P x y H1 H2; unfold Rmin in |- *; case (Rle_dec x y); intro; + assumption. +Qed. + +Lemma exp_le_3 : exp 1 <= 3. +assert (exp_1 : exp 1 <> 0). +assert (H0 := exp_pos 1); red in |- *; intro; rewrite H in H0; + elim (Rlt_irrefl _ H0). +apply Rmult_le_reg_l with (/ exp 1). +apply Rinv_0_lt_compat; apply exp_pos. +rewrite <- Rinv_l_sym. +apply Rmult_le_reg_l with (/ 3). +apply Rinv_0_lt_compat; prove_sup0. +rewrite Rmult_1_r; rewrite <- (Rmult_comm 3); rewrite <- Rmult_assoc; + rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; replace (/ exp 1) with (exp (-1)). +unfold exp in |- *; case (exist_exp (-1)); intros; simpl in |- *; + unfold exp_in in e; + assert (H := alternated_series_ineq (fun i:nat => / INR (fact i)) x 1). +cut + (sum_f_R0 (tg_alt (fun i:nat => / INR (fact i))) (S (2 * 1)) <= x <= + sum_f_R0 (tg_alt (fun i:nat => / INR (fact i))) (2 * 1)). +intro; elim H0; clear H0; intros H0 _; simpl in H0; unfold tg_alt in H0; + simpl in H0. +replace (/ 3) with + (1 * / 1 + -1 * 1 * / 1 + -1 * (-1 * 1) * / 2 + + -1 * (-1 * (-1 * 1)) * / (2 + 1 + 1 + 1 + 1)). +apply H0. +repeat rewrite Rinv_1; repeat rewrite Rmult_1_r; + rewrite Ropp_mult_distr_l_reverse; rewrite Rmult_1_l; + rewrite Ropp_involutive; rewrite Rplus_opp_r; rewrite Rmult_1_r; + rewrite Rplus_0_l; rewrite Rmult_1_l; apply Rmult_eq_reg_l with 6. +rewrite Rmult_plus_distr_l; replace (2 + 1 + 1 + 1 + 1) with 6. +rewrite <- (Rmult_comm (/ 6)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. +rewrite Rmult_1_l; replace 6 with 6. +do 2 rewrite Rmult_assoc; rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; rewrite (Rmult_comm 3); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym. +ring. +discrR. +discrR. +ring. +discrR. +ring. +discrR. +apply H. +unfold Un_decreasing in |- *; intros; + apply Rmult_le_reg_l with (INR (fact n)). +apply INR_fact_lt_0. +apply Rmult_le_reg_l with (INR (fact (S n))). +apply INR_fact_lt_0. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; rewrite Rmult_comm; rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; apply le_INR; apply fact_le; apply le_n_Sn. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +assert (H0 := cv_speed_pow_fact 1); unfold Un_cv in |- *; unfold Un_cv in H0; + intros; elim (H0 _ H1); intros; exists x0; intros; + unfold R_dist in H2; unfold R_dist in |- *; + replace (/ INR (fact n)) with (1 ^ n / INR (fact n)). +apply (H2 _ H3). +unfold Rdiv in |- *; rewrite pow1; rewrite Rmult_1_l; reflexivity. +unfold infinit_sum in e; unfold Un_cv, tg_alt in |- *; intros; elim (e _ H0); + intros; exists x0; intros; + replace (sum_f_R0 (fun i:nat => (-1) ^ i * / INR (fact i)) n) with + (sum_f_R0 (fun i:nat => / INR (fact i) * (-1) ^ i) n). +apply (H1 _ H2). +apply sum_eq; intros; apply Rmult_comm. +apply Rmult_eq_reg_l with (exp 1). +rewrite <- exp_plus; rewrite Rplus_opp_r; rewrite exp_0; + rewrite <- Rinv_r_sym. +reflexivity. +assumption. +assumption. +discrR. +assumption. +Qed. + +(******************************************************************) +(* Properties of Exp *) +(******************************************************************) + +Theorem exp_increasing : forall x y:R, x < y -> exp x < exp y. +intros x y H. +assert (H0 : derivable exp). +apply derivable_exp. +assert (H1 := positive_derivative _ H0). +unfold strict_increasing in H1. +apply H1. +intro. +replace (derive_pt exp x0 (H0 x0)) with (exp x0). +apply exp_pos. +symmetry in |- *; apply derive_pt_eq_0. +apply (derivable_pt_lim_exp x0). +apply H. +Qed. + +Theorem exp_lt_inv : forall x y:R, exp x < exp y -> x < y. +intros x y H; case (Rtotal_order x y); [ intros H1 | intros [H1| H1] ]. +assumption. +rewrite H1 in H; elim (Rlt_irrefl _ H). +assert (H2 := exp_increasing _ _ H1). +elim (Rlt_irrefl _ (Rlt_trans _ _ _ H H2)). +Qed. + +Lemma exp_ineq1 : forall x:R, 0 < x -> 1 + x < exp x. +intros; apply Rplus_lt_reg_r with (- exp 0); rewrite <- (Rplus_comm (exp x)); + assert (H0 := MVT_cor1 exp 0 x derivable_exp H); elim H0; + intros; elim H1; intros; unfold Rminus in H2; rewrite H2; + rewrite Ropp_0; rewrite Rplus_0_r; + replace (derive_pt exp x0 (derivable_exp x0)) with (exp x0). +rewrite exp_0; rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; + pattern x at 1 in |- *; rewrite <- Rmult_1_r; rewrite (Rmult_comm (exp x0)); + apply Rmult_lt_compat_l. +apply H. +rewrite <- exp_0; apply exp_increasing; elim H3; intros; assumption. +symmetry in |- *; apply derive_pt_eq_0; apply derivable_pt_lim_exp. +Qed. + +Lemma ln_exists1 : forall y:R, 0 < y -> 1 <= y -> sigT (fun z:R => y = exp z). +intros; set (f := fun x:R => exp x - y); cut (f 0 <= 0). +intro; cut (continuity f). +intro; cut (0 <= f y). +intro; cut (f 0 * f y <= 0). +intro; assert (X := IVT_cor f 0 y H2 (Rlt_le _ _ H) H4); elim X; intros t H5; + apply existT with t; elim H5; intros; unfold f in H7; + apply Rminus_diag_uniq_sym; exact H7. +pattern 0 at 2 in |- *; rewrite <- (Rmult_0_r (f y)); + rewrite (Rmult_comm (f 0)); apply Rmult_le_compat_l; + assumption. +unfold f in |- *; apply Rplus_le_reg_l with y; left; + apply Rlt_trans with (1 + y). +rewrite <- (Rplus_comm y); apply Rplus_lt_compat_l; apply Rlt_0_1. +replace (y + (exp y - y)) with (exp y); [ apply (exp_ineq1 y H) | ring ]. +unfold f in |- *; change (continuity (exp - fct_cte y)) in |- *; + apply continuity_minus; + [ apply derivable_continuous; apply derivable_exp + | apply derivable_continuous; apply derivable_const ]. +unfold f in |- *; rewrite exp_0; apply Rplus_le_reg_l with y; + rewrite Rplus_0_r; replace (y + (1 - y)) with 1; [ apply H0 | ring ]. +Qed. + +(**********) +Lemma ln_exists : forall y:R, 0 < y -> sigT (fun z:R => y = exp z). +intros; case (Rle_dec 1 y); intro. +apply (ln_exists1 _ H r). +assert (H0 : 1 <= / y). +apply Rmult_le_reg_l with y. +apply H. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; left; apply (Rnot_le_lt _ _ n). +red in |- *; intro; rewrite H0 in H; elim (Rlt_irrefl _ H). +assert (H1 : 0 < / y). +apply Rinv_0_lt_compat; apply H. +assert (H2 := ln_exists1 _ H1 H0); elim H2; intros; apply existT with (- x); + apply Rmult_eq_reg_l with (exp x / y). +unfold Rdiv in |- *; rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; rewrite <- (Rmult_comm (/ y)); rewrite Rmult_assoc; + rewrite <- exp_plus; rewrite Rplus_opp_r; rewrite exp_0; + rewrite Rmult_1_r; symmetry in |- *; apply p. +red in |- *; intro; rewrite H3 in H; elim (Rlt_irrefl _ H). +unfold Rdiv in |- *; apply prod_neq_R0. +assert (H3 := exp_pos x); red in |- *; intro; rewrite H4 in H3; + elim (Rlt_irrefl _ H3). +apply Rinv_neq_0_compat; red in |- *; intro; rewrite H3 in H; + elim (Rlt_irrefl _ H). +Qed. + +(* Definition of log R+* -> R *) +Definition Rln (y:posreal) : R := + match ln_exists (pos y) (cond_pos y) with + | existT a b => a + end. + +(* Extension on R *) +Definition ln (x:R) : R := + match Rlt_dec 0 x with + | left a => Rln (mkposreal x a) + | right a => 0 + end. + +Lemma exp_ln : forall x:R, 0 < x -> exp (ln x) = x. +intros; unfold ln in |- *; case (Rlt_dec 0 x); intro. +unfold Rln in |- *; + case (ln_exists (mkposreal x r) (cond_pos (mkposreal x r))); + intros. +simpl in e; symmetry in |- *; apply e. +elim n; apply H. +Qed. + +Theorem exp_inv : forall x y:R, exp x = exp y -> x = y. +intros x y H; case (Rtotal_order x y); [ intros H1 | intros [H1| H1] ]; auto; + assert (H2 := exp_increasing _ _ H1); rewrite H in H2; + elim (Rlt_irrefl _ H2). +Qed. + +Theorem exp_Ropp : forall x:R, exp (- x) = / exp x. +intros x; assert (H : exp x <> 0). +assert (H := exp_pos x); red in |- *; intro; rewrite H0 in H; + elim (Rlt_irrefl _ H). +apply Rmult_eq_reg_l with (r := exp x). +rewrite <- exp_plus; rewrite Rplus_opp_r; rewrite exp_0. +apply Rinv_r_sym. +apply H. +apply H. +Qed. + +(******************************************************************) +(* Properties of Ln *) +(******************************************************************) + +Theorem ln_increasing : forall x y:R, 0 < x -> x < y -> ln x < ln y. +intros x y H H0; apply exp_lt_inv. +repeat rewrite exp_ln. +apply H0. +apply Rlt_trans with x; assumption. +apply H. +Qed. + +Theorem ln_exp : forall x:R, ln (exp x) = x. +intros x; apply exp_inv. +apply exp_ln. +apply exp_pos. +Qed. + +Theorem ln_1 : ln 1 = 0. +rewrite <- exp_0; rewrite ln_exp; reflexivity. +Qed. + +Theorem ln_lt_inv : forall x y:R, 0 < x -> 0 < y -> ln x < ln y -> x < y. +intros x y H H0 H1; rewrite <- (exp_ln x); try rewrite <- (exp_ln y). +apply exp_increasing; apply H1. +assumption. +assumption. +Qed. + +Theorem ln_inv : forall x y:R, 0 < x -> 0 < y -> ln x = ln y -> x = y. +intros x y H H0 H'0; case (Rtotal_order x y); [ intros H1 | intros [H1| H1] ]; + auto. +assert (H2 := ln_increasing _ _ H H1); rewrite H'0 in H2; + elim (Rlt_irrefl _ H2). +assert (H2 := ln_increasing _ _ H0 H1); rewrite H'0 in H2; + elim (Rlt_irrefl _ H2). +Qed. + +Theorem ln_mult : forall x y:R, 0 < x -> 0 < y -> ln (x * y) = ln x + ln y. +intros x y H H0; apply exp_inv. +rewrite exp_plus. +repeat rewrite exp_ln. +reflexivity. +assumption. +assumption. +apply Rmult_lt_0_compat; assumption. +Qed. + +Theorem ln_Rinv : forall x:R, 0 < x -> ln (/ x) = - ln x. +intros x H; apply exp_inv; repeat rewrite exp_ln || rewrite exp_Ropp. +reflexivity. +assumption. +apply Rinv_0_lt_compat; assumption. +Qed. + +Theorem ln_continue : + forall y:R, 0 < y -> continue_in ln (fun x:R => 0 < x) y. +intros y H. +unfold continue_in, limit1_in, limit_in in |- *; intros eps Heps. +cut (1 < exp eps); [ intros H1 | idtac ]. +cut (exp (- eps) < 1); [ intros H2 | idtac ]. +exists (Rmin (y * (exp eps - 1)) (y * (1 - exp (- eps)))); split. +red in |- *; apply P_Rmin. +apply Rmult_lt_0_compat. +assumption. +apply Rplus_lt_reg_r with 1. +rewrite Rplus_0_r; replace (1 + (exp eps - 1)) with (exp eps); + [ apply H1 | ring ]. +apply Rmult_lt_0_compat. +assumption. +apply Rplus_lt_reg_r with (exp (- eps)). +rewrite Rplus_0_r; replace (exp (- eps) + (1 - exp (- eps))) with 1; + [ apply H2 | ring ]. +unfold dist, R_met, R_dist in |- *; simpl in |- *. +intros x [[H3 H4] H5]. +cut (y * (x * / y) = x). +intro Hxyy. +replace (ln x - ln y) with (ln (x * / y)). +case (Rtotal_order x y); [ intros Hxy | intros [Hxy| Hxy] ]. +rewrite Rabs_left. +apply Ropp_lt_cancel; rewrite Ropp_involutive. +apply exp_lt_inv. +rewrite exp_ln. +apply Rmult_lt_reg_l with (r := y). +apply H. +rewrite Hxyy. +apply Ropp_lt_cancel. +apply Rplus_lt_reg_r with (r := y). +replace (y + - (y * exp (- eps))) with (y * (1 - exp (- eps))); + [ idtac | ring ]. +replace (y + - x) with (Rabs (x - y)); [ idtac | ring ]. +apply Rlt_le_trans with (1 := H5); apply Rmin_r. +rewrite Rabs_left; [ ring | idtac ]. +apply (Rlt_minus _ _ Hxy). +apply Rmult_lt_0_compat; [ apply H3 | apply (Rinv_0_lt_compat _ H) ]. +rewrite <- ln_1. +apply ln_increasing. +apply Rmult_lt_0_compat; [ apply H3 | apply (Rinv_0_lt_compat _ H) ]. +apply Rmult_lt_reg_l with (r := y). +apply H. +rewrite Hxyy; rewrite Rmult_1_r; apply Hxy. +rewrite Hxy; rewrite Rinv_r. +rewrite ln_1; rewrite Rabs_R0; apply Heps. +red in |- *; intro; rewrite H0 in H; elim (Rlt_irrefl _ H). +rewrite Rabs_right. +apply exp_lt_inv. +rewrite exp_ln. +apply Rmult_lt_reg_l with (r := y). +apply H. +rewrite Hxyy. +apply Rplus_lt_reg_r with (r := - y). +replace (- y + y * exp eps) with (y * (exp eps - 1)); [ idtac | ring ]. +replace (- y + x) with (Rabs (x - y)); [ idtac | ring ]. +apply Rlt_le_trans with (1 := H5); apply Rmin_l. +rewrite Rabs_right; [ ring | idtac ]. +left; apply (Rgt_minus _ _ Hxy). +apply Rmult_lt_0_compat; [ apply H3 | apply (Rinv_0_lt_compat _ H) ]. +rewrite <- ln_1. +apply Rgt_ge; red in |- *; apply ln_increasing. +apply Rlt_0_1. +apply Rmult_lt_reg_l with (r := y). +apply H. +rewrite Hxyy; rewrite Rmult_1_r; apply Hxy. +rewrite ln_mult. +rewrite ln_Rinv. +ring. +assumption. +assumption. +apply Rinv_0_lt_compat; assumption. +rewrite (Rmult_comm x); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. +ring. +red in |- *; intro; rewrite H0 in H; elim (Rlt_irrefl _ H). +apply Rmult_lt_reg_l with (exp eps). +apply exp_pos. +rewrite <- exp_plus; rewrite Rmult_1_r; rewrite Rplus_opp_r; rewrite exp_0; + apply H1. +rewrite <- exp_0. +apply exp_increasing; apply Heps. +Qed. + +(******************************************************************) +(* Definition of Rpower *) +(******************************************************************) + +Definition Rpower (x y:R) := exp (y * ln x). + +Infix Local "^R" := Rpower (at level 30, right associativity) : R_scope. + +(******************************************************************) +(* Properties of Rpower *) +(******************************************************************) + +Theorem Rpower_plus : forall x y z:R, z ^R (x + y) = z ^R x * z ^R y. +intros x y z; unfold Rpower in |- *. +rewrite Rmult_plus_distr_r; rewrite exp_plus; auto. +Qed. + +Theorem Rpower_mult : forall x y z:R, (x ^R y) ^R z = x ^R (y * z). +intros x y z; unfold Rpower in |- *. +rewrite ln_exp. +replace (z * (y * ln x)) with (y * z * ln x). +reflexivity. +ring. +Qed. + +Theorem Rpower_O : forall x:R, 0 < x -> x ^R 0 = 1. +intros x H; unfold Rpower in |- *. +rewrite Rmult_0_l; apply exp_0. +Qed. + +Theorem Rpower_1 : forall x:R, 0 < x -> x ^R 1 = x. +intros x H; unfold Rpower in |- *. +rewrite Rmult_1_l; apply exp_ln; apply H. +Qed. + +Theorem Rpower_pow : forall (n:nat) (x:R), 0 < x -> x ^R INR n = x ^ n. +intros n; elim n; simpl in |- *; auto; fold INR in |- *. +intros x H; apply Rpower_O; auto. +intros n1; case n1. +intros H x H0; simpl in |- *; rewrite Rmult_1_r; apply Rpower_1; auto. +intros n0 H x H0; rewrite Rpower_plus; rewrite H; try rewrite Rpower_1; + try apply Rmult_comm || assumption. +Qed. + +Theorem Rpower_lt : + forall x y z:R, 1 < x -> 0 <= y -> y < z -> x ^R y < x ^R z. +intros x y z H H0 H1. +unfold Rpower in |- *. +apply exp_increasing. +apply Rmult_lt_compat_r. +rewrite <- ln_1; apply ln_increasing. +apply Rlt_0_1. +apply H. +apply H1. +Qed. + +Theorem Rpower_sqrt : forall x:R, 0 < x -> x ^R (/ 2) = sqrt x. +intros x H. +apply ln_inv. +unfold Rpower in |- *; apply exp_pos. +apply sqrt_lt_R0; apply H. +apply Rmult_eq_reg_l with (INR 2). +apply exp_inv. +fold Rpower in |- *. +cut ((x ^R (/ 2)) ^R INR 2 = sqrt x ^R INR 2). +unfold Rpower in |- *; auto. +rewrite Rpower_mult. +rewrite Rinv_l. +replace 1 with (INR 1); auto. +repeat rewrite Rpower_pow; simpl in |- *. +pattern x at 1 in |- *; rewrite <- (sqrt_sqrt x (Rlt_le _ _ H)). +ring. +apply sqrt_lt_R0; apply H. +apply H. +apply not_O_INR; discriminate. +apply not_O_INR; discriminate. +Qed. + +Theorem Rpower_Ropp : forall x y:R, x ^R (- y) = / x ^R y. +unfold Rpower in |- *. +intros x y; rewrite Ropp_mult_distr_l_reverse. +apply exp_Ropp. +Qed. + +Theorem Rle_Rpower : + forall e n m:R, 1 < e -> 0 <= n -> n <= m -> e ^R n <= e ^R m. +intros e n m H H0 H1; case H1. +intros H2; left; apply Rpower_lt; assumption. +intros H2; rewrite H2; right; reflexivity. +Qed. + +Theorem ln_lt_2 : / 2 < ln 2. +apply Rmult_lt_reg_l with (r := 2). +prove_sup0. +rewrite Rinv_r. +apply exp_lt_inv. +apply Rle_lt_trans with (1 := exp_le_3). +change (3 < 2 ^R 2) in |- *. +repeat rewrite Rpower_plus; repeat rewrite Rpower_1. +repeat rewrite Rmult_plus_distr_r; repeat rewrite Rmult_plus_distr_l; + repeat rewrite Rmult_1_l. +pattern 3 at 1 in |- *; rewrite <- Rplus_0_r; replace (2 + 2) with (3 + 1); + [ apply Rplus_lt_compat_l; apply Rlt_0_1 | ring ]. +prove_sup0. +discrR. +Qed. + +(**************************************) +(* Differentiability of Ln and Rpower *) +(**************************************) + +Theorem limit1_ext : + forall (f g:R -> R) (D:R -> Prop) (l x:R), + (forall x:R, D x -> f x = g x) -> limit1_in f D l x -> limit1_in g D l x. +intros f g D l x H; unfold limit1_in, limit_in in |- *. +intros H0 eps H1; case (H0 eps); auto. +intros x0 [H2 H3]; exists x0; split; auto. +intros x1 [H4 H5]; rewrite <- H; auto. +Qed. + +Theorem limit1_imp : + forall (f:R -> R) (D D1:R -> Prop) (l x:R), + (forall x:R, D1 x -> D x) -> limit1_in f D l x -> limit1_in f D1 l x. +intros f D D1 l x H; unfold limit1_in, limit_in in |- *. +intros H0 eps H1; case (H0 eps H1); auto. +intros alpha [H2 H3]; exists alpha; split; auto. +intros d [H4 H5]; apply H3; split; auto. +Qed. + +Theorem Rinv_Rdiv : forall x y:R, x <> 0 -> y <> 0 -> / (x / y) = y / x. +intros x y H1 H2; unfold Rdiv in |- *; rewrite Rinv_mult_distr. +rewrite Rinv_involutive. +apply Rmult_comm. +assumption. +assumption. +apply Rinv_neq_0_compat; assumption. +Qed. + +Theorem Dln : forall y:R, 0 < y -> D_in ln Rinv (fun x:R => 0 < x) y. +intros y Hy; unfold D_in in |- *. +apply limit1_ext with + (f := fun x:R => / ((exp (ln x) - exp (ln y)) / (ln x - ln y))). +intros x [HD1 HD2]; repeat rewrite exp_ln. +unfold Rdiv in |- *; rewrite Rinv_mult_distr. +rewrite Rinv_involutive. +apply Rmult_comm. +apply Rminus_eq_contra. +red in |- *; intros H2; case HD2. +symmetry in |- *; apply (ln_inv _ _ HD1 Hy H2). +apply Rminus_eq_contra; apply (sym_not_eq HD2). +apply Rinv_neq_0_compat; apply Rminus_eq_contra; red in |- *; intros H2; + case HD2; apply ln_inv; auto. +assumption. +assumption. +apply limit_inv with + (f := fun x:R => (exp (ln x) - exp (ln y)) / (ln x - ln y)). +apply limit1_imp with + (f := fun x:R => (fun x:R => (exp x - exp (ln y)) / (x - ln y)) (ln x)) + (D := Dgf (D_x (fun x:R => 0 < x) y) (D_x (fun x:R => True) (ln y)) ln). +intros x [H1 H2]; split. +split; auto. +split; auto. +red in |- *; intros H3; case H2; apply ln_inv; auto. +apply limit_comp with + (l := ln y) (g := fun x:R => (exp x - exp (ln y)) / (x - ln y)) (f := ln). +apply ln_continue; auto. +assert (H0 := derivable_pt_lim_exp (ln y)); unfold derivable_pt_lim in H0; + unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold R_dist in |- *; intros; elim (H0 _ H); + intros; exists (pos x); split. +apply (cond_pos x). +intros; pattern y at 3 in |- *; rewrite <- exp_ln. +pattern x0 at 1 in |- *; replace x0 with (ln y + (x0 - ln y)); + [ idtac | ring ]. +apply H1. +elim H2; intros H3 _; unfold D_x in H3; elim H3; clear H3; intros _ H3; + apply Rminus_eq_contra; apply (sym_not_eq (A:=R)); + apply H3. +elim H2; clear H2; intros _ H2; apply H2. +assumption. +red in |- *; intro; rewrite H in Hy; elim (Rlt_irrefl _ Hy). +Qed. + +Lemma derivable_pt_lim_ln : forall x:R, 0 < x -> derivable_pt_lim ln x (/ x). +intros; assert (H0 := Dln x H); unfold D_in in H0; unfold limit1_in in H0; + unfold limit_in in H0; simpl in H0; unfold R_dist in H0; + unfold derivable_pt_lim in |- *; intros; elim (H0 _ H1); + intros; elim H2; clear H2; intros; set (alp := Rmin x0 (x / 2)); + assert (H4 : 0 < alp). +unfold alp in |- *; unfold Rmin in |- *; case (Rle_dec x0 (x / 2)); intro. +apply H2. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +exists (mkposreal _ H4); intros; pattern h at 2 in |- *; + replace h with (x + h - x); [ idtac | ring ]. +apply H3; split. +unfold D_x in |- *; split. +case (Rcase_abs h); intro. +assert (H7 : Rabs h < x / 2). +apply Rlt_le_trans with alp. +apply H6. +unfold alp in |- *; apply Rmin_r. +apply Rlt_trans with (x / 2). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +rewrite Rabs_left in H7. +apply Rplus_lt_reg_r with (- h - x / 2). +replace (- h - x / 2 + x / 2) with (- h); [ idtac | ring ]. +pattern x at 2 in |- *; rewrite double_var. +replace (- h - x / 2 + (x / 2 + x / 2 + h)) with (x / 2); [ apply H7 | ring ]. +apply r. +apply Rplus_lt_le_0_compat; [ assumption | apply Rge_le; apply r ]. +apply (sym_not_eq (A:=R)); apply Rminus_not_eq; replace (x + h - x) with h; + [ apply H5 | ring ]. +replace (x + h - x) with h; + [ apply Rlt_le_trans with alp; + [ apply H6 | unfold alp in |- *; apply Rmin_l ] + | ring ]. +Qed. + +Theorem D_in_imp : + forall (f g:R -> R) (D D1:R -> Prop) (x:R), + (forall x:R, D1 x -> D x) -> D_in f g D x -> D_in f g D1 x. +intros f g D D1 x H; unfold D_in in |- *. +intros H0; apply limit1_imp with (D := D_x D x); auto. +intros x1 [H1 H2]; split; auto. +Qed. + +Theorem D_in_ext : + forall (f g h:R -> R) (D:R -> Prop) (x:R), + f x = g x -> D_in h f D x -> D_in h g D x. +intros f g h D x H; unfold D_in in |- *. +rewrite H; auto. +Qed. + +Theorem Dpower : + forall y z:R, + 0 < y -> + D_in (fun x:R => x ^R z) (fun x:R => z * x ^R (z - 1)) ( + fun x:R => 0 < x) y. +intros y z H; + apply D_in_imp with (D := Dgf (fun x:R => 0 < x) (fun x:R => True) ln). +intros x H0; repeat split. +assumption. +apply D_in_ext with (f := fun x:R => / x * (z * exp (z * ln x))). +unfold Rminus in |- *; rewrite Rpower_plus; rewrite Rpower_Ropp; + rewrite (Rpower_1 _ H); ring. +apply Dcomp with + (f := ln) + (g := fun x:R => exp (z * x)) + (df := Rinv) + (dg := fun x:R => z * exp (z * x)). +apply (Dln _ H). +apply D_in_imp with + (D := Dgf (fun x:R => True) (fun x:R => True) (fun x:R => z * x)). +intros x H1; repeat split; auto. +apply + (Dcomp (fun _:R => True) (fun _:R => True) (fun x => z) exp + (fun x:R => z * x) exp); simpl in |- *. +apply D_in_ext with (f := fun x:R => z * 1). +apply Rmult_1_r. +apply (Dmult_const (fun x => True) (fun x => x) (fun x => 1)); apply Dx. +assert (H0 := derivable_pt_lim_D_in exp exp (z * ln y)); elim H0; clear H0; + intros _ H0; apply H0; apply derivable_pt_lim_exp. +Qed. + +Theorem derivable_pt_lim_power : + forall x y:R, + 0 < x -> derivable_pt_lim (fun x => x ^R y) x (y * x ^R (y - 1)). +intros x y H. +unfold Rminus in |- *; rewrite Rpower_plus. +rewrite Rpower_Ropp. +rewrite Rpower_1; auto. +rewrite <- Rmult_assoc. +unfold Rpower in |- *. +apply derivable_pt_lim_comp with (f1 := ln) (f2 := fun x => exp (y * x)). +apply derivable_pt_lim_ln; assumption. +rewrite (Rmult_comm y). +apply derivable_pt_lim_comp with (f1 := fun x => y * x) (f2 := exp). +pattern y at 2 in |- *; replace y with (0 * ln x + y * 1). +apply derivable_pt_lim_mult with (f1 := fun x:R => y) (f2 := fun x:R => x). +apply derivable_pt_lim_const with (a := y). +apply derivable_pt_lim_id. +ring. +apply derivable_pt_lim_exp. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Rprod.v b/theories/Reals/Rprod.v new file mode 100644 index 00000000..6577146f --- /dev/null +++ b/theories/Reals/Rprod.v @@ -0,0 +1,191 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Rprod.v,v 1.10.2.1 2004/07/16 19:31:13 herbelin Exp $ i*) + +Require Import Compare. +Require Import Rbase. +Require Import Rfunctions. +Require Import Rseries. +Require Import PartSum. +Require Import Binomial. +Open Local Scope R_scope. + +(* TT Ak; 1<=k<=N *) +Fixpoint prod_f_SO (An:nat -> R) (N:nat) {struct N} : R := + match N with + | O => 1 + | S p => prod_f_SO An p * An (S p) + end. + +(**********) +Lemma prod_SO_split : + forall (An:nat -> R) (n k:nat), + (k <= n)%nat -> + prod_f_SO An n = + prod_f_SO An k * prod_f_SO (fun l:nat => An (k + l)%nat) (n - k). +intros; induction n as [| n Hrecn]. +cut (k = 0%nat); + [ intro; rewrite H0; simpl in |- *; ring | inversion H; reflexivity ]. +cut (k = S n \/ (k <= n)%nat). +intro; elim H0; intro. +rewrite H1; simpl in |- *; rewrite <- minus_n_n; simpl in |- *; ring. +replace (S n - k)%nat with (S (n - k)). +simpl in |- *; replace (k + S (n - k))%nat with (S n). +rewrite Hrecn; [ ring | assumption ]. +apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite S_INR; + rewrite minus_INR; [ ring | assumption ]. +apply INR_eq; rewrite S_INR; repeat rewrite minus_INR. +rewrite S_INR; ring. +apply le_trans with n; [ assumption | apply le_n_Sn ]. +assumption. +inversion H; [ left; reflexivity | right; assumption ]. +Qed. + +(**********) +Lemma prod_SO_pos : + forall (An:nat -> R) (N:nat), + (forall n:nat, (n <= N)%nat -> 0 <= An n) -> 0 <= prod_f_SO An N. +intros; induction N as [| N HrecN]. +simpl in |- *; left; apply Rlt_0_1. +simpl in |- *; apply Rmult_le_pos. +apply HrecN; intros; apply H; apply le_trans with N; + [ assumption | apply le_n_Sn ]. +apply H; apply le_n. +Qed. + +(**********) +Lemma prod_SO_Rle : + forall (An Bn:nat -> R) (N:nat), + (forall n:nat, (n <= N)%nat -> 0 <= An n <= Bn n) -> + prod_f_SO An N <= prod_f_SO Bn N. +intros; induction N as [| N HrecN]. +right; reflexivity. +simpl in |- *; apply Rle_trans with (prod_f_SO An N * Bn (S N)). +apply Rmult_le_compat_l. +apply prod_SO_pos; intros; elim (H n (le_trans _ _ _ H0 (le_n_Sn N))); intros; + assumption. +elim (H (S N) (le_n (S N))); intros; assumption. +do 2 rewrite <- (Rmult_comm (Bn (S N))); apply Rmult_le_compat_l. +elim (H (S N) (le_n (S N))); intros. +apply Rle_trans with (An (S N)); assumption. +apply HrecN; intros; elim (H n (le_trans _ _ _ H0 (le_n_Sn N))); intros; + split; assumption. +Qed. + +(* Application to factorial *) +Lemma fact_prodSO : + forall n:nat, INR (fact n) = prod_f_SO (fun k:nat => INR k) n. +intro; induction n as [| n Hrecn]. +reflexivity. +change (INR (S n * fact n) = prod_f_SO (fun k:nat => INR k) (S n)) in |- *. +rewrite mult_INR; rewrite Rmult_comm; rewrite Hrecn; reflexivity. +Qed. + +Lemma le_n_2n : forall n:nat, (n <= 2 * n)%nat. +simple induction n. +replace (2 * 0)%nat with 0%nat; [ apply le_n | ring ]. +intros; replace (2 * S n0)%nat with (S (S (2 * n0))). +apply le_n_S; apply le_S; assumption. +replace (S (S (2 * n0))) with (2 * n0 + 2)%nat; [ idtac | ring ]. +replace (S n0) with (n0 + 1)%nat; [ idtac | ring ]. +ring. +Qed. + +(* We prove that (N!)²<=(2N-k)!*k! forall k in [|O;2N|] *) +Lemma RfactN_fact2N_factk : + forall N k:nat, + (k <= 2 * N)%nat -> + Rsqr (INR (fact N)) <= INR (fact (2 * N - k)) * INR (fact k). +intros; unfold Rsqr in |- *; repeat rewrite fact_prodSO. +cut ((k <= N)%nat \/ (N <= k)%nat). +intro; elim H0; intro. +rewrite (prod_SO_split (fun l:nat => INR l) (2 * N - k) N). +rewrite Rmult_assoc; apply Rmult_le_compat_l. +apply prod_SO_pos; intros; apply pos_INR. +replace (2 * N - k - N)%nat with (N - k)%nat. +rewrite Rmult_comm; rewrite (prod_SO_split (fun l:nat => INR l) N k). +apply Rmult_le_compat_l. +apply prod_SO_pos; intros; apply pos_INR. +apply prod_SO_Rle; intros; split. +apply pos_INR. +apply le_INR; apply plus_le_compat_r; assumption. +assumption. +apply INR_eq; repeat rewrite minus_INR. +rewrite mult_INR; repeat rewrite S_INR; ring. +apply le_trans with N; [ assumption | apply le_n_2n ]. +apply (fun p n m:nat => plus_le_reg_l n m p) with k; rewrite <- le_plus_minus. +replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ]. +apply plus_le_compat_r; assumption. +assumption. +assumption. +apply (fun p n m:nat => plus_le_reg_l n m p) with k; rewrite <- le_plus_minus. +replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ]. +apply plus_le_compat_r; assumption. +assumption. +rewrite <- (Rmult_comm (prod_f_SO (fun l:nat => INR l) k)); + rewrite (prod_SO_split (fun l:nat => INR l) k N). +rewrite Rmult_assoc; apply Rmult_le_compat_l. +apply prod_SO_pos; intros; apply pos_INR. +rewrite Rmult_comm; + rewrite (prod_SO_split (fun l:nat => INR l) N (2 * N - k)). +apply Rmult_le_compat_l. +apply prod_SO_pos; intros; apply pos_INR. +replace (N - (2 * N - k))%nat with (k - N)%nat. +apply prod_SO_Rle; intros; split. +apply pos_INR. +apply le_INR; apply plus_le_compat_r. +apply (fun p n m:nat => plus_le_reg_l n m p) with k; rewrite <- le_plus_minus. +replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ]; + apply plus_le_compat_r; assumption. +assumption. +apply INR_eq; repeat rewrite minus_INR. +rewrite mult_INR; do 2 rewrite S_INR; ring. +assumption. +apply (fun p n m:nat => plus_le_reg_l n m p) with k; rewrite <- le_plus_minus. +replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ]; + apply plus_le_compat_r; assumption. +assumption. +assumption. +apply (fun p n m:nat => plus_le_reg_l n m p) with k; rewrite <- le_plus_minus. +replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ]; + apply plus_le_compat_r; assumption. +assumption. +assumption. +elim (le_dec k N); intro; [ left; assumption | right; assumption ]. +Qed. + +(**********) +Lemma INR_fact_lt_0 : forall n:nat, 0 < INR (fact n). +intro; apply lt_INR_0; apply neq_O_lt; red in |- *; intro; + elim (fact_neq_0 n); symmetry in |- *; assumption. +Qed. + +(* We have the following inequality : (C 2N k) <= (C 2N N) forall k in [|O;2N|] *) +Lemma C_maj : forall N k:nat, (k <= 2 * N)%nat -> C (2 * N) k <= C (2 * N) N. +intros; unfold C in |- *; unfold Rdiv in |- *; apply Rmult_le_compat_l. +apply pos_INR. +replace (2 * N - N)%nat with N. +apply Rmult_le_reg_l with (INR (fact N) * INR (fact N)). +apply Rmult_lt_0_compat; apply INR_fact_lt_0. +rewrite <- Rinv_r_sym. +rewrite Rmult_comm; + apply Rmult_le_reg_l with (INR (fact k) * INR (fact (2 * N - k))). +apply Rmult_lt_0_compat; apply INR_fact_lt_0. +rewrite Rmult_1_r; rewrite <- mult_INR; rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym. +rewrite Rmult_1_l; rewrite mult_INR; rewrite (Rmult_comm (INR (fact k))); + replace (INR (fact N) * INR (fact N)) with (Rsqr (INR (fact N))). +apply RfactN_fact2N_factk. +assumption. +reflexivity. +rewrite mult_INR; apply prod_neq_R0; apply INR_fact_neq_0. +apply prod_neq_R0; apply INR_fact_neq_0. +apply INR_eq; rewrite minus_INR; + [ rewrite mult_INR; do 2 rewrite S_INR; ring | apply le_n_2n ]. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Rseries.v b/theories/Reals/Rseries.v new file mode 100644 index 00000000..cbf93278 --- /dev/null +++ b/theories/Reals/Rseries.v @@ -0,0 +1,275 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Rseries.v,v 1.11.2.1 2004/07/16 19:31:13 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rfunctions. +Require Import Classical. +Require Import Compare. +Open Local Scope R_scope. + +Implicit Type r : R. + +(* classical is needed for [Un_cv_crit] *) +(*********************************************************) +(* Definition of sequence and properties *) +(* *) +(*********************************************************) + +Section sequence. + +(*********) +Variable Un : nat -> R. + +(*********) +Fixpoint Rmax_N (N:nat) : R := + match N with + | O => Un 0 + | S n => Rmax (Un (S n)) (Rmax_N n) + end. + +(*********) +Definition EUn r : Prop := exists i : nat, r = Un i. + +(*********) +Definition Un_cv (l:R) : Prop := + forall eps:R, + eps > 0 -> + exists N : nat, (forall n:nat, (n >= N)%nat -> R_dist (Un n) l < eps). + +(*********) +Definition Cauchy_crit : Prop := + forall eps:R, + eps > 0 -> + exists N : nat, + (forall n m:nat, + (n >= N)%nat -> (m >= N)%nat -> R_dist (Un n) (Un m) < eps). + +(*********) +Definition Un_growing : Prop := forall n:nat, Un n <= Un (S n). + +(*********) +Lemma EUn_noempty : exists r : R, EUn r. +unfold EUn in |- *; split with (Un 0); split with 0%nat; trivial. +Qed. + +(*********) +Lemma Un_in_EUn : forall n:nat, EUn (Un n). +intro; unfold EUn in |- *; split with n; trivial. +Qed. + +(*********) +Lemma Un_bound_imp : + forall x:R, (forall n:nat, Un n <= x) -> is_upper_bound EUn x. +intros; unfold is_upper_bound in |- *; intros; unfold EUn in H0; elim H0; + clear H0; intros; generalize (H x1); intro; rewrite <- H0 in H1; + trivial. +Qed. + +(*********) +Lemma growing_prop : + forall n m:nat, Un_growing -> (n >= m)%nat -> Un n >= Un m. +double induction n m; intros. +unfold Rge in |- *; right; trivial. +elimtype False; unfold ge in H1; generalize (le_Sn_O n0); intro; auto. +cut (n0 >= 0)%nat. +generalize H0; intros; unfold Un_growing in H0; + apply + (Rge_trans (Un (S n0)) (Un n0) (Un 0) (Rle_ge (Un n0) (Un (S n0)) (H0 n0)) + (H 0%nat H2 H3)). +elim n0; auto. +elim (lt_eq_lt_dec n1 n0); intro y. +elim y; clear y; intro y. +unfold ge in H2; generalize (le_not_lt n0 n1 (le_S_n n0 n1 H2)); intro; + elimtype False; auto. +rewrite y; unfold Rge in |- *; right; trivial. +unfold ge in H0; generalize (H0 (S n0) H1 (lt_le_S n0 n1 y)); intro; + unfold Un_growing in H1; + apply + (Rge_trans (Un (S n1)) (Un n1) (Un (S n0)) + (Rle_ge (Un n1) (Un (S n1)) (H1 n1)) H3). +Qed. + + +(* classical is needed: [not_all_not_ex] *) +(*********) +Lemma Un_cv_crit : Un_growing -> bound EUn -> exists l : R, Un_cv l. +unfold Un_growing, Un_cv in |- *; intros; + generalize (completeness_weak EUn H0 EUn_noempty); + intro; elim H1; clear H1; intros; split with x; intros; + unfold is_lub in H1; unfold bound in H0; unfold is_upper_bound in H0, H1; + elim H0; clear H0; intros; elim H1; clear H1; intros; + generalize (H3 x0 H0); intro; cut (forall n:nat, Un n <= x); + intro. +cut (exists N : nat, x - eps < Un N). +intro; elim H6; clear H6; intros; split with x1. +intros; unfold R_dist in |- *; apply (Rabs_def1 (Un n - x) eps). +unfold Rgt in H2; + apply (Rle_lt_trans (Un n - x) 0 eps (Rle_minus (Un n) x (H5 n)) H2). +fold Un_growing in H; generalize (growing_prop n x1 H H7); intro; + generalize + (Rlt_le_trans (x - eps) (Un x1) (Un n) H6 (Rge_le (Un n) (Un x1) H8)); + intro; generalize (Rplus_lt_compat_l (- x) (x - eps) (Un n) H9); + unfold Rminus in |- *; rewrite <- (Rplus_assoc (- x) x (- eps)); + rewrite (Rplus_comm (- x) (Un n)); fold (Un n - x) in |- *; + rewrite Rplus_opp_l; rewrite (let (H1, H2) := Rplus_ne (- eps) in H2); + trivial. +cut (~ (forall N:nat, x - eps >= Un N)). +intro; apply (not_all_not_ex nat (fun N:nat => x - eps < Un N)); red in |- *; + intro; red in H6; elim H6; clear H6; intro; + apply (Rnot_lt_ge (x - eps) (Un N) (H7 N)). +red in |- *; intro; cut (forall N:nat, Un N <= x - eps). +intro; generalize (Un_bound_imp (x - eps) H7); intro; + unfold is_upper_bound in H8; generalize (H3 (x - eps) H8); + intro; generalize (Rle_minus x (x - eps) H9); unfold Rminus in |- *; + rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; rewrite Rplus_opp_r; + rewrite (let (H1, H2) := Rplus_ne (- - eps) in H2); + rewrite Ropp_involutive; intro; unfold Rgt in H2; + generalize (Rgt_not_le eps 0 H2); intro; auto. +intro; elim (H6 N); intro; unfold Rle in |- *. +left; unfold Rgt in H7; assumption. +right; auto. +apply (H1 (Un n) (Un_in_EUn n)). +Qed. + +(*********) +Lemma finite_greater : + forall N:nat, exists M : R, (forall n:nat, (n <= N)%nat -> Un n <= M). +intro; induction N as [| N HrecN]. +split with (Un 0); intros; rewrite (le_n_O_eq n H); + apply (Req_le (Un n) (Un n) (refl_equal (Un n))). +elim HrecN; clear HrecN; intros; split with (Rmax (Un (S N)) x); intros; + elim (Rmax_Rle (Un (S N)) x (Un n)); intros; clear H1; + inversion H0. +rewrite <- H1; rewrite <- H1 in H2; + apply + (H2 (or_introl (Un n <= x) (Req_le (Un n) (Un n) (refl_equal (Un n))))). +apply (H2 (or_intror (Un n <= Un (S N)) (H n H3))). +Qed. + +(*********) +Lemma cauchy_bound : Cauchy_crit -> bound EUn. +unfold Cauchy_crit, bound in |- *; intros; unfold is_upper_bound in |- *; + unfold Rgt in H; elim (H 1 Rlt_0_1); clear H; intros; + generalize (H x); intro; generalize (le_dec x); intro; + elim (finite_greater x); intros; split with (Rmax x0 (Un x + 1)); + clear H; intros; unfold EUn in H; elim H; clear H; + intros; elim (H1 x2); clear H1; intro y. +unfold ge in H0; generalize (H0 x2 (le_n x) y); clear H0; intro; + rewrite <- H in H0; unfold R_dist in H0; elim (Rabs_def2 (Un x - x1) 1 H0); + clear H0; intros; elim (Rmax_Rle x0 (Un x + 1) x1); + intros; apply H4; clear H3 H4; right; clear H H0 y; + apply (Rlt_le x1 (Un x + 1)); generalize (Rlt_minus (-1) (Un x - x1) H1); + clear H1; intro; apply (Rminus_lt x1 (Un x + 1)); + cut (-1 - (Un x - x1) = x1 - (Un x + 1)); + [ intro; rewrite H0 in H; assumption | ring ]. +generalize (H2 x2 y); clear H2 H0; intro; rewrite <- H in H0; + elim (Rmax_Rle x0 (Un x + 1) x1); intros; clear H1; + apply H2; left; assumption. +Qed. + +End sequence. + +(*****************************************************************) +(* Definition of Power Series and properties *) +(* *) +(*****************************************************************) + +Section Isequence. + +(*********) +Variable An : nat -> R. + +(*********) +Definition Pser (x l:R) : Prop := infinit_sum (fun n:nat => An n * x ^ n) l. + +End Isequence. + +Lemma GP_infinite : + forall x:R, Rabs x < 1 -> Pser (fun n:nat => 1) x (/ (1 - x)). +intros; unfold Pser in |- *; unfold infinit_sum in |- *; intros; + elim (Req_dec x 0). +intros; exists 0%nat; intros; rewrite H1; rewrite Rminus_0_r; rewrite Rinv_1; + cut (sum_f_R0 (fun n0:nat => 1 * 0 ^ n0) n = 1). +intros; rewrite H3; rewrite R_dist_eq; auto. +elim n; simpl in |- *. +ring. +intros; rewrite H3; ring. +intro; cut (0 < eps * (Rabs (1 - x) * Rabs (/ x))). +intro; elim (pow_lt_1_zero x H (eps * (Rabs (1 - x) * Rabs (/ x))) H2); + intro N; intros; exists N; intros; + cut + (sum_f_R0 (fun n0:nat => 1 * x ^ n0) n = sum_f_R0 (fun n0:nat => x ^ n0) n). +intros; rewrite H5; + apply + (Rmult_lt_reg_l (Rabs (1 - x)) + (R_dist (sum_f_R0 (fun n0:nat => x ^ n0) n) (/ (1 - x))) eps). +apply Rabs_pos_lt. +apply Rminus_eq_contra. +apply Rlt_dichotomy_converse. +right; unfold Rgt in |- *. +apply (Rle_lt_trans x (Rabs x) 1). +apply RRle_abs. +assumption. +unfold R_dist in |- *; rewrite <- Rabs_mult. +rewrite Rmult_minus_distr_l. +cut + ((1 - x) * sum_f_R0 (fun n0:nat => x ^ n0) n = + - (sum_f_R0 (fun n0:nat => x ^ n0) n * (x - 1))). +intro; rewrite H6. +rewrite GP_finite. +rewrite Rinv_r. +cut (- (x ^ (n + 1) - 1) - 1 = - x ^ (n + 1)). +intro; rewrite H7. +rewrite Rabs_Ropp; cut ((n + 1)%nat = S n); auto. +intro H8; rewrite H8; simpl in |- *; rewrite Rabs_mult; + apply + (Rlt_le_trans (Rabs x * Rabs (x ^ n)) + (Rabs x * (eps * (Rabs (1 - x) * Rabs (/ x)))) ( + Rabs (1 - x) * eps)). +apply Rmult_lt_compat_l. +apply Rabs_pos_lt. +assumption. +auto. +cut + (Rabs x * (eps * (Rabs (1 - x) * Rabs (/ x))) = + Rabs x * Rabs (/ x) * (eps * Rabs (1 - x))). +clear H8; intros; rewrite H8; rewrite <- Rabs_mult; rewrite Rinv_r. +rewrite Rabs_R1; cut (1 * (eps * Rabs (1 - x)) = Rabs (1 - x) * eps). +intros; rewrite H9; unfold Rle in |- *; right; reflexivity. +ring. +assumption. +ring. +ring. +ring. +apply Rminus_eq_contra. +apply Rlt_dichotomy_converse. +right; unfold Rgt in |- *. +apply (Rle_lt_trans x (Rabs x) 1). +apply RRle_abs. +assumption. +ring; ring. +elim n; simpl in |- *. +ring. +intros; rewrite H5. +ring. +apply Rmult_lt_0_compat. +auto. +apply Rmult_lt_0_compat. +apply Rabs_pos_lt. +apply Rminus_eq_contra. +apply Rlt_dichotomy_converse. +right; unfold Rgt in |- *. +apply (Rle_lt_trans x (Rabs x) 1). +apply RRle_abs. +assumption. +apply Rabs_pos_lt. +apply Rinv_neq_0_compat. +assumption. +Qed. diff --git a/theories/Reals/Rsigma.v b/theories/Reals/Rsigma.v new file mode 100644 index 00000000..e54c3675 --- /dev/null +++ b/theories/Reals/Rsigma.v @@ -0,0 +1,140 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Rsigma.v,v 1.12.2.1 2004/07/16 19:31:13 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rfunctions. +Require Import Rseries. +Require Import PartSum. +Open Local Scope R_scope. + +Set Implicit Arguments. + +Section Sigma. + +Variable f : nat -> R. + +Definition sigma (low high:nat) : R := + sum_f_R0 (fun k:nat => f (low + k)) (high - low). + +Theorem sigma_split : + forall low high k:nat, + (low <= k)%nat -> + (k < high)%nat -> sigma low high = sigma low k + sigma (S k) high. +intros; induction k as [| k Hreck]. +cut (low = 0%nat). +intro; rewrite H1; unfold sigma in |- *; rewrite <- minus_n_n; + rewrite <- minus_n_O; simpl in |- *; replace (high - 1)%nat with (pred high). +apply (decomp_sum (fun k:nat => f k)). +assumption. +apply pred_of_minus. +inversion H; reflexivity. +cut ((low <= k)%nat \/ low = S k). +intro; elim H1; intro. +replace (sigma low (S k)) with (sigma low k + f (S k)). +rewrite Rplus_assoc; + replace (f (S k) + sigma (S (S k)) high) with (sigma (S k) high). +apply Hreck. +assumption. +apply lt_trans with (S k); [ apply lt_n_Sn | assumption ]. +unfold sigma in |- *; replace (high - S (S k))%nat with (pred (high - S k)). +pattern (S k) at 3 in |- *; replace (S k) with (S k + 0)%nat; + [ idtac | ring ]. +replace (sum_f_R0 (fun k0:nat => f (S (S k) + k0)) (pred (high - S k))) with + (sum_f_R0 (fun k0:nat => f (S k + S k0)) (pred (high - S k))). +apply (decomp_sum (fun i:nat => f (S k + i))). +apply lt_minus_O_lt; assumption. +apply sum_eq; intros; replace (S k + S i)%nat with (S (S k) + i)%nat. +reflexivity. +apply INR_eq; do 2 rewrite plus_INR; do 3 rewrite S_INR; ring. +replace (high - S (S k))%nat with (high - S k - 1)%nat. +apply pred_of_minus. +apply INR_eq; repeat rewrite minus_INR. +do 4 rewrite S_INR; ring. +apply lt_le_S; assumption. +apply lt_le_weak; assumption. +apply lt_le_S; apply lt_minus_O_lt; assumption. +unfold sigma in |- *; replace (S k - low)%nat with (S (k - low)). +pattern (S k) at 1 in |- *; replace (S k) with (low + S (k - low))%nat. +symmetry in |- *; apply (tech5 (fun i:nat => f (low + i))). +apply INR_eq; rewrite plus_INR; do 2 rewrite S_INR; rewrite minus_INR. +ring. +assumption. +apply minus_Sn_m; assumption. +rewrite <- H2; unfold sigma in |- *; rewrite <- minus_n_n; simpl in |- *; + replace (high - S low)%nat with (pred (high - low)). +replace (sum_f_R0 (fun k0:nat => f (S (low + k0))) (pred (high - low))) with + (sum_f_R0 (fun k0:nat => f (low + S k0)) (pred (high - low))). +apply (decomp_sum (fun k0:nat => f (low + k0))). +apply lt_minus_O_lt. +apply le_lt_trans with (S k); [ rewrite H2; apply le_n | assumption ]. +apply sum_eq; intros; replace (S (low + i)) with (low + S i)%nat. +reflexivity. +apply INR_eq; rewrite plus_INR; do 2 rewrite S_INR; rewrite plus_INR; ring. +replace (high - S low)%nat with (high - low - 1)%nat. +apply pred_of_minus. +apply INR_eq; repeat rewrite minus_INR. +do 2 rewrite S_INR; ring. +apply lt_le_S; rewrite H2; assumption. +rewrite H2; apply lt_le_weak; assumption. +apply lt_le_S; apply lt_minus_O_lt; rewrite H2; assumption. +inversion H; [ right; reflexivity | left; assumption ]. +Qed. + +Theorem sigma_diff : + forall low high k:nat, + (low <= k)%nat -> + (k < high)%nat -> sigma low high - sigma low k = sigma (S k) high. +intros low high k H1 H2; symmetry in |- *; rewrite (sigma_split H1 H2); ring. +Qed. + +Theorem sigma_diff_neg : + forall low high k:nat, + (low <= k)%nat -> + (k < high)%nat -> sigma low k - sigma low high = - sigma (S k) high. +intros low high k H1 H2; rewrite (sigma_split H1 H2); ring. +Qed. + +Theorem sigma_first : + forall low high:nat, + (low < high)%nat -> sigma low high = f low + sigma (S low) high. +intros low high H1; generalize (lt_le_S low high H1); intro H2; + generalize (lt_le_weak low high H1); intro H3; + replace (f low) with (sigma low low). +apply sigma_split. +apply le_n. +assumption. +unfold sigma in |- *; rewrite <- minus_n_n. +simpl in |- *. +replace (low + 0)%nat with low; [ reflexivity | ring ]. +Qed. + +Theorem sigma_last : + forall low high:nat, + (low < high)%nat -> sigma low high = f high + sigma low (pred high). +intros low high H1; generalize (lt_le_S low high H1); intro H2; + generalize (lt_le_weak low high H1); intro H3; + replace (f high) with (sigma high high). +rewrite Rplus_comm; cut (high = S (pred high)). +intro; pattern high at 3 in |- *; rewrite H. +apply sigma_split. +apply le_S_n; rewrite <- H; apply lt_le_S; assumption. +apply lt_pred_n_n; apply le_lt_trans with low; [ apply le_O_n | assumption ]. +apply S_pred with 0%nat; apply le_lt_trans with low; + [ apply le_O_n | assumption ]. +unfold sigma in |- *; rewrite <- minus_n_n; simpl in |- *; + replace (high + 0)%nat with high; [ reflexivity | ring ]. +Qed. + +Theorem sigma_eq_arg : forall low:nat, sigma low low = f low. +intro; unfold sigma in |- *; rewrite <- minus_n_n. +simpl in |- *; replace (low + 0)%nat with low; [ reflexivity | ring ]. +Qed. + +End Sigma.
\ No newline at end of file diff --git a/theories/Reals/Rsqrt_def.v b/theories/Reals/Rsqrt_def.v new file mode 100644 index 00000000..459f2716 --- /dev/null +++ b/theories/Reals/Rsqrt_def.v @@ -0,0 +1,762 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Rsqrt_def.v,v 1.14.2.1 2004/07/16 19:31:13 herbelin Exp $ i*) + +Require Import Sumbool. +Require Import Rbase. +Require Import Rfunctions. +Require Import SeqSeries. +Require Import Ranalysis1. +Open Local Scope R_scope. + +Fixpoint Dichotomy_lb (x y:R) (P:R -> bool) (N:nat) {struct N} : R := + match N with + | O => x + | S n => + let down := Dichotomy_lb x y P n in + let up := Dichotomy_ub x y P n in + let z := (down + up) / 2 in if P z then down else z + end + + with Dichotomy_ub (x y:R) (P:R -> bool) (N:nat) {struct N} : R := + match N with + | O => y + | S n => + let down := Dichotomy_lb x y P n in + let up := Dichotomy_ub x y P n in + let z := (down + up) / 2 in if P z then z else up + end. + +Definition dicho_lb (x y:R) (P:R -> bool) (N:nat) : R := Dichotomy_lb x y P N. +Definition dicho_up (x y:R) (P:R -> bool) (N:nat) : R := Dichotomy_ub x y P N. + +(**********) +Lemma dicho_comp : + forall (x y:R) (P:R -> bool) (n:nat), + x <= y -> dicho_lb x y P n <= dicho_up x y P n. +intros. +induction n as [| n Hrecn]. +simpl in |- *; assumption. +simpl in |- *. +case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)). +unfold Rdiv in |- *; apply Rmult_le_reg_l with 2. +prove_sup0. +pattern 2 at 1 in |- *; rewrite Rmult_comm. +rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ]. +rewrite Rmult_1_r. +rewrite double. +apply Rplus_le_compat_l. +assumption. +unfold Rdiv in |- *; apply Rmult_le_reg_l with 2. +prove_sup0. +pattern 2 at 3 in |- *; rewrite Rmult_comm. +rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ]. +rewrite Rmult_1_r. +rewrite double. +rewrite <- (Rplus_comm (Dichotomy_ub x y P n)). +apply Rplus_le_compat_l. +assumption. +Qed. + +Lemma dicho_lb_growing : + forall (x y:R) (P:R -> bool), x <= y -> Un_growing (dicho_lb x y P). +intros. +unfold Un_growing in |- *. +intro. +simpl in |- *. +case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)). +right; reflexivity. +unfold Rdiv in |- *; apply Rmult_le_reg_l with 2. +prove_sup0. +pattern 2 at 1 in |- *; rewrite Rmult_comm. +rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ]. +rewrite Rmult_1_r. +rewrite double. +apply Rplus_le_compat_l. +replace (Dichotomy_ub x y P n) with (dicho_up x y P n); + [ apply dicho_comp; assumption | reflexivity ]. +Qed. + +Lemma dicho_up_decreasing : + forall (x y:R) (P:R -> bool), x <= y -> Un_decreasing (dicho_up x y P). +intros. +unfold Un_decreasing in |- *. +intro. +simpl in |- *. +case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)). +unfold Rdiv in |- *; apply Rmult_le_reg_l with 2. +prove_sup0. +pattern 2 at 3 in |- *; rewrite Rmult_comm. +rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ]. +rewrite Rmult_1_r. +rewrite double. +replace (Dichotomy_ub x y P n) with (dicho_up x y P n); + [ idtac | reflexivity ]. +replace (Dichotomy_lb x y P n) with (dicho_lb x y P n); + [ idtac | reflexivity ]. +rewrite <- (Rplus_comm (dicho_up x y P n)). +apply Rplus_le_compat_l. +apply dicho_comp; assumption. +right; reflexivity. +Qed. + +Lemma dicho_lb_maj_y : + forall (x y:R) (P:R -> bool), x <= y -> forall n:nat, dicho_lb x y P n <= y. +intros. +induction n as [| n Hrecn]. +simpl in |- *; assumption. +simpl in |- *. +case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)). +assumption. +unfold Rdiv in |- *; apply Rmult_le_reg_l with 2. +prove_sup0. +pattern 2 at 3 in |- *; rewrite Rmult_comm. +rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ rewrite Rmult_1_r | discrR ]. +rewrite double; apply Rplus_le_compat. +assumption. +pattern y at 2 in |- *; replace y with (Dichotomy_ub x y P 0); + [ idtac | reflexivity ]. +apply decreasing_prop. +assert (H0 := dicho_up_decreasing x y P H). +assumption. +apply le_O_n. +Qed. + +Lemma dicho_lb_maj : + forall (x y:R) (P:R -> bool), x <= y -> has_ub (dicho_lb x y P). +intros. +cut (forall n:nat, dicho_lb x y P n <= y). +intro. +unfold has_ub in |- *. +unfold bound in |- *. +exists y. +unfold is_upper_bound in |- *. +intros. +elim H1; intros. +rewrite H2; apply H0. +apply dicho_lb_maj_y; assumption. +Qed. + +Lemma dicho_up_min_x : + forall (x y:R) (P:R -> bool), x <= y -> forall n:nat, x <= dicho_up x y P n. +intros. +induction n as [| n Hrecn]. +simpl in |- *; assumption. +simpl in |- *. +case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)). +unfold Rdiv in |- *; apply Rmult_le_reg_l with 2. +prove_sup0. +pattern 2 at 1 in |- *; rewrite Rmult_comm. +rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ rewrite Rmult_1_r | discrR ]. +rewrite double; apply Rplus_le_compat. +pattern x at 1 in |- *; replace x with (Dichotomy_lb x y P 0); + [ idtac | reflexivity ]. +apply tech9. +assert (H0 := dicho_lb_growing x y P H). +assumption. +apply le_O_n. +assumption. +assumption. +Qed. + +Lemma dicho_up_min : + forall (x y:R) (P:R -> bool), x <= y -> has_lb (dicho_up x y P). +intros. +cut (forall n:nat, x <= dicho_up x y P n). +intro. +unfold has_lb in |- *. +unfold bound in |- *. +exists (- x). +unfold is_upper_bound in |- *. +intros. +elim H1; intros. +rewrite H2. +unfold opp_seq in |- *. +apply Ropp_le_contravar. +apply H0. +apply dicho_up_min_x; assumption. +Qed. + +Lemma dicho_lb_cv : + forall (x y:R) (P:R -> bool), + x <= y -> sigT (fun l:R => Un_cv (dicho_lb x y P) l). +intros. +apply growing_cv. +apply dicho_lb_growing; assumption. +apply dicho_lb_maj; assumption. +Qed. + +Lemma dicho_up_cv : + forall (x y:R) (P:R -> bool), + x <= y -> sigT (fun l:R => Un_cv (dicho_up x y P) l). +intros. +apply decreasing_cv. +apply dicho_up_decreasing; assumption. +apply dicho_up_min; assumption. +Qed. + +Lemma dicho_lb_dicho_up : + forall (x y:R) (P:R -> bool) (n:nat), + x <= y -> dicho_up x y P n - dicho_lb x y P n = (y - x) / 2 ^ n. +intros. +induction n as [| n Hrecn]. +simpl in |- *. +unfold Rdiv in |- *; rewrite Rinv_1; ring. +simpl in |- *. +case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)). +unfold Rdiv in |- *. +replace + ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) * / 2 - Dichotomy_lb x y P n) + with ((dicho_up x y P n - dicho_lb x y P n) / 2). +unfold Rdiv in |- *; rewrite Hrecn. +unfold Rdiv in |- *. +rewrite Rinv_mult_distr. +ring. +discrR. +apply pow_nonzero; discrR. +pattern (Dichotomy_lb x y P n) at 2 in |- *; + rewrite (double_var (Dichotomy_lb x y P n)); + unfold dicho_up, dicho_lb, Rminus, Rdiv in |- *; ring. +replace + (Dichotomy_ub x y P n - (Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2) + with ((dicho_up x y P n - dicho_lb x y P n) / 2). +unfold Rdiv in |- *; rewrite Hrecn. +unfold Rdiv in |- *. +rewrite Rinv_mult_distr. +ring. +discrR. +apply pow_nonzero; discrR. +pattern (Dichotomy_ub x y P n) at 1 in |- *; + rewrite (double_var (Dichotomy_ub x y P n)); + unfold dicho_up, dicho_lb, Rminus, Rdiv in |- *; ring. +Qed. + +Definition pow_2_n (n:nat) := 2 ^ n. + +Lemma pow_2_n_neq_R0 : forall n:nat, pow_2_n n <> 0. +intro. +unfold pow_2_n in |- *. +apply pow_nonzero. +discrR. +Qed. + +Lemma pow_2_n_growing : Un_growing pow_2_n. +unfold Un_growing in |- *. +intro. +replace (S n) with (n + 1)%nat; + [ unfold pow_2_n in |- *; rewrite pow_add | ring ]. +pattern (2 ^ n) at 1 in |- *; rewrite <- Rmult_1_r. +apply Rmult_le_compat_l. +left; apply pow_lt; prove_sup0. +simpl in |- *. +rewrite Rmult_1_r. +pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; + apply Rlt_0_1. +Qed. + +Lemma pow_2_n_infty : cv_infty pow_2_n. +cut (forall N:nat, INR N <= 2 ^ N). +intros. +unfold cv_infty in |- *. +intro. +case (total_order_T 0 M); intro. +elim s; intro. +set (N := up M). +cut (0 <= N)%Z. +intro. +elim (IZN N H0); intros N0 H1. +exists N0. +intros. +apply Rlt_le_trans with (INR N0). +rewrite INR_IZR_INZ. +rewrite <- H1. +unfold N in |- *. +assert (H3 := archimed M). +elim H3; intros; assumption. +apply Rle_trans with (pow_2_n N0). +unfold pow_2_n in |- *; apply H. +apply Rge_le. +apply growing_prop. +apply pow_2_n_growing. +assumption. +apply le_IZR. +unfold N in |- *. +simpl in |- *. +assert (H0 := archimed M); elim H0; intros. +left; apply Rlt_trans with M; assumption. +exists 0%nat; intros. +rewrite <- b. +unfold pow_2_n in |- *; apply pow_lt; prove_sup0. +exists 0%nat; intros. +apply Rlt_trans with 0. +assumption. +unfold pow_2_n in |- *; apply pow_lt; prove_sup0. +simple induction N. +simpl in |- *. +left; apply Rlt_0_1. +intros. +pattern (S n) at 2 in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ]. +rewrite S_INR; rewrite pow_add. +simpl in |- *. +rewrite Rmult_1_r. +apply Rle_trans with (2 ^ n). +rewrite <- (Rplus_comm 1). +rewrite <- (Rmult_1_r (INR n)). +apply (poly n 1). +apply Rlt_0_1. +pattern (2 ^ n) at 1 in |- *; rewrite <- Rplus_0_r. +rewrite <- (Rmult_comm 2). +rewrite double. +apply Rplus_le_compat_l. +left; apply pow_lt; prove_sup0. +Qed. + +Lemma cv_dicho : + forall (x y l1 l2:R) (P:R -> bool), + x <= y -> + Un_cv (dicho_lb x y P) l1 -> Un_cv (dicho_up x y P) l2 -> l1 = l2. +intros. +assert (H2 := CV_minus _ _ _ _ H0 H1). +cut (Un_cv (fun i:nat => dicho_lb x y P i - dicho_up x y P i) 0). +intro. +assert (H4 := UL_sequence _ _ _ H2 H3). +symmetry in |- *; apply Rminus_diag_uniq_sym; assumption. +unfold Un_cv in |- *; unfold R_dist in |- *. +intros. +assert (H4 := cv_infty_cv_R0 pow_2_n pow_2_n_neq_R0 pow_2_n_infty). +case (total_order_T x y); intro. +elim s; intro. +unfold Un_cv in H4; unfold R_dist in H4. +cut (0 < y - x). +intro Hyp. +cut (0 < eps / (y - x)). +intro. +elim (H4 (eps / (y - x)) H5); intros N H6. +exists N; intros. +replace (dicho_lb x y P n - dicho_up x y P n - 0) with + (dicho_lb x y P n - dicho_up x y P n); [ idtac | ring ]. +rewrite <- Rabs_Ropp. +rewrite Ropp_minus_distr'. +rewrite dicho_lb_dicho_up. +unfold Rdiv in |- *; rewrite Rabs_mult. +rewrite (Rabs_right (y - x)). +apply Rmult_lt_reg_l with (/ (y - x)). +apply Rinv_0_lt_compat; assumption. +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_l. +replace (/ 2 ^ n) with (/ 2 ^ n - 0); + [ unfold pow_2_n, Rdiv in H6; rewrite <- (Rmult_comm eps); apply H6; + assumption + | ring ]. +red in |- *; intro; rewrite H8 in Hyp; elim (Rlt_irrefl _ Hyp). +apply Rle_ge. +apply Rplus_le_reg_l with x; rewrite Rplus_0_r. +replace (x + (y - x)) with y; [ assumption | ring ]. +assumption. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; assumption ]. +apply Rplus_lt_reg_r with x; rewrite Rplus_0_r. +replace (x + (y - x)) with y; [ assumption | ring ]. +exists 0%nat; intros. +replace (dicho_lb x y P n - dicho_up x y P n - 0) with + (dicho_lb x y P n - dicho_up x y P n); [ idtac | ring ]. +rewrite <- Rabs_Ropp. +rewrite Ropp_minus_distr'. +rewrite dicho_lb_dicho_up. +rewrite b. +unfold Rminus, Rdiv in |- *; rewrite Rplus_opp_r; rewrite Rmult_0_l; + rewrite Rabs_R0; assumption. +assumption. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). +Qed. + +Definition cond_positivity (x:R) : bool := + match Rle_dec 0 x with + | left _ => true + | right _ => false + end. + +(* Sequential caracterisation of continuity *) +Lemma continuity_seq : + forall (f:R -> R) (Un:nat -> R) (l:R), + continuity_pt f l -> Un_cv Un l -> Un_cv (fun i:nat => f (Un i)) (f l). +unfold continuity_pt, Un_cv in |- *; unfold continue_in in |- *. +unfold limit1_in in |- *. +unfold limit_in in |- *. +unfold dist in |- *. +simpl in |- *. +unfold R_dist in |- *. +intros. +elim (H eps H1); intros alp H2. +elim H2; intros. +elim (H0 alp H3); intros N H5. +exists N; intros. +case (Req_dec (Un n) l); intro. +rewrite H7; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + assumption. +apply H4. +split. +unfold D_x, no_cond in |- *. +split. +trivial. +apply (sym_not_eq (A:=R)); assumption. +apply H5; assumption. +Qed. + +Lemma dicho_lb_car : + forall (x y:R) (P:R -> bool) (n:nat), + P x = false -> P (dicho_lb x y P n) = false. +intros. +induction n as [| n Hrecn]. +simpl in |- *. +assumption. +simpl in |- *. +assert + (X := + sumbool_of_bool (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2))). +elim X; intro. +rewrite a. +unfold dicho_lb in Hrecn; assumption. +rewrite b. +assumption. +Qed. + +Lemma dicho_up_car : + forall (x y:R) (P:R -> bool) (n:nat), + P y = true -> P (dicho_up x y P n) = true. +intros. +induction n as [| n Hrecn]. +simpl in |- *. +assumption. +simpl in |- *. +assert + (X := + sumbool_of_bool (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2))). +elim X; intro. +rewrite a. +unfold dicho_lb in Hrecn; assumption. +rewrite b. +assumption. +Qed. + +(* Intermediate Value Theorem *) +Lemma IVT : + forall (f:R -> R) (x y:R), + continuity f -> + x < y -> f x < 0 -> 0 < f y -> sigT (fun z:R => x <= z <= y /\ f z = 0). +intros. +cut (x <= y). +intro. +generalize (dicho_lb_cv x y (fun z:R => cond_positivity (f z)) H3). +generalize (dicho_up_cv x y (fun z:R => cond_positivity (f z)) H3). +intros. +elim X; intros. +elim X0; intros. +assert (H4 := cv_dicho _ _ _ _ _ H3 p0 p). +rewrite H4 in p0. +apply existT with x0. +split. +split. +apply Rle_trans with (dicho_lb x y (fun z:R => cond_positivity (f z)) 0). +simpl in |- *. +right; reflexivity. +apply growing_ineq. +apply dicho_lb_growing; assumption. +assumption. +apply Rle_trans with (dicho_up x y (fun z:R => cond_positivity (f z)) 0). +apply decreasing_ineq. +apply dicho_up_decreasing; assumption. +assumption. +right; reflexivity. +2: left; assumption. +set (Vn := fun n:nat => dicho_lb x y (fun z:R => cond_positivity (f z)) n). +set (Wn := fun n:nat => dicho_up x y (fun z:R => cond_positivity (f z)) n). +cut ((forall n:nat, f (Vn n) <= 0) -> f x0 <= 0). +cut ((forall n:nat, 0 <= f (Wn n)) -> 0 <= f x0). +intros. +cut (forall n:nat, f (Vn n) <= 0). +cut (forall n:nat, 0 <= f (Wn n)). +intros. +assert (H9 := H6 H8). +assert (H10 := H5 H7). +apply Rle_antisym; assumption. +intro. +unfold Wn in |- *. +cut (forall z:R, cond_positivity z = true <-> 0 <= z). +intro. +assert (H8 := dicho_up_car x y (fun z:R => cond_positivity (f z)) n). +elim (H7 (f (dicho_up x y (fun z:R => cond_positivity (f z)) n))); intros. +apply H9. +apply H8. +elim (H7 (f y)); intros. +apply H12. +left; assumption. +intro. +unfold cond_positivity in |- *. +case (Rle_dec 0 z); intro. +split. +intro; assumption. +intro; reflexivity. +split. +intro; elim diff_false_true; assumption. +intro. +elim n0; assumption. +unfold Vn in |- *. +cut (forall z:R, cond_positivity z = false <-> z < 0). +intros. +assert (H8 := dicho_lb_car x y (fun z:R => cond_positivity (f z)) n). +left. +elim (H7 (f (dicho_lb x y (fun z:R => cond_positivity (f z)) n))); intros. +apply H9. +apply H8. +elim (H7 (f x)); intros. +apply H12. +assumption. +intro. +unfold cond_positivity in |- *. +case (Rle_dec 0 z); intro. +split. +intro; elim diff_true_false; assumption. +intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H7)). +split. +intro; auto with real. +intro; reflexivity. +cut (Un_cv Wn x0). +intros. +assert (H7 := continuity_seq f Wn x0 (H x0) H5). +case (total_order_T 0 (f x0)); intro. +elim s; intro. +left; assumption. +rewrite <- b; right; reflexivity. +unfold Un_cv in H7; unfold R_dist in H7. +cut (0 < - f x0). +intro. +elim (H7 (- f x0) H8); intros. +cut (x2 >= x2)%nat; [ intro | unfold ge in |- *; apply le_n ]. +assert (H11 := H9 x2 H10). +rewrite Rabs_right in H11. +pattern (- f x0) at 1 in H11; rewrite <- Rplus_0_r in H11. +unfold Rminus in H11; rewrite (Rplus_comm (f (Wn x2))) in H11. +assert (H12 := Rplus_lt_reg_r _ _ _ H11). +assert (H13 := H6 x2). +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H13 H12)). +apply Rle_ge; left; unfold Rminus in |- *; apply Rplus_le_lt_0_compat. +apply H6. +exact H8. +apply Ropp_0_gt_lt_contravar; assumption. +unfold Wn in |- *; assumption. +cut (Un_cv Vn x0). +intros. +assert (H7 := continuity_seq f Vn x0 (H x0) H5). +case (total_order_T 0 (f x0)); intro. +elim s; intro. +unfold Un_cv in H7; unfold R_dist in H7. +elim (H7 (f x0) a); intros. +cut (x2 >= x2)%nat; [ intro | unfold ge in |- *; apply le_n ]. +assert (H10 := H8 x2 H9). +rewrite Rabs_left in H10. +pattern (f x0) at 2 in H10; rewrite <- Rplus_0_r in H10. +rewrite Ropp_minus_distr' in H10. +unfold Rminus in H10. +assert (H11 := Rplus_lt_reg_r _ _ _ H10). +assert (H12 := H6 x2). +cut (0 < f (Vn x2)). +intro. +elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H13 H12)). +rewrite <- (Ropp_involutive (f (Vn x2))). +apply Ropp_0_gt_lt_contravar; assumption. +apply Rplus_lt_reg_r with (f x0 - f (Vn x2)). +rewrite Rplus_0_r; replace (f x0 - f (Vn x2) + (f (Vn x2) - f x0)) with 0; + [ unfold Rminus in |- *; apply Rplus_lt_le_0_compat | ring ]. +assumption. +apply Ropp_0_ge_le_contravar; apply Rle_ge; apply H6. +right; rewrite <- b; reflexivity. +left; assumption. +unfold Vn in |- *; assumption. +Qed. + +Lemma IVT_cor : + forall (f:R -> R) (x y:R), + continuity f -> + x <= y -> f x * f y <= 0 -> sigT (fun z:R => x <= z <= y /\ f z = 0). +intros. +case (total_order_T 0 (f x)); intro. +case (total_order_T 0 (f y)); intro. +elim s; intro. +elim s0; intro. +cut (0 < f x * f y); + [ intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 H2)) + | apply Rmult_lt_0_compat; assumption ]. +exists y. +split. +split; [ assumption | right; reflexivity ]. +symmetry in |- *; exact b. +exists x. +split. +split; [ right; reflexivity | assumption ]. +symmetry in |- *; exact b. +elim s; intro. +cut (x < y). +intro. +assert (H3 := IVT (- f)%F x y (continuity_opp f H) H2). +cut ((- f)%F x < 0). +cut (0 < (- f)%F y). +intros. +elim (H3 H5 H4); intros. +apply existT with x0. +elim p; intros. +split. +assumption. +unfold opp_fct in H7. +rewrite <- (Ropp_involutive (f x0)). +apply Ropp_eq_0_compat; assumption. +unfold opp_fct in |- *; apply Ropp_0_gt_lt_contravar; assumption. +unfold opp_fct in |- *. +apply Rplus_lt_reg_r with (f x); rewrite Rplus_opp_r; rewrite Rplus_0_r; + assumption. +inversion H0. +assumption. +rewrite H2 in a. +elim (Rlt_irrefl _ (Rlt_trans _ _ _ r a)). +apply existT with x. +split. +split; [ right; reflexivity | assumption ]. +symmetry in |- *; assumption. +case (total_order_T 0 (f y)); intro. +elim s; intro. +cut (x < y). +intro. +apply IVT; assumption. +inversion H0. +assumption. +rewrite H2 in r. +elim (Rlt_irrefl _ (Rlt_trans _ _ _ r a)). +apply existT with y. +split. +split; [ assumption | right; reflexivity ]. +symmetry in |- *; assumption. +cut (0 < f x * f y). +intro. +elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H2 H1)). +rewrite <- Rmult_opp_opp; apply Rmult_lt_0_compat; + apply Ropp_0_gt_lt_contravar; assumption. +Qed. + +(* We can now define the square root function as the reciprocal transformation of the square root function *) +Lemma Rsqrt_exists : + forall y:R, 0 <= y -> sigT (fun z:R => 0 <= z /\ y = Rsqr z). +intros. +set (f := fun x:R => Rsqr x - y). +cut (f 0 <= 0). +intro. +cut (continuity f). +intro. +case (total_order_T y 1); intro. +elim s; intro. +cut (0 <= f 1). +intro. +cut (f 0 * f 1 <= 0). +intro. +assert (X := IVT_cor f 0 1 H1 (Rlt_le _ _ Rlt_0_1) H3). +elim X; intros t H4. +apply existT with t. +elim H4; intros. +split. +elim H5; intros; assumption. +unfold f in H6. +apply Rminus_diag_uniq_sym; exact H6. +rewrite Rmult_comm; pattern 0 at 2 in |- *; rewrite <- (Rmult_0_r (f 1)). +apply Rmult_le_compat_l; assumption. +unfold f in |- *. +rewrite Rsqr_1. +apply Rplus_le_reg_l with y. +rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *; + rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; + left; assumption. +apply existT with 1. +split. +left; apply Rlt_0_1. +rewrite b; symmetry in |- *; apply Rsqr_1. +cut (0 <= f y). +intro. +cut (f 0 * f y <= 0). +intro. +assert (X := IVT_cor f 0 y H1 H H3). +elim X; intros t H4. +apply existT with t. +elim H4; intros. +split. +elim H5; intros; assumption. +unfold f in H6. +apply Rminus_diag_uniq_sym; exact H6. +rewrite Rmult_comm; pattern 0 at 2 in |- *; rewrite <- (Rmult_0_r (f y)). +apply Rmult_le_compat_l; assumption. +unfold f in |- *. +apply Rplus_le_reg_l with y. +rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *; + rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r. +pattern y at 1 in |- *; rewrite <- Rmult_1_r. +unfold Rsqr in |- *; apply Rmult_le_compat_l. +assumption. +left; exact r. +replace f with (Rsqr - fct_cte y)%F. +apply continuity_minus. +apply derivable_continuous; apply derivable_Rsqr. +apply derivable_continuous; apply derivable_const. +reflexivity. +unfold f in |- *; rewrite Rsqr_0. +unfold Rminus in |- *; rewrite Rplus_0_l. +apply Rge_le. +apply Ropp_0_le_ge_contravar; assumption. +Qed. + +(* Definition of the square root: R+->R *) +Definition Rsqrt (y:nonnegreal) : R := + match Rsqrt_exists (nonneg y) (cond_nonneg y) with + | existT a b => a + end. + +(**********) +Lemma Rsqrt_positivity : forall x:nonnegreal, 0 <= Rsqrt x. +intro. +assert (X := Rsqrt_exists (nonneg x) (cond_nonneg x)). +elim X; intros. +cut (x0 = Rsqrt x). +intros. +elim p; intros. +rewrite H in H0; assumption. +unfold Rsqrt in |- *. +case (Rsqrt_exists x (cond_nonneg x)). +intros. +elim p; elim a; intros. +apply Rsqr_inj. +assumption. +assumption. +rewrite <- H0; rewrite <- H2; reflexivity. +Qed. + +(**********) +Lemma Rsqrt_Rsqrt : forall x:nonnegreal, Rsqrt x * Rsqrt x = x. +intros. +assert (X := Rsqrt_exists (nonneg x) (cond_nonneg x)). +elim X; intros. +cut (x0 = Rsqrt x). +intros. +rewrite <- H. +elim p; intros. +rewrite H1; reflexivity. +unfold Rsqrt in |- *. +case (Rsqrt_exists x (cond_nonneg x)). +intros. +elim p; elim a; intros. +apply Rsqr_inj. +assumption. +assumption. +rewrite <- H0; rewrite <- H2; reflexivity. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Rtopology.v b/theories/Reals/Rtopology.v new file mode 100644 index 00000000..1c112bf1 --- /dev/null +++ b/theories/Reals/Rtopology.v @@ -0,0 +1,1825 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Rtopology.v,v 1.19.2.1 2004/07/16 19:31:13 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rfunctions. +Require Import Ranalysis1. +Require Import RList. +Require Import Classical_Prop. +Require Import Classical_Pred_Type. Open Local Scope R_scope. + +Definition included (D1 D2:R -> Prop) : Prop := forall x:R, D1 x -> D2 x. +Definition disc (x:R) (delta:posreal) (y:R) : Prop := Rabs (y - x) < delta. +Definition neighbourhood (V:R -> Prop) (x:R) : Prop := + exists delta : posreal, included (disc x delta) V. +Definition open_set (D:R -> Prop) : Prop := + forall x:R, D x -> neighbourhood D x. +Definition complementary (D:R -> Prop) (c:R) : Prop := ~ D c. +Definition closed_set (D:R -> Prop) : Prop := open_set (complementary D). +Definition intersection_domain (D1 D2:R -> Prop) (c:R) : Prop := D1 c /\ D2 c. +Definition union_domain (D1 D2:R -> Prop) (c:R) : Prop := D1 c \/ D2 c. +Definition interior (D:R -> Prop) (x:R) : Prop := neighbourhood D x. + +Lemma interior_P1 : forall D:R -> Prop, included (interior D) D. +intros; unfold included in |- *; unfold interior in |- *; intros; + unfold neighbourhood in H; elim H; intros; unfold included in H0; + apply H0; unfold disc in |- *; unfold Rminus in |- *; + rewrite Rplus_opp_r; rewrite Rabs_R0; apply (cond_pos x0). +Qed. + +Lemma interior_P2 : forall D:R -> Prop, open_set D -> included D (interior D). +intros; unfold open_set in H; unfold included in |- *; intros; + assert (H1 := H _ H0); unfold interior in |- *; apply H1. +Qed. + +Definition point_adherent (D:R -> Prop) (x:R) : Prop := + forall V:R -> Prop, + neighbourhood V x -> exists y : R, intersection_domain V D y. +Definition adherence (D:R -> Prop) (x:R) : Prop := point_adherent D x. + +Lemma adherence_P1 : forall D:R -> Prop, included D (adherence D). +intro; unfold included in |- *; intros; unfold adherence in |- *; + unfold point_adherent in |- *; intros; exists x; + unfold intersection_domain in |- *; split. +unfold neighbourhood in H0; elim H0; intros; unfold included in H1; apply H1; + unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rabs_R0; apply (cond_pos x0). +apply H. +Qed. + +Lemma included_trans : + forall D1 D2 D3:R -> Prop, + included D1 D2 -> included D2 D3 -> included D1 D3. +unfold included in |- *; intros; apply H0; apply H; apply H1. +Qed. + +Lemma interior_P3 : forall D:R -> Prop, open_set (interior D). +intro; unfold open_set, interior in |- *; unfold neighbourhood in |- *; + intros; elim H; intros. +exists x0; unfold included in |- *; intros. +set (del := x0 - Rabs (x - x1)). +cut (0 < del). +intro; exists (mkposreal del H2); intros. +cut (included (disc x1 (mkposreal del H2)) (disc x x0)). +intro; assert (H5 := included_trans _ _ _ H4 H0). +apply H5; apply H3. +unfold included in |- *; unfold disc in |- *; intros. +apply Rle_lt_trans with (Rabs (x3 - x1) + Rabs (x1 - x)). +replace (x3 - x) with (x3 - x1 + (x1 - x)); [ apply Rabs_triang | ring ]. +replace (pos x0) with (del + Rabs (x1 - x)). +do 2 rewrite <- (Rplus_comm (Rabs (x1 - x))); apply Rplus_lt_compat_l; + apply H4. +unfold del in |- *; rewrite <- (Rabs_Ropp (x - x1)); rewrite Ropp_minus_distr; + ring. +unfold del in |- *; apply Rplus_lt_reg_r with (Rabs (x - x1)); + rewrite Rplus_0_r; + replace (Rabs (x - x1) + (x0 - Rabs (x - x1))) with (pos x0); + [ idtac | ring ]. +unfold disc in H1; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H1. +Qed. + +Lemma complementary_P1 : + forall D:R -> Prop, + ~ (exists y : R, intersection_domain D (complementary D) y). +intro; red in |- *; intro; elim H; intros; + unfold intersection_domain, complementary in H0; elim H0; + intros; elim H2; assumption. +Qed. + +Lemma adherence_P2 : + forall D:R -> Prop, closed_set D -> included (adherence D) D. +unfold closed_set in |- *; unfold open_set, complementary in |- *; intros; + unfold included, adherence in |- *; intros; assert (H1 := classic (D x)); + elim H1; intro. +assumption. +assert (H3 := H _ H2); assert (H4 := H0 _ H3); elim H4; intros; + unfold intersection_domain in H5; elim H5; intros; + elim H6; assumption. +Qed. + +Lemma adherence_P3 : forall D:R -> Prop, closed_set (adherence D). +intro; unfold closed_set, adherence in |- *; + unfold open_set, complementary, point_adherent in |- *; + intros; + set + (P := + fun V:R -> Prop => + neighbourhood V x -> exists y : R, intersection_domain V D y); + assert (H0 := not_all_ex_not _ P H); elim H0; intros V0 H1; + unfold P in H1; assert (H2 := imply_to_and _ _ H1); + unfold neighbourhood in |- *; elim H2; intros; unfold neighbourhood in H3; + elim H3; intros; exists x0; unfold included in |- *; + intros; red in |- *; intro. +assert (H8 := H7 V0); + cut (exists delta : posreal, (forall x:R, disc x1 delta x -> V0 x)). +intro; assert (H10 := H8 H9); elim H4; assumption. +cut (0 < x0 - Rabs (x - x1)). +intro; set (del := mkposreal _ H9); exists del; intros; + unfold included in H5; apply H5; unfold disc in |- *; + apply Rle_lt_trans with (Rabs (x2 - x1) + Rabs (x1 - x)). +replace (x2 - x) with (x2 - x1 + (x1 - x)); [ apply Rabs_triang | ring ]. +replace (pos x0) with (del + Rabs (x1 - x)). +do 2 rewrite <- (Rplus_comm (Rabs (x1 - x))); apply Rplus_lt_compat_l; + apply H10. +unfold del in |- *; simpl in |- *; rewrite <- (Rabs_Ropp (x - x1)); + rewrite Ropp_minus_distr; ring. +apply Rplus_lt_reg_r with (Rabs (x - x1)); rewrite Rplus_0_r; + replace (Rabs (x - x1) + (x0 - Rabs (x - x1))) with (pos x0); + [ rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H6 | ring ]. +Qed. + +Definition eq_Dom (D1 D2:R -> Prop) : Prop := + included D1 D2 /\ included D2 D1. + +Infix "=_D" := eq_Dom (at level 70, no associativity). + +Lemma open_set_P1 : forall D:R -> Prop, open_set D <-> D =_D interior D. +intro; split. +intro; unfold eq_Dom in |- *; split. +apply interior_P2; assumption. +apply interior_P1. +intro; unfold eq_Dom in H; elim H; clear H; intros; unfold open_set in |- *; + intros; unfold included, interior in H; unfold included in H0; + apply (H _ H1). +Qed. + +Lemma closed_set_P1 : forall D:R -> Prop, closed_set D <-> D =_D adherence D. +intro; split. +intro; unfold eq_Dom in |- *; split. +apply adherence_P1. +apply adherence_P2; assumption. +unfold eq_Dom in |- *; unfold included in |- *; intros; + assert (H0 := adherence_P3 D); unfold closed_set in H0; + unfold closed_set in |- *; unfold open_set in |- *; + unfold open_set in H0; intros; assert (H2 : complementary (adherence D) x). +unfold complementary in |- *; unfold complementary in H1; red in |- *; intro; + elim H; clear H; intros _ H; elim H1; apply (H _ H2). +assert (H3 := H0 _ H2); unfold neighbourhood in |- *; + unfold neighbourhood in H3; elim H3; intros; exists x0; + unfold included in |- *; unfold included in H4; intros; + assert (H6 := H4 _ H5); unfold complementary in H6; + unfold complementary in |- *; red in |- *; intro; + elim H; clear H; intros H _; elim H6; apply (H _ H7). +Qed. + +Lemma neighbourhood_P1 : + forall (D1 D2:R -> Prop) (x:R), + included D1 D2 -> neighbourhood D1 x -> neighbourhood D2 x. +unfold included, neighbourhood in |- *; intros; elim H0; intros; exists x0; + intros; unfold included in |- *; unfold included in H1; + intros; apply (H _ (H1 _ H2)). +Qed. + +Lemma open_set_P2 : + forall D1 D2:R -> Prop, + open_set D1 -> open_set D2 -> open_set (union_domain D1 D2). +unfold open_set in |- *; intros; unfold union_domain in H1; elim H1; intro. +apply neighbourhood_P1 with D1. +unfold included, union_domain in |- *; tauto. +apply H; assumption. +apply neighbourhood_P1 with D2. +unfold included, union_domain in |- *; tauto. +apply H0; assumption. +Qed. + +Lemma open_set_P3 : + forall D1 D2:R -> Prop, + open_set D1 -> open_set D2 -> open_set (intersection_domain D1 D2). +unfold open_set in |- *; intros; unfold intersection_domain in H1; elim H1; + intros. +assert (H4 := H _ H2); assert (H5 := H0 _ H3); + unfold intersection_domain in |- *; unfold neighbourhood in H4, H5; + elim H4; clear H; intros del1 H; elim H5; clear H0; + intros del2 H0; cut (0 < Rmin del1 del2). +intro; set (del := mkposreal _ H6). +exists del; unfold included in |- *; intros; unfold included in H, H0; + unfold disc in H, H0, H7. +split. +apply H; apply Rlt_le_trans with (pos del). +apply H7. +unfold del in |- *; simpl in |- *; apply Rmin_l. +apply H0; apply Rlt_le_trans with (pos del). +apply H7. +unfold del in |- *; simpl in |- *; apply Rmin_r. +unfold Rmin in |- *; case (Rle_dec del1 del2); intro. +apply (cond_pos del1). +apply (cond_pos del2). +Qed. + +Lemma open_set_P4 : open_set (fun x:R => False). +unfold open_set in |- *; intros; elim H. +Qed. + +Lemma open_set_P5 : open_set (fun x:R => True). +unfold open_set in |- *; intros; unfold neighbourhood in |- *. +exists (mkposreal 1 Rlt_0_1); unfold included in |- *; intros; trivial. +Qed. + +Lemma disc_P1 : forall (x:R) (del:posreal), open_set (disc x del). +intros; assert (H := open_set_P1 (disc x del)). +elim H; intros; apply H1. +unfold eq_Dom in |- *; split. +unfold included, interior, disc in |- *; intros; + cut (0 < del - Rabs (x - x0)). +intro; set (del2 := mkposreal _ H3). +exists del2; unfold included in |- *; intros. +apply Rle_lt_trans with (Rabs (x1 - x0) + Rabs (x0 - x)). +replace (x1 - x) with (x1 - x0 + (x0 - x)); [ apply Rabs_triang | ring ]. +replace (pos del) with (del2 + Rabs (x0 - x)). +do 2 rewrite <- (Rplus_comm (Rabs (x0 - x))); apply Rplus_lt_compat_l. +apply H4. +unfold del2 in |- *; simpl in |- *; rewrite <- (Rabs_Ropp (x - x0)); + rewrite Ropp_minus_distr; ring. +apply Rplus_lt_reg_r with (Rabs (x - x0)); rewrite Rplus_0_r; + replace (Rabs (x - x0) + (del - Rabs (x - x0))) with (pos del); + [ rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H2 | ring ]. +apply interior_P1. +Qed. + +Lemma continuity_P1 : + forall (f:R -> R) (x:R), + continuity_pt f x <-> + (forall W:R -> Prop, + neighbourhood W (f x) -> + exists V : R -> Prop, + neighbourhood V x /\ (forall y:R, V y -> W (f y))). +intros; split. +intros; unfold neighbourhood in H0. +elim H0; intros del1 H1. +unfold continuity_pt in H; unfold continue_in in H; unfold limit1_in in H; + unfold limit_in in H; simpl in H; unfold R_dist in H. +assert (H2 := H del1 (cond_pos del1)). +elim H2; intros del2 H3. +elim H3; intros. +exists (disc x (mkposreal del2 H4)). +intros; unfold included in H1; split. +unfold neighbourhood, disc in |- *. +exists (mkposreal del2 H4). +unfold included in |- *; intros; assumption. +intros; apply H1; unfold disc in |- *; case (Req_dec y x); intro. +rewrite H7; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + apply (cond_pos del1). +apply H5; split. +unfold D_x, no_cond in |- *; split. +trivial. +apply (sym_not_eq (A:=R)); apply H7. +unfold disc in H6; apply H6. +intros; unfold continuity_pt in |- *; unfold continue_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + intros. +assert (H1 := H (disc (f x) (mkposreal eps H0))). +cut (neighbourhood (disc (f x) (mkposreal eps H0)) (f x)). +intro; assert (H3 := H1 H2). +elim H3; intros D H4; elim H4; intros; unfold neighbourhood in H5; elim H5; + intros del1 H7. +exists (pos del1); split. +apply (cond_pos del1). +intros; elim H8; intros; simpl in H10; unfold R_dist in H10; simpl in |- *; + unfold R_dist in |- *; apply (H6 _ (H7 _ H10)). +unfold neighbourhood, disc in |- *; exists (mkposreal eps H0); + unfold included in |- *; intros; assumption. +Qed. + +Definition image_rec (f:R -> R) (D:R -> Prop) (x:R) : Prop := D (f x). + +(**********) +Lemma continuity_P2 : + forall (f:R -> R) (D:R -> Prop), + continuity f -> open_set D -> open_set (image_rec f D). +intros; unfold open_set in H0; unfold open_set in |- *; intros; + assert (H2 := continuity_P1 f x); elim H2; intros H3 _; + assert (H4 := H3 (H x)); unfold neighbourhood, image_rec in |- *; + unfold image_rec in H1; assert (H5 := H4 D (H0 (f x) H1)); + elim H5; intros V0 H6; elim H6; intros; unfold neighbourhood in H7; + elim H7; intros del H9; exists del; unfold included in H9; + unfold included in |- *; intros; apply (H8 _ (H9 _ H10)). +Qed. + +(**********) +Lemma continuity_P3 : + forall f:R -> R, + continuity f <-> + (forall D:R -> Prop, open_set D -> open_set (image_rec f D)). +intros; split. +intros; apply continuity_P2; assumption. +intros; unfold continuity in |- *; unfold continuity_pt in |- *; + unfold continue_in in |- *; unfold limit1_in in |- *; + unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; + intros; cut (open_set (disc (f x) (mkposreal _ H0))). +intro; assert (H2 := H _ H1). +unfold open_set, image_rec in H2; cut (disc (f x) (mkposreal _ H0) (f x)). +intro; assert (H4 := H2 _ H3). +unfold neighbourhood in H4; elim H4; intros del H5. +exists (pos del); split. +apply (cond_pos del). +intros; unfold included in H5; apply H5; elim H6; intros; apply H8. +unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rabs_R0; apply H0. +apply disc_P1. +Qed. + +(**********) +Theorem Rsepare : + forall x y:R, + x <> y -> + exists V : R -> Prop, + (exists W : R -> Prop, + neighbourhood V x /\ + neighbourhood W y /\ ~ (exists y : R, intersection_domain V W y)). +intros x y Hsep; set (D := Rabs (x - y)). +cut (0 < D / 2). +intro; exists (disc x (mkposreal _ H)). +exists (disc y (mkposreal _ H)); split. +unfold neighbourhood in |- *; exists (mkposreal _ H); unfold included in |- *; + tauto. +split. +unfold neighbourhood in |- *; exists (mkposreal _ H); unfold included in |- *; + tauto. +red in |- *; intro; elim H0; intros; unfold intersection_domain in H1; + elim H1; intros. +cut (D < D). +intro; elim (Rlt_irrefl _ H4). +change (Rabs (x - y) < D) in |- *; + apply Rle_lt_trans with (Rabs (x - x0) + Rabs (x0 - y)). +replace (x - y) with (x - x0 + (x0 - y)); [ apply Rabs_triang | ring ]. +rewrite (double_var D); apply Rplus_lt_compat. +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H2. +apply H3. +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +unfold D in |- *; apply Rabs_pos_lt; apply (Rminus_eq_contra _ _ Hsep). +apply Rinv_0_lt_compat; prove_sup0. +Qed. + +Record family : Type := mkfamily + {ind : R -> Prop; + f :> R -> R -> Prop; + cond_fam : forall x:R, (exists y : R, f x y) -> ind x}. + +Definition family_open_set (f:family) : Prop := forall x:R, open_set (f x). + +Definition domain_finite (D:R -> Prop) : Prop := + exists l : Rlist, (forall x:R, D x <-> In x l). + +Definition family_finite (f:family) : Prop := domain_finite (ind f). + +Definition covering (D:R -> Prop) (f:family) : Prop := + forall x:R, D x -> exists y : R, f y x. + +Definition covering_open_set (D:R -> Prop) (f:family) : Prop := + covering D f /\ family_open_set f. + +Definition covering_finite (D:R -> Prop) (f:family) : Prop := + covering D f /\ family_finite f. + +Lemma restriction_family : + forall (f:family) (D:R -> Prop) (x:R), + (exists y : R, (fun z1 z2:R => f z1 z2 /\ D z1) x y) -> + intersection_domain (ind f) D x. +intros; elim H; intros; unfold intersection_domain in |- *; elim H0; intros; + split. +apply (cond_fam f0); exists x0; assumption. +assumption. +Qed. + +Definition subfamily (f:family) (D:R -> Prop) : family := + mkfamily (intersection_domain (ind f) D) (fun x y:R => f x y /\ D x) + (restriction_family f D). + +Definition compact (X:R -> Prop) : Prop := + forall f:family, + covering_open_set X f -> + exists D : R -> Prop, covering_finite X (subfamily f D). + +(**********) +Lemma family_P1 : + forall (f:family) (D:R -> Prop), + family_open_set f -> family_open_set (subfamily f D). +unfold family_open_set in |- *; intros; unfold subfamily in |- *; + simpl in |- *; assert (H0 := classic (D x)). +elim H0; intro. +cut (open_set (f0 x) -> open_set (fun y:R => f0 x y /\ D x)). +intro; apply H2; apply H. +unfold open_set in |- *; unfold neighbourhood in |- *; intros; elim H3; + intros; assert (H6 := H2 _ H4); elim H6; intros; exists x1; + unfold included in |- *; intros; split. +apply (H7 _ H8). +assumption. +cut (open_set (fun y:R => False) -> open_set (fun y:R => f0 x y /\ D x)). +intro; apply H2; apply open_set_P4. +unfold open_set in |- *; unfold neighbourhood in |- *; intros; elim H3; + intros; elim H1; assumption. +Qed. + +Definition bounded (D:R -> Prop) : Prop := + exists m : R, (exists M : R, (forall x:R, D x -> m <= x <= M)). + +Lemma open_set_P6 : + forall D1 D2:R -> Prop, open_set D1 -> D1 =_D D2 -> open_set D2. +unfold open_set in |- *; unfold neighbourhood in |- *; intros. +unfold eq_Dom in H0; elim H0; intros. +assert (H4 := H _ (H3 _ H1)). +elim H4; intros. +exists x0; apply included_trans with D1; assumption. +Qed. + +(**********) +Lemma compact_P1 : forall X:R -> Prop, compact X -> bounded X. +intros; unfold compact in H; set (D := fun x:R => True); + set (g := fun x y:R => Rabs y < x); + cut (forall x:R, (exists y : _, g x y) -> True); + [ intro | intro; trivial ]. +set (f0 := mkfamily D g H0); assert (H1 := H f0); + cut (covering_open_set X f0). +intro; assert (H3 := H1 H2); elim H3; intros D' H4; + unfold covering_finite in H4; elim H4; intros; unfold family_finite in H6; + unfold domain_finite in H6; elim H6; intros l H7; + unfold bounded in |- *; set (r := MaxRlist l). +exists (- r); exists r; intros. +unfold covering in H5; assert (H9 := H5 _ H8); elim H9; intros; + unfold subfamily in H10; simpl in H10; elim H10; intros; + assert (H13 := H7 x0); simpl in H13; cut (intersection_domain D D' x0). +elim H13; clear H13; intros. +assert (H16 := H13 H15); unfold g in H11; split. +cut (x0 <= r). +intro; cut (Rabs x < r). +intro; assert (H19 := Rabs_def2 x r H18); elim H19; intros; left; assumption. +apply Rlt_le_trans with x0; assumption. +apply (MaxRlist_P1 l x0 H16). +cut (x0 <= r). +intro; apply Rle_trans with (Rabs x). +apply RRle_abs. +apply Rle_trans with x0. +left; apply H11. +assumption. +apply (MaxRlist_P1 l x0 H16). +unfold intersection_domain, D in |- *; tauto. +unfold covering_open_set in |- *; split. +unfold covering in |- *; intros; simpl in |- *; exists (Rabs x + 1); + unfold g in |- *; pattern (Rabs x) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_lt_compat_l; apply Rlt_0_1. +unfold family_open_set in |- *; intro; case (Rtotal_order 0 x); intro. +apply open_set_P6 with (disc 0 (mkposreal _ H2)). +apply disc_P1. +unfold eq_Dom in |- *; unfold f0 in |- *; simpl in |- *; + unfold g, disc in |- *; split. +unfold included in |- *; intros; unfold Rminus in H3; rewrite Ropp_0 in H3; + rewrite Rplus_0_r in H3; apply H3. +unfold included in |- *; intros; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; apply H3. +apply open_set_P6 with (fun x:R => False). +apply open_set_P4. +unfold eq_Dom in |- *; split. +unfold included in |- *; intros; elim H3. +unfold included, f0 in |- *; simpl in |- *; unfold g in |- *; intros; elim H2; + intro; + [ rewrite <- H4 in H3; assert (H5 := Rabs_pos x0); + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H5 H3)) + | assert (H6 := Rabs_pos x0); assert (H7 := Rlt_trans _ _ _ H3 H4); + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H6 H7)) ]. +Qed. + +(**********) +Lemma compact_P2 : forall X:R -> Prop, compact X -> closed_set X. +intros; assert (H0 := closed_set_P1 X); elim H0; clear H0; intros _ H0; + apply H0; clear H0. +unfold eq_Dom in |- *; split. +apply adherence_P1. +unfold included in |- *; unfold adherence in |- *; + unfold point_adherent in |- *; intros; unfold compact in H; + assert (H1 := classic (X x)); elim H1; clear H1; intro. +assumption. +cut (forall y:R, X y -> 0 < Rabs (y - x) / 2). +intro; set (D := X); + set (g := fun y z:R => Rabs (y - z) < Rabs (y - x) / 2 /\ D y); + cut (forall x:R, (exists y : _, g x y) -> D x). +intro; set (f0 := mkfamily D g H3); assert (H4 := H f0); + cut (covering_open_set X f0). +intro; assert (H6 := H4 H5); elim H6; clear H6; intros D' H6. +unfold covering_finite in H6; decompose [and] H6; + unfold covering, subfamily in H7; simpl in H7; + unfold family_finite, subfamily in H8; simpl in H8; + unfold domain_finite in H8; elim H8; clear H8; intros l H8; + set (alp := MinRlist (AbsList l x)); cut (0 < alp). +intro; assert (H10 := H0 (disc x (mkposreal _ H9))); + cut (neighbourhood (disc x (mkposreal alp H9)) x). +intro; assert (H12 := H10 H11); elim H12; clear H12; intros y H12; + unfold intersection_domain in H12; elim H12; clear H12; + intros; assert (H14 := H7 _ H13); elim H14; clear H14; + intros y0 H14; elim H14; clear H14; intros; unfold g in H14; + elim H14; clear H14; intros; unfold disc in H12; simpl in H12; + cut (alp <= Rabs (y0 - x) / 2). +intro; assert (H18 := Rlt_le_trans _ _ _ H12 H17); + cut (Rabs (y0 - x) < Rabs (y0 - x)). +intro; elim (Rlt_irrefl _ H19). +apply Rle_lt_trans with (Rabs (y0 - y) + Rabs (y - x)). +replace (y0 - x) with (y0 - y + (y - x)); [ apply Rabs_triang | ring ]. +rewrite (double_var (Rabs (y0 - x))); apply Rplus_lt_compat; assumption. +apply (MinRlist_P1 (AbsList l x) (Rabs (y0 - x) / 2)); apply AbsList_P1; + elim (H8 y0); clear H8; intros; apply H8; unfold intersection_domain in |- *; + split; assumption. +assert (H11 := disc_P1 x (mkposreal alp H9)); unfold open_set in H11; + apply H11. +unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rabs_R0; apply H9. +unfold alp in |- *; apply MinRlist_P2; intros; + assert (H10 := AbsList_P2 _ _ _ H9); elim H10; clear H10; + intros z H10; elim H10; clear H10; intros; rewrite H11; + apply H2; elim (H8 z); clear H8; intros; assert (H13 := H12 H10); + unfold intersection_domain, D in H13; elim H13; clear H13; + intros; assumption. +unfold covering_open_set in |- *; split. +unfold covering in |- *; intros; exists x0; simpl in |- *; unfold g in |- *; + split. +unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + unfold Rminus in H2; apply (H2 _ H5). +apply H5. +unfold family_open_set in |- *; intro; simpl in |- *; unfold g in |- *; + elim (classic (D x0)); intro. +apply open_set_P6 with (disc x0 (mkposreal _ (H2 _ H5))). +apply disc_P1. +unfold eq_Dom in |- *; split. +unfold included, disc in |- *; simpl in |- *; intros; split. +rewrite <- (Rabs_Ropp (x0 - x1)); rewrite Ropp_minus_distr; apply H6. +apply H5. +unfold included, disc in |- *; simpl in |- *; intros; elim H6; intros; + rewrite <- (Rabs_Ropp (x1 - x0)); rewrite Ropp_minus_distr; + apply H7. +apply open_set_P6 with (fun z:R => False). +apply open_set_P4. +unfold eq_Dom in |- *; split. +unfold included in |- *; intros; elim H6. +unfold included in |- *; intros; elim H6; intros; elim H5; assumption. +intros; elim H3; intros; unfold g in H4; elim H4; clear H4; intros _ H4; + apply H4. +intros; unfold Rdiv in |- *; apply Rmult_lt_0_compat. +apply Rabs_pos_lt; apply Rminus_eq_contra; red in |- *; intro; + rewrite H3 in H2; elim H1; apply H2. +apply Rinv_0_lt_compat; prove_sup0. +Qed. + +(**********) +Lemma compact_EMP : compact (fun _:R => False). +unfold compact in |- *; intros; exists (fun x:R => False); + unfold covering_finite in |- *; split. +unfold covering in |- *; intros; elim H0. +unfold family_finite in |- *; unfold domain_finite in |- *; exists nil; intro. +split. +simpl in |- *; unfold intersection_domain in |- *; intros; elim H0. +elim H0; clear H0; intros _ H0; elim H0. +simpl in |- *; intro; elim H0. +Qed. + +Lemma compact_eqDom : + forall X1 X2:R -> Prop, compact X1 -> X1 =_D X2 -> compact X2. +unfold compact in |- *; intros; unfold eq_Dom in H0; elim H0; clear H0; + unfold included in |- *; intros; assert (H3 : covering_open_set X1 f0). +unfold covering_open_set in |- *; unfold covering_open_set in H1; elim H1; + clear H1; intros; split. +unfold covering in H1; unfold covering in |- *; intros; + apply (H1 _ (H0 _ H4)). +apply H3. +elim (H _ H3); intros D H4; exists D; unfold covering_finite in |- *; + unfold covering_finite in H4; elim H4; intros; split. +unfold covering in H5; unfold covering in |- *; intros; + apply (H5 _ (H2 _ H7)). +apply H6. +Qed. + +(* Borel-Lebesgue's lemma *) +Lemma compact_P3 : forall a b:R, compact (fun c:R => a <= c <= b). +intros; case (Rle_dec a b); intro. +unfold compact in |- *; intros; + set + (A := + fun x:R => + a <= x <= b /\ + (exists D : R -> Prop, + covering_finite (fun c:R => a <= c <= x) (subfamily f0 D))); + cut (A a). +intro; cut (bound A). +intro; cut (exists a0 : R, A a0). +intro; assert (H3 := completeness A H1 H2); elim H3; clear H3; intros m H3; + unfold is_lub in H3; cut (a <= m <= b). +intro; unfold covering_open_set in H; elim H; clear H; intros; + unfold covering in H; assert (H6 := H m H4); elim H6; + clear H6; intros y0 H6; unfold family_open_set in H5; + assert (H7 := H5 y0); unfold open_set in H7; assert (H8 := H7 m H6); + unfold neighbourhood in H8; elim H8; clear H8; intros eps H8; + cut (exists x : R, A x /\ m - eps < x <= m). +intro; elim H9; clear H9; intros x H9; elim H9; clear H9; intros; + case (Req_dec m b); intro. +rewrite H11 in H10; rewrite H11 in H8; unfold A in H9; elim H9; clear H9; + intros; elim H12; clear H12; intros Dx H12; + set (Db := fun x:R => Dx x \/ x = y0); exists Db; + unfold covering_finite in |- *; split. +unfold covering in |- *; unfold covering_finite in H12; elim H12; clear H12; + intros; unfold covering in H12; case (Rle_dec x0 x); + intro. +cut (a <= x0 <= x). +intro; assert (H16 := H12 x0 H15); elim H16; clear H16; intros; exists x1; + simpl in H16; simpl in |- *; unfold Db in |- *; elim H16; + clear H16; intros; split; [ apply H16 | left; apply H17 ]. +split. +elim H14; intros; assumption. +assumption. +exists y0; simpl in |- *; split. +apply H8; unfold disc in |- *; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; + rewrite Rabs_right. +apply Rlt_trans with (b - x). +unfold Rminus in |- *; apply Rplus_lt_compat_l; apply Ropp_lt_gt_contravar; + auto with real. +elim H10; intros H15 _; apply Rplus_lt_reg_r with (x - eps); + replace (x - eps + (b - x)) with (b - eps); + [ replace (x - eps + eps) with x; [ apply H15 | ring ] | ring ]. +apply Rge_minus; apply Rle_ge; elim H14; intros _ H15; apply H15. +unfold Db in |- *; right; reflexivity. +unfold family_finite in |- *; unfold domain_finite in |- *; + unfold covering_finite in H12; elim H12; clear H12; + intros; unfold family_finite in H13; unfold domain_finite in H13; + elim H13; clear H13; intros l H13; exists (cons y0 l); + intro; split. +intro; simpl in H14; unfold intersection_domain in H14; elim (H13 x0); + clear H13; intros; case (Req_dec x0 y0); intro. +simpl in |- *; left; apply H16. +simpl in |- *; right; apply H13. +simpl in |- *; unfold intersection_domain in |- *; unfold Db in H14; + decompose [and or] H14. +split; assumption. +elim H16; assumption. +intro; simpl in H14; elim H14; intro; simpl in |- *; + unfold intersection_domain in |- *. +split. +apply (cond_fam f0); rewrite H15; exists m; apply H6. +unfold Db in |- *; right; assumption. +simpl in |- *; unfold intersection_domain in |- *; elim (H13 x0). +intros _ H16; assert (H17 := H16 H15); simpl in H17; + unfold intersection_domain in H17; split. +elim H17; intros; assumption. +unfold Db in |- *; left; elim H17; intros; assumption. +set (m' := Rmin (m + eps / 2) b); cut (A m'). +intro; elim H3; intros; unfold is_upper_bound in H13; + assert (H15 := H13 m' H12); cut (m < m'). +intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H15 H16)). +unfold m' in |- *; unfold Rmin in |- *; case (Rle_dec (m + eps / 2) b); intro. +pattern m at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ]. +elim H4; intros. +elim H17; intro. +assumption. +elim H11; assumption. +unfold A in |- *; split. +split. +apply Rle_trans with m. +elim H4; intros; assumption. +unfold m' in |- *; unfold Rmin in |- *; case (Rle_dec (m + eps / 2) b); intro. +pattern m at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ]. +elim H4; intros. +elim H13; intro. +assumption. +elim H11; assumption. +unfold m' in |- *; apply Rmin_r. +unfold A in H9; elim H9; clear H9; intros; elim H12; clear H12; intros Dx H12; + set (Db := fun x:R => Dx x \/ x = y0); exists Db; + unfold covering_finite in |- *; split. +unfold covering in |- *; unfold covering_finite in H12; elim H12; clear H12; + intros; unfold covering in H12; case (Rle_dec x0 x); + intro. +cut (a <= x0 <= x). +intro; assert (H16 := H12 x0 H15); elim H16; clear H16; intros; exists x1; + simpl in H16; simpl in |- *; unfold Db in |- *. +elim H16; clear H16; intros; split; [ apply H16 | left; apply H17 ]. +elim H14; intros; split; assumption. +exists y0; simpl in |- *; split. +apply H8; unfold disc in |- *; unfold Rabs in |- *; case (Rcase_abs (x0 - m)); + intro. +rewrite Ropp_minus_distr; apply Rlt_trans with (m - x). +unfold Rminus in |- *; apply Rplus_lt_compat_l; apply Ropp_lt_gt_contravar; + auto with real. +apply Rplus_lt_reg_r with (x - eps); + replace (x - eps + (m - x)) with (m - eps). +replace (x - eps + eps) with x. +elim H10; intros; assumption. +ring. +ring. +apply Rle_lt_trans with (m' - m). +unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- m)); + apply Rplus_le_compat_l; elim H14; intros; assumption. +apply Rplus_lt_reg_r with m; replace (m + (m' - m)) with m'. +apply Rle_lt_trans with (m + eps / 2). +unfold m' in |- *; apply Rmin_l. +apply Rplus_lt_compat_l; apply Rmult_lt_reg_l with 2. +prove_sup0. +unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym. +rewrite Rmult_1_l; pattern (pos eps) at 1 in |- *; rewrite <- Rplus_0_r; + rewrite double; apply Rplus_lt_compat_l; apply (cond_pos eps). +discrR. +ring. +unfold Db in |- *; right; reflexivity. +unfold family_finite in |- *; unfold domain_finite in |- *; + unfold covering_finite in H12; elim H12; clear H12; + intros; unfold family_finite in H13; unfold domain_finite in H13; + elim H13; clear H13; intros l H13; exists (cons y0 l); + intro; split. +intro; simpl in H14; unfold intersection_domain in H14; elim (H13 x0); + clear H13; intros; case (Req_dec x0 y0); intro. +simpl in |- *; left; apply H16. +simpl in |- *; right; apply H13; simpl in |- *; + unfold intersection_domain in |- *; unfold Db in H14; + decompose [and or] H14. +split; assumption. +elim H16; assumption. +intro; simpl in H14; elim H14; intro; simpl in |- *; + unfold intersection_domain in |- *. +split. +apply (cond_fam f0); rewrite H15; exists m; apply H6. +unfold Db in |- *; right; assumption. +elim (H13 x0); intros _ H16. +assert (H17 := H16 H15). +simpl in H17. +unfold intersection_domain in H17. +split. +elim H17; intros; assumption. +unfold Db in |- *; left; elim H17; intros; assumption. +elim (classic (exists x : R, A x /\ m - eps < x <= m)); intro. +assumption. +elim H3; intros; cut (is_upper_bound A (m - eps)). +intro; assert (H13 := H11 _ H12); cut (m - eps < m). +intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H13 H14)). +pattern m at 2 in |- *; rewrite <- Rplus_0_r; unfold Rminus in |- *; + apply Rplus_lt_compat_l; apply Ropp_lt_cancel; rewrite Ropp_involutive; + rewrite Ropp_0; apply (cond_pos eps). +set (P := fun n:R => A n /\ m - eps < n <= m); + assert (H12 := not_ex_all_not _ P H9); unfold P in H12; + unfold is_upper_bound in |- *; intros; + assert (H14 := not_and_or _ _ (H12 x)); elim H14; + intro. +elim H15; apply H13. +elim (not_and_or _ _ H15); intro. +case (Rle_dec x (m - eps)); intro. +assumption. +elim H16; auto with real. +unfold is_upper_bound in H10; assert (H17 := H10 x H13); elim H16; apply H17. +elim H3; clear H3; intros. +unfold is_upper_bound in H3. +split. +apply (H3 _ H0). +apply (H4 b); unfold is_upper_bound in |- *; intros; unfold A in H5; elim H5; + clear H5; intros H5 _; elim H5; clear H5; intros _ H5; + apply H5. +exists a; apply H0. +unfold bound in |- *; exists b; unfold is_upper_bound in |- *; intros; + unfold A in H1; elim H1; clear H1; intros H1 _; elim H1; + clear H1; intros _ H1; apply H1. +unfold A in |- *; split. +split; [ right; reflexivity | apply r ]. +unfold covering_open_set in H; elim H; clear H; intros; unfold covering in H; + cut (a <= a <= b). +intro; elim (H _ H1); intros y0 H2; set (D' := fun x:R => x = y0); exists D'; + unfold covering_finite in |- *; split. +unfold covering in |- *; simpl in |- *; intros; cut (x = a). +intro; exists y0; split. +rewrite H4; apply H2. +unfold D' in |- *; reflexivity. +elim H3; intros; apply Rle_antisym; assumption. +unfold family_finite in |- *; unfold domain_finite in |- *; + exists (cons y0 nil); intro; split. +simpl in |- *; unfold intersection_domain in |- *; intro; elim H3; clear H3; + intros; unfold D' in H4; left; apply H4. +simpl in |- *; unfold intersection_domain in |- *; intro; elim H3; intro. +split; [ rewrite H4; apply (cond_fam f0); exists a; apply H2 | apply H4 ]. +elim H4. +split; [ right; reflexivity | apply r ]. +apply compact_eqDom with (fun c:R => False). +apply compact_EMP. +unfold eq_Dom in |- *; split. +unfold included in |- *; intros; elim H. +unfold included in |- *; intros; elim H; clear H; intros; + assert (H1 := Rle_trans _ _ _ H H0); elim n; apply H1. +Qed. + +Lemma compact_P4 : + forall X F:R -> Prop, compact X -> closed_set F -> included F X -> compact F. +unfold compact in |- *; intros; elim (classic (exists z : R, F z)); + intro Hyp_F_NE. +set (D := ind f0); set (g := f f0); unfold closed_set in H0. +set (g' := fun x y:R => f0 x y \/ complementary F y /\ D x). +set (D' := D). +cut (forall x:R, (exists y : R, g' x y) -> D' x). +intro; set (f' := mkfamily D' g' H3); cut (covering_open_set X f'). +intro; elim (H _ H4); intros DX H5; exists DX. +unfold covering_finite in |- *; unfold covering_finite in H5; elim H5; + clear H5; intros. +split. +unfold covering in |- *; unfold covering in H5; intros. +elim (H5 _ (H1 _ H7)); intros y0 H8; exists y0; simpl in H8; simpl in |- *; + elim H8; clear H8; intros. +split. +unfold g' in H8; elim H8; intro. +apply H10. +elim H10; intros H11 _; unfold complementary in H11; elim H11; apply H7. +apply H9. +unfold family_finite in |- *; unfold domain_finite in |- *; + unfold family_finite in H6; unfold domain_finite in H6; + elim H6; clear H6; intros l H6; exists l; intro; assert (H7 := H6 x); + elim H7; clear H7; intros. +split. +intro; apply H7; simpl in |- *; unfold intersection_domain in |- *; + simpl in H9; unfold intersection_domain in H9; unfold D' in |- *; + apply H9. +intro; assert (H10 := H8 H9); simpl in H10; unfold intersection_domain in H10; + simpl in |- *; unfold intersection_domain in |- *; + unfold D' in H10; apply H10. +unfold covering_open_set in |- *; unfold covering_open_set in H2; elim H2; + clear H2; intros. +split. +unfold covering in |- *; unfold covering in H2; intros. +elim (classic (F x)); intro. +elim (H2 _ H6); intros y0 H7; exists y0; simpl in |- *; unfold g' in |- *; + left; assumption. +cut (exists z : R, D z). +intro; elim H7; clear H7; intros x0 H7; exists x0; simpl in |- *; + unfold g' in |- *; right. +split. +unfold complementary in |- *; apply H6. +apply H7. +elim Hyp_F_NE; intros z0 H7. +assert (H8 := H2 _ H7). +elim H8; clear H8; intros t H8; exists t; apply (cond_fam f0); exists z0; + apply H8. +unfold family_open_set in |- *; intro; simpl in |- *; unfold g' in |- *; + elim (classic (D x)); intro. +apply open_set_P6 with (union_domain (f0 x) (complementary F)). +apply open_set_P2. +unfold family_open_set in H4; apply H4. +apply H0. +unfold eq_Dom in |- *; split. +unfold included, union_domain, complementary in |- *; intros. +elim H6; intro; [ left; apply H7 | right; split; assumption ]. +unfold included, union_domain, complementary in |- *; intros. +elim H6; intro; [ left; apply H7 | right; elim H7; intros; apply H8 ]. +apply open_set_P6 with (f0 x). +unfold family_open_set in H4; apply H4. +unfold eq_Dom in |- *; split. +unfold included, complementary in |- *; intros; left; apply H6. +unfold included, complementary in |- *; intros. +elim H6; intro. +apply H7. +elim H7; intros _ H8; elim H5; apply H8. +intros; elim H3; intros y0 H4; unfold g' in H4; elim H4; intro. +apply (cond_fam f0); exists y0; apply H5. +elim H5; clear H5; intros _ H5; apply H5. +(* Cas ou F est l'ensemble vide *) +cut (compact F). +intro; apply (H3 f0 H2). +apply compact_eqDom with (fun _:R => False). +apply compact_EMP. +unfold eq_Dom in |- *; split. +unfold included in |- *; intros; elim H3. +assert (H3 := not_ex_all_not _ _ Hyp_F_NE); unfold included in |- *; intros; + elim (H3 x); apply H4. +Qed. + +(**********) +Lemma compact_P5 : forall X:R -> Prop, closed_set X -> bounded X -> compact X. +intros; unfold bounded in H0. +elim H0; clear H0; intros m H0. +elim H0; clear H0; intros M H0. +assert (H1 := compact_P3 m M). +apply (compact_P4 (fun c:R => m <= c <= M) X H1 H H0). +Qed. + +(**********) +Lemma compact_carac : + forall X:R -> Prop, compact X <-> closed_set X /\ bounded X. +intro; split. +intro; split; [ apply (compact_P2 _ H) | apply (compact_P1 _ H) ]. +intro; elim H; clear H; intros; apply (compact_P5 _ H H0). +Qed. + +Definition image_dir (f:R -> R) (D:R -> Prop) (x:R) : Prop := + exists y : R, x = f y /\ D y. + +(**********) +Lemma continuity_compact : + forall (f:R -> R) (X:R -> Prop), + (forall x:R, continuity_pt f x) -> compact X -> compact (image_dir f X). +unfold compact in |- *; intros; unfold covering_open_set in H1. +elim H1; clear H1; intros. +set (D := ind f1). +set (g := fun x y:R => image_rec f0 (f1 x) y). +cut (forall x:R, (exists y : R, g x y) -> D x). +intro; set (f' := mkfamily D g H3). +cut (covering_open_set X f'). +intro; elim (H0 f' H4); intros D' H5; exists D'. +unfold covering_finite in H5; elim H5; clear H5; intros; + unfold covering_finite in |- *; split. +unfold covering, image_dir in |- *; simpl in |- *; unfold covering in H5; + intros; elim H7; intros y H8; elim H8; intros; assert (H11 := H5 _ H10); + simpl in H11; elim H11; intros z H12; exists z; unfold g in H12; + unfold image_rec in H12; rewrite H9; apply H12. +unfold family_finite in H6; unfold domain_finite in H6; + unfold family_finite in |- *; unfold domain_finite in |- *; + elim H6; intros l H7; exists l; intro; elim (H7 x); + intros; split; intro. +apply H8; simpl in H10; simpl in |- *; apply H10. +apply (H9 H10). +unfold covering_open_set in |- *; split. +unfold covering in |- *; intros; simpl in |- *; unfold covering in H1; + unfold image_dir in H1; unfold g in |- *; unfold image_rec in |- *; + apply H1. +exists x; split; [ reflexivity | apply H4 ]. +unfold family_open_set in |- *; unfold family_open_set in H2; intro; + simpl in |- *; unfold g in |- *; + cut ((fun y:R => image_rec f0 (f1 x) y) = image_rec f0 (f1 x)). +intro; rewrite H4. +apply (continuity_P2 f0 (f1 x) H (H2 x)). +reflexivity. +intros; apply (cond_fam f1); unfold g in H3; unfold image_rec in H3; elim H3; + intros; exists (f0 x0); apply H4. +Qed. + +Lemma Rlt_Rminus : forall a b:R, a < b -> 0 < b - a. +intros; apply Rplus_lt_reg_r with a; rewrite Rplus_0_r; + replace (a + (b - a)) with b; [ assumption | ring ]. +Qed. + +Lemma prolongement_C0 : + forall (f:R -> R) (a b:R), + a <= b -> + (forall c:R, a <= c <= b -> continuity_pt f c) -> + exists g : R -> R, + continuity g /\ (forall c:R, a <= c <= b -> g c = f c). +intros; elim H; intro. +set + (h := + fun x:R => + match Rle_dec x a with + | left _ => f0 a + | right _ => + match Rle_dec x b with + | left _ => f0 x + | right _ => f0 b + end + end). +assert (H2 : 0 < b - a). +apply Rlt_Rminus; assumption. +exists h; split. +unfold continuity in |- *; intro; case (Rtotal_order x a); intro. +unfold continuity_pt in |- *; unfold continue_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold R_dist in |- *; intros; exists (a - x); + split. +change (0 < a - x) in |- *; apply Rlt_Rminus; assumption. +intros; elim H5; clear H5; intros _ H5; unfold h in |- *. +case (Rle_dec x a); intro. +case (Rle_dec x0 a); intro. +unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. +elim n; left; apply Rplus_lt_reg_r with (- x); + do 2 rewrite (Rplus_comm (- x)); apply Rle_lt_trans with (Rabs (x0 - x)). +apply RRle_abs. +assumption. +elim n; left; assumption. +elim H3; intro. +assert (H5 : a <= a <= b). +split; [ right; reflexivity | left; assumption ]. +assert (H6 := H0 _ H5); unfold continuity_pt in H6; unfold continue_in in H6; + unfold limit1_in in H6; unfold limit_in in H6; simpl in H6; + unfold R_dist in H6; unfold continuity_pt in |- *; + unfold continue_in in |- *; unfold limit1_in in |- *; + unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; + intros; elim (H6 _ H7); intros; exists (Rmin x0 (b - a)); + split. +unfold Rmin in |- *; case (Rle_dec x0 (b - a)); intro. +elim H8; intros; assumption. +change (0 < b - a) in |- *; apply Rlt_Rminus; assumption. +intros; elim H9; clear H9; intros _ H9; cut (x1 < b). +intro; unfold h in |- *; case (Rle_dec x a); intro. +case (Rle_dec x1 a); intro. +unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. +case (Rle_dec x1 b); intro. +elim H8; intros; apply H12; split. +unfold D_x, no_cond in |- *; split. +trivial. +red in |- *; intro; elim n; right; symmetry in |- *; assumption. +apply Rlt_le_trans with (Rmin x0 (b - a)). +rewrite H4 in H9; apply H9. +apply Rmin_l. +elim n0; left; assumption. +elim n; right; assumption. +apply Rplus_lt_reg_r with (- a); do 2 rewrite (Rplus_comm (- a)); + rewrite H4 in H9; apply Rle_lt_trans with (Rabs (x1 - a)). +apply RRle_abs. +apply Rlt_le_trans with (Rmin x0 (b - a)). +assumption. +apply Rmin_r. +case (Rtotal_order x b); intro. +assert (H6 : a <= x <= b). +split; left; assumption. +assert (H7 := H0 _ H6); unfold continuity_pt in H7; unfold continue_in in H7; + unfold limit1_in in H7; unfold limit_in in H7; simpl in H7; + unfold R_dist in H7; unfold continuity_pt in |- *; + unfold continue_in in |- *; unfold limit1_in in |- *; + unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; + intros; elim (H7 _ H8); intros; elim H9; clear H9; + intros. +assert (H11 : 0 < x - a). +apply Rlt_Rminus; assumption. +assert (H12 : 0 < b - x). +apply Rlt_Rminus; assumption. +exists (Rmin x0 (Rmin (x - a) (b - x))); split. +unfold Rmin in |- *; case (Rle_dec (x - a) (b - x)); intro. +case (Rle_dec x0 (x - a)); intro. +assumption. +assumption. +case (Rle_dec x0 (b - x)); intro. +assumption. +assumption. +intros; elim H13; clear H13; intros; cut (a < x1 < b). +intro; elim H15; clear H15; intros; unfold h in |- *; case (Rle_dec x a); + intro. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H4)). +case (Rle_dec x b); intro. +case (Rle_dec x1 a); intro. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 H15)). +case (Rle_dec x1 b); intro. +apply H10; split. +assumption. +apply Rlt_le_trans with (Rmin x0 (Rmin (x - a) (b - x))). +assumption. +apply Rmin_l. +elim n1; left; assumption. +elim n0; left; assumption. +split. +apply Ropp_lt_cancel; apply Rplus_lt_reg_r with x; + apply Rle_lt_trans with (Rabs (x1 - x)). +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs. +apply Rlt_le_trans with (Rmin x0 (Rmin (x - a) (b - x))). +assumption. +apply Rle_trans with (Rmin (x - a) (b - x)). +apply Rmin_r. +apply Rmin_l. +apply Rplus_lt_reg_r with (- x); do 2 rewrite (Rplus_comm (- x)); + apply Rle_lt_trans with (Rabs (x1 - x)). +apply RRle_abs. +apply Rlt_le_trans with (Rmin x0 (Rmin (x - a) (b - x))). +assumption. +apply Rle_trans with (Rmin (x - a) (b - x)); apply Rmin_r. +elim H5; intro. +assert (H7 : a <= b <= b). +split; [ left; assumption | right; reflexivity ]. +assert (H8 := H0 _ H7); unfold continuity_pt in H8; unfold continue_in in H8; + unfold limit1_in in H8; unfold limit_in in H8; simpl in H8; + unfold R_dist in H8; unfold continuity_pt in |- *; + unfold continue_in in |- *; unfold limit1_in in |- *; + unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; + intros; elim (H8 _ H9); intros; exists (Rmin x0 (b - a)); + split. +unfold Rmin in |- *; case (Rle_dec x0 (b - a)); intro. +elim H10; intros; assumption. +change (0 < b - a) in |- *; apply Rlt_Rminus; assumption. +intros; elim H11; clear H11; intros _ H11; cut (a < x1). +intro; unfold h in |- *; case (Rle_dec x a); intro. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H4)). +case (Rle_dec x1 a); intro. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H12)). +case (Rle_dec x b); intro. +case (Rle_dec x1 b); intro. +rewrite H6; elim H10; intros; elim r0; intro. +apply H14; split. +unfold D_x, no_cond in |- *; split. +trivial. +red in |- *; intro; rewrite <- H16 in H15; elim (Rlt_irrefl _ H15). +rewrite H6 in H11; apply Rlt_le_trans with (Rmin x0 (b - a)). +apply H11. +apply Rmin_l. +rewrite H15; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + assumption. +rewrite H6; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + assumption. +elim n1; right; assumption. +rewrite H6 in H11; apply Ropp_lt_cancel; apply Rplus_lt_reg_r with b; + apply Rle_lt_trans with (Rabs (x1 - b)). +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs. +apply Rlt_le_trans with (Rmin x0 (b - a)). +assumption. +apply Rmin_r. +unfold continuity_pt in |- *; unfold continue_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold R_dist in |- *; intros; exists (x - b); + split. +change (0 < x - b) in |- *; apply Rlt_Rminus; assumption. +intros; elim H8; clear H8; intros. +assert (H10 : b < x0). +apply Ropp_lt_cancel; apply Rplus_lt_reg_r with x; + apply Rle_lt_trans with (Rabs (x0 - x)). +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs. +assumption. +unfold h in |- *; case (Rle_dec x a); intro. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H4)). +case (Rle_dec x b); intro. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H6)). +case (Rle_dec x0 a); intro. +elim (Rlt_irrefl _ (Rlt_trans _ _ _ H1 (Rlt_le_trans _ _ _ H10 r))). +case (Rle_dec x0 b); intro. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H10)). +unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. +intros; elim H3; intros; unfold h in |- *; case (Rle_dec c a); intro. +elim r; intro. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 H6)). +rewrite H6; reflexivity. +case (Rle_dec c b); intro. +reflexivity. +elim n0; assumption. +exists (fun _:R => f0 a); split. +apply derivable_continuous; apply (derivable_const (f0 a)). +intros; elim H2; intros; rewrite H1 in H3; cut (b = c). +intro; rewrite <- H5; rewrite H1; reflexivity. +apply Rle_antisym; assumption. +Qed. + +(**********) +Lemma continuity_ab_maj : + forall (f:R -> R) (a b:R), + a <= b -> + (forall c:R, a <= c <= b -> continuity_pt f c) -> + exists Mx : R, (forall c:R, a <= c <= b -> f c <= f Mx) /\ a <= Mx <= b. +intros; + cut + (exists g : R -> R, + continuity g /\ (forall c:R, a <= c <= b -> g c = f0 c)). +intro HypProl. +elim HypProl; intros g Hcont_eq. +elim Hcont_eq; clear Hcont_eq; intros Hcont Heq. +assert (H1 := compact_P3 a b). +assert (H2 := continuity_compact g (fun c:R => a <= c <= b) Hcont H1). +assert (H3 := compact_P2 _ H2). +assert (H4 := compact_P1 _ H2). +cut (bound (image_dir g (fun c:R => a <= c <= b))). +cut (exists x : R, image_dir g (fun c:R => a <= c <= b) x). +intros; assert (H7 := completeness _ H6 H5). +elim H7; clear H7; intros M H7; cut (image_dir g (fun c:R => a <= c <= b) M). +intro; unfold image_dir in H8; elim H8; clear H8; intros Mxx H8; elim H8; + clear H8; intros; exists Mxx; split. +intros; rewrite <- (Heq c H10); rewrite <- (Heq Mxx H9); intros; + rewrite <- H8; unfold is_lub in H7; elim H7; clear H7; + intros H7 _; unfold is_upper_bound in H7; apply H7; + unfold image_dir in |- *; exists c; split; [ reflexivity | apply H10 ]. +apply H9. +elim (classic (image_dir g (fun c:R => a <= c <= b) M)); intro. +assumption. +cut + (exists eps : posreal, + (forall y:R, + ~ + intersection_domain (disc M eps) + (image_dir g (fun c:R => a <= c <= b)) y)). +intro; elim H9; clear H9; intros eps H9; unfold is_lub in H7; elim H7; + clear H7; intros; + cut (is_upper_bound (image_dir g (fun c:R => a <= c <= b)) (M - eps)). +intro; assert (H12 := H10 _ H11); cut (M - eps < M). +intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H12 H13)). +pattern M at 2 in |- *; rewrite <- Rplus_0_r; unfold Rminus in |- *; + apply Rplus_lt_compat_l; apply Ropp_lt_cancel; rewrite Ropp_0; + rewrite Ropp_involutive; apply (cond_pos eps). +unfold is_upper_bound, image_dir in |- *; intros; cut (x <= M). +intro; case (Rle_dec x (M - eps)); intro. +apply r. +elim (H9 x); unfold intersection_domain, disc, image_dir in |- *; split. +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; rewrite Rabs_right. +apply Rplus_lt_reg_r with (x - eps); + replace (x - eps + (M - x)) with (M - eps). +replace (x - eps + eps) with x. +auto with real. +ring. +ring. +apply Rge_minus; apply Rle_ge; apply H12. +apply H11. +apply H7; apply H11. +cut + (exists V : R -> Prop, + neighbourhood V M /\ + (forall y:R, + ~ intersection_domain V (image_dir g (fun c:R => a <= c <= b)) y)). +intro; elim H9; intros V H10; elim H10; clear H10; intros. +unfold neighbourhood in H10; elim H10; intros del H12; exists del; intros; + red in |- *; intro; elim (H11 y). +unfold intersection_domain in |- *; unfold intersection_domain in H13; + elim H13; clear H13; intros; split. +apply (H12 _ H13). +apply H14. +cut (~ point_adherent (image_dir g (fun c:R => a <= c <= b)) M). +intro; unfold point_adherent in H9. +assert + (H10 := + not_all_ex_not _ + (fun V:R -> Prop => + neighbourhood V M -> + exists y : R, + intersection_domain V (image_dir g (fun c:R => a <= c <= b)) y) H9). +elim H10; intros V0 H11; exists V0; assert (H12 := imply_to_and _ _ H11); + elim H12; clear H12; intros. +split. +apply H12. +apply (not_ex_all_not _ _ H13). +red in |- *; intro; cut (adherence (image_dir g (fun c:R => a <= c <= b)) M). +intro; elim (closed_set_P1 (image_dir g (fun c:R => a <= c <= b))); + intros H11 _; assert (H12 := H11 H3). +elim H8. +unfold eq_Dom in H12; elim H12; clear H12; intros. +apply (H13 _ H10). +apply H9. +exists (g a); unfold image_dir in |- *; exists a; split. +reflexivity. +split; [ right; reflexivity | apply H ]. +unfold bound in |- *; unfold bounded in H4; elim H4; clear H4; intros m H4; + elim H4; clear H4; intros M H4; exists M; unfold is_upper_bound in |- *; + intros; elim (H4 _ H5); intros _ H6; apply H6. +apply prolongement_C0; assumption. +Qed. + +(**********) +Lemma continuity_ab_min : + forall (f:R -> R) (a b:R), + a <= b -> + (forall c:R, a <= c <= b -> continuity_pt f c) -> + exists mx : R, (forall c:R, a <= c <= b -> f mx <= f c) /\ a <= mx <= b. +intros. +cut (forall c:R, a <= c <= b -> continuity_pt (- f0) c). +intro; assert (H2 := continuity_ab_maj (- f0)%F a b H H1); elim H2; + intros x0 H3; exists x0; intros; split. +intros; rewrite <- (Ropp_involutive (f0 x0)); + rewrite <- (Ropp_involutive (f0 c)); apply Ropp_le_contravar; + elim H3; intros; unfold opp_fct in H5; apply H5; apply H4. +elim H3; intros; assumption. +intros. +assert (H2 := H0 _ H1). +apply (continuity_pt_opp _ _ H2). +Qed. + + +(********************************************************) +(* Proof of Bolzano-Weierstrass theorem *) +(********************************************************) + +Definition ValAdh (un:nat -> R) (x:R) : Prop := + forall (V:R -> Prop) (N:nat), + neighbourhood V x -> exists p : nat, (N <= p)%nat /\ V (un p). + +Definition intersection_family (f:family) (x:R) : Prop := + forall y:R, ind f y -> f y x. + +Lemma ValAdh_un_exists : + forall (un:nat -> R) (D:=fun x:R => exists n : nat, x = INR n) + (f:= + fun x:R => + adherence + (fun y:R => (exists p : nat, y = un p /\ x <= INR p) /\ D x)) + (x:R), (exists y : R, f x y) -> D x. +intros; elim H; intros; unfold f in H0; unfold adherence in H0; + unfold point_adherent in H0; + assert (H1 : neighbourhood (disc x0 (mkposreal _ Rlt_0_1)) x0). +unfold neighbourhood, disc in |- *; exists (mkposreal _ Rlt_0_1); + unfold included in |- *; trivial. +elim (H0 _ H1); intros; unfold intersection_domain in H2; elim H2; intros; + elim H4; intros; apply H6. +Qed. + +Definition ValAdh_un (un:nat -> R) : R -> Prop := + let D := fun x:R => exists n : nat, x = INR n in + let f := + fun x:R => + adherence + (fun y:R => (exists p : nat, y = un p /\ x <= INR p) /\ D x) in + intersection_family (mkfamily D f (ValAdh_un_exists un)). + +Lemma ValAdh_un_prop : + forall (un:nat -> R) (x:R), ValAdh un x <-> ValAdh_un un x. +intros; split; intro. +unfold ValAdh in H; unfold ValAdh_un in |- *; + unfold intersection_family in |- *; simpl in |- *; + intros; elim H0; intros N H1; unfold adherence in |- *; + unfold point_adherent in |- *; intros; elim (H V N H2); + intros; exists (un x0); unfold intersection_domain in |- *; + elim H3; clear H3; intros; split. +assumption. +split. +exists x0; split; [ reflexivity | rewrite H1; apply (le_INR _ _ H3) ]. +exists N; assumption. +unfold ValAdh in |- *; intros; unfold ValAdh_un in H; + unfold intersection_family in H; simpl in H; + assert + (H1 : + adherence + (fun y0:R => + (exists p : nat, y0 = un p /\ INR N <= INR p) /\ + (exists n : nat, INR N = INR n)) x). +apply H; exists N; reflexivity. +unfold adherence in H1; unfold point_adherent in H1; assert (H2 := H1 _ H0); + elim H2; intros; unfold intersection_domain in H3; + elim H3; clear H3; intros; elim H4; clear H4; intros; + elim H4; clear H4; intros; elim H4; clear H4; intros; + exists x1; split. +apply (INR_le _ _ H6). +rewrite H4 in H3; apply H3. +Qed. + +Lemma adherence_P4 : + forall F G:R -> Prop, included F G -> included (adherence F) (adherence G). +unfold adherence, included in |- *; unfold point_adherent in |- *; intros; + elim (H0 _ H1); unfold intersection_domain in |- *; + intros; elim H2; clear H2; intros; exists x0; split; + [ assumption | apply (H _ H3) ]. +Qed. + +Definition family_closed_set (f:family) : Prop := + forall x:R, closed_set (f x). + +Definition intersection_vide_in (D:R -> Prop) (f:family) : Prop := + forall x:R, + (ind f x -> included (f x) D) /\ + ~ (exists y : R, intersection_family f y). + +Definition intersection_vide_finite_in (D:R -> Prop) + (f:family) : Prop := intersection_vide_in D f /\ family_finite f. + +(**********) +Lemma compact_P6 : + forall X:R -> Prop, + compact X -> + (exists z : R, X z) -> + forall g:family, + family_closed_set g -> + intersection_vide_in X g -> + exists D : R -> Prop, intersection_vide_finite_in X (subfamily g D). +intros X H Hyp g H0 H1. +set (D' := ind g). +set (f' := fun x y:R => complementary (g x) y /\ D' x). +assert (H2 : forall x:R, (exists y : R, f' x y) -> D' x). +intros; elim H2; intros; unfold f' in H3; elim H3; intros; assumption. +set (f0 := mkfamily D' f' H2). +unfold compact in H; assert (H3 : covering_open_set X f0). +unfold covering_open_set in |- *; split. +unfold covering in |- *; intros; unfold intersection_vide_in in H1; + elim (H1 x); intros; unfold intersection_family in H5; + assert + (H6 := not_ex_all_not _ (fun y:R => forall y0:R, ind g y0 -> g y0 y) H5 x); + assert (H7 := not_all_ex_not _ (fun y0:R => ind g y0 -> g y0 x) H6); + elim H7; intros; exists x0; elim (imply_to_and _ _ H8); + intros; unfold f0 in |- *; simpl in |- *; unfold f' in |- *; + split; [ apply H10 | apply H9 ]. +unfold family_open_set in |- *; intro; elim (classic (D' x)); intro. +apply open_set_P6 with (complementary (g x)). +unfold family_closed_set in H0; unfold closed_set in H0; apply H0. +unfold f0 in |- *; simpl in |- *; unfold f' in |- *; unfold eq_Dom in |- *; + split. +unfold included in |- *; intros; split; [ apply H4 | apply H3 ]. +unfold included in |- *; intros; elim H4; intros; assumption. +apply open_set_P6 with (fun _:R => False). +apply open_set_P4. +unfold eq_Dom in |- *; unfold included in |- *; split; intros; + [ elim H4 + | simpl in H4; unfold f' in H4; elim H4; intros; elim H3; assumption ]. +elim (H _ H3); intros SF H4; exists SF; + unfold intersection_vide_finite_in in |- *; split. +unfold intersection_vide_in in |- *; simpl in |- *; intros; split. +intros; unfold included in |- *; intros; unfold intersection_vide_in in H1; + elim (H1 x); intros; elim H6; intros; apply H7. +unfold intersection_domain in H5; elim H5; intros; assumption. +assumption. +elim (classic (exists y : R, intersection_domain (ind g) SF y)); intro Hyp'. +red in |- *; intro; elim H5; intros; unfold intersection_family in H6; + simpl in H6. +cut (X x0). +intro; unfold covering_finite in H4; elim H4; clear H4; intros H4 _; + unfold covering in H4; elim (H4 x0 H7); intros; simpl in H8; + unfold intersection_domain in H6; cut (ind g x1 /\ SF x1). +intro; assert (H10 := H6 x1 H9); elim H10; clear H10; intros H10 _; elim H8; + clear H8; intros H8 _; unfold f' in H8; unfold complementary in H8; + elim H8; clear H8; intros H8 _; elim H8; assumption. +split. +apply (cond_fam f0). +exists x0; elim H8; intros; assumption. +elim H8; intros; assumption. +unfold intersection_vide_in in H1; elim Hyp'; intros; assert (H8 := H6 _ H7); + elim H8; intros; cut (ind g x1). +intro; elim (H1 x1); intros; apply H12. +apply H11. +apply H9. +apply (cond_fam g); exists x0; assumption. +unfold covering_finite in H4; elim H4; clear H4; intros H4 _; + cut (exists z : R, X z). +intro; elim H5; clear H5; intros; unfold covering in H4; elim (H4 x0 H5); + intros; simpl in H6; elim Hyp'; exists x1; elim H6; + intros; unfold intersection_domain in |- *; split. +apply (cond_fam f0); exists x0; apply H7. +apply H8. +apply Hyp. +unfold covering_finite in H4; elim H4; clear H4; intros; + unfold family_finite in H5; unfold domain_finite in H5; + unfold family_finite in |- *; unfold domain_finite in |- *; + elim H5; clear H5; intros l H5; exists l; intro; elim (H5 x); + intros; split; intro; + [ apply H6; simpl in |- *; simpl in H8; apply H8 | apply (H7 H8) ]. +Qed. + +Theorem Bolzano_Weierstrass : + forall (un:nat -> R) (X:R -> Prop), + compact X -> (forall n:nat, X (un n)) -> exists l : R, ValAdh un l. +intros; cut (exists l : R, ValAdh_un un l). +intro; elim H1; intros; exists x; elim (ValAdh_un_prop un x); intros; + apply (H4 H2). +assert (H1 : exists z : R, X z). +exists (un 0%nat); apply H0. +set (D := fun x:R => exists n : nat, x = INR n). +set + (g := + fun x:R => + adherence (fun y:R => (exists p : nat, y = un p /\ x <= INR p) /\ D x)). +assert (H2 : forall x:R, (exists y : R, g x y) -> D x). +intros; elim H2; intros; unfold g in H3; unfold adherence in H3; + unfold point_adherent in H3. +assert (H4 : neighbourhood (disc x0 (mkposreal _ Rlt_0_1)) x0). +unfold neighbourhood in |- *; exists (mkposreal _ Rlt_0_1); + unfold included in |- *; trivial. +elim (H3 _ H4); intros; unfold intersection_domain in H5; decompose [and] H5; + assumption. +set (f0 := mkfamily D g H2). +assert (H3 := compact_P6 X H H1 f0). +elim (classic (exists l : R, ValAdh_un un l)); intro. +assumption. +cut (family_closed_set f0). +intro; cut (intersection_vide_in X f0). +intro; assert (H7 := H3 H5 H6). +elim H7; intros SF H8; unfold intersection_vide_finite_in in H8; elim H8; + clear H8; intros; unfold intersection_vide_in in H8; + elim (H8 0); intros _ H10; elim H10; unfold family_finite in H9; + unfold domain_finite in H9; elim H9; clear H9; intros l H9; + set (r := MaxRlist l); cut (D r). +intro; unfold D in H11; elim H11; intros; exists (un x); + unfold intersection_family in |- *; simpl in |- *; + unfold intersection_domain in |- *; intros; split. +unfold g in |- *; apply adherence_P1; split. +exists x; split; + [ reflexivity + | rewrite <- H12; unfold r in |- *; apply MaxRlist_P1; elim (H9 y); intros; + apply H14; simpl in |- *; apply H13 ]. +elim H13; intros; assumption. +elim H13; intros; assumption. +elim (H9 r); intros. +simpl in H12; unfold intersection_domain in H12; cut (In r l). +intro; elim (H12 H13); intros; assumption. +unfold r in |- *; apply MaxRlist_P2; + cut (exists z : R, intersection_domain (ind f0) SF z). +intro; elim H13; intros; elim (H9 x); intros; simpl in H15; + assert (H17 := H15 H14); exists x; apply H17. +elim (classic (exists z : R, intersection_domain (ind f0) SF z)); intro. +assumption. +elim (H8 0); intros _ H14; elim H1; intros; + assert + (H16 := + not_ex_all_not _ (fun y:R => intersection_family (subfamily f0 SF) y) H14); + assert + (H17 := + not_ex_all_not _ (fun z:R => intersection_domain (ind f0) SF z) H13); + assert (H18 := H16 x); unfold intersection_family in H18; + simpl in H18; + assert + (H19 := + not_all_ex_not _ (fun y:R => intersection_domain D SF y -> g y x /\ SF y) + H18); elim H19; intros; assert (H21 := imply_to_and _ _ H20); + elim (H17 x0); elim H21; intros; assumption. +unfold intersection_vide_in in |- *; intros; split. +intro; simpl in H6; unfold f0 in |- *; simpl in |- *; unfold g in |- *; + apply included_trans with (adherence X). +apply adherence_P4. +unfold included in |- *; intros; elim H7; intros; elim H8; intros; elim H10; + intros; rewrite H11; apply H0. +apply adherence_P2; apply compact_P2; assumption. +apply H4. +unfold family_closed_set in |- *; unfold f0 in |- *; simpl in |- *; + unfold g in |- *; intro; apply adherence_P3. +Qed. + +(********************************************************) +(* Proof of Heine's theorem *) +(********************************************************) + +Definition uniform_continuity (f:R -> R) (X:R -> Prop) : Prop := + forall eps:posreal, + exists delta : posreal, + (forall x y:R, + X x -> X y -> Rabs (x - y) < delta -> Rabs (f x - f y) < eps). + +Lemma is_lub_u : + forall (E:R -> Prop) (x y:R), is_lub E x -> is_lub E y -> x = y. +unfold is_lub in |- *; intros; elim H; elim H0; intros; apply Rle_antisym; + [ apply (H4 _ H1) | apply (H2 _ H3) ]. +Qed. + +Lemma domain_P1 : + forall X:R -> Prop, + ~ (exists y : R, X y) \/ + (exists y : R, X y /\ (forall x:R, X x -> x = y)) \/ + (exists x : R, (exists y : R, X x /\ X y /\ x <> y)). +intro; elim (classic (exists y : R, X y)); intro. +right; elim H; intros; elim (classic (exists y : R, X y /\ y <> x)); intro. +right; elim H1; intros; elim H2; intros; exists x; exists x0; intros. +split; + [ assumption + | split; [ assumption | apply (sym_not_eq (A:=R)); assumption ] ]. +left; exists x; split. +assumption. +intros; case (Req_dec x0 x); intro. +assumption. +elim H1; exists x0; split; assumption. +left; assumption. +Qed. + +Theorem Heine : + forall (f:R -> R) (X:R -> Prop), + compact X -> + (forall x:R, X x -> continuity_pt f x) -> uniform_continuity f X. +intros f0 X H0 H; elim (domain_P1 X); intro Hyp. +(* X est vide *) +unfold uniform_continuity in |- *; intros; exists (mkposreal _ Rlt_0_1); + intros; elim Hyp; exists x; assumption. +elim Hyp; clear Hyp; intro Hyp. +(* X possède un seul élément *) +unfold uniform_continuity in |- *; intros; exists (mkposreal _ Rlt_0_1); + intros; elim Hyp; clear Hyp; intros; elim H4; clear H4; + intros; assert (H6 := H5 _ H1); assert (H7 := H5 _ H2); + rewrite H6; rewrite H7; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rabs_R0; apply (cond_pos eps). +(* X possède au moins deux éléments distincts *) +assert + (X_enc : + exists m : R, (exists M : R, (forall x:R, X x -> m <= x <= M) /\ m < M)). +assert (H1 := compact_P1 X H0); unfold bounded in H1; elim H1; intros; + elim H2; intros; exists x; exists x0; split. +apply H3. +elim Hyp; intros; elim H4; intros; decompose [and] H5; + assert (H10 := H3 _ H6); assert (H11 := H3 _ H8); + elim H10; intros; elim H11; intros; case (total_order_T x x0); + intro. +elim s; intro. +assumption. +rewrite b in H13; rewrite b in H7; elim H9; apply Rle_antisym; + apply Rle_trans with x0; assumption. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (Rle_trans _ _ _ H13 H14) r)). +elim X_enc; clear X_enc; intros m X_enc; elim X_enc; clear X_enc; + intros M X_enc; elim X_enc; clear X_enc Hyp; intros X_enc Hyp; + unfold uniform_continuity in |- *; intro; + assert (H1 : forall t:posreal, 0 < t / 2). +intro; unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos t) | apply Rinv_0_lt_compat; prove_sup0 ]. +set + (g := + fun x y:R => + X x /\ + (exists del : posreal, + (forall z:R, Rabs (z - x) < del -> Rabs (f0 z - f0 x) < eps / 2) /\ + is_lub + (fun zeta:R => + 0 < zeta <= M - m /\ + (forall z:R, Rabs (z - x) < zeta -> Rabs (f0 z - f0 x) < eps / 2)) + del /\ disc x (mkposreal (del / 2) (H1 del)) y)). +assert (H2 : forall x:R, (exists y : R, g x y) -> X x). +intros; elim H2; intros; unfold g in H3; elim H3; clear H3; intros H3 _; + apply H3. +set (f' := mkfamily X g H2); unfold compact in H0; + assert (H3 : covering_open_set X f'). +unfold covering_open_set in |- *; split. +unfold covering in |- *; intros; exists x; simpl in |- *; unfold g in |- *; + split. +assumption. +assert (H4 := H _ H3); unfold continuity_pt in H4; unfold continue_in in H4; + unfold limit1_in in H4; unfold limit_in in H4; simpl in H4; + unfold R_dist in H4; elim (H4 (eps / 2) (H1 eps)); + intros; + set + (E := + fun zeta:R => + 0 < zeta <= M - m /\ + (forall z:R, Rabs (z - x) < zeta -> Rabs (f0 z - f0 x) < eps / 2)); + assert (H6 : bound E). +unfold bound in |- *; exists (M - m); unfold is_upper_bound in |- *; + unfold E in |- *; intros; elim H6; clear H6; intros H6 _; + elim H6; clear H6; intros _ H6; apply H6. +assert (H7 : exists x : R, E x). +elim H5; clear H5; intros; exists (Rmin x0 (M - m)); unfold E in |- *; intros; + split. +split. +unfold Rmin in |- *; case (Rle_dec x0 (M - m)); intro. +apply H5. +apply Rlt_Rminus; apply Hyp. +apply Rmin_r. +intros; case (Req_dec x z); intro. +rewrite H9; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + apply (H1 eps). +apply H7; split. +unfold D_x, no_cond in |- *; split; [ trivial | assumption ]. +apply Rlt_le_trans with (Rmin x0 (M - m)); [ apply H8 | apply Rmin_l ]. +assert (H8 := completeness _ H6 H7); elim H8; clear H8; intros; + cut (0 < x1 <= M - m). +intro; elim H8; clear H8; intros; exists (mkposreal _ H8); split. +intros; cut (exists alp : R, Rabs (z - x) < alp <= x1 /\ E alp). +intros; elim H11; intros; elim H12; clear H12; intros; unfold E in H13; + elim H13; intros; apply H15. +elim H12; intros; assumption. +elim (classic (exists alp : R, Rabs (z - x) < alp <= x1 /\ E alp)); intro. +assumption. +assert + (H12 := + not_ex_all_not _ (fun alp:R => Rabs (z - x) < alp <= x1 /\ E alp) H11); + unfold is_lub in p; elim p; intros; cut (is_upper_bound E (Rabs (z - x))). +intro; assert (H16 := H14 _ H15); + elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H10 H16)). +unfold is_upper_bound in |- *; intros; unfold is_upper_bound in H13; + assert (H16 := H13 _ H15); case (Rle_dec x2 (Rabs (z - x))); + intro. +assumption. +elim (H12 x2); split; [ split; [ auto with real | assumption ] | assumption ]. +split. +apply p. +unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rabs_R0; simpl in |- *; unfold Rdiv in |- *; + apply Rmult_lt_0_compat; [ apply H8 | apply Rinv_0_lt_compat; prove_sup0 ]. +elim H7; intros; unfold E in H8; elim H8; intros H9 _; elim H9; intros H10 _; + unfold is_lub in p; elim p; intros; unfold is_upper_bound in H12; + unfold is_upper_bound in H11; split. +apply Rlt_le_trans with x2; [ assumption | apply (H11 _ H8) ]. +apply H12; intros; unfold E in H13; elim H13; intros; elim H14; intros; + assumption. +unfold family_open_set in |- *; intro; simpl in |- *; elim (classic (X x)); + intro. +unfold g in |- *; unfold open_set in |- *; intros; elim H4; clear H4; + intros _ H4; elim H4; clear H4; intros; elim H4; clear H4; + intros; unfold neighbourhood in |- *; case (Req_dec x x0); + intro. +exists (mkposreal _ (H1 x1)); rewrite <- H6; unfold included in |- *; intros; + split. +assumption. +exists x1; split. +apply H4. +split. +elim H5; intros; apply H8. +apply H7. +set (d := x1 / 2 - Rabs (x0 - x)); assert (H7 : 0 < d). +unfold d in |- *; apply Rlt_Rminus; elim H5; clear H5; intros; + unfold disc in H7; apply H7. +exists (mkposreal _ H7); unfold included in |- *; intros; split. +assumption. +exists x1; split. +apply H4. +elim H5; intros; split. +assumption. +unfold disc in H8; simpl in H8; unfold disc in |- *; simpl in |- *; + unfold disc in H10; simpl in H10; + apply Rle_lt_trans with (Rabs (x2 - x0) + Rabs (x0 - x)). +replace (x2 - x) with (x2 - x0 + (x0 - x)); [ apply Rabs_triang | ring ]. +replace (x1 / 2) with (d + Rabs (x0 - x)); [ idtac | unfold d in |- *; ring ]. +do 2 rewrite <- (Rplus_comm (Rabs (x0 - x))); apply Rplus_lt_compat_l; + apply H8. +apply open_set_P6 with (fun _:R => False). +apply open_set_P4. +unfold eq_Dom in |- *; unfold included in |- *; intros; split. +intros; elim H4. +intros; unfold g in H4; elim H4; clear H4; intros H4 _; elim H3; apply H4. +elim (H0 _ H3); intros DF H4; unfold covering_finite in H4; elim H4; clear H4; + intros; unfold family_finite in H5; unfold domain_finite in H5; + unfold covering in H4; simpl in H4; simpl in H5; elim H5; + clear H5; intros l H5; unfold intersection_domain in H5; + cut + (forall x:R, + In x l -> + exists del : R, + 0 < del /\ + (forall z:R, Rabs (z - x) < del -> Rabs (f0 z - f0 x) < eps / 2) /\ + included (g x) (fun z:R => Rabs (z - x) < del / 2)). +intros; + assert + (H7 := + Rlist_P1 l + (fun x del:R => + 0 < del /\ + (forall z:R, Rabs (z - x) < del -> Rabs (f0 z - f0 x) < eps / 2) /\ + included (g x) (fun z:R => Rabs (z - x) < del / 2)) H6); + elim H7; clear H7; intros l' H7; elim H7; clear H7; + intros; set (D := MinRlist l'); cut (0 < D / 2). +intro; exists (mkposreal _ H9); intros; assert (H13 := H4 _ H10); elim H13; + clear H13; intros xi H13; assert (H14 : In xi l). +unfold g in H13; decompose [and] H13; elim (H5 xi); intros; apply H14; split; + assumption. +elim (pos_Rl_P2 l xi); intros H15 _; elim (H15 H14); intros i H16; elim H16; + intros; apply Rle_lt_trans with (Rabs (f0 x - f0 xi) + Rabs (f0 xi - f0 y)). +replace (f0 x - f0 y) with (f0 x - f0 xi + (f0 xi - f0 y)); + [ apply Rabs_triang | ring ]. +rewrite (double_var eps); apply Rplus_lt_compat. +assert (H19 := H8 i H17); elim H19; clear H19; intros; rewrite <- H18 in H20; + elim H20; clear H20; intros; apply H20; unfold included in H21; + apply Rlt_trans with (pos_Rl l' i / 2). +apply H21. +elim H13; clear H13; intros; assumption. +unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2. +prove_sup0. +rewrite Rmult_comm; rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; pattern (pos_Rl l' i) at 1 in |- *; rewrite <- Rplus_0_r; + rewrite double; apply Rplus_lt_compat_l; apply H19. +discrR. +assert (H19 := H8 i H17); elim H19; clear H19; intros; rewrite <- H18 in H20; + elim H20; clear H20; intros; rewrite <- Rabs_Ropp; + rewrite Ropp_minus_distr; apply H20; unfold included in H21; + elim H13; intros; assert (H24 := H21 x H22); + apply Rle_lt_trans with (Rabs (y - x) + Rabs (x - xi)). +replace (y - xi) with (y - x + (x - xi)); [ apply Rabs_triang | ring ]. +rewrite (double_var (pos_Rl l' i)); apply Rplus_lt_compat. +apply Rlt_le_trans with (D / 2). +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H12. +unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ 2)); + apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; prove_sup0. +unfold D in |- *; apply MinRlist_P1; elim (pos_Rl_P2 l' (pos_Rl l' i)); + intros; apply H26; exists i; split; + [ rewrite <- H7; assumption | reflexivity ]. +assumption. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ unfold D in |- *; apply MinRlist_P2; intros; elim (pos_Rl_P2 l' y); intros; + elim (H10 H9); intros; elim H12; intros; rewrite H14; + rewrite <- H7 in H13; elim (H8 x H13); intros; + apply H15 + | apply Rinv_0_lt_compat; prove_sup0 ]. +intros; elim (H5 x); intros; elim (H8 H6); intros; + set + (E := + fun zeta:R => + 0 < zeta <= M - m /\ + (forall z:R, Rabs (z - x) < zeta -> Rabs (f0 z - f0 x) < eps / 2)); + assert (H11 : bound E). +unfold bound in |- *; exists (M - m); unfold is_upper_bound in |- *; + unfold E in |- *; intros; elim H11; clear H11; intros H11 _; + elim H11; clear H11; intros _ H11; apply H11. +assert (H12 : exists x : R, E x). +assert (H13 := H _ H9); unfold continuity_pt in H13; + unfold continue_in in H13; unfold limit1_in in H13; + unfold limit_in in H13; simpl in H13; unfold R_dist in H13; + elim (H13 _ (H1 eps)); intros; elim H12; clear H12; + intros; exists (Rmin x0 (M - m)); unfold E in |- *; + intros; split. +split; + [ unfold Rmin in |- *; case (Rle_dec x0 (M - m)); intro; + [ apply H12 | apply Rlt_Rminus; apply Hyp ] + | apply Rmin_r ]. +intros; case (Req_dec x z); intro. +rewrite H16; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + apply (H1 eps). +apply H14; split; + [ unfold D_x, no_cond in |- *; split; [ trivial | assumption ] + | apply Rlt_le_trans with (Rmin x0 (M - m)); [ apply H15 | apply Rmin_l ] ]. +assert (H13 := completeness _ H11 H12); elim H13; clear H13; intros; + cut (0 < x0 <= M - m). +intro; elim H13; clear H13; intros; exists x0; split. +assumption. +split. +intros; cut (exists alp : R, Rabs (z - x) < alp <= x0 /\ E alp). +intros; elim H16; intros; elim H17; clear H17; intros; unfold E in H18; + elim H18; intros; apply H20; elim H17; intros; assumption. +elim (classic (exists alp : R, Rabs (z - x) < alp <= x0 /\ E alp)); intro. +assumption. +assert + (H17 := + not_ex_all_not _ (fun alp:R => Rabs (z - x) < alp <= x0 /\ E alp) H16); + unfold is_lub in p; elim p; intros; cut (is_upper_bound E (Rabs (z - x))). +intro; assert (H21 := H19 _ H20); + elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H15 H21)). +unfold is_upper_bound in |- *; intros; unfold is_upper_bound in H18; + assert (H21 := H18 _ H20); case (Rle_dec x1 (Rabs (z - x))); + intro. +assumption. +elim (H17 x1); split. +split; [ auto with real | assumption ]. +assumption. +unfold included, g in |- *; intros; elim H15; intros; elim H17; intros; + decompose [and] H18; cut (x0 = x2). +intro; rewrite H20; apply H22. +unfold E in p; eapply is_lub_u. +apply p. +apply H21. +elim H12; intros; unfold E in H13; elim H13; intros H14 _; elim H14; + intros H15 _; unfold is_lub in p; elim p; intros; + unfold is_upper_bound in H16; unfold is_upper_bound in H17; + split. +apply Rlt_le_trans with x1; [ assumption | apply (H16 _ H13) ]. +apply H17; intros; unfold E in H18; elim H18; intros; elim H19; intros; + assumption. +Qed. diff --git a/theories/Reals/Rtrigo.v b/theories/Reals/Rtrigo.v new file mode 100644 index 00000000..e4cae6c6 --- /dev/null +++ b/theories/Reals/Rtrigo.v @@ -0,0 +1,1707 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Rtrigo.v,v 1.40.2.1 2004/07/16 19:31:14 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rfunctions. +Require Import SeqSeries. +Require Export Rtrigo_fun. +Require Export Rtrigo_def. +Require Export Rtrigo_alt. +Require Export Cos_rel. +Require Export Cos_plus. +Require Import ZArith_base. +Require Import Zcomplements. +Require Import Classical_Prop. +Open Local Scope nat_scope. +Open Local Scope R_scope. + +(** sin_PI2 is the only remaining axiom **) +Axiom sin_PI2 : sin (PI / 2) = 1. + +(**********) +Lemma PI_neq0 : PI <> 0. +red in |- *; intro; assert (H0 := PI_RGT_0); rewrite H in H0; + elim (Rlt_irrefl _ H0). +Qed. + +(**********) +Lemma cos_minus : forall x y:R, cos (x - y) = cos x * cos y + sin x * sin y. +intros; unfold Rminus in |- *; rewrite cos_plus. +rewrite <- cos_sym; rewrite sin_antisym; ring. +Qed. + +(**********) +Lemma sin2_cos2 : forall x:R, Rsqr (sin x) + Rsqr (cos x) = 1. +intro; unfold Rsqr in |- *; rewrite Rplus_comm; rewrite <- (cos_minus x x); + unfold Rminus in |- *; rewrite Rplus_opp_r; apply cos_0. +Qed. + +Lemma cos2 : forall x:R, Rsqr (cos x) = 1 - Rsqr (sin x). +intro x; generalize (sin2_cos2 x); intro H1; rewrite <- H1; + unfold Rminus in |- *; rewrite <- (Rplus_comm (Rsqr (cos x))); + rewrite Rplus_assoc; rewrite Rplus_opp_r; symmetry in |- *; + apply Rplus_0_r. +Qed. + +(**********) +Lemma cos_PI2 : cos (PI / 2) = 0. +apply Rsqr_eq_0; rewrite cos2; rewrite sin_PI2; rewrite Rsqr_1; + unfold Rminus in |- *; apply Rplus_opp_r. +Qed. + +(**********) +Lemma cos_PI : cos PI = -1. +replace PI with (PI / 2 + PI / 2). +rewrite cos_plus. +rewrite sin_PI2; rewrite cos_PI2. +ring. +symmetry in |- *; apply double_var. +Qed. + +Lemma sin_PI : sin PI = 0. +assert (H := sin2_cos2 PI). +rewrite cos_PI in H. +rewrite <- Rsqr_neg in H. +rewrite Rsqr_1 in H. +cut (Rsqr (sin PI) = 0). +intro; apply (Rsqr_eq_0 _ H0). +apply Rplus_eq_reg_l with 1. +rewrite Rplus_0_r; rewrite Rplus_comm; exact H. +Qed. + +(**********) +Lemma neg_cos : forall x:R, cos (x + PI) = - cos x. +intro x; rewrite cos_plus; rewrite sin_PI; rewrite cos_PI; ring. +Qed. + +(**********) +Lemma sin_cos : forall x:R, sin x = - cos (PI / 2 + x). +intro x; rewrite cos_plus; rewrite sin_PI2; rewrite cos_PI2; ring. +Qed. + +(**********) +Lemma sin_plus : forall x y:R, sin (x + y) = sin x * cos y + cos x * sin y. +intros. +rewrite (sin_cos (x + y)). +replace (PI / 2 + (x + y)) with (PI / 2 + x + y); [ rewrite cos_plus | ring ]. +rewrite (sin_cos (PI / 2 + x)). +replace (PI / 2 + (PI / 2 + x)) with (x + PI). +rewrite neg_cos. +replace (cos (PI / 2 + x)) with (- sin x). +ring. +rewrite sin_cos; rewrite Ropp_involutive; reflexivity. +pattern PI at 1 in |- *; rewrite (double_var PI); ring. +Qed. + +Lemma sin_minus : forall x y:R, sin (x - y) = sin x * cos y - cos x * sin y. +intros; unfold Rminus in |- *; rewrite sin_plus. +rewrite <- cos_sym; rewrite sin_antisym; ring. +Qed. + +(**********) +Definition tan (x:R) : R := sin x / cos x. + +Lemma tan_plus : + forall x y:R, + cos x <> 0 -> + cos y <> 0 -> + cos (x + y) <> 0 -> + 1 - tan x * tan y <> 0 -> + tan (x + y) = (tan x + tan y) / (1 - tan x * tan y). +intros; unfold tan in |- *; rewrite sin_plus; rewrite cos_plus; + unfold Rdiv in |- *; + replace (cos x * cos y - sin x * sin y) with + (cos x * cos y * (1 - sin x * / cos x * (sin y * / cos y))). +rewrite Rinv_mult_distr. +repeat rewrite <- Rmult_assoc; + replace ((sin x * cos y + cos x * sin y) * / (cos x * cos y)) with + (sin x * / cos x + sin y * / cos y). +reflexivity. +rewrite Rmult_plus_distr_r; rewrite Rinv_mult_distr. +repeat rewrite Rmult_assoc; repeat rewrite (Rmult_comm (sin x)); + repeat rewrite <- Rmult_assoc. +repeat rewrite Rinv_r_simpl_m; [ reflexivity | assumption | assumption ]. +assumption. +assumption. +apply prod_neq_R0; assumption. +assumption. +unfold Rminus in |- *; rewrite Rmult_plus_distr_l; rewrite Rmult_1_r; + apply Rplus_eq_compat_l; repeat rewrite Rmult_assoc; + rewrite (Rmult_comm (sin x)); rewrite (Rmult_comm (cos y)); + rewrite <- Ropp_mult_distr_r_reverse; repeat rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym. +rewrite Rmult_1_l; rewrite (Rmult_comm (sin x)); + rewrite <- Ropp_mult_distr_r_reverse; repeat rewrite Rmult_assoc; + apply Rmult_eq_compat_l; rewrite (Rmult_comm (/ cos y)); + rewrite Rmult_assoc; rewrite <- Rinv_r_sym. +apply Rmult_1_r. +assumption. +assumption. +Qed. + +(*******************************************************) +(* Some properties of cos, sin and tan *) +(*******************************************************) + +Lemma sin2 : forall x:R, Rsqr (sin x) = 1 - Rsqr (cos x). +intro x; generalize (cos2 x); intro H1; rewrite H1. +unfold Rminus in |- *; rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; + rewrite Rplus_opp_r; rewrite Rplus_0_l; symmetry in |- *; + apply Ropp_involutive. +Qed. + +Lemma sin_2a : forall x:R, sin (2 * x) = 2 * sin x * cos x. +intro x; rewrite double; rewrite sin_plus. +rewrite <- (Rmult_comm (sin x)); symmetry in |- *; rewrite Rmult_assoc; + apply double. +Qed. + +Lemma cos_2a : forall x:R, cos (2 * x) = cos x * cos x - sin x * sin x. +intro x; rewrite double; apply cos_plus. +Qed. + +Lemma cos_2a_cos : forall x:R, cos (2 * x) = 2 * cos x * cos x - 1. +intro x; rewrite double; unfold Rminus in |- *; rewrite Rmult_assoc; + rewrite cos_plus; generalize (sin2_cos2 x); rewrite double; + intro H1; rewrite <- H1; ring_Rsqr. +Qed. + +Lemma cos_2a_sin : forall x:R, cos (2 * x) = 1 - 2 * sin x * sin x. +intro x; rewrite Rmult_assoc; unfold Rminus in |- *; repeat rewrite double. +generalize (sin2_cos2 x); intro H1; rewrite <- H1; rewrite cos_plus; + ring_Rsqr. +Qed. + +Lemma tan_2a : + forall x:R, + cos x <> 0 -> + cos (2 * x) <> 0 -> + 1 - tan x * tan x <> 0 -> tan (2 * x) = 2 * tan x / (1 - tan x * tan x). +repeat rewrite double; intros; repeat rewrite double; rewrite double in H0; + apply tan_plus; assumption. +Qed. + +Lemma sin_neg : forall x:R, sin (- x) = - sin x. +apply sin_antisym. +Qed. + +Lemma cos_neg : forall x:R, cos (- x) = cos x. +intro; symmetry in |- *; apply cos_sym. +Qed. + +Lemma tan_0 : tan 0 = 0. +unfold tan in |- *; rewrite sin_0; rewrite cos_0. +unfold Rdiv in |- *; apply Rmult_0_l. +Qed. + +Lemma tan_neg : forall x:R, tan (- x) = - tan x. +intros x; unfold tan in |- *; rewrite sin_neg; rewrite cos_neg; + unfold Rdiv in |- *. +apply Ropp_mult_distr_l_reverse. +Qed. + +Lemma tan_minus : + forall x y:R, + cos x <> 0 -> + cos y <> 0 -> + cos (x - y) <> 0 -> + 1 + tan x * tan y <> 0 -> + tan (x - y) = (tan x - tan y) / (1 + tan x * tan y). +intros; unfold Rminus in |- *; rewrite tan_plus. +rewrite tan_neg; unfold Rminus in |- *; rewrite <- Ropp_mult_distr_l_reverse; + rewrite Rmult_opp_opp; reflexivity. +assumption. +rewrite cos_neg; assumption. +assumption. +rewrite tan_neg; unfold Rminus in |- *; rewrite <- Ropp_mult_distr_l_reverse; + rewrite Rmult_opp_opp; assumption. +Qed. + +Lemma cos_3PI2 : cos (3 * (PI / 2)) = 0. +replace (3 * (PI / 2)) with (PI + PI / 2). +rewrite cos_plus; rewrite sin_PI; rewrite cos_PI2; ring. +pattern PI at 1 in |- *; rewrite (double_var PI). +ring. +Qed. + +Lemma sin_2PI : sin (2 * PI) = 0. +rewrite sin_2a; rewrite sin_PI; ring. +Qed. + +Lemma cos_2PI : cos (2 * PI) = 1. +rewrite cos_2a; rewrite sin_PI; rewrite cos_PI; ring. +Qed. + +Lemma neg_sin : forall x:R, sin (x + PI) = - sin x. +intro x; rewrite sin_plus; rewrite sin_PI; rewrite cos_PI; ring. +Qed. + +Lemma sin_PI_x : forall x:R, sin (PI - x) = sin x. +intro x; rewrite sin_minus; rewrite sin_PI; rewrite cos_PI; rewrite Rmult_0_l; + unfold Rminus in |- *; rewrite Rplus_0_l; rewrite Ropp_mult_distr_l_reverse; + rewrite Ropp_involutive; apply Rmult_1_l. +Qed. + +Lemma sin_period : forall (x:R) (k:nat), sin (x + 2 * INR k * PI) = sin x. +intros x k; induction k as [| k Hreck]. +cut (x + 2 * INR 0 * PI = x); [ intro; rewrite H; reflexivity | ring ]. +replace (x + 2 * INR (S k) * PI) with (x + 2 * INR k * PI + 2 * PI); + [ rewrite sin_plus; rewrite sin_2PI; rewrite cos_2PI; ring; apply Hreck + | rewrite S_INR; ring ]. +Qed. + +Lemma cos_period : forall (x:R) (k:nat), cos (x + 2 * INR k * PI) = cos x. +intros x k; induction k as [| k Hreck]. +cut (x + 2 * INR 0 * PI = x); [ intro; rewrite H; reflexivity | ring ]. +replace (x + 2 * INR (S k) * PI) with (x + 2 * INR k * PI + 2 * PI); + [ rewrite cos_plus; rewrite sin_2PI; rewrite cos_2PI; ring; apply Hreck + | rewrite S_INR; ring ]. +Qed. + +Lemma sin_shift : forall x:R, sin (PI / 2 - x) = cos x. +intro x; rewrite sin_minus; rewrite sin_PI2; rewrite cos_PI2; ring. +Qed. + +Lemma cos_shift : forall x:R, cos (PI / 2 - x) = sin x. +intro x; rewrite cos_minus; rewrite sin_PI2; rewrite cos_PI2; ring. +Qed. + +Lemma cos_sin : forall x:R, cos x = sin (PI / 2 + x). +intro x; rewrite sin_plus; rewrite sin_PI2; rewrite cos_PI2; ring. +Qed. + +Lemma PI2_RGT_0 : 0 < PI / 2. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup ]. +Qed. + +Lemma SIN_bound : forall x:R, -1 <= sin x <= 1. +intro; case (Rle_dec (-1) (sin x)); intro. +case (Rle_dec (sin x) 1); intro. +split; assumption. +cut (1 < sin x). +intro; + generalize + (Rsqr_incrst_1 1 (sin x) H (Rlt_le 0 1 Rlt_0_1) + (Rlt_le 0 (sin x) (Rlt_trans 0 1 (sin x) Rlt_0_1 H))); + rewrite Rsqr_1; intro; rewrite sin2 in H0; unfold Rminus in H0; + generalize (Rplus_lt_compat_l (-1) 1 (1 + - Rsqr (cos x)) H0); + repeat rewrite <- Rplus_assoc; repeat rewrite Rplus_opp_l; + rewrite Rplus_0_l; intro; rewrite <- Ropp_0 in H1; + generalize (Ropp_lt_gt_contravar (-0) (- Rsqr (cos x)) H1); + repeat rewrite Ropp_involutive; intro; generalize (Rle_0_sqr (cos x)); + intro; elim (Rlt_irrefl 0 (Rle_lt_trans 0 (Rsqr (cos x)) 0 H3 H2)). +auto with real. +cut (sin x < -1). +intro; generalize (Ropp_lt_gt_contravar (sin x) (-1) H); + rewrite Ropp_involutive; clear H; intro; + generalize + (Rsqr_incrst_1 1 (- sin x) H (Rlt_le 0 1 Rlt_0_1) + (Rlt_le 0 (- sin x) (Rlt_trans 0 1 (- sin x) Rlt_0_1 H))); + rewrite Rsqr_1; intro; rewrite <- Rsqr_neg in H0; + rewrite sin2 in H0; unfold Rminus in H0; + generalize (Rplus_lt_compat_l (-1) 1 (1 + - Rsqr (cos x)) H0); + repeat rewrite <- Rplus_assoc; repeat rewrite Rplus_opp_l; + rewrite Rplus_0_l; intro; rewrite <- Ropp_0 in H1; + generalize (Ropp_lt_gt_contravar (-0) (- Rsqr (cos x)) H1); + repeat rewrite Ropp_involutive; intro; generalize (Rle_0_sqr (cos x)); + intro; elim (Rlt_irrefl 0 (Rle_lt_trans 0 (Rsqr (cos x)) 0 H3 H2)). +auto with real. +Qed. + +Lemma COS_bound : forall x:R, -1 <= cos x <= 1. +intro; rewrite <- sin_shift; apply SIN_bound. +Qed. + +Lemma cos_sin_0 : forall x:R, ~ (cos x = 0 /\ sin x = 0). +intro; red in |- *; intro; elim H; intros; generalize (sin2_cos2 x); intro; + rewrite H0 in H2; rewrite H1 in H2; repeat rewrite Rsqr_0 in H2; + rewrite Rplus_0_r in H2; generalize Rlt_0_1; intro; + rewrite <- H2 in H3; elim (Rlt_irrefl 0 H3). +Qed. + +Lemma cos_sin_0_var : forall x:R, cos x <> 0 \/ sin x <> 0. +intro; apply not_and_or; apply cos_sin_0. +Qed. + +(*****************************************************************) +(* Using series definitions of cos and sin *) +(*****************************************************************) + +Definition sin_lb (a:R) : R := sin_approx a 3. +Definition sin_ub (a:R) : R := sin_approx a 4. +Definition cos_lb (a:R) : R := cos_approx a 3. +Definition cos_ub (a:R) : R := cos_approx a 4. + +Lemma sin_lb_gt_0 : forall a:R, 0 < a -> a <= PI / 2 -> 0 < sin_lb a. +intros. +unfold sin_lb in |- *; unfold sin_approx in |- *; unfold sin_term in |- *. +set (Un := fun i:nat => a ^ (2 * i + 1) / INR (fact (2 * i + 1))). +replace + (sum_f_R0 + (fun i:nat => (-1) ^ i * (a ^ (2 * i + 1) / INR (fact (2 * i + 1)))) 3) + with (sum_f_R0 (fun i:nat => (-1) ^ i * Un i) 3); + [ idtac | apply sum_eq; intros; unfold Un in |- *; reflexivity ]. +cut (forall n:nat, Un (S n) < Un n). +intro; simpl in |- *. +repeat rewrite Rmult_1_l; repeat rewrite Rmult_1_r; + replace (-1 * Un 1%nat) with (- Un 1%nat); [ idtac | ring ]; + replace (-1 * -1 * Un 2%nat) with (Un 2%nat); [ idtac | ring ]; + replace (-1 * (-1 * -1) * Un 3%nat) with (- Un 3%nat); + [ idtac | ring ]; + replace (Un 0%nat + - Un 1%nat + Un 2%nat + - Un 3%nat) with + (Un 0%nat - Un 1%nat + (Un 2%nat - Un 3%nat)); [ idtac | ring ]. +apply Rplus_lt_0_compat. +unfold Rminus in |- *; apply Rplus_lt_reg_r with (Un 1%nat); + rewrite Rplus_0_r; rewrite (Rplus_comm (Un 1%nat)); + rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; + apply H1. +unfold Rminus in |- *; apply Rplus_lt_reg_r with (Un 3%nat); + rewrite Rplus_0_r; rewrite (Rplus_comm (Un 3%nat)); + rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; + apply H1. +intro; unfold Un in |- *. +cut ((2 * S n + 1)%nat = (2 * n + 1 + 2)%nat). +intro; rewrite H1. +rewrite pow_add; unfold Rdiv in |- *; rewrite Rmult_assoc; + apply Rmult_lt_compat_l. +apply pow_lt; assumption. +rewrite <- H1; apply Rmult_lt_reg_l with (INR (fact (2 * n + 1))). +apply lt_INR_0; apply neq_O_lt. +assert (H2 := fact_neq_0 (2 * n + 1)). +red in |- *; intro; elim H2; symmetry in |- *; assumption. +rewrite <- Rinv_r_sym. +apply Rmult_lt_reg_l with (INR (fact (2 * S n + 1))). +apply lt_INR_0; apply neq_O_lt. +assert (H2 := fact_neq_0 (2 * S n + 1)). +red in |- *; intro; elim H2; symmetry in |- *; assumption. +rewrite (Rmult_comm (INR (fact (2 * S n + 1)))); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. +do 2 rewrite Rmult_1_r; apply Rle_lt_trans with (INR (fact (2 * n + 1)) * 4). +apply Rmult_le_compat_l. +replace 0 with (INR 0); [ idtac | reflexivity ]; apply le_INR; apply le_O_n. +simpl in |- *; rewrite Rmult_1_r; replace 4 with (Rsqr 2); + [ idtac | ring_Rsqr ]; replace (a * a) with (Rsqr a); + [ idtac | reflexivity ]; apply Rsqr_incr_1. +apply Rle_trans with (PI / 2); + [ assumption + | unfold Rdiv in |- *; apply Rmult_le_reg_l with 2; + [ prove_sup0 + | rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m; + [ replace 4 with 4; [ apply PI_4 | ring ] | discrR ] ] ]. +left; assumption. +left; prove_sup0. +rewrite H1; replace (2 * n + 1 + 2)%nat with (S (S (2 * n + 1))). +do 2 rewrite fact_simpl; do 2 rewrite mult_INR. +repeat rewrite <- Rmult_assoc. +rewrite <- (Rmult_comm (INR (fact (2 * n + 1)))). +rewrite Rmult_assoc. +apply Rmult_lt_compat_l. +apply lt_INR_0; apply neq_O_lt. +assert (H2 := fact_neq_0 (2 * n + 1)). +red in |- *; intro; elim H2; symmetry in |- *; assumption. +do 2 rewrite S_INR; rewrite plus_INR; rewrite mult_INR; set (x := INR n); + unfold INR in |- *. +replace ((2 * x + 1 + 1 + 1) * (2 * x + 1 + 1)) with (4 * x * x + 10 * x + 6); + [ idtac | ring ]. +apply Rplus_lt_reg_r with (-4); rewrite Rplus_opp_l; + replace (-4 + (4 * x * x + 10 * x + 6)) with (4 * x * x + 10 * x + 2); + [ idtac | ring ]. +apply Rplus_le_lt_0_compat. +cut (0 <= x). +intro; apply Rplus_le_le_0_compat; repeat apply Rmult_le_pos; + assumption || left; prove_sup. +unfold x in |- *; replace 0 with (INR 0); + [ apply le_INR; apply le_O_n | reflexivity ]. +prove_sup0. +apply INR_eq; do 2 rewrite S_INR; do 3 rewrite plus_INR; rewrite mult_INR; + repeat rewrite S_INR; ring. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply INR_eq; do 3 rewrite plus_INR; do 2 rewrite mult_INR; + repeat rewrite S_INR; ring. +Qed. + +Lemma SIN : forall a:R, 0 <= a -> a <= PI -> sin_lb a <= sin a <= sin_ub a. +intros; unfold sin_lb, sin_ub in |- *; apply (sin_bound a 1 H H0). +Qed. + +Lemma COS : + forall a:R, - PI / 2 <= a -> a <= PI / 2 -> cos_lb a <= cos a <= cos_ub a. +intros; unfold cos_lb, cos_ub in |- *; apply (cos_bound a 1 H H0). +Qed. + +(**********) +Lemma _PI2_RLT_0 : - (PI / 2) < 0. +rewrite <- Ropp_0; apply Ropp_lt_contravar; apply PI2_RGT_0. +Qed. + +Lemma PI4_RLT_PI2 : PI / 4 < PI / 2. +unfold Rdiv in |- *; apply Rmult_lt_compat_l. +apply PI_RGT_0. +apply Rinv_lt_contravar. +apply Rmult_lt_0_compat; prove_sup0. +pattern 2 at 1 in |- *; rewrite <- Rplus_0_r. +replace 4 with (2 + 2); [ apply Rplus_lt_compat_l; prove_sup0 | ring ]. +Qed. + +Lemma PI2_Rlt_PI : PI / 2 < PI. +unfold Rdiv in |- *; pattern PI at 2 in |- *; rewrite <- Rmult_1_r. +apply Rmult_lt_compat_l. +apply PI_RGT_0. +pattern 1 at 3 in |- *; rewrite <- Rinv_1; apply Rinv_lt_contravar. +rewrite Rmult_1_l; prove_sup0. +pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; + apply Rlt_0_1. +Qed. + +(********************************************) +(* Increasing and decreasing of COS and SIN *) +(********************************************) +Theorem sin_gt_0 : forall x:R, 0 < x -> x < PI -> 0 < sin x. +intros; elim (SIN x (Rlt_le 0 x H) (Rlt_le x PI H0)); intros H1 _; + case (Rtotal_order x (PI / 2)); intro H2. +apply Rlt_le_trans with (sin_lb x). +apply sin_lb_gt_0; [ assumption | left; assumption ]. +assumption. +elim H2; intro H3. +rewrite H3; rewrite sin_PI2; apply Rlt_0_1. +rewrite <- sin_PI_x; generalize (Ropp_gt_lt_contravar x (PI / 2) H3); + intro H4; generalize (Rplus_lt_compat_l PI (- x) (- (PI / 2)) H4). +replace (PI + - x) with (PI - x). +replace (PI + - (PI / 2)) with (PI / 2). +intro H5; generalize (Ropp_lt_gt_contravar x PI H0); intro H6; + change (- PI < - x) in H6; generalize (Rplus_lt_compat_l PI (- PI) (- x) H6). +rewrite Rplus_opp_r. +replace (PI + - x) with (PI - x). +intro H7; + elim + (SIN (PI - x) (Rlt_le 0 (PI - x) H7) + (Rlt_le (PI - x) PI (Rlt_trans (PI - x) (PI / 2) PI H5 PI2_Rlt_PI))); + intros H8 _; + generalize (sin_lb_gt_0 (PI - x) H7 (Rlt_le (PI - x) (PI / 2) H5)); + intro H9; apply (Rlt_le_trans 0 (sin_lb (PI - x)) (sin (PI - x)) H9 H8). +reflexivity. +pattern PI at 2 in |- *; rewrite double_var; ring. +reflexivity. +Qed. + +Theorem cos_gt_0 : forall x:R, - (PI / 2) < x -> x < PI / 2 -> 0 < cos x. +intros; rewrite cos_sin; + generalize (Rplus_lt_compat_l (PI / 2) (- (PI / 2)) x H). +rewrite Rplus_opp_r; intro H1; + generalize (Rplus_lt_compat_l (PI / 2) x (PI / 2) H0); + rewrite <- double_var; intro H2; apply (sin_gt_0 (PI / 2 + x) H1 H2). +Qed. + +Lemma sin_ge_0 : forall x:R, 0 <= x -> x <= PI -> 0 <= sin x. +intros x H1 H2; elim H1; intro H3; + [ elim H2; intro H4; + [ left; apply (sin_gt_0 x H3 H4) + | rewrite H4; right; symmetry in |- *; apply sin_PI ] + | rewrite <- H3; right; symmetry in |- *; apply sin_0 ]. +Qed. + +Lemma cos_ge_0 : forall x:R, - (PI / 2) <= x -> x <= PI / 2 -> 0 <= cos x. +intros x H1 H2; elim H1; intro H3; + [ elim H2; intro H4; + [ left; apply (cos_gt_0 x H3 H4) + | rewrite H4; right; symmetry in |- *; apply cos_PI2 ] + | rewrite <- H3; rewrite cos_neg; right; symmetry in |- *; apply cos_PI2 ]. +Qed. + +Lemma sin_le_0 : forall x:R, PI <= x -> x <= 2 * PI -> sin x <= 0. +intros x H1 H2; apply Rge_le; rewrite <- Ropp_0; + rewrite <- (Ropp_involutive (sin x)); apply Ropp_le_ge_contravar; + rewrite <- neg_sin; replace (x + PI) with (x - PI + 2 * INR 1 * PI); + [ rewrite (sin_period (x - PI) 1); apply sin_ge_0; + [ replace (x - PI) with (x + - PI); + [ rewrite Rplus_comm; replace 0 with (- PI + PI); + [ apply Rplus_le_compat_l; assumption | ring ] + | ring ] + | replace (x - PI) with (x + - PI); rewrite Rplus_comm; + [ pattern PI at 2 in |- *; replace PI with (- PI + 2 * PI); + [ apply Rplus_le_compat_l; assumption | ring ] + | ring ] ] + | unfold INR in |- *; ring ]. +Qed. + +Lemma cos_le_0 : forall x:R, PI / 2 <= x -> x <= 3 * (PI / 2) -> cos x <= 0. +intros x H1 H2; apply Rge_le; rewrite <- Ropp_0; + rewrite <- (Ropp_involutive (cos x)); apply Ropp_le_ge_contravar; + rewrite <- neg_cos; replace (x + PI) with (x - PI + 2 * INR 1 * PI). +rewrite cos_period; apply cos_ge_0. +replace (- (PI / 2)) with (- PI + PI / 2). +unfold Rminus in |- *; rewrite (Rplus_comm x); apply Rplus_le_compat_l; + assumption. +pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr; + ring. +unfold Rminus in |- *; rewrite Rplus_comm; + replace (PI / 2) with (- PI + 3 * (PI / 2)). +apply Rplus_le_compat_l; assumption. +pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr; + ring. +unfold INR in |- *; ring. +Qed. + +Lemma sin_lt_0 : forall x:R, PI < x -> x < 2 * PI -> sin x < 0. +intros x H1 H2; rewrite <- Ropp_0; rewrite <- (Ropp_involutive (sin x)); + apply Ropp_lt_gt_contravar; rewrite <- neg_sin; + replace (x + PI) with (x - PI + 2 * INR 1 * PI); + [ rewrite (sin_period (x - PI) 1); apply sin_gt_0; + [ replace (x - PI) with (x + - PI); + [ rewrite Rplus_comm; replace 0 with (- PI + PI); + [ apply Rplus_lt_compat_l; assumption | ring ] + | ring ] + | replace (x - PI) with (x + - PI); rewrite Rplus_comm; + [ pattern PI at 2 in |- *; replace PI with (- PI + 2 * PI); + [ apply Rplus_lt_compat_l; assumption | ring ] + | ring ] ] + | unfold INR in |- *; ring ]. +Qed. + +Lemma sin_lt_0_var : forall x:R, - PI < x -> x < 0 -> sin x < 0. +intros; generalize (Rplus_lt_compat_l (2 * PI) (- PI) x H); + replace (2 * PI + - PI) with PI; + [ intro H1; rewrite Rplus_comm in H1; + generalize (Rplus_lt_compat_l (2 * PI) x 0 H0); + intro H2; rewrite (Rplus_comm (2 * PI)) in H2; + rewrite <- (Rplus_comm 0) in H2; rewrite Rplus_0_l in H2; + rewrite <- (sin_period x 1); unfold INR in |- *; + replace (2 * 1 * PI) with (2 * PI); + [ apply (sin_lt_0 (x + 2 * PI) H1 H2) | ring ] + | ring ]. +Qed. + +Lemma cos_lt_0 : forall x:R, PI / 2 < x -> x < 3 * (PI / 2) -> cos x < 0. +intros x H1 H2; rewrite <- Ropp_0; rewrite <- (Ropp_involutive (cos x)); + apply Ropp_lt_gt_contravar; rewrite <- neg_cos; + replace (x + PI) with (x - PI + 2 * INR 1 * PI). +rewrite cos_period; apply cos_gt_0. +replace (- (PI / 2)) with (- PI + PI / 2). +unfold Rminus in |- *; rewrite (Rplus_comm x); apply Rplus_lt_compat_l; + assumption. +pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr; + ring. +unfold Rminus in |- *; rewrite Rplus_comm; + replace (PI / 2) with (- PI + 3 * (PI / 2)). +apply Rplus_lt_compat_l; assumption. +pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr; + ring. +unfold INR in |- *; ring. +Qed. + +Lemma tan_gt_0 : forall x:R, 0 < x -> x < PI / 2 -> 0 < tan x. +intros x H1 H2; unfold tan in |- *; generalize _PI2_RLT_0; + generalize (Rlt_trans 0 x (PI / 2) H1 H2); intros; + generalize (Rlt_trans (- (PI / 2)) 0 x H0 H1); intro H5; + generalize (Rlt_trans x (PI / 2) PI H2 PI2_Rlt_PI); + intro H7; unfold Rdiv in |- *; apply Rmult_lt_0_compat. +apply sin_gt_0; assumption. +apply Rinv_0_lt_compat; apply cos_gt_0; assumption. +Qed. + +Lemma tan_lt_0 : forall x:R, - (PI / 2) < x -> x < 0 -> tan x < 0. +intros x H1 H2; unfold tan in |- *; + generalize (cos_gt_0 x H1 (Rlt_trans x 0 (PI / 2) H2 PI2_RGT_0)); + intro H3; rewrite <- Ropp_0; + replace (sin x / cos x) with (- (- sin x / cos x)). +rewrite <- sin_neg; apply Ropp_gt_lt_contravar; + change (0 < sin (- x) / cos x) in |- *; unfold Rdiv in |- *; + apply Rmult_lt_0_compat. +apply sin_gt_0. +rewrite <- Ropp_0; apply Ropp_gt_lt_contravar; assumption. +apply Rlt_trans with (PI / 2). +rewrite <- (Ropp_involutive (PI / 2)); apply Ropp_gt_lt_contravar; assumption. +apply PI2_Rlt_PI. +apply Rinv_0_lt_compat; assumption. +unfold Rdiv in |- *; ring. +Qed. + +Lemma cos_ge_0_3PI2 : + forall x:R, 3 * (PI / 2) <= x -> x <= 2 * PI -> 0 <= cos x. +intros; rewrite <- cos_neg; rewrite <- (cos_period (- x) 1); + unfold INR in |- *; replace (- x + 2 * 1 * PI) with (2 * PI - x). +generalize (Ropp_le_ge_contravar x (2 * PI) H0); intro H1; + generalize (Rge_le (- x) (- (2 * PI)) H1); clear H1; + intro H1; generalize (Rplus_le_compat_l (2 * PI) (- (2 * PI)) (- x) H1). +rewrite Rplus_opp_r. +intro H2; generalize (Ropp_le_ge_contravar (3 * (PI / 2)) x H); intro H3; + generalize (Rge_le (- (3 * (PI / 2))) (- x) H3); clear H3; + intro H3; + generalize (Rplus_le_compat_l (2 * PI) (- x) (- (3 * (PI / 2))) H3). +replace (2 * PI + - (3 * (PI / 2))) with (PI / 2). +intro H4; + apply + (cos_ge_0 (2 * PI - x) + (Rlt_le (- (PI / 2)) (2 * PI - x) + (Rlt_le_trans (- (PI / 2)) 0 (2 * PI - x) _PI2_RLT_0 H2)) H4). +rewrite double; pattern PI at 2 3 in |- *; rewrite double_var; ring. +ring. +Qed. + +Lemma form1 : + forall p q:R, cos p + cos q = 2 * cos ((p - q) / 2) * cos ((p + q) / 2). +intros p q; pattern p at 1 in |- *; + replace p with ((p - q) / 2 + (p + q) / 2). +rewrite <- (cos_neg q); replace (- q) with ((p - q) / 2 - (p + q) / 2). +rewrite cos_plus; rewrite cos_minus; ring. +pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring. +pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring. +Qed. + +Lemma form2 : + forall p q:R, cos p - cos q = -2 * sin ((p - q) / 2) * sin ((p + q) / 2). +intros p q; pattern p at 1 in |- *; + replace p with ((p - q) / 2 + (p + q) / 2). +rewrite <- (cos_neg q); replace (- q) with ((p - q) / 2 - (p + q) / 2). +rewrite cos_plus; rewrite cos_minus; ring. +pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring. +pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring. +Qed. + +Lemma form3 : + forall p q:R, sin p + sin q = 2 * cos ((p - q) / 2) * sin ((p + q) / 2). +intros p q; pattern p at 1 in |- *; + replace p with ((p - q) / 2 + (p + q) / 2). +pattern q at 3 in |- *; replace q with ((p + q) / 2 - (p - q) / 2). +rewrite sin_plus; rewrite sin_minus; ring. +pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring. +pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring. +Qed. + +Lemma form4 : + forall p q:R, sin p - sin q = 2 * cos ((p + q) / 2) * sin ((p - q) / 2). +intros p q; pattern p at 1 in |- *; + replace p with ((p - q) / 2 + (p + q) / 2). +pattern q at 3 in |- *; replace q with ((p + q) / 2 - (p - q) / 2). +rewrite sin_plus; rewrite sin_minus; ring. +pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring. +pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring. + +Qed. + +Lemma sin_increasing_0 : + forall x y:R, + - (PI / 2) <= x -> + x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> sin x < sin y -> x < y. +intros; cut (sin ((x - y) / 2) < 0). +intro H4; case (Rtotal_order ((x - y) / 2) 0); intro H5. +assert (Hyp : 0 < 2). +prove_sup0. +generalize (Rmult_lt_compat_l 2 ((x - y) / 2) 0 Hyp H5). +unfold Rdiv in |- *. +rewrite <- Rmult_assoc. +rewrite Rinv_r_simpl_m. +rewrite Rmult_0_r. +clear H5; intro H5; apply Rminus_lt; assumption. +discrR. +elim H5; intro H6. +rewrite H6 in H4; rewrite sin_0 in H4; elim (Rlt_irrefl 0 H4). +change (0 < (x - y) / 2) in H6; + generalize (Ropp_le_ge_contravar (- (PI / 2)) y H1). +rewrite Ropp_involutive. +intro H7; generalize (Rge_le (PI / 2) (- y) H7); clear H7; intro H7; + generalize (Rplus_le_compat x (PI / 2) (- y) (PI / 2) H0 H7). +rewrite <- double_var. +intro H8. +assert (Hyp : 0 < 2). +prove_sup0. +generalize + (Rmult_le_compat_l (/ 2) (x - y) PI + (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H8). +repeat rewrite (Rmult_comm (/ 2)). +intro H9; + generalize + (sin_gt_0 ((x - y) / 2) H6 + (Rle_lt_trans ((x - y) / 2) (PI / 2) PI H9 PI2_Rlt_PI)); + intro H10; + elim + (Rlt_irrefl (sin ((x - y) / 2)) + (Rlt_trans (sin ((x - y) / 2)) 0 (sin ((x - y) / 2)) H4 H10)). +generalize (Rlt_minus (sin x) (sin y) H3); clear H3; intro H3; + rewrite form4 in H3; + generalize (Rplus_le_compat x (PI / 2) y (PI / 2) H0 H2). +rewrite <- double_var. +assert (Hyp : 0 < 2). +prove_sup0. +intro H4; + generalize + (Rmult_le_compat_l (/ 2) (x + y) PI + (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H4). +repeat rewrite (Rmult_comm (/ 2)). +clear H4; intro H4; + generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) y H H1); + replace (- (PI / 2) + - (PI / 2)) with (- PI). +intro H5; + generalize + (Rmult_le_compat_l (/ 2) (- PI) (x + y) + (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H5). +replace (/ 2 * (x + y)) with ((x + y) / 2). +replace (/ 2 * - PI) with (- (PI / 2)). +clear H5; intro H5; elim H4; intro H40. +elim H5; intro H50. +generalize (cos_gt_0 ((x + y) / 2) H50 H40); intro H6; + generalize (Rmult_lt_compat_l 2 0 (cos ((x + y) / 2)) Hyp H6). +rewrite Rmult_0_r. +clear H6; intro H6; case (Rcase_abs (sin ((x - y) / 2))); intro H7. +assumption. +generalize (Rge_le (sin ((x - y) / 2)) 0 H7); clear H7; intro H7; + generalize + (Rmult_le_pos (2 * cos ((x + y) / 2)) (sin ((x - y) / 2)) + (Rlt_le 0 (2 * cos ((x + y) / 2)) H6) H7); intro H8; + generalize + (Rle_lt_trans 0 (2 * cos ((x + y) / 2) * sin ((x - y) / 2)) 0 H8 H3); + intro H9; elim (Rlt_irrefl 0 H9). +rewrite <- H50 in H3; rewrite cos_neg in H3; rewrite cos_PI2 in H3; + rewrite Rmult_0_r in H3; rewrite Rmult_0_l in H3; + elim (Rlt_irrefl 0 H3). +unfold Rdiv in H3. +rewrite H40 in H3; assert (H50 := cos_PI2); unfold Rdiv in H50; + rewrite H50 in H3; rewrite Rmult_0_r in H3; rewrite Rmult_0_l in H3; + elim (Rlt_irrefl 0 H3). +unfold Rdiv in |- *. +rewrite <- Ropp_mult_distr_l_reverse. +apply Rmult_comm. +unfold Rdiv in |- *; apply Rmult_comm. +pattern PI at 1 in |- *; rewrite double_var. +rewrite Ropp_plus_distr. +reflexivity. +Qed. + +Lemma sin_increasing_1 : + forall x y:R, + - (PI / 2) <= x -> + x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> x < y -> sin x < sin y. +intros; generalize (Rplus_lt_compat_l x x y H3); intro H4; + generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) x H H); + replace (- (PI / 2) + - (PI / 2)) with (- PI). +assert (Hyp : 0 < 2). +prove_sup0. +intro H5; generalize (Rle_lt_trans (- PI) (x + x) (x + y) H5 H4); intro H6; + generalize + (Rmult_lt_compat_l (/ 2) (- PI) (x + y) (Rinv_0_lt_compat 2 Hyp) H6); + replace (/ 2 * - PI) with (- (PI / 2)). +replace (/ 2 * (x + y)) with ((x + y) / 2). +clear H4 H5 H6; intro H4; generalize (Rplus_lt_compat_l y x y H3); intro H5; + rewrite Rplus_comm in H5; + generalize (Rplus_le_compat y (PI / 2) y (PI / 2) H2 H2). +rewrite <- double_var. +intro H6; generalize (Rlt_le_trans (x + y) (y + y) PI H5 H6); intro H7; + generalize (Rmult_lt_compat_l (/ 2) (x + y) PI (Rinv_0_lt_compat 2 Hyp) H7); + replace (/ 2 * PI) with (PI / 2). +replace (/ 2 * (x + y)) with ((x + y) / 2). +clear H5 H6 H7; intro H5; generalize (Ropp_le_ge_contravar (- (PI / 2)) y H1); + rewrite Ropp_involutive; clear H1; intro H1; + generalize (Rge_le (PI / 2) (- y) H1); clear H1; intro H1; + generalize (Ropp_le_ge_contravar y (PI / 2) H2); clear H2; + intro H2; generalize (Rge_le (- y) (- (PI / 2)) H2); + clear H2; intro H2; generalize (Rplus_lt_compat_l (- y) x y H3); + replace (- y + x) with (x - y). +rewrite Rplus_opp_l. +intro H6; + generalize (Rmult_lt_compat_l (/ 2) (x - y) 0 (Rinv_0_lt_compat 2 Hyp) H6); + rewrite Rmult_0_r; replace (/ 2 * (x - y)) with ((x - y) / 2). +clear H6; intro H6; + generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) (- y) H H2); + replace (- (PI / 2) + - (PI / 2)) with (- PI). +replace (x + - y) with (x - y). +intro H7; + generalize + (Rmult_le_compat_l (/ 2) (- PI) (x - y) + (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H7); + replace (/ 2 * - PI) with (- (PI / 2)). +replace (/ 2 * (x - y)) with ((x - y) / 2). +clear H7; intro H7; clear H H0 H1 H2; apply Rminus_lt; rewrite form4; + generalize (cos_gt_0 ((x + y) / 2) H4 H5); intro H8; + generalize (Rmult_lt_0_compat 2 (cos ((x + y) / 2)) Hyp H8); + clear H8; intro H8; cut (- PI < - (PI / 2)). +intro H9; + generalize + (sin_lt_0_var ((x - y) / 2) + (Rlt_le_trans (- PI) (- (PI / 2)) ((x - y) / 2) H9 H7) H6); + intro H10; + generalize + (Rmult_lt_gt_compat_neg_l (sin ((x - y) / 2)) 0 ( + 2 * cos ((x + y) / 2)) H10 H8); intro H11; rewrite Rmult_0_r in H11; + rewrite Rmult_comm; assumption. +apply Ropp_lt_gt_contravar; apply PI2_Rlt_PI. +unfold Rdiv in |- *; apply Rmult_comm. +unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse; apply Rmult_comm. +reflexivity. +pattern PI at 1 in |- *; rewrite double_var. +rewrite Ropp_plus_distr. +reflexivity. +unfold Rdiv in |- *; apply Rmult_comm. +unfold Rminus in |- *; apply Rplus_comm. +unfold Rdiv in |- *; apply Rmult_comm. +unfold Rdiv in |- *; apply Rmult_comm. +unfold Rdiv in |- *; apply Rmult_comm. +unfold Rdiv in |- *. +rewrite <- Ropp_mult_distr_l_reverse. +apply Rmult_comm. +pattern PI at 1 in |- *; rewrite double_var. +rewrite Ropp_plus_distr. +reflexivity. +Qed. + +Lemma sin_decreasing_0 : + forall x y:R, + x <= 3 * (PI / 2) -> + PI / 2 <= x -> y <= 3 * (PI / 2) -> PI / 2 <= y -> sin x < sin y -> y < x. +intros; rewrite <- (sin_PI_x x) in H3; rewrite <- (sin_PI_x y) in H3; + generalize (Ropp_lt_gt_contravar (sin (PI - x)) (sin (PI - y)) H3); + repeat rewrite <- sin_neg; + generalize (Rplus_le_compat_l (- PI) x (3 * (PI / 2)) H); + generalize (Rplus_le_compat_l (- PI) (PI / 2) x H0); + generalize (Rplus_le_compat_l (- PI) y (3 * (PI / 2)) H1); + generalize (Rplus_le_compat_l (- PI) (PI / 2) y H2); + replace (- PI + x) with (x - PI). +replace (- PI + PI / 2) with (- (PI / 2)). +replace (- PI + y) with (y - PI). +replace (- PI + 3 * (PI / 2)) with (PI / 2). +replace (- (PI - x)) with (x - PI). +replace (- (PI - y)) with (y - PI). +intros; change (sin (y - PI) < sin (x - PI)) in H8; + apply Rplus_lt_reg_r with (- PI); rewrite Rplus_comm; + replace (y + - PI) with (y - PI). +rewrite Rplus_comm; replace (x + - PI) with (x - PI). +apply (sin_increasing_0 (y - PI) (x - PI) H4 H5 H6 H7 H8). +reflexivity. +reflexivity. +unfold Rminus in |- *; rewrite Ropp_plus_distr. +rewrite Ropp_involutive. +apply Rplus_comm. +unfold Rminus in |- *; rewrite Ropp_plus_distr. +rewrite Ropp_involutive. +apply Rplus_comm. +pattern PI at 2 in |- *; rewrite double_var. +rewrite Ropp_plus_distr. +ring. +unfold Rminus in |- *; apply Rplus_comm. +pattern PI at 2 in |- *; rewrite double_var. +rewrite Ropp_plus_distr. +ring. +unfold Rminus in |- *; apply Rplus_comm. +Qed. + +Lemma sin_decreasing_1 : + forall x y:R, + x <= 3 * (PI / 2) -> + PI / 2 <= x -> y <= 3 * (PI / 2) -> PI / 2 <= y -> x < y -> sin y < sin x. +intros; rewrite <- (sin_PI_x x); rewrite <- (sin_PI_x y); + generalize (Rplus_le_compat_l (- PI) x (3 * (PI / 2)) H); + generalize (Rplus_le_compat_l (- PI) (PI / 2) x H0); + generalize (Rplus_le_compat_l (- PI) y (3 * (PI / 2)) H1); + generalize (Rplus_le_compat_l (- PI) (PI / 2) y H2); + generalize (Rplus_lt_compat_l (- PI) x y H3); + replace (- PI + PI / 2) with (- (PI / 2)). +replace (- PI + y) with (y - PI). +replace (- PI + 3 * (PI / 2)) with (PI / 2). +replace (- PI + x) with (x - PI). +intros; apply Ropp_lt_cancel; repeat rewrite <- sin_neg; + replace (- (PI - x)) with (x - PI). +replace (- (PI - y)) with (y - PI). +apply (sin_increasing_1 (x - PI) (y - PI) H7 H8 H5 H6 H4). +unfold Rminus in |- *; rewrite Ropp_plus_distr. +rewrite Ropp_involutive. +apply Rplus_comm. +unfold Rminus in |- *; rewrite Ropp_plus_distr. +rewrite Ropp_involutive. +apply Rplus_comm. +unfold Rminus in |- *; apply Rplus_comm. +pattern PI at 2 in |- *; rewrite double_var; ring. +unfold Rminus in |- *; apply Rplus_comm. +pattern PI at 2 in |- *; rewrite double_var; ring. +Qed. + +Lemma cos_increasing_0 : + forall x y:R, + PI <= x -> x <= 2 * PI -> PI <= y -> y <= 2 * PI -> cos x < cos y -> x < y. +intros x y H1 H2 H3 H4; rewrite <- (cos_neg x); rewrite <- (cos_neg y); + rewrite <- (cos_period (- x) 1); rewrite <- (cos_period (- y) 1); + unfold INR in |- *; + replace (- x + 2 * 1 * PI) with (PI / 2 - (x - 3 * (PI / 2))). +replace (- y + 2 * 1 * PI) with (PI / 2 - (y - 3 * (PI / 2))). +repeat rewrite cos_shift; intro H5; + generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI x H1); + generalize (Rplus_le_compat_l (-3 * (PI / 2)) x (2 * PI) H2); + generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI y H3); + generalize (Rplus_le_compat_l (-3 * (PI / 2)) y (2 * PI) H4). +replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)). +replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)). +replace (-3 * (PI / 2) + 2 * PI) with (PI / 2). +replace (-3 * (PI / 2) + PI) with (- (PI / 2)). +clear H1 H2 H3 H4; intros H1 H2 H3 H4; + apply Rplus_lt_reg_r with (-3 * (PI / 2)); + replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)). +replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)). +apply (sin_increasing_0 (x - 3 * (PI / 2)) (y - 3 * (PI / 2)) H4 H3 H2 H1 H5). +unfold Rminus in |- *. +rewrite Ropp_mult_distr_l_reverse. +apply Rplus_comm. +unfold Rminus in |- *. +rewrite Ropp_mult_distr_l_reverse. +apply Rplus_comm. +pattern PI at 3 in |- *; rewrite double_var. +ring. +rewrite double; pattern PI at 3 4 in |- *; rewrite double_var. +ring. +unfold Rminus in |- *. +rewrite Ropp_mult_distr_l_reverse. +apply Rplus_comm. +unfold Rminus in |- *. +rewrite Ropp_mult_distr_l_reverse. +apply Rplus_comm. +rewrite Rmult_1_r. +rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var. +ring. +rewrite Rmult_1_r. +rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var. +ring. +Qed. + +Lemma cos_increasing_1 : + forall x y:R, + PI <= x -> x <= 2 * PI -> PI <= y -> y <= 2 * PI -> x < y -> cos x < cos y. +intros x y H1 H2 H3 H4 H5; + generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI x H1); + generalize (Rplus_le_compat_l (-3 * (PI / 2)) x (2 * PI) H2); + generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI y H3); + generalize (Rplus_le_compat_l (-3 * (PI / 2)) y (2 * PI) H4); + generalize (Rplus_lt_compat_l (-3 * (PI / 2)) x y H5); + rewrite <- (cos_neg x); rewrite <- (cos_neg y); + rewrite <- (cos_period (- x) 1); rewrite <- (cos_period (- y) 1); + unfold INR in |- *; replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)). +replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)). +replace (-3 * (PI / 2) + PI) with (- (PI / 2)). +replace (-3 * (PI / 2) + 2 * PI) with (PI / 2). +clear H1 H2 H3 H4 H5; intros H1 H2 H3 H4 H5; + replace (- x + 2 * 1 * PI) with (PI / 2 - (x - 3 * (PI / 2))). +replace (- y + 2 * 1 * PI) with (PI / 2 - (y - 3 * (PI / 2))). +repeat rewrite cos_shift; + apply + (sin_increasing_1 (x - 3 * (PI / 2)) (y - 3 * (PI / 2)) H5 H4 H3 H2 H1). +rewrite Rmult_1_r. +rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var. +ring. +rewrite Rmult_1_r. +rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var. +ring. +rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var. +ring. +pattern PI at 3 in |- *; rewrite double_var; ring. +unfold Rminus in |- *. +rewrite <- Ropp_mult_distr_l_reverse. +apply Rplus_comm. +unfold Rminus in |- *. +rewrite <- Ropp_mult_distr_l_reverse. +apply Rplus_comm. +Qed. + +Lemma cos_decreasing_0 : + forall x y:R, + 0 <= x -> x <= PI -> 0 <= y -> y <= PI -> cos x < cos y -> y < x. +intros; generalize (Ropp_lt_gt_contravar (cos x) (cos y) H3); + repeat rewrite <- neg_cos; intro H4; + change (cos (y + PI) < cos (x + PI)) in H4; rewrite (Rplus_comm x) in H4; + rewrite (Rplus_comm y) in H4; generalize (Rplus_le_compat_l PI 0 x H); + generalize (Rplus_le_compat_l PI x PI H0); + generalize (Rplus_le_compat_l PI 0 y H1); + generalize (Rplus_le_compat_l PI y PI H2); rewrite Rplus_0_r. +rewrite <- double. +clear H H0 H1 H2 H3; intros; apply Rplus_lt_reg_r with PI; + apply (cos_increasing_0 (PI + y) (PI + x) H0 H H2 H1 H4). +Qed. + +Lemma cos_decreasing_1 : + forall x y:R, + 0 <= x -> x <= PI -> 0 <= y -> y <= PI -> x < y -> cos y < cos x. +intros; apply Ropp_lt_cancel; repeat rewrite <- neg_cos; + rewrite (Rplus_comm x); rewrite (Rplus_comm y); + generalize (Rplus_le_compat_l PI 0 x H); + generalize (Rplus_le_compat_l PI x PI H0); + generalize (Rplus_le_compat_l PI 0 y H1); + generalize (Rplus_le_compat_l PI y PI H2); rewrite Rplus_0_r. +rewrite <- double. +generalize (Rplus_lt_compat_l PI x y H3); clear H H0 H1 H2 H3; intros; + apply (cos_increasing_1 (PI + x) (PI + y) H3 H2 H1 H0 H). +Qed. + +Lemma tan_diff : + forall x y:R, + cos x <> 0 -> cos y <> 0 -> tan x - tan y = sin (x - y) / (cos x * cos y). +intros; unfold tan in |- *; rewrite sin_minus. +unfold Rdiv in |- *. +unfold Rminus in |- *. +rewrite Rmult_plus_distr_r. +rewrite Rinv_mult_distr. +repeat rewrite (Rmult_comm (sin x)). +repeat rewrite Rmult_assoc. +rewrite (Rmult_comm (cos y)). +repeat rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +rewrite (Rmult_comm (sin x)). +apply Rplus_eq_compat_l. +rewrite <- Ropp_mult_distr_l_reverse. +rewrite <- Ropp_mult_distr_r_reverse. +rewrite (Rmult_comm (/ cos x)). +repeat rewrite Rmult_assoc. +rewrite (Rmult_comm (cos x)). +repeat rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +reflexivity. +assumption. +assumption. +assumption. +assumption. +Qed. + +Lemma tan_increasing_0 : + forall x y:R, + - (PI / 4) <= x -> + x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> tan x < tan y -> x < y. +intros; generalize PI4_RLT_PI2; intro H4; + generalize (Ropp_lt_gt_contravar (PI / 4) (PI / 2) H4); + intro H5; change (- (PI / 2) < - (PI / 4)) in H5; + generalize + (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H) + (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)); intro HP1; + generalize + (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1) + (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)); intro HP2; + generalize + (sym_not_eq + (Rlt_not_eq 0 (cos x) + (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H) + (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)))); + intro H6; + generalize + (sym_not_eq + (Rlt_not_eq 0 (cos y) + (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1) + (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)))); + intro H7; generalize (tan_diff x y H6 H7); intro H8; + generalize (Rlt_minus (tan x) (tan y) H3); clear H3; + intro H3; rewrite H8 in H3; cut (sin (x - y) < 0). +intro H9; generalize (Ropp_le_ge_contravar (- (PI / 4)) y H1); + rewrite Ropp_involutive; intro H10; generalize (Rge_le (PI / 4) (- y) H10); + clear H10; intro H10; generalize (Ropp_le_ge_contravar y (PI / 4) H2); + intro H11; generalize (Rge_le (- y) (- (PI / 4)) H11); + clear H11; intro H11; + generalize (Rplus_le_compat (- (PI / 4)) x (- (PI / 4)) (- y) H H11); + generalize (Rplus_le_compat x (PI / 4) (- y) (PI / 4) H0 H10); + replace (x + - y) with (x - y). +replace (PI / 4 + PI / 4) with (PI / 2). +replace (- (PI / 4) + - (PI / 4)) with (- (PI / 2)). +intros; case (Rtotal_order 0 (x - y)); intro H14. +generalize + (sin_gt_0 (x - y) H14 (Rle_lt_trans (x - y) (PI / 2) PI H12 PI2_Rlt_PI)); + intro H15; elim (Rlt_irrefl 0 (Rlt_trans 0 (sin (x - y)) 0 H15 H9)). +elim H14; intro H15. +rewrite <- H15 in H9; rewrite sin_0 in H9; elim (Rlt_irrefl 0 H9). +apply Rminus_lt; assumption. +pattern PI at 1 in |- *; rewrite double_var. +unfold Rdiv in |- *. +rewrite Rmult_plus_distr_r. +repeat rewrite Rmult_assoc. +rewrite <- Rinv_mult_distr. +rewrite Ropp_plus_distr. +replace 4 with 4. +reflexivity. +ring. +discrR. +discrR. +pattern PI at 1 in |- *; rewrite double_var. +unfold Rdiv in |- *. +rewrite Rmult_plus_distr_r. +repeat rewrite Rmult_assoc. +rewrite <- Rinv_mult_distr. +replace 4 with 4. +reflexivity. +ring. +discrR. +discrR. +reflexivity. +case (Rcase_abs (sin (x - y))); intro H9. +assumption. +generalize (Rge_le (sin (x - y)) 0 H9); clear H9; intro H9; + generalize (Rinv_0_lt_compat (cos x) HP1); intro H10; + generalize (Rinv_0_lt_compat (cos y) HP2); intro H11; + generalize (Rmult_lt_0_compat (/ cos x) (/ cos y) H10 H11); + replace (/ cos x * / cos y) with (/ (cos x * cos y)). +intro H12; + generalize + (Rmult_le_pos (sin (x - y)) (/ (cos x * cos y)) H9 + (Rlt_le 0 (/ (cos x * cos y)) H12)); intro H13; + elim + (Rlt_irrefl 0 (Rle_lt_trans 0 (sin (x - y) * / (cos x * cos y)) 0 H13 H3)). +rewrite Rinv_mult_distr. +reflexivity. +assumption. +assumption. +Qed. + +Lemma tan_increasing_1 : + forall x y:R, + - (PI / 4) <= x -> + x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> x < y -> tan x < tan y. +intros; apply Rminus_lt; generalize PI4_RLT_PI2; intro H4; + generalize (Ropp_lt_gt_contravar (PI / 4) (PI / 2) H4); + intro H5; change (- (PI / 2) < - (PI / 4)) in H5; + generalize + (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H) + (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)); intro HP1; + generalize + (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1) + (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)); intro HP2; + generalize + (sym_not_eq + (Rlt_not_eq 0 (cos x) + (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H) + (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)))); + intro H6; + generalize + (sym_not_eq + (Rlt_not_eq 0 (cos y) + (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1) + (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)))); + intro H7; rewrite (tan_diff x y H6 H7); + generalize (Rinv_0_lt_compat (cos x) HP1); intro H10; + generalize (Rinv_0_lt_compat (cos y) HP2); intro H11; + generalize (Rmult_lt_0_compat (/ cos x) (/ cos y) H10 H11); + replace (/ cos x * / cos y) with (/ (cos x * cos y)). +clear H10 H11; intro H8; generalize (Ropp_le_ge_contravar y (PI / 4) H2); + intro H11; generalize (Rge_le (- y) (- (PI / 4)) H11); + clear H11; intro H11; + generalize (Rplus_le_compat (- (PI / 4)) x (- (PI / 4)) (- y) H H11); + replace (x + - y) with (x - y). +replace (- (PI / 4) + - (PI / 4)) with (- (PI / 2)). +clear H11; intro H9; generalize (Rlt_minus x y H3); clear H3; intro H3; + clear H H0 H1 H2 H4 H5 HP1 HP2; generalize PI2_Rlt_PI; + intro H1; generalize (Ropp_lt_gt_contravar (PI / 2) PI H1); + clear H1; intro H1; + generalize + (sin_lt_0_var (x - y) (Rlt_le_trans (- PI) (- (PI / 2)) (x - y) H1 H9) H3); + intro H2; + generalize + (Rmult_lt_gt_compat_neg_l (sin (x - y)) 0 (/ (cos x * cos y)) H2 H8); + rewrite Rmult_0_r; intro H4; assumption. +pattern PI at 1 in |- *; rewrite double_var. +unfold Rdiv in |- *. +rewrite Rmult_plus_distr_r. +repeat rewrite Rmult_assoc. +rewrite <- Rinv_mult_distr. +replace 4 with 4. +rewrite Ropp_plus_distr. +reflexivity. +ring. +discrR. +discrR. +reflexivity. +apply Rinv_mult_distr; assumption. +Qed. + +Lemma sin_incr_0 : + forall x y:R, + - (PI / 2) <= x -> + x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> sin x <= sin y -> x <= y. +intros; case (Rtotal_order (sin x) (sin y)); intro H4; + [ left; apply (sin_increasing_0 x y H H0 H1 H2 H4) + | elim H4; intro H5; + [ case (Rtotal_order x y); intro H6; + [ left; assumption + | elim H6; intro H7; + [ right; assumption + | generalize (sin_increasing_1 y x H1 H2 H H0 H7); intro H8; + rewrite H5 in H8; elim (Rlt_irrefl (sin y) H8) ] ] + | elim (Rlt_irrefl (sin x) (Rle_lt_trans (sin x) (sin y) (sin x) H3 H5)) ] ]. +Qed. + +Lemma sin_incr_1 : + forall x y:R, + - (PI / 2) <= x -> + x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> x <= y -> sin x <= sin y. +intros; case (Rtotal_order x y); intro H4; + [ left; apply (sin_increasing_1 x y H H0 H1 H2 H4) + | elim H4; intro H5; + [ case (Rtotal_order (sin x) (sin y)); intro H6; + [ left; assumption + | elim H6; intro H7; + [ right; assumption + | generalize (sin_increasing_0 y x H1 H2 H H0 H7); intro H8; + rewrite H5 in H8; elim (Rlt_irrefl y H8) ] ] + | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ]. +Qed. + +Lemma sin_decr_0 : + forall x y:R, + x <= 3 * (PI / 2) -> + PI / 2 <= x -> + y <= 3 * (PI / 2) -> PI / 2 <= y -> sin x <= sin y -> y <= x. +intros; case (Rtotal_order (sin x) (sin y)); intro H4; + [ left; apply (sin_decreasing_0 x y H H0 H1 H2 H4) + | elim H4; intro H5; + [ case (Rtotal_order x y); intro H6; + [ generalize (sin_decreasing_1 x y H H0 H1 H2 H6); intro H8; + rewrite H5 in H8; elim (Rlt_irrefl (sin y) H8) + | elim H6; intro H7; + [ right; symmetry in |- *; assumption | left; assumption ] ] + | elim (Rlt_irrefl (sin x) (Rle_lt_trans (sin x) (sin y) (sin x) H3 H5)) ] ]. +Qed. + +Lemma sin_decr_1 : + forall x y:R, + x <= 3 * (PI / 2) -> + PI / 2 <= x -> + y <= 3 * (PI / 2) -> PI / 2 <= y -> x <= y -> sin y <= sin x. +intros; case (Rtotal_order x y); intro H4; + [ left; apply (sin_decreasing_1 x y H H0 H1 H2 H4) + | elim H4; intro H5; + [ case (Rtotal_order (sin x) (sin y)); intro H6; + [ generalize (sin_decreasing_0 x y H H0 H1 H2 H6); intro H8; + rewrite H5 in H8; elim (Rlt_irrefl y H8) + | elim H6; intro H7; + [ right; symmetry in |- *; assumption | left; assumption ] ] + | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ]. +Qed. + +Lemma cos_incr_0 : + forall x y:R, + PI <= x -> + x <= 2 * PI -> PI <= y -> y <= 2 * PI -> cos x <= cos y -> x <= y. +intros; case (Rtotal_order (cos x) (cos y)); intro H4; + [ left; apply (cos_increasing_0 x y H H0 H1 H2 H4) + | elim H4; intro H5; + [ case (Rtotal_order x y); intro H6; + [ left; assumption + | elim H6; intro H7; + [ right; assumption + | generalize (cos_increasing_1 y x H1 H2 H H0 H7); intro H8; + rewrite H5 in H8; elim (Rlt_irrefl (cos y) H8) ] ] + | elim (Rlt_irrefl (cos x) (Rle_lt_trans (cos x) (cos y) (cos x) H3 H5)) ] ]. +Qed. + +Lemma cos_incr_1 : + forall x y:R, + PI <= x -> + x <= 2 * PI -> PI <= y -> y <= 2 * PI -> x <= y -> cos x <= cos y. +intros; case (Rtotal_order x y); intro H4; + [ left; apply (cos_increasing_1 x y H H0 H1 H2 H4) + | elim H4; intro H5; + [ case (Rtotal_order (cos x) (cos y)); intro H6; + [ left; assumption + | elim H6; intro H7; + [ right; assumption + | generalize (cos_increasing_0 y x H1 H2 H H0 H7); intro H8; + rewrite H5 in H8; elim (Rlt_irrefl y H8) ] ] + | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ]. +Qed. + +Lemma cos_decr_0 : + forall x y:R, + 0 <= x -> x <= PI -> 0 <= y -> y <= PI -> cos x <= cos y -> y <= x. +intros; case (Rtotal_order (cos x) (cos y)); intro H4; + [ left; apply (cos_decreasing_0 x y H H0 H1 H2 H4) + | elim H4; intro H5; + [ case (Rtotal_order x y); intro H6; + [ generalize (cos_decreasing_1 x y H H0 H1 H2 H6); intro H8; + rewrite H5 in H8; elim (Rlt_irrefl (cos y) H8) + | elim H6; intro H7; + [ right; symmetry in |- *; assumption | left; assumption ] ] + | elim (Rlt_irrefl (cos x) (Rle_lt_trans (cos x) (cos y) (cos x) H3 H5)) ] ]. +Qed. + +Lemma cos_decr_1 : + forall x y:R, + 0 <= x -> x <= PI -> 0 <= y -> y <= PI -> x <= y -> cos y <= cos x. +intros; case (Rtotal_order x y); intro H4; + [ left; apply (cos_decreasing_1 x y H H0 H1 H2 H4) + | elim H4; intro H5; + [ case (Rtotal_order (cos x) (cos y)); intro H6; + [ generalize (cos_decreasing_0 x y H H0 H1 H2 H6); intro H8; + rewrite H5 in H8; elim (Rlt_irrefl y H8) + | elim H6; intro H7; + [ right; symmetry in |- *; assumption | left; assumption ] ] + | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ]. +Qed. + +Lemma tan_incr_0 : + forall x y:R, + - (PI / 4) <= x -> + x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> tan x <= tan y -> x <= y. +intros; case (Rtotal_order (tan x) (tan y)); intro H4; + [ left; apply (tan_increasing_0 x y H H0 H1 H2 H4) + | elim H4; intro H5; + [ case (Rtotal_order x y); intro H6; + [ left; assumption + | elim H6; intro H7; + [ right; assumption + | generalize (tan_increasing_1 y x H1 H2 H H0 H7); intro H8; + rewrite H5 in H8; elim (Rlt_irrefl (tan y) H8) ] ] + | elim (Rlt_irrefl (tan x) (Rle_lt_trans (tan x) (tan y) (tan x) H3 H5)) ] ]. +Qed. + +Lemma tan_incr_1 : + forall x y:R, + - (PI / 4) <= x -> + x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> x <= y -> tan x <= tan y. +intros; case (Rtotal_order x y); intro H4; + [ left; apply (tan_increasing_1 x y H H0 H1 H2 H4) + | elim H4; intro H5; + [ case (Rtotal_order (tan x) (tan y)); intro H6; + [ left; assumption + | elim H6; intro H7; + [ right; assumption + | generalize (tan_increasing_0 y x H1 H2 H H0 H7); intro H8; + rewrite H5 in H8; elim (Rlt_irrefl y H8) ] ] + | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ]. +Qed. + +(**********) +Lemma sin_eq_0_1 : forall x:R, (exists k : Z, x = IZR k * PI) -> sin x = 0. +intros. +elim H; intros. +apply (Zcase_sign x0). +intro. +rewrite H1 in H0. +simpl in H0. +rewrite H0; rewrite Rmult_0_l; apply sin_0. +intro. +cut (0 <= x0)%Z. +intro. +elim (IZN x0 H2); intros. +rewrite H3 in H0. +rewrite <- INR_IZR_INZ in H0. +rewrite H0. +elim (even_odd_cor x1); intros. +elim H4; intro. +rewrite H5. +rewrite mult_INR. +simpl in |- *. +rewrite <- (Rplus_0_l (2 * INR x2 * PI)). +rewrite sin_period. +apply sin_0. +rewrite H5. +rewrite S_INR; rewrite mult_INR. +simpl in |- *. +rewrite Rmult_plus_distr_r. +rewrite Rmult_1_l; rewrite sin_plus. +rewrite sin_PI. +rewrite Rmult_0_r. +rewrite <- (Rplus_0_l (2 * INR x2 * PI)). +rewrite sin_period. +rewrite sin_0; ring. +apply le_IZR. +left; apply IZR_lt. +assert (H2 := Zorder.Zgt_iff_lt). +elim (H2 x0 0%Z); intros. +apply H3; assumption. +intro. +rewrite H0. +replace (sin (IZR x0 * PI)) with (- sin (- IZR x0 * PI)). +cut (0 <= - x0)%Z. +intro. +rewrite <- Ropp_Ropp_IZR. +elim (IZN (- x0) H2); intros. +rewrite H3. +rewrite <- INR_IZR_INZ. +elim (even_odd_cor x1); intros. +elim H4; intro. +rewrite H5. +rewrite mult_INR. +simpl in |- *. +rewrite <- (Rplus_0_l (2 * INR x2 * PI)). +rewrite sin_period. +rewrite sin_0; ring. +rewrite H5. +rewrite S_INR; rewrite mult_INR. +simpl in |- *. +rewrite Rmult_plus_distr_r. +rewrite Rmult_1_l; rewrite sin_plus. +rewrite sin_PI. +rewrite Rmult_0_r. +rewrite <- (Rplus_0_l (2 * INR x2 * PI)). +rewrite sin_period. +rewrite sin_0; ring. +apply le_IZR. +apply Rplus_le_reg_l with (IZR x0). +rewrite Rplus_0_r. +rewrite Ropp_Ropp_IZR. +rewrite Rplus_opp_r. +left; replace 0 with (IZR 0); [ apply IZR_lt | reflexivity ]. +assumption. +rewrite <- sin_neg. +rewrite Ropp_mult_distr_l_reverse. +rewrite Ropp_involutive. +reflexivity. +Qed. + +Lemma sin_eq_0_0 : forall x:R, sin x = 0 -> exists k : Z, x = IZR k * PI. +intros. +assert (H0 := euclidian_division x PI PI_neq0). +elim H0; intros q H1. +elim H1; intros r H2. +exists q. +cut (r = 0). +intro. +elim H2; intros H4 _; rewrite H4; rewrite H3. +apply Rplus_0_r. +elim H2; intros. +rewrite H3 in H. +rewrite sin_plus in H. +cut (sin (IZR q * PI) = 0). +intro. +rewrite H5 in H. +rewrite Rmult_0_l in H. +rewrite Rplus_0_l in H. +assert (H6 := Rmult_integral _ _ H). +elim H6; intro. +assert (H8 := sin2_cos2 (IZR q * PI)). +rewrite H5 in H8; rewrite H7 in H8. +rewrite Rsqr_0 in H8. +rewrite Rplus_0_r in H8. +elim R1_neq_R0; symmetry in |- *; assumption. +cut (r = 0 \/ 0 < r < PI). +intro; elim H8; intro. +assumption. +elim H9; intros. +assert (H12 := sin_gt_0 _ H10 H11). +rewrite H7 in H12; elim (Rlt_irrefl _ H12). +rewrite Rabs_right in H4. +elim H4; intros. +case (Rtotal_order 0 r); intro. +right; split; assumption. +elim H10; intro. +left; symmetry in |- *; assumption. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H8 H11)). +apply Rle_ge. +left; apply PI_RGT_0. +apply sin_eq_0_1. +exists q; reflexivity. +Qed. + +Lemma cos_eq_0_0 : + forall x:R, cos x = 0 -> exists k : Z, x = IZR k * PI + PI / 2. +intros x H; rewrite cos_sin in H; generalize (sin_eq_0_0 (PI / INR 2 + x) H); + intro H2; elim H2; intros x0 H3; exists (x0 - Z_of_nat 1)%Z; + rewrite <- Z_R_minus; ring; rewrite Rmult_comm; rewrite <- H3; + unfold INR in |- *. +rewrite (double_var (- PI)); unfold Rdiv in |- *; ring. +Qed. + +Lemma cos_eq_0_1 : + forall x:R, (exists k : Z, x = IZR k * PI + PI / 2) -> cos x = 0. +intros x H1; rewrite cos_sin; elim H1; intros x0 H2; rewrite H2; + replace (PI / 2 + (IZR x0 * PI + PI / 2)) with (IZR x0 * PI + PI). +rewrite neg_sin; rewrite <- Ropp_0. +apply Ropp_eq_compat; apply sin_eq_0_1; exists x0; reflexivity. +pattern PI at 2 in |- *; rewrite (double_var PI); ring. +Qed. + +Lemma sin_eq_O_2PI_0 : + forall x:R, + 0 <= x -> x <= 2 * PI -> sin x = 0 -> x = 0 \/ x = PI \/ x = 2 * PI. +intros; generalize (sin_eq_0_0 x H1); intro. +elim H2; intros k0 H3. +case (Rtotal_order PI x); intro. +rewrite H3 in H4; rewrite H3 in H0. +right; right. +generalize + (Rmult_lt_compat_r (/ PI) PI (IZR k0 * PI) (Rinv_0_lt_compat PI PI_RGT_0) H4); + rewrite Rmult_assoc; repeat rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; intro; + generalize + (Rmult_le_compat_r (/ PI) (IZR k0 * PI) (2 * PI) + (Rlt_le 0 (/ PI) (Rinv_0_lt_compat PI PI_RGT_0)) H0); + repeat rewrite Rmult_assoc; repeat rewrite <- Rinv_r_sym. +repeat rewrite Rmult_1_r; intro; + generalize (Rplus_lt_compat_l (IZR (-2)) 1 (IZR k0) H5); + rewrite <- plus_IZR. +replace (IZR (-2) + 1) with (-1). +intro; generalize (Rplus_le_compat_l (IZR (-2)) (IZR k0) 2 H6); + rewrite <- plus_IZR. +replace (IZR (-2) + 2) with 0. +intro; cut (-1 < IZR (-2 + k0) < 1). +intro; generalize (one_IZR_lt1 (-2 + k0) H9); intro. +cut (k0 = 2%Z). +intro; rewrite H11 in H3; rewrite H3; simpl in |- *. +reflexivity. +rewrite <- (Zplus_opp_l 2) in H10; generalize (Zplus_reg_l (-2) k0 2 H10); + intro; assumption. +split. +assumption. +apply Rle_lt_trans with 0. +assumption. +apply Rlt_0_1. +simpl in |- *; ring. +simpl in |- *; ring. +apply PI_neq0. +apply PI_neq0. +elim H4; intro. +right; left. +symmetry in |- *; assumption. +left. +rewrite H3 in H5; rewrite H3 in H; + generalize + (Rmult_lt_compat_r (/ PI) (IZR k0 * PI) PI (Rinv_0_lt_compat PI PI_RGT_0) + H5); rewrite Rmult_assoc; repeat rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; intro; + generalize + (Rmult_le_compat_r (/ PI) 0 (IZR k0 * PI) + (Rlt_le 0 (/ PI) (Rinv_0_lt_compat PI PI_RGT_0)) H); + repeat rewrite Rmult_assoc; repeat rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; rewrite Rmult_0_l; intro. +cut (-1 < IZR k0 < 1). +intro; generalize (one_IZR_lt1 k0 H8); intro; rewrite H9 in H3; rewrite H3; + simpl in |- *; apply Rmult_0_l. +split. +apply Rlt_le_trans with 0. +rewrite <- Ropp_0; apply Ropp_gt_lt_contravar; apply Rlt_0_1. +assumption. +assumption. +apply PI_neq0. +apply PI_neq0. +Qed. + +Lemma sin_eq_O_2PI_1 : + forall x:R, + 0 <= x -> x <= 2 * PI -> x = 0 \/ x = PI \/ x = 2 * PI -> sin x = 0. +intros x H1 H2 H3; elim H3; intro H4; + [ rewrite H4; rewrite sin_0; reflexivity + | elim H4; intro H5; + [ rewrite H5; rewrite sin_PI; reflexivity + | rewrite H5; rewrite sin_2PI; reflexivity ] ]. +Qed. + +Lemma cos_eq_0_2PI_0 : + forall x:R, + 0 <= x -> x <= 2 * PI -> cos x = 0 -> x = PI / 2 \/ x = 3 * (PI / 2). +intros; case (Rtotal_order x (3 * (PI / 2))); intro. +rewrite cos_sin in H1. +cut (0 <= PI / 2 + x). +cut (PI / 2 + x <= 2 * PI). +intros; generalize (sin_eq_O_2PI_0 (PI / 2 + x) H4 H3 H1); intros. +decompose [or] H5. +generalize (Rplus_le_compat_l (PI / 2) 0 x H); rewrite Rplus_0_r; rewrite H6; + intro. +elim (Rlt_irrefl 0 (Rlt_le_trans 0 (PI / 2) 0 PI2_RGT_0 H7)). +left. +generalize (Rplus_eq_compat_l (- (PI / 2)) (PI / 2 + x) PI H7). +replace (- (PI / 2) + (PI / 2 + x)) with x. +replace (- (PI / 2) + PI) with (PI / 2). +intro; assumption. +pattern PI at 3 in |- *; rewrite (double_var PI); ring. +ring. +right. +generalize (Rplus_eq_compat_l (- (PI / 2)) (PI / 2 + x) (2 * PI) H7). +replace (- (PI / 2) + (PI / 2 + x)) with x. +replace (- (PI / 2) + 2 * PI) with (3 * (PI / 2)). +intro; assumption. +rewrite double; pattern PI at 3 4 in |- *; rewrite (double_var PI); ring. +ring. +left; replace (2 * PI) with (PI / 2 + 3 * (PI / 2)). +apply Rplus_lt_compat_l; assumption. +rewrite (double PI); pattern PI at 3 4 in |- *; rewrite (double_var PI); ring. +apply Rplus_le_le_0_compat. +left; unfold Rdiv in |- *; apply Rmult_lt_0_compat. +apply PI_RGT_0. +apply Rinv_0_lt_compat; prove_sup0. +assumption. +elim H2; intro. +right; assumption. +generalize (cos_eq_0_0 x H1); intro; elim H4; intros k0 H5. +rewrite H5 in H3; rewrite H5 in H0; + generalize + (Rplus_lt_compat_l (- (PI / 2)) (3 * (PI / 2)) (IZR k0 * PI + PI / 2) H3); + generalize + (Rplus_le_compat_l (- (PI / 2)) (IZR k0 * PI + PI / 2) (2 * PI) H0). +replace (- (PI / 2) + 3 * (PI / 2)) with PI. +replace (- (PI / 2) + (IZR k0 * PI + PI / 2)) with (IZR k0 * PI). +replace (- (PI / 2) + 2 * PI) with (3 * (PI / 2)). +intros; + generalize + (Rmult_lt_compat_l (/ PI) PI (IZR k0 * PI) (Rinv_0_lt_compat PI PI_RGT_0) + H7); + generalize + (Rmult_le_compat_l (/ PI) (IZR k0 * PI) (3 * (PI / 2)) + (Rlt_le 0 (/ PI) (Rinv_0_lt_compat PI PI_RGT_0)) H6). +replace (/ PI * (IZR k0 * PI)) with (IZR k0). +replace (/ PI * (3 * (PI / 2))) with (3 * / 2). +rewrite <- Rinv_l_sym. +intros; generalize (Rplus_lt_compat_l (IZR (-2)) 1 (IZR k0) H9); + rewrite <- plus_IZR. +replace (IZR (-2) + 1) with (-1). +intro; generalize (Rplus_le_compat_l (IZR (-2)) (IZR k0) (3 * / 2) H8); + rewrite <- plus_IZR. +replace (IZR (-2) + 2) with 0. +intro; cut (-1 < IZR (-2 + k0) < 1). +intro; generalize (one_IZR_lt1 (-2 + k0) H12); intro. +cut (k0 = 2%Z). +intro; rewrite H14 in H8. +assert (Hyp : 0 < 2). +prove_sup0. +generalize (Rmult_le_compat_l 2 (IZR 2) (3 * / 2) (Rlt_le 0 2 Hyp) H8); + simpl in |- *. +replace 4 with 4. +replace (2 * (3 * / 2)) with 3. +intro; cut (3 < 4). +intro; elim (Rlt_irrefl 3 (Rlt_le_trans 3 4 3 H16 H15)). +generalize (Rplus_lt_compat_l 3 0 1 Rlt_0_1); rewrite Rplus_0_r. +replace (3 + 1) with 4. +intro; assumption. +ring. +symmetry in |- *; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m. +discrR. +ring. +rewrite <- (Zplus_opp_l 2) in H13; generalize (Zplus_reg_l (-2) k0 2 H13); + intro; assumption. +split. +assumption. +apply Rle_lt_trans with (IZR (-2) + 3 * / 2). +assumption. +simpl in |- *; replace (-2 + 3 * / 2) with (- (1 * / 2)). +apply Rlt_trans with 0. +rewrite <- Ropp_0; apply Ropp_lt_gt_contravar. +apply Rmult_lt_0_compat; + [ apply Rlt_0_1 | apply Rinv_0_lt_compat; prove_sup0 ]. +apply Rlt_0_1. +rewrite Rmult_1_l; apply Rmult_eq_reg_l with 2. +rewrite Ropp_mult_distr_r_reverse; rewrite <- Rinv_r_sym. +rewrite Rmult_plus_distr_l; rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m. +ring. +discrR. +discrR. +discrR. +simpl in |- *; ring. +simpl in |- *; ring. +apply PI_neq0. +unfold Rdiv in |- *; pattern 3 at 1 in |- *; rewrite (Rmult_comm 3); + repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; apply Rmult_comm. +apply PI_neq0. +symmetry in |- *; rewrite (Rmult_comm (/ PI)); rewrite Rmult_assoc; + rewrite <- Rinv_r_sym. +apply Rmult_1_r. +apply PI_neq0. +rewrite double; pattern PI at 3 4 in |- *; rewrite double_var; ring. +ring. +pattern PI at 1 in |- *; rewrite double_var; ring. +Qed. + +Lemma cos_eq_0_2PI_1 : + forall x:R, + 0 <= x -> x <= 2 * PI -> x = PI / 2 \/ x = 3 * (PI / 2) -> cos x = 0. +intros x H1 H2 H3; elim H3; intro H4; + [ rewrite H4; rewrite cos_PI2; reflexivity + | rewrite H4; rewrite cos_3PI2; reflexivity ]. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Rtrigo_alt.v b/theories/Reals/Rtrigo_alt.v new file mode 100644 index 00000000..3cda9290 --- /dev/null +++ b/theories/Reals/Rtrigo_alt.v @@ -0,0 +1,426 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Rtrigo_alt.v,v 1.16.2.1 2004/07/16 19:31:14 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rfunctions. +Require Import SeqSeries. +Require Import Rtrigo_def. +Open Local Scope R_scope. + +(*****************************************************************) +(* Using series definitions of cos and sin *) +(*****************************************************************) + +Definition sin_term (a:R) (i:nat) : R := + (-1) ^ i * (a ^ (2 * i + 1) / INR (fact (2 * i + 1))). + +Definition cos_term (a:R) (i:nat) : R := + (-1) ^ i * (a ^ (2 * i) / INR (fact (2 * i))). + +Definition sin_approx (a:R) (n:nat) : R := sum_f_R0 (sin_term a) n. + +Definition cos_approx (a:R) (n:nat) : R := sum_f_R0 (cos_term a) n. + +(**********) +Lemma PI_4 : PI <= 4. +assert (H0 := PI_ineq 0). +elim H0; clear H0; intros _ H0. +unfold tg_alt, PI_tg in H0; simpl in H0. +rewrite Rinv_1 in H0; rewrite Rmult_1_r in H0; unfold Rdiv in H0. +apply Rmult_le_reg_l with (/ 4). +apply Rinv_0_lt_compat; prove_sup0. +rewrite <- Rinv_l_sym; [ rewrite Rmult_comm; assumption | discrR ]. +Qed. + +(**********) +Theorem sin_bound : + forall (a:R) (n:nat), + 0 <= a -> + a <= PI -> sin_approx a (2 * n + 1) <= sin a <= sin_approx a (2 * (n + 1)). +intros; case (Req_dec a 0); intro Hyp_a. +rewrite Hyp_a; rewrite sin_0; split; right; unfold sin_approx in |- *; + apply sum_eq_R0 || (symmetry in |- *; apply sum_eq_R0); + intros; unfold sin_term in |- *; rewrite pow_add; + simpl in |- *; unfold Rdiv in |- *; rewrite Rmult_0_l; + ring. +unfold sin_approx in |- *; cut (0 < a). +intro Hyp_a_pos. +rewrite (decomp_sum (sin_term a) (2 * n + 1)). +rewrite (decomp_sum (sin_term a) (2 * (n + 1))). +replace (sin_term a 0) with a. +cut + (sum_f_R0 (fun i:nat => sin_term a (S i)) (pred (2 * n + 1)) <= sin a - a /\ + sin a - a <= sum_f_R0 (fun i:nat => sin_term a (S i)) (pred (2 * (n + 1))) -> + a + sum_f_R0 (fun i:nat => sin_term a (S i)) (pred (2 * n + 1)) <= sin a /\ + sin a <= a + sum_f_R0 (fun i:nat => sin_term a (S i)) (pred (2 * (n + 1)))). +intro; apply H1. +set (Un := fun n:nat => a ^ (2 * S n + 1) / INR (fact (2 * S n + 1))). +replace (pred (2 * n + 1)) with (2 * n)%nat. +replace (pred (2 * (n + 1))) with (S (2 * n)). +replace (sum_f_R0 (fun i:nat => sin_term a (S i)) (2 * n)) with + (- sum_f_R0 (tg_alt Un) (2 * n)). +replace (sum_f_R0 (fun i:nat => sin_term a (S i)) (S (2 * n))) with + (- sum_f_R0 (tg_alt Un) (S (2 * n))). +cut + (sum_f_R0 (tg_alt Un) (S (2 * n)) <= a - sin a <= + sum_f_R0 (tg_alt Un) (2 * n) -> + - sum_f_R0 (tg_alt Un) (2 * n) <= sin a - a <= + - sum_f_R0 (tg_alt Un) (S (2 * n))). +intro; apply H2. +apply alternated_series_ineq. +unfold Un_decreasing, Un in |- *; intro; + cut ((2 * S (S n0) + 1)%nat = S (S (2 * S n0 + 1))). +intro; rewrite H3. +replace (a ^ S (S (2 * S n0 + 1))) with (a ^ (2 * S n0 + 1) * (a * a)). +unfold Rdiv in |- *; rewrite Rmult_assoc; apply Rmult_le_compat_l. +left; apply pow_lt; assumption. +apply Rmult_le_reg_l with (INR (fact (S (S (2 * S n0 + 1))))). +rewrite <- H3; apply lt_INR_0; apply neq_O_lt; red in |- *; intro; + assert (H5 := sym_eq H4); elim (fact_neq_0 _ H5). +rewrite <- H3; rewrite (Rmult_comm (INR (fact (2 * S (S n0) + 1)))); + rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; rewrite H3; do 2 rewrite fact_simpl; do 2 rewrite mult_INR; + repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym. +rewrite Rmult_1_r. +do 2 rewrite S_INR; rewrite plus_INR; rewrite mult_INR; repeat rewrite S_INR; + simpl in |- *; + replace + (((0 + 1 + 1) * (INR n0 + 1) + (0 + 1) + 1 + 1) * + ((0 + 1 + 1) * (INR n0 + 1) + (0 + 1) + 1)) with + (4 * INR n0 * INR n0 + 18 * INR n0 + 20); [ idtac | ring ]. +apply Rle_trans with 20. +apply Rle_trans with 16. +replace 16 with (Rsqr 4); [ idtac | ring_Rsqr ]. +replace (a * a) with (Rsqr a); [ idtac | reflexivity ]. +apply Rsqr_incr_1. +apply Rle_trans with PI; [ assumption | apply PI_4 ]. +assumption. +left; prove_sup0. +rewrite <- (Rplus_0_r 16); replace 20 with (16 + 4); + [ apply Rplus_le_compat_l; left; prove_sup0 | ring ]. +rewrite <- (Rplus_comm 20); pattern 20 at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_le_compat_l. +apply Rplus_le_le_0_compat. +repeat apply Rmult_le_pos. +left; prove_sup0. +left; prove_sup0. +replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ]. +replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ]. +apply Rmult_le_pos. +left; prove_sup0. +replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ]. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +simpl in |- *; ring. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite plus_INR; + do 2 rewrite mult_INR; repeat rewrite S_INR; ring. +assert (H3 := cv_speed_pow_fact a); unfold Un in |- *; unfold Un_cv in H3; + unfold R_dist in H3; unfold Un_cv in |- *; unfold R_dist in |- *; + intros; elim (H3 eps H4); intros N H5. +exists N; intros; apply H5. +replace (2 * S n0 + 1)%nat with (S (2 * S n0)). +unfold ge in |- *; apply le_trans with (2 * S n0)%nat. +apply le_trans with (2 * S N)%nat. +apply le_trans with (2 * N)%nat. +apply le_n_2n. +apply (fun m n p:nat => mult_le_compat_l p n m); apply le_n_Sn. +apply (fun m n p:nat => mult_le_compat_l p n m); apply le_n_S; assumption. +apply le_n_Sn. +apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR; reflexivity. +assert (X := exist_sin (Rsqr a)); elim X; intros. +cut (x = sin a / a). +intro; rewrite H3 in p; unfold sin_in in p; unfold infinit_sum in p; + unfold R_dist in p; unfold Un_cv in |- *; unfold R_dist in |- *; + intros. +cut (0 < eps / Rabs a). +intro; elim (p _ H5); intros N H6. +exists N; intros. +replace (sum_f_R0 (tg_alt Un) n0) with + (a * (1 - sum_f_R0 (fun i:nat => sin_n i * Rsqr a ^ i) (S n0))). +unfold Rminus in |- *; rewrite Rmult_plus_distr_l; rewrite Rmult_1_r; + rewrite Ropp_plus_distr; rewrite Ropp_involutive; + repeat rewrite Rplus_assoc; rewrite (Rplus_comm a); + rewrite (Rplus_comm (- a)); repeat rewrite Rplus_assoc; + rewrite Rplus_opp_l; rewrite Rplus_0_r; apply Rmult_lt_reg_l with (/ Rabs a). +apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. +pattern (/ Rabs a) at 1 in |- *; rewrite <- (Rabs_Rinv a Hyp_a). +rewrite <- Rabs_mult; rewrite Rmult_plus_distr_l; rewrite <- Rmult_assoc; + rewrite <- Rinv_l_sym; [ rewrite Rmult_1_l | assumption ]; + rewrite (Rmult_comm (/ a)); rewrite (Rmult_comm (/ Rabs a)); + rewrite <- Rabs_Ropp; rewrite Ropp_plus_distr; rewrite Ropp_involutive; + unfold Rminus, Rdiv in H6; apply H6; unfold ge in |- *; + apply le_trans with n0; [ exact H7 | apply le_n_Sn ]. +rewrite (decomp_sum (fun i:nat => sin_n i * Rsqr a ^ i) (S n0)). +replace (sin_n 0) with 1. +simpl in |- *; rewrite Rmult_1_r; unfold Rminus in |- *; + rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; rewrite Rplus_opp_r; + rewrite Rplus_0_l; rewrite Ropp_mult_distr_r_reverse; + rewrite <- Ropp_mult_distr_l_reverse; rewrite scal_sum; + apply sum_eq. +intros; unfold sin_n, Un, tg_alt in |- *; + replace ((-1) ^ S i) with (- (-1) ^ i). +replace (a ^ (2 * S i + 1)) with (Rsqr a * Rsqr a ^ i * a). +unfold Rdiv in |- *; ring. +rewrite pow_add; rewrite pow_Rsqr; simpl in |- *; ring. +simpl in |- *; ring. +unfold sin_n in |- *; unfold Rdiv in |- *; simpl in |- *; rewrite Rinv_1; + rewrite Rmult_1_r; reflexivity. +apply lt_O_Sn. +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +assumption. +apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. +unfold sin in |- *; case (exist_sin (Rsqr a)). +intros; cut (x = x0). +intro; rewrite H3; unfold Rdiv in |- *. +symmetry in |- *; apply Rinv_r_simpl_m; assumption. +unfold sin_in in p; unfold sin_in in s; eapply uniqueness_sum. +apply p. +apply s. +intros; elim H2; intros. +replace (sin a - a) with (- (a - sin a)); [ idtac | ring ]. +split; apply Ropp_le_contravar; assumption. +replace (- sum_f_R0 (tg_alt Un) (S (2 * n))) with + (-1 * sum_f_R0 (tg_alt Un) (S (2 * n))); [ rewrite scal_sum | ring ]. +apply sum_eq; intros; unfold sin_term, Un, tg_alt in |- *; + replace ((-1) ^ S i) with (-1 * (-1) ^ i). +unfold Rdiv in |- *; ring. +reflexivity. +replace (- sum_f_R0 (tg_alt Un) (2 * n)) with + (-1 * sum_f_R0 (tg_alt Un) (2 * n)); [ rewrite scal_sum | ring ]. +apply sum_eq; intros. +unfold sin_term, Un, tg_alt in |- *; + replace ((-1) ^ S i) with (-1 * (-1) ^ i). +unfold Rdiv in |- *; ring. +reflexivity. +replace (2 * (n + 1))%nat with (S (S (2 * n))). +reflexivity. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; rewrite plus_INR; + repeat rewrite S_INR; ring. +replace (2 * n + 1)%nat with (S (2 * n)). +reflexivity. +apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR; + repeat rewrite S_INR; ring. +intro; elim H1; intros. +split. +apply Rplus_le_reg_l with (- a). +rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; + rewrite (Rplus_comm (- a)); apply H2. +apply Rplus_le_reg_l with (- a). +rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; + rewrite (Rplus_comm (- a)); apply H3. +unfold sin_term in |- *; simpl in |- *; unfold Rdiv in |- *; rewrite Rinv_1; + ring. +replace (2 * (n + 1))%nat with (S (S (2 * n))). +apply lt_O_Sn. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; rewrite plus_INR; + repeat rewrite S_INR; ring. +replace (2 * n + 1)%nat with (S (2 * n)). +apply lt_O_Sn. +apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR; + repeat rewrite S_INR; ring. +inversion H; [ assumption | elim Hyp_a; symmetry in |- *; assumption ]. +Qed. + +(**********) +Lemma cos_bound : + forall (a:R) (n:nat), + - PI / 2 <= a -> + a <= PI / 2 -> + cos_approx a (2 * n + 1) <= cos a <= cos_approx a (2 * (n + 1)). +cut + ((forall (a:R) (n:nat), + 0 <= a -> + a <= PI / 2 -> + cos_approx a (2 * n + 1) <= cos a <= cos_approx a (2 * (n + 1))) -> + forall (a:R) (n:nat), + - PI / 2 <= a -> + a <= PI / 2 -> + cos_approx a (2 * n + 1) <= cos a <= cos_approx a (2 * (n + 1))). +intros H a n; apply H. +intros; unfold cos_approx in |- *. +rewrite (decomp_sum (cos_term a0) (2 * n0 + 1)). +rewrite (decomp_sum (cos_term a0) (2 * (n0 + 1))). +replace (cos_term a0 0) with 1. +cut + (sum_f_R0 (fun i:nat => cos_term a0 (S i)) (pred (2 * n0 + 1)) <= cos a0 - 1 /\ + cos a0 - 1 <= + sum_f_R0 (fun i:nat => cos_term a0 (S i)) (pred (2 * (n0 + 1))) -> + 1 + sum_f_R0 (fun i:nat => cos_term a0 (S i)) (pred (2 * n0 + 1)) <= cos a0 /\ + cos a0 <= + 1 + sum_f_R0 (fun i:nat => cos_term a0 (S i)) (pred (2 * (n0 + 1)))). +intro; apply H2. +set (Un := fun n:nat => a0 ^ (2 * S n) / INR (fact (2 * S n))). +replace (pred (2 * n0 + 1)) with (2 * n0)%nat. +replace (pred (2 * (n0 + 1))) with (S (2 * n0)). +replace (sum_f_R0 (fun i:nat => cos_term a0 (S i)) (2 * n0)) with + (- sum_f_R0 (tg_alt Un) (2 * n0)). +replace (sum_f_R0 (fun i:nat => cos_term a0 (S i)) (S (2 * n0))) with + (- sum_f_R0 (tg_alt Un) (S (2 * n0))). +cut + (sum_f_R0 (tg_alt Un) (S (2 * n0)) <= 1 - cos a0 <= + sum_f_R0 (tg_alt Un) (2 * n0) -> + - sum_f_R0 (tg_alt Un) (2 * n0) <= cos a0 - 1 <= + - sum_f_R0 (tg_alt Un) (S (2 * n0))). +intro; apply H3. +apply alternated_series_ineq. +unfold Un_decreasing in |- *; intro; unfold Un in |- *. +cut ((2 * S (S n1))%nat = S (S (2 * S n1))). +intro; rewrite H4; + replace (a0 ^ S (S (2 * S n1))) with (a0 ^ (2 * S n1) * (a0 * a0)). +unfold Rdiv in |- *; rewrite Rmult_assoc; apply Rmult_le_compat_l. +apply pow_le; assumption. +apply Rmult_le_reg_l with (INR (fact (S (S (2 * S n1))))). +rewrite <- H4; apply lt_INR_0; apply neq_O_lt; red in |- *; intro; + assert (H6 := sym_eq H5); elim (fact_neq_0 _ H6). +rewrite <- H4; rewrite (Rmult_comm (INR (fact (2 * S (S n1))))); + rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; rewrite H4; do 2 rewrite fact_simpl; do 2 rewrite mult_INR; + repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; do 2 rewrite S_INR; rewrite mult_INR; repeat rewrite S_INR; + simpl in |- *; + replace + (((0 + 1 + 1) * (INR n1 + 1) + 1 + 1) * ((0 + 1 + 1) * (INR n1 + 1) + 1)) + with (4 * INR n1 * INR n1 + 14 * INR n1 + 12); [ idtac | ring ]. +apply Rle_trans with 12. +apply Rle_trans with 4. +replace 4 with (Rsqr 2); [ idtac | ring_Rsqr ]. +replace (a0 * a0) with (Rsqr a0); [ idtac | reflexivity ]. +apply Rsqr_incr_1. +apply Rle_trans with (PI / 2). +assumption. +unfold Rdiv in |- *; apply Rmult_le_reg_l with 2. +prove_sup0. +rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m. +replace 4 with 4; [ apply PI_4 | ring ]. +discrR. +assumption. +left; prove_sup0. +pattern 4 at 1 in |- *; rewrite <- Rplus_0_r; replace 12 with (4 + 8); + [ apply Rplus_le_compat_l; left; prove_sup0 | ring ]. +rewrite <- (Rplus_comm 12); pattern 12 at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_le_compat_l. +apply Rplus_le_le_0_compat. +repeat apply Rmult_le_pos. +left; prove_sup0. +left; prove_sup0. +replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ]. +replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ]. +apply Rmult_le_pos. +left; prove_sup0. +replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ]. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +simpl in |- *; ring. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; + ring. +assert (H4 := cv_speed_pow_fact a0); unfold Un in |- *; unfold Un_cv in H4; + unfold R_dist in H4; unfold Un_cv in |- *; unfold R_dist in |- *; + intros; elim (H4 eps H5); intros N H6; exists N; intros. +apply H6; unfold ge in |- *; apply le_trans with (2 * S N)%nat. +apply le_trans with (2 * N)%nat. +apply le_n_2n. +apply (fun m n p:nat => mult_le_compat_l p n m); apply le_n_Sn. +apply (fun m n p:nat => mult_le_compat_l p n m); apply le_n_S; assumption. +assert (X := exist_cos (Rsqr a0)); elim X; intros. +cut (x = cos a0). +intro; rewrite H4 in p; unfold cos_in in p; unfold infinit_sum in p; + unfold R_dist in p; unfold Un_cv in |- *; unfold R_dist in |- *; + intros. +elim (p _ H5); intros N H6. +exists N; intros. +replace (sum_f_R0 (tg_alt Un) n1) with + (1 - sum_f_R0 (fun i:nat => cos_n i * Rsqr a0 ^ i) (S n1)). +unfold Rminus in |- *; rewrite Ropp_plus_distr; rewrite Ropp_involutive; + repeat rewrite Rplus_assoc; rewrite (Rplus_comm 1); + rewrite (Rplus_comm (-1)); repeat rewrite Rplus_assoc; + rewrite Rplus_opp_l; rewrite Rplus_0_r; rewrite <- Rabs_Ropp; + rewrite Ropp_plus_distr; rewrite Ropp_involutive; + unfold Rminus in H6; apply H6. +unfold ge in |- *; apply le_trans with n1. +exact H7. +apply le_n_Sn. +rewrite (decomp_sum (fun i:nat => cos_n i * Rsqr a0 ^ i) (S n1)). +replace (cos_n 0) with 1. +simpl in |- *; rewrite Rmult_1_r; unfold Rminus in |- *; + rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; rewrite Rplus_opp_r; + rewrite Rplus_0_l; + replace (- sum_f_R0 (fun i:nat => cos_n (S i) * (Rsqr a0 * Rsqr a0 ^ i)) n1) + with + (-1 * sum_f_R0 (fun i:nat => cos_n (S i) * (Rsqr a0 * Rsqr a0 ^ i)) n1); + [ idtac | ring ]; rewrite scal_sum; apply sum_eq; + intros; unfold cos_n, Un, tg_alt in |- *. +replace ((-1) ^ S i) with (- (-1) ^ i). +replace (a0 ^ (2 * S i)) with (Rsqr a0 * Rsqr a0 ^ i). +unfold Rdiv in |- *; ring. +rewrite pow_Rsqr; reflexivity. +simpl in |- *; ring. +unfold cos_n in |- *; unfold Rdiv in |- *; simpl in |- *; rewrite Rinv_1; + rewrite Rmult_1_r; reflexivity. +apply lt_O_Sn. +unfold cos in |- *; case (exist_cos (Rsqr a0)); intros; unfold cos_in in p; + unfold cos_in in c; eapply uniqueness_sum. +apply p. +apply c. +intros; elim H3; intros; replace (cos a0 - 1) with (- (1 - cos a0)); + [ idtac | ring ]. +split; apply Ropp_le_contravar; assumption. +replace (- sum_f_R0 (tg_alt Un) (S (2 * n0))) with + (-1 * sum_f_R0 (tg_alt Un) (S (2 * n0))); [ rewrite scal_sum | ring ]. +apply sum_eq; intros; unfold cos_term, Un, tg_alt in |- *; + replace ((-1) ^ S i) with (-1 * (-1) ^ i). +unfold Rdiv in |- *; ring. +reflexivity. +replace (- sum_f_R0 (tg_alt Un) (2 * n0)) with + (-1 * sum_f_R0 (tg_alt Un) (2 * n0)); [ rewrite scal_sum | ring ]; + apply sum_eq; intros; unfold cos_term, Un, tg_alt in |- *; + replace ((-1) ^ S i) with (-1 * (-1) ^ i). +unfold Rdiv in |- *; ring. +reflexivity. +replace (2 * (n0 + 1))%nat with (S (S (2 * n0))). +reflexivity. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; rewrite plus_INR; + repeat rewrite S_INR; ring. +replace (2 * n0 + 1)%nat with (S (2 * n0)). +reflexivity. +apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR; + repeat rewrite S_INR; ring. +intro; elim H2; intros; split. +apply Rplus_le_reg_l with (-1). +rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; + rewrite (Rplus_comm (-1)); apply H3. +apply Rplus_le_reg_l with (-1). +rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; + rewrite (Rplus_comm (-1)); apply H4. +unfold cos_term in |- *; simpl in |- *; unfold Rdiv in |- *; rewrite Rinv_1; + ring. +replace (2 * (n0 + 1))%nat with (S (S (2 * n0))). +apply lt_O_Sn. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; rewrite plus_INR; + repeat rewrite S_INR; ring. +replace (2 * n0 + 1)%nat with (S (2 * n0)). +apply lt_O_Sn. +apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR; + repeat rewrite S_INR; ring. +intros; case (total_order_T 0 a); intro. +elim s; intro. +apply H; [ left; assumption | assumption ]. +apply H; [ right; assumption | assumption ]. +cut (0 < - a). +intro; cut (forall (x:R) (n:nat), cos_approx x n = cos_approx (- x) n). +intro; rewrite H3; rewrite (H3 a (2 * (n + 1))%nat); rewrite cos_sym; apply H. +left; assumption. +rewrite <- (Ropp_involutive (PI / 2)); apply Ropp_le_contravar; + unfold Rdiv in |- *; unfold Rdiv in H0; rewrite <- Ropp_mult_distr_l_reverse; + exact H0. +intros; unfold cos_approx in |- *; apply sum_eq; intros; + unfold cos_term in |- *; do 2 rewrite pow_Rsqr; rewrite Rsqr_neg; + unfold Rdiv in |- *; reflexivity. +apply Ropp_0_gt_lt_contravar; assumption. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Rtrigo_calc.v b/theories/Reals/Rtrigo_calc.v new file mode 100644 index 00000000..0ef87322 --- /dev/null +++ b/theories/Reals/Rtrigo_calc.v @@ -0,0 +1,434 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Rtrigo_calc.v,v 1.15.2.1 2004/07/16 19:31:14 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rfunctions. +Require Import SeqSeries. +Require Import Rtrigo. +Require Import R_sqrt. +Open Local Scope R_scope. + +Lemma tan_PI : tan PI = 0. +unfold tan in |- *; rewrite sin_PI; rewrite cos_PI; unfold Rdiv in |- *; + apply Rmult_0_l. +Qed. + +Lemma sin_3PI2 : sin (3 * (PI / 2)) = -1. +replace (3 * (PI / 2)) with (PI + PI / 2). +rewrite sin_plus; rewrite sin_PI; rewrite cos_PI; rewrite sin_PI2; ring. +pattern PI at 1 in |- *; rewrite (double_var PI); ring. +Qed. + +Lemma tan_2PI : tan (2 * PI) = 0. +unfold tan in |- *; rewrite sin_2PI; unfold Rdiv in |- *; apply Rmult_0_l. +Qed. + +Lemma sin_cos_PI4 : sin (PI / 4) = cos (PI / 4). +Proof with trivial. +rewrite cos_sin... +replace (PI / 2 + PI / 4) with (- (PI / 4) + PI)... +rewrite neg_sin; rewrite sin_neg; ring... +cut (PI = PI / 2 + PI / 2); [ intro | apply double_var ]... +pattern PI at 2 3 in |- *; rewrite H; pattern PI at 2 3 in |- *; rewrite H... +assert (H0 : 2 <> 0); + [ discrR | unfold Rdiv in |- *; rewrite Rinv_mult_distr; try ring ]... +Qed. + +Lemma sin_PI3_cos_PI6 : sin (PI / 3) = cos (PI / 6). +Proof with trivial. +replace (PI / 6) with (PI / 2 - PI / 3)... +rewrite cos_shift... +assert (H0 : 6 <> 0); [ discrR | idtac ]... +assert (H1 : 3 <> 0); [ discrR | idtac ]... +assert (H2 : 2 <> 0); [ discrR | idtac ]... +apply Rmult_eq_reg_l with 6... +rewrite Rmult_minus_distr_l; repeat rewrite (Rmult_comm 6)... +unfold Rdiv in |- *; repeat rewrite Rmult_assoc... +rewrite <- Rinv_l_sym... +rewrite (Rmult_comm (/ 3)); repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym... +pattern PI at 2 in |- *; rewrite (Rmult_comm PI); repeat rewrite Rmult_1_r; + repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym... +ring... +Qed. + +Lemma sin_PI6_cos_PI3 : cos (PI / 3) = sin (PI / 6). +Proof with trivial. +replace (PI / 6) with (PI / 2 - PI / 3)... +rewrite sin_shift... +assert (H0 : 6 <> 0); [ discrR | idtac ]... +assert (H1 : 3 <> 0); [ discrR | idtac ]... +assert (H2 : 2 <> 0); [ discrR | idtac ]... +apply Rmult_eq_reg_l with 6... +rewrite Rmult_minus_distr_l; repeat rewrite (Rmult_comm 6)... +unfold Rdiv in |- *; repeat rewrite Rmult_assoc... +rewrite <- Rinv_l_sym... +rewrite (Rmult_comm (/ 3)); repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym... +pattern PI at 2 in |- *; rewrite (Rmult_comm PI); repeat rewrite Rmult_1_r; + repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym... +ring... +Qed. + +Lemma PI6_RGT_0 : 0 < PI / 6. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup0 ]. +Qed. + +Lemma PI6_RLT_PI2 : PI / 6 < PI / 2. +unfold Rdiv in |- *; apply Rmult_lt_compat_l. +apply PI_RGT_0. +apply Rinv_lt_contravar; prove_sup. +Qed. + +Lemma sin_PI6 : sin (PI / 6) = 1 / 2. +Proof with trivial. +assert (H : 2 <> 0); [ discrR | idtac ]... +apply Rmult_eq_reg_l with (2 * cos (PI / 6))... +replace (2 * cos (PI / 6) * sin (PI / 6)) with + (2 * sin (PI / 6) * cos (PI / 6))... +rewrite <- sin_2a; replace (2 * (PI / 6)) with (PI / 3)... +rewrite sin_PI3_cos_PI6... +unfold Rdiv in |- *; rewrite Rmult_1_l; rewrite Rmult_assoc; + pattern 2 at 2 in |- *; rewrite (Rmult_comm 2); rewrite Rmult_assoc; + rewrite <- Rinv_l_sym... +rewrite Rmult_1_r... +unfold Rdiv in |- *; rewrite Rinv_mult_distr... +rewrite (Rmult_comm (/ 2)); rewrite (Rmult_comm 2); + repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym... +rewrite Rmult_1_r... +discrR... +ring... +apply prod_neq_R0... +cut (0 < cos (PI / 6)); + [ intro H1; auto with real + | apply cos_gt_0; + [ apply (Rlt_trans (- (PI / 2)) 0 (PI / 6) _PI2_RLT_0 PI6_RGT_0) + | apply PI6_RLT_PI2 ] ]... +Qed. + +Lemma sqrt2_neq_0 : sqrt 2 <> 0. +assert (Hyp : 0 < 2); + [ prove_sup0 + | generalize (Rlt_le 0 2 Hyp); intro H1; red in |- *; intro H2; + generalize (sqrt_eq_0 2 H1 H2); intro H; absurd (2 = 0); + [ discrR | assumption ] ]. +Qed. + +Lemma R1_sqrt2_neq_0 : 1 / sqrt 2 <> 0. +generalize (Rinv_neq_0_compat (sqrt 2) sqrt2_neq_0); intro H; + generalize (prod_neq_R0 1 (/ sqrt 2) R1_neq_R0 H); + intro H0; assumption. +Qed. + +Lemma sqrt3_2_neq_0 : 2 * sqrt 3 <> 0. +apply prod_neq_R0; + [ discrR + | assert (Hyp : 0 < 3); + [ prove_sup0 + | generalize (Rlt_le 0 3 Hyp); intro H1; red in |- *; intro H2; + generalize (sqrt_eq_0 3 H1 H2); intro H; absurd (3 = 0); + [ discrR | assumption ] ] ]. +Qed. + +Lemma Rlt_sqrt2_0 : 0 < sqrt 2. +assert (Hyp : 0 < 2); + [ prove_sup0 + | generalize (sqrt_positivity 2 (Rlt_le 0 2 Hyp)); intro H1; elim H1; + intro H2; + [ assumption + | absurd (0 = sqrt 2); + [ apply (sym_not_eq (A:=R)); apply sqrt2_neq_0 | assumption ] ] ]. +Qed. + +Lemma Rlt_sqrt3_0 : 0 < sqrt 3. +cut (0%nat <> 1%nat); + [ intro H0; assert (Hyp : 0 < 2); + [ prove_sup0 + | generalize (Rlt_le 0 2 Hyp); intro H1; assert (Hyp2 : 0 < 3); + [ prove_sup0 + | generalize (Rlt_le 0 3 Hyp2); intro H2; + generalize (lt_INR_0 1 (neq_O_lt 1 H0)); + unfold INR in |- *; intro H3; + generalize (Rplus_lt_compat_l 2 0 1 H3); + rewrite Rplus_comm; rewrite Rplus_0_l; replace (2 + 1) with 3; + [ intro H4; generalize (sqrt_lt_1 2 3 H1 H2 H4); clear H3; intro H3; + apply (Rlt_trans 0 (sqrt 2) (sqrt 3) Rlt_sqrt2_0 H3) + | ring ] ] ] + | discriminate ]. +Qed. + +Lemma PI4_RGT_0 : 0 < PI / 4. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup0 ]. +Qed. + +Lemma cos_PI4 : cos (PI / 4) = 1 / sqrt 2. +Proof with trivial. +apply Rsqr_inj... +apply cos_ge_0... +left; apply (Rlt_trans (- (PI / 2)) 0 (PI / 4) _PI2_RLT_0 PI4_RGT_0)... +left; apply PI4_RLT_PI2... +left; apply (Rmult_lt_0_compat 1 (/ sqrt 2))... +prove_sup... +apply Rinv_0_lt_compat; apply Rlt_sqrt2_0... +rewrite Rsqr_div... +rewrite Rsqr_1; rewrite Rsqr_sqrt... +assert (H : 2 <> 0); [ discrR | idtac ]... +unfold Rsqr in |- *; pattern (cos (PI / 4)) at 1 in |- *; + rewrite <- sin_cos_PI4; + replace (sin (PI / 4) * cos (PI / 4)) with + (1 / 2 * (2 * sin (PI / 4) * cos (PI / 4)))... +rewrite <- sin_2a; replace (2 * (PI / 4)) with (PI / 2)... +rewrite sin_PI2... +apply Rmult_1_r... +unfold Rdiv in |- *; rewrite (Rmult_comm 2); rewrite Rinv_mult_distr... +repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym... +rewrite Rmult_1_r... +unfold Rdiv in |- *; rewrite Rmult_1_l; repeat rewrite <- Rmult_assoc... +rewrite <- Rinv_l_sym... +rewrite Rmult_1_l... +left; prove_sup... +apply sqrt2_neq_0... +Qed. + +Lemma sin_PI4 : sin (PI / 4) = 1 / sqrt 2. +rewrite sin_cos_PI4; apply cos_PI4. +Qed. + +Lemma tan_PI4 : tan (PI / 4) = 1. +unfold tan in |- *; rewrite sin_cos_PI4. +unfold Rdiv in |- *; apply Rinv_r. +change (cos (PI / 4) <> 0) in |- *; rewrite cos_PI4; apply R1_sqrt2_neq_0. +Qed. + +Lemma cos3PI4 : cos (3 * (PI / 4)) = -1 / sqrt 2. +Proof with trivial. +replace (3 * (PI / 4)) with (PI / 2 - - (PI / 4))... +rewrite cos_shift; rewrite sin_neg; rewrite sin_PI4... +unfold Rdiv in |- *; rewrite Ropp_mult_distr_l_reverse... +unfold Rminus in |- *; rewrite Ropp_involutive; pattern PI at 1 in |- *; + rewrite double_var; unfold Rdiv in |- *; rewrite Rmult_plus_distr_r; + repeat rewrite Rmult_assoc; rewrite <- Rinv_mult_distr; + [ ring | discrR | discrR ]... +Qed. + +Lemma sin3PI4 : sin (3 * (PI / 4)) = 1 / sqrt 2. +Proof with trivial. +replace (3 * (PI / 4)) with (PI / 2 - - (PI / 4))... +rewrite sin_shift; rewrite cos_neg; rewrite cos_PI4... +unfold Rminus in |- *; rewrite Ropp_involutive; pattern PI at 1 in |- *; + rewrite double_var; unfold Rdiv in |- *; rewrite Rmult_plus_distr_r; + repeat rewrite Rmult_assoc; rewrite <- Rinv_mult_distr; + [ ring | discrR | discrR ]... +Qed. + +Lemma cos_PI6 : cos (PI / 6) = sqrt 3 / 2. +Proof with trivial. +apply Rsqr_inj... +apply cos_ge_0... +left; apply (Rlt_trans (- (PI / 2)) 0 (PI / 6) _PI2_RLT_0 PI6_RGT_0)... +left; apply PI6_RLT_PI2... +left; apply (Rmult_lt_0_compat (sqrt 3) (/ 2))... +apply Rlt_sqrt3_0... +apply Rinv_0_lt_compat; prove_sup0... +assert (H : 2 <> 0); [ discrR | idtac ]... +assert (H1 : 4 <> 0); [ apply prod_neq_R0 | idtac ]... +rewrite Rsqr_div... +rewrite cos2; unfold Rsqr in |- *; rewrite sin_PI6; rewrite sqrt_def... +unfold Rdiv in |- *; rewrite Rmult_1_l; apply Rmult_eq_reg_l with 4... +rewrite Rmult_minus_distr_l; rewrite (Rmult_comm 3); + repeat rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym... +rewrite Rmult_1_l; rewrite Rmult_1_r... +rewrite <- (Rmult_comm (/ 2)); repeat rewrite <- Rmult_assoc... +rewrite <- Rinv_l_sym... +rewrite Rmult_1_l; rewrite <- Rinv_r_sym... +ring... +left; prove_sup0... +Qed. + +Lemma tan_PI6 : tan (PI / 6) = 1 / sqrt 3. +unfold tan in |- *; rewrite sin_PI6; rewrite cos_PI6; unfold Rdiv in |- *; + repeat rewrite Rmult_1_l; rewrite Rinv_mult_distr. +rewrite Rinv_involutive. +rewrite (Rmult_comm (/ 2)); rewrite Rmult_assoc; rewrite <- Rinv_r_sym. +apply Rmult_1_r. +discrR. +discrR. +red in |- *; intro; assert (H1 := Rlt_sqrt3_0); rewrite H in H1; + elim (Rlt_irrefl 0 H1). +apply Rinv_neq_0_compat; discrR. +Qed. + +Lemma sin_PI3 : sin (PI / 3) = sqrt 3 / 2. +rewrite sin_PI3_cos_PI6; apply cos_PI6. +Qed. + +Lemma cos_PI3 : cos (PI / 3) = 1 / 2. +rewrite sin_PI6_cos_PI3; apply sin_PI6. +Qed. + +Lemma tan_PI3 : tan (PI / 3) = sqrt 3. +unfold tan in |- *; rewrite sin_PI3; rewrite cos_PI3; unfold Rdiv in |- *; + rewrite Rmult_1_l; rewrite Rinv_involutive. +rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +apply Rmult_1_r. +discrR. +discrR. +Qed. + +Lemma sin_2PI3 : sin (2 * (PI / 3)) = sqrt 3 / 2. +rewrite double; rewrite sin_plus; rewrite sin_PI3; rewrite cos_PI3; + unfold Rdiv in |- *; repeat rewrite Rmult_1_l; rewrite (Rmult_comm (/ 2)); + repeat rewrite <- Rmult_assoc; rewrite double_var; + reflexivity. +Qed. + +Lemma cos_2PI3 : cos (2 * (PI / 3)) = -1 / 2. +Proof with trivial. +assert (H : 2 <> 0); [ discrR | idtac ]... +assert (H0 : 4 <> 0); [ apply prod_neq_R0 | idtac ]... +rewrite double; rewrite cos_plus; rewrite sin_PI3; rewrite cos_PI3; + unfold Rdiv in |- *; rewrite Rmult_1_l; apply Rmult_eq_reg_l with 4... +rewrite Rmult_minus_distr_l; repeat rewrite Rmult_assoc; + rewrite (Rmult_comm 2)... +repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym... +rewrite Rmult_1_r; rewrite <- Rinv_r_sym... +pattern 2 at 4 in |- *; rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym... +rewrite Rmult_1_r; rewrite Ropp_mult_distr_r_reverse; rewrite Rmult_1_r... +rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym... +rewrite Rmult_1_r; rewrite (Rmult_comm 2); rewrite (Rmult_comm (/ 2))... +repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym... +rewrite Rmult_1_r; rewrite sqrt_def... +ring... +left; prove_sup... +Qed. + +Lemma tan_2PI3 : tan (2 * (PI / 3)) = - sqrt 3. +Proof with trivial. +assert (H : 2 <> 0); [ discrR | idtac ]... +unfold tan in |- *; rewrite sin_2PI3; rewrite cos_2PI3; unfold Rdiv in |- *; + rewrite Ropp_mult_distr_l_reverse; rewrite Rmult_1_l; + rewrite <- Ropp_inv_permute... +rewrite Rinv_involutive... +rewrite Rmult_assoc; rewrite Ropp_mult_distr_r_reverse; rewrite <- Rinv_l_sym... +ring... +apply Rinv_neq_0_compat... +Qed. + +Lemma cos_5PI4 : cos (5 * (PI / 4)) = -1 / sqrt 2. +Proof with trivial. +replace (5 * (PI / 4)) with (PI / 4 + PI)... +rewrite neg_cos; rewrite cos_PI4; unfold Rdiv in |- *; + rewrite Ropp_mult_distr_l_reverse... +pattern PI at 2 in |- *; rewrite double_var; pattern PI at 2 3 in |- *; + rewrite double_var; assert (H : 2 <> 0); + [ discrR | unfold Rdiv in |- *; repeat rewrite Rinv_mult_distr; try ring ]... +Qed. + +Lemma sin_5PI4 : sin (5 * (PI / 4)) = -1 / sqrt 2. +Proof with trivial. +replace (5 * (PI / 4)) with (PI / 4 + PI)... +rewrite neg_sin; rewrite sin_PI4; unfold Rdiv in |- *; + rewrite Ropp_mult_distr_l_reverse... +pattern PI at 2 in |- *; rewrite double_var; pattern PI at 2 3 in |- *; + rewrite double_var; assert (H : 2 <> 0); + [ discrR | unfold Rdiv in |- *; repeat rewrite Rinv_mult_distr; try ring ]... +Qed. + +Lemma sin_cos5PI4 : cos (5 * (PI / 4)) = sin (5 * (PI / 4)). +rewrite cos_5PI4; rewrite sin_5PI4; reflexivity. +Qed. + +Lemma Rgt_3PI2_0 : 0 < 3 * (PI / 2). +apply Rmult_lt_0_compat; + [ prove_sup0 + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup0 ] ]. +Qed. + +Lemma Rgt_2PI_0 : 0 < 2 * PI. +apply Rmult_lt_0_compat; [ prove_sup0 | apply PI_RGT_0 ]. +Qed. + +Lemma Rlt_PI_3PI2 : PI < 3 * (PI / 2). +generalize PI2_RGT_0; intro H1; + generalize (Rplus_lt_compat_l PI 0 (PI / 2) H1); + replace (PI + PI / 2) with (3 * (PI / 2)). +rewrite Rplus_0_r; intro H2; assumption. +pattern PI at 2 in |- *; rewrite double_var; ring. +Qed. + +Lemma Rlt_3PI2_2PI : 3 * (PI / 2) < 2 * PI. +generalize PI2_RGT_0; intro H1; + generalize (Rplus_lt_compat_l (3 * (PI / 2)) 0 (PI / 2) H1); + replace (3 * (PI / 2) + PI / 2) with (2 * PI). +rewrite Rplus_0_r; intro H2; assumption. +rewrite double; pattern PI at 1 2 in |- *; rewrite double_var; ring. +Qed. + +(***************************************************************) +(* Radian -> Degree | Degree -> Radian *) +(***************************************************************) + +Definition plat : R := 180. +Definition toRad (x:R) : R := x * PI * / plat. +Definition toDeg (x:R) : R := x * plat * / PI. + +Lemma rad_deg : forall x:R, toRad (toDeg x) = x. +intro; unfold toRad, toDeg in |- *; + replace (x * plat * / PI * PI * / plat) with + (x * (plat * / plat) * (PI * / PI)); [ idtac | ring ]. +repeat rewrite <- Rinv_r_sym. +ring. +apply PI_neq0. +unfold plat in |- *; discrR. +Qed. + +Lemma toRad_inj : forall x y:R, toRad x = toRad y -> x = y. +intros; unfold toRad in H; apply Rmult_eq_reg_l with PI. +rewrite <- (Rmult_comm x); rewrite <- (Rmult_comm y). +apply Rmult_eq_reg_l with (/ plat). +rewrite <- (Rmult_comm (x * PI)); rewrite <- (Rmult_comm (y * PI)); + assumption. +apply Rinv_neq_0_compat; unfold plat in |- *; discrR. +apply PI_neq0. +Qed. + +Lemma deg_rad : forall x:R, toDeg (toRad x) = x. +intro x; apply toRad_inj; rewrite (rad_deg (toRad x)); reflexivity. +Qed. + +Definition sind (x:R) : R := sin (toRad x). +Definition cosd (x:R) : R := cos (toRad x). +Definition tand (x:R) : R := tan (toRad x). + +Lemma Rsqr_sin_cos_d_one : forall x:R, Rsqr (sind x) + Rsqr (cosd x) = 1. +intro x; unfold sind in |- *; unfold cosd in |- *; apply sin2_cos2. +Qed. + +(***************************************************) +(* Other properties *) +(***************************************************) + +Lemma sin_lb_ge_0 : forall a:R, 0 <= a -> a <= PI / 2 -> 0 <= sin_lb a. +intros; case (Rtotal_order 0 a); intro. +left; apply sin_lb_gt_0; assumption. +elim H1; intro. +rewrite <- H2; unfold sin_lb in |- *; unfold sin_approx in |- *; + unfold sum_f_R0 in |- *; unfold sin_term in |- *; + repeat rewrite pow_ne_zero. +unfold Rdiv in |- *; repeat rewrite Rmult_0_l; repeat rewrite Rmult_0_r; + repeat rewrite Rplus_0_r; right; reflexivity. +discriminate. +discriminate. +discriminate. +discriminate. +elim (Rlt_irrefl 0 (Rle_lt_trans 0 a 0 H H2)). +Qed.
\ No newline at end of file diff --git a/theories/Reals/Rtrigo_def.v b/theories/Reals/Rtrigo_def.v new file mode 100644 index 00000000..92ec68ce --- /dev/null +++ b/theories/Reals/Rtrigo_def.v @@ -0,0 +1,412 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Rtrigo_def.v,v 1.17.2.1 2004/07/16 19:31:14 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rfunctions. +Require Import SeqSeries. +Require Import Rtrigo_fun. +Require Import Max. +Open Local Scope R_scope. + +(*****************************) +(* Definition of exponential *) +(*****************************) +Definition exp_in (x l:R) : Prop := + infinit_sum (fun i:nat => / INR (fact i) * x ^ i) l. + +Lemma exp_cof_no_R0 : forall n:nat, / INR (fact n) <> 0. +intro. +apply Rinv_neq_0_compat. +apply INR_fact_neq_0. +Qed. + +Lemma exist_exp : forall x:R, sigT (fun l:R => exp_in x l). +intro; + generalize + (Alembert_C3 (fun n:nat => / INR (fact n)) x exp_cof_no_R0 Alembert_exp). +unfold Pser, exp_in in |- *. +trivial. +Defined. + +Definition exp (x:R) : R := projT1 (exist_exp x). + +Lemma pow_i : forall i:nat, (0 < i)%nat -> 0 ^ i = 0. +intros; apply pow_ne_zero. +red in |- *; intro; rewrite H0 in H; elim (lt_irrefl _ H). +Qed. + +(*i Calculus of $e^0$ *) +Lemma exist_exp0 : sigT (fun l:R => exp_in 0 l). +apply existT with 1. +unfold exp_in in |- *; unfold infinit_sum in |- *; intros. +exists 0%nat. +intros; replace (sum_f_R0 (fun i:nat => / INR (fact i) * 0 ^ i) n) with 1. +unfold R_dist in |- *; replace (1 - 1) with 0; + [ rewrite Rabs_R0; assumption | ring ]. +induction n as [| n Hrecn]. +simpl in |- *; rewrite Rinv_1; ring. +rewrite tech5. +rewrite <- Hrecn. +simpl in |- *. +ring. +unfold ge in |- *; apply le_O_n. +Defined. + +Lemma exp_0 : exp 0 = 1. +cut (exp_in 0 (exp 0)). +cut (exp_in 0 1). +unfold exp_in in |- *; intros; eapply uniqueness_sum. +apply H0. +apply H. +exact (projT2 exist_exp0). +exact (projT2 (exist_exp 0)). +Qed. + +(**************************************) +(* Definition of hyperbolic functions *) +(**************************************) +Definition cosh (x:R) : R := (exp x + exp (- x)) / 2. +Definition sinh (x:R) : R := (exp x - exp (- x)) / 2. +Definition tanh (x:R) : R := sinh x / cosh x. + +Lemma cosh_0 : cosh 0 = 1. +unfold cosh in |- *; rewrite Ropp_0; rewrite exp_0. +unfold Rdiv in |- *; rewrite <- Rinv_r_sym; [ reflexivity | discrR ]. +Qed. + +Lemma sinh_0 : sinh 0 = 0. +unfold sinh in |- *; rewrite Ropp_0; rewrite exp_0. +unfold Rminus, Rdiv in |- *; rewrite Rplus_opp_r; apply Rmult_0_l. +Qed. + +Definition cos_n (n:nat) : R := (-1) ^ n / INR (fact (2 * n)). + +Lemma simpl_cos_n : + forall n:nat, cos_n (S n) / cos_n n = - / INR (2 * S n * (2 * n + 1)). +intro; unfold cos_n in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ]. +rewrite pow_add; unfold Rdiv in |- *; rewrite Rinv_mult_distr. +rewrite Rinv_involutive. +replace + ((-1) ^ n * (-1) ^ 1 * / INR (fact (2 * (n + 1))) * + (/ (-1) ^ n * INR (fact (2 * n)))) with + ((-1) ^ n * / (-1) ^ n * / INR (fact (2 * (n + 1))) * INR (fact (2 * n)) * + (-1) ^ 1); [ idtac | ring ]. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_l; unfold pow in |- *; rewrite Rmult_1_r. +replace (2 * (n + 1))%nat with (S (S (2 * n))); [ idtac | ring ]. +do 2 rewrite fact_simpl; do 2 rewrite mult_INR; + repeat rewrite Rinv_mult_distr; try (apply not_O_INR; discriminate). +rewrite <- (Rmult_comm (-1)). +repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +replace (S (2 * n)) with (2 * n + 1)%nat; [ idtac | ring ]. +rewrite mult_INR; rewrite Rinv_mult_distr. +ring. +apply not_O_INR; discriminate. +replace (2 * n + 1)%nat with (S (2 * n)); + [ apply not_O_INR; discriminate | ring ]. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply prod_neq_R0; [ apply not_O_INR; discriminate | apply INR_fact_neq_0 ]. +apply pow_nonzero; discrR. +apply INR_fact_neq_0. +apply pow_nonzero; discrR. +apply Rinv_neq_0_compat; apply INR_fact_neq_0. +Qed. + +Lemma archimed_cor1 : + forall eps:R, 0 < eps -> exists N : nat, / INR N < eps /\ (0 < N)%nat. +intros; cut (/ eps < IZR (up (/ eps))). +intro; cut (0 <= up (/ eps))%Z. +intro; assert (H2 := IZN _ H1); elim H2; intros; exists (max x 1). +split. +cut (0 < IZR (Z_of_nat x)). +intro; rewrite INR_IZR_INZ; apply Rle_lt_trans with (/ IZR (Z_of_nat x)). +apply Rmult_le_reg_l with (IZR (Z_of_nat x)). +assumption. +rewrite <- Rinv_r_sym; + [ idtac | red in |- *; intro; rewrite H5 in H4; elim (Rlt_irrefl _ H4) ]. +apply Rmult_le_reg_l with (IZR (Z_of_nat (max x 1))). +apply Rlt_le_trans with (IZR (Z_of_nat x)). +assumption. +repeat rewrite <- INR_IZR_INZ; apply le_INR; apply le_max_l. +rewrite Rmult_1_r; rewrite (Rmult_comm (IZR (Z_of_nat (max x 1)))); + rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; repeat rewrite <- INR_IZR_INZ; apply le_INR; + apply le_max_l. +rewrite <- INR_IZR_INZ; apply not_O_INR. +red in |- *; intro; assert (H6 := le_max_r x 1); cut (0 < 1)%nat; + [ intro | apply lt_O_Sn ]; assert (H8 := lt_le_trans _ _ _ H7 H6); + rewrite H5 in H8; elim (lt_irrefl _ H8). +pattern eps at 1 in |- *; rewrite <- Rinv_involutive. +apply Rinv_lt_contravar. +apply Rmult_lt_0_compat; [ apply Rinv_0_lt_compat; assumption | assumption ]. +rewrite H3 in H0; assumption. +red in |- *; intro; rewrite H5 in H; elim (Rlt_irrefl _ H). +apply Rlt_trans with (/ eps). +apply Rinv_0_lt_compat; assumption. +rewrite H3 in H0; assumption. +apply lt_le_trans with 1%nat; [ apply lt_O_Sn | apply le_max_r ]. +apply le_IZR; replace (IZR 0) with 0; [ idtac | reflexivity ]; left; + apply Rlt_trans with (/ eps); + [ apply Rinv_0_lt_compat; assumption | assumption ]. +assert (H0 := archimed (/ eps)). +elim H0; intros; assumption. +Qed. + +Lemma Alembert_cos : Un_cv (fun n:nat => Rabs (cos_n (S n) / cos_n n)) 0. +unfold Un_cv in |- *; intros. +assert (H0 := archimed_cor1 eps H). +elim H0; intros; exists x. +intros; rewrite simpl_cos_n; unfold R_dist in |- *; unfold Rminus in |- *; + rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; + rewrite Rabs_Ropp; rewrite Rabs_right. +rewrite mult_INR; rewrite Rinv_mult_distr. +cut (/ INR (2 * S n) < 1). +intro; cut (/ INR (2 * n + 1) < eps). +intro; rewrite <- (Rmult_1_l eps). +apply Rmult_gt_0_lt_compat; try assumption. +change (0 < / INR (2 * n + 1)) in |- *; apply Rinv_0_lt_compat; + apply lt_INR_0. +replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_O_Sn | ring ]. +apply Rlt_0_1. +cut (x < 2 * n + 1)%nat. +intro; assert (H5 := lt_INR _ _ H4). +apply Rlt_trans with (/ INR x). +apply Rinv_lt_contravar. +apply Rmult_lt_0_compat. +apply lt_INR_0. +elim H1; intros; assumption. +apply lt_INR_0; replace (2 * n + 1)%nat with (S (2 * n)); + [ apply lt_O_Sn | ring ]. +assumption. +elim H1; intros; assumption. +apply lt_le_trans with (S n). +unfold ge in H2; apply le_lt_n_Sm; assumption. +replace (2 * n + 1)%nat with (S (2 * n)); [ idtac | ring ]. +apply le_n_S; apply le_n_2n. +apply Rmult_lt_reg_l with (INR (2 * S n)). +apply lt_INR_0; replace (2 * S n)%nat with (S (S (2 * n))). +apply lt_O_Sn. +replace (S n) with (n + 1)%nat; [ idtac | ring ]. +ring. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; replace 1 with (INR 1); [ apply lt_INR | reflexivity ]. +replace (2 * S n)%nat with (S (S (2 * n))). +apply lt_n_S; apply lt_O_Sn. +replace (S n) with (n + 1)%nat; [ ring | ring ]. +apply not_O_INR; discriminate. +apply not_O_INR; discriminate. +replace (2 * n + 1)%nat with (S (2 * n)); + [ apply not_O_INR; discriminate | ring ]. +apply Rle_ge; left; apply Rinv_0_lt_compat. +apply lt_INR_0. +replace (2 * S n * (2 * n + 1))%nat with (S (S (4 * (n * n) + 6 * n))). +apply lt_O_Sn. +apply INR_eq. +repeat rewrite S_INR; rewrite plus_INR; repeat rewrite mult_INR; + rewrite plus_INR; rewrite mult_INR; repeat rewrite S_INR; + replace (INR 0) with 0; [ ring | reflexivity ]. +Qed. + +Lemma cosn_no_R0 : forall n:nat, cos_n n <> 0. +intro; unfold cos_n in |- *; unfold Rdiv in |- *; apply prod_neq_R0. +apply pow_nonzero; discrR. +apply Rinv_neq_0_compat. +apply INR_fact_neq_0. +Qed. + +(**********) +Definition cos_in (x l:R) : Prop := + infinit_sum (fun i:nat => cos_n i * x ^ i) l. + +(**********) +Lemma exist_cos : forall x:R, sigT (fun l:R => cos_in x l). +intro; generalize (Alembert_C3 cos_n x cosn_no_R0 Alembert_cos). +unfold Pser, cos_in in |- *; trivial. +Qed. + +(* Definition of cosinus *) +(*************************) +Definition cos (x:R) : R := + match exist_cos (Rsqr x) with + | existT a b => a + end. + + +Definition sin_n (n:nat) : R := (-1) ^ n / INR (fact (2 * n + 1)). + +Lemma simpl_sin_n : + forall n:nat, sin_n (S n) / sin_n n = - / INR ((2 * S n + 1) * (2 * S n)). +intro; unfold sin_n in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ]. +rewrite pow_add; unfold Rdiv in |- *; rewrite Rinv_mult_distr. +rewrite Rinv_involutive. +replace + ((-1) ^ n * (-1) ^ 1 * / INR (fact (2 * (n + 1) + 1)) * + (/ (-1) ^ n * INR (fact (2 * n + 1)))) with + ((-1) ^ n * / (-1) ^ n * / INR (fact (2 * (n + 1) + 1)) * + INR (fact (2 * n + 1)) * (-1) ^ 1); [ idtac | ring ]. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_l; unfold pow in |- *; rewrite Rmult_1_r; + replace (2 * (n + 1) + 1)%nat with (S (S (2 * n + 1))). +do 2 rewrite fact_simpl; do 2 rewrite mult_INR; + repeat rewrite Rinv_mult_distr. +rewrite <- (Rmult_comm (-1)); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; replace (S (2 * n + 1)) with (2 * (n + 1))%nat. +repeat rewrite mult_INR; repeat rewrite Rinv_mult_distr. +ring. +apply not_O_INR; discriminate. +replace (n + 1)%nat with (S n); [ apply not_O_INR; discriminate | ring ]. +apply not_O_INR; discriminate. +apply prod_neq_R0. +apply not_O_INR; discriminate. +replace (n + 1)%nat with (S n); [ apply not_O_INR; discriminate | ring ]. +apply not_O_INR; discriminate. +replace (n + 1)%nat with (S n); [ apply not_O_INR; discriminate | ring ]. +rewrite mult_plus_distr_l; cut (forall n:nat, S n = (n + 1)%nat). +intros; rewrite (H (2 * n + 1)%nat). +ring. +intros; ring. +apply INR_fact_neq_0. +apply not_O_INR; discriminate. +apply INR_fact_neq_0. +apply not_O_INR; discriminate. +apply prod_neq_R0; [ apply not_O_INR; discriminate | apply INR_fact_neq_0 ]. +cut (forall n:nat, S (S n) = (n + 2)%nat); + [ intros; rewrite (H (2 * n + 1)%nat); ring | intros; ring ]. +apply pow_nonzero; discrR. +apply INR_fact_neq_0. +apply pow_nonzero; discrR. +apply Rinv_neq_0_compat; apply INR_fact_neq_0. +Qed. + +Lemma Alembert_sin : Un_cv (fun n:nat => Rabs (sin_n (S n) / sin_n n)) 0. +unfold Un_cv in |- *; intros; assert (H0 := archimed_cor1 eps H). +elim H0; intros; exists x. +intros; rewrite simpl_sin_n; unfold R_dist in |- *; unfold Rminus in |- *; + rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; + rewrite Rabs_Ropp; rewrite Rabs_right. +rewrite mult_INR; rewrite Rinv_mult_distr. +cut (/ INR (2 * S n) < 1). +intro; cut (/ INR (2 * S n + 1) < eps). +intro; rewrite <- (Rmult_1_l eps); rewrite (Rmult_comm (/ INR (2 * S n + 1))); + apply Rmult_gt_0_lt_compat; try assumption. +change (0 < / INR (2 * S n + 1)) in |- *; apply Rinv_0_lt_compat; + apply lt_INR_0; replace (2 * S n + 1)%nat with (S (2 * S n)); + [ apply lt_O_Sn | ring ]. +apply Rlt_0_1. +cut (x < 2 * S n + 1)%nat. +intro; assert (H5 := lt_INR _ _ H4); apply Rlt_trans with (/ INR x). +apply Rinv_lt_contravar. +apply Rmult_lt_0_compat. +apply lt_INR_0; elim H1; intros; assumption. +apply lt_INR_0; replace (2 * S n + 1)%nat with (S (2 * S n)); + [ apply lt_O_Sn | ring ]. +assumption. +elim H1; intros; assumption. +apply lt_le_trans with (S n). +unfold ge in H2; apply le_lt_n_Sm; assumption. +replace (2 * S n + 1)%nat with (S (2 * S n)); [ idtac | ring ]. +apply le_S; apply le_n_2n. +apply Rmult_lt_reg_l with (INR (2 * S n)). +apply lt_INR_0; replace (2 * S n)%nat with (S (S (2 * n))); + [ apply lt_O_Sn | replace (S n) with (n + 1)%nat; [ idtac | ring ]; ring ]. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; replace 1 with (INR 1); [ apply lt_INR | reflexivity ]. +replace (2 * S n)%nat with (S (S (2 * n))). +apply lt_n_S; apply lt_O_Sn. +replace (S n) with (n + 1)%nat; [ ring | ring ]. +apply not_O_INR; discriminate. +apply not_O_INR; discriminate. +apply not_O_INR; discriminate. +left; change (0 < / INR ((2 * S n + 1) * (2 * S n))) in |- *; + apply Rinv_0_lt_compat. +apply lt_INR_0. +replace ((2 * S n + 1) * (2 * S n))%nat with + (S (S (S (S (S (S (4 * (n * n) + 10 * n))))))). +apply lt_O_Sn. +apply INR_eq; repeat rewrite S_INR; rewrite plus_INR; repeat rewrite mult_INR; + rewrite plus_INR; rewrite mult_INR; repeat rewrite S_INR; + replace (INR 0) with 0; [ ring | reflexivity ]. +Qed. + +Lemma sin_no_R0 : forall n:nat, sin_n n <> 0. +intro; unfold sin_n in |- *; unfold Rdiv in |- *; apply prod_neq_R0. +apply pow_nonzero; discrR. +apply Rinv_neq_0_compat; apply INR_fact_neq_0. +Qed. + +(**********) +Definition sin_in (x l:R) : Prop := + infinit_sum (fun i:nat => sin_n i * x ^ i) l. + +(**********) +Lemma exist_sin : forall x:R, sigT (fun l:R => sin_in x l). +intro; generalize (Alembert_C3 sin_n x sin_no_R0 Alembert_sin). +unfold Pser, sin_n in |- *; trivial. +Qed. + +(***********************) +(* Definition of sinus *) +Definition sin (x:R) : R := + match exist_sin (Rsqr x) with + | existT a b => x * a + end. + +(*********************************************) +(* PROPERTIES *) +(*********************************************) + +Lemma cos_sym : forall x:R, cos x = cos (- x). +intros; unfold cos in |- *; replace (Rsqr (- x)) with (Rsqr x). +reflexivity. +apply Rsqr_neg. +Qed. + +Lemma sin_antisym : forall x:R, sin (- x) = - sin x. +intro; unfold sin in |- *; replace (Rsqr (- x)) with (Rsqr x); + [ idtac | apply Rsqr_neg ]. +case (exist_sin (Rsqr x)); intros; ring. +Qed. + +Lemma sin_0 : sin 0 = 0. +unfold sin in |- *; case (exist_sin (Rsqr 0)). +intros; ring. +Qed. + +Lemma exist_cos0 : sigT (fun l:R => cos_in 0 l). +apply existT with 1. +unfold cos_in in |- *; unfold infinit_sum in |- *; intros; exists 0%nat. +intros. +unfold R_dist in |- *. +induction n as [| n Hrecn]. +unfold cos_n in |- *; simpl in |- *. +unfold Rdiv in |- *; rewrite Rinv_1. +do 2 rewrite Rmult_1_r. +unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. +rewrite tech5. +replace (cos_n (S n) * 0 ^ S n) with 0. +rewrite Rplus_0_r. +apply Hrecn; unfold ge in |- *; apply le_O_n. +simpl in |- *; ring. +Defined. + +(* Calculus of (cos 0) *) +Lemma cos_0 : cos 0 = 1. +cut (cos_in 0 (cos 0)). +cut (cos_in 0 1). +unfold cos_in in |- *; intros; eapply uniqueness_sum. +apply H0. +apply H. +exact (projT2 exist_cos0). +assert (H := projT2 (exist_cos (Rsqr 0))); unfold cos in |- *; + pattern 0 at 1 in |- *; replace 0 with (Rsqr 0); [ exact H | apply Rsqr_0 ]. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Rtrigo_fun.v b/theories/Reals/Rtrigo_fun.v new file mode 100644 index 00000000..b0f29e5c --- /dev/null +++ b/theories/Reals/Rtrigo_fun.v @@ -0,0 +1,109 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Rtrigo_fun.v,v 1.7.2.1 2004/07/16 19:31:15 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rfunctions. +Require Import SeqSeries. +Open Local Scope R_scope. + +(*****************************************************************) +(* To define transcendental functions *) +(* *) +(*****************************************************************) +(*****************************************************************) +(* For exponential function *) +(* *) +(*****************************************************************) + +(*********) +Lemma Alembert_exp : + Un_cv (fun n:nat => Rabs (/ INR (fact (S n)) * / / INR (fact n))) 0. +unfold Un_cv in |- *; intros; elim (Rgt_dec eps 1); intro. +split with 0%nat; intros; rewrite (simpl_fact n); unfold R_dist in |- *; + rewrite (Rminus_0_r (Rabs (/ INR (S n)))); + rewrite (Rabs_Rabsolu (/ INR (S n))); cut (/ INR (S n) > 0). +intro; rewrite (Rabs_pos_eq (/ INR (S n))). +cut (/ eps - 1 < 0). +intro; generalize (Rlt_le_trans (/ eps - 1) 0 (INR n) H2 (pos_INR n)); + clear H2; intro; unfold Rminus in H2; + generalize (Rplus_lt_compat_l 1 (/ eps + -1) (INR n) H2); + replace (1 + (/ eps + -1)) with (/ eps); [ clear H2; intro | ring ]. +rewrite (Rplus_comm 1 (INR n)) in H2; rewrite <- (S_INR n) in H2; + generalize (Rmult_gt_0_compat (/ INR (S n)) eps H1 H); + intro; unfold Rgt in H3; + generalize (Rmult_lt_compat_l (/ INR (S n) * eps) (/ eps) (INR (S n)) H3 H2); + intro; rewrite (Rmult_assoc (/ INR (S n)) eps (/ eps)) in H4; + rewrite (Rinv_r eps (Rlt_dichotomy_converse eps 0 (or_intror (eps < 0) H))) + in H4; rewrite (let (H1, H2) := Rmult_ne (/ INR (S n)) in H1) in H4; + rewrite (Rmult_comm (/ INR (S n))) in H4; + rewrite (Rmult_assoc eps (/ INR (S n)) (INR (S n))) in H4; + rewrite (Rinv_l (INR (S n)) (not_O_INR (S n) (sym_not_equal (O_S n)))) in H4; + rewrite (let (H1, H2) := Rmult_ne eps in H1) in H4; + assumption. +apply Rlt_minus; unfold Rgt in a; rewrite <- Rinv_1; + apply (Rinv_lt_contravar 1 eps); auto; + rewrite (let (H1, H2) := Rmult_ne eps in H2); unfold Rgt in H; + assumption. +unfold Rgt in H1; apply Rlt_le; assumption. +unfold Rgt in |- *; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn. +(**) +cut (0 <= up (/ eps - 1))%Z. +intro; elim (IZN (up (/ eps - 1)) H0); intros; split with x; intros; + rewrite (simpl_fact n); unfold R_dist in |- *; + rewrite (Rminus_0_r (Rabs (/ INR (S n)))); + rewrite (Rabs_Rabsolu (/ INR (S n))); cut (/ INR (S n) > 0). +intro; rewrite (Rabs_pos_eq (/ INR (S n))). +cut (/ eps - 1 < INR x). +intro; + generalize + (Rlt_le_trans (/ eps - 1) (INR x) (INR n) H4 + (le_INR x n ((fun (n m:nat) (H:(m >= n)%nat) => H) x n H2))); + clear H4; intro; unfold Rminus in H4; + generalize (Rplus_lt_compat_l 1 (/ eps + -1) (INR n) H4); + replace (1 + (/ eps + -1)) with (/ eps); [ clear H4; intro | ring ]. +rewrite (Rplus_comm 1 (INR n)) in H4; rewrite <- (S_INR n) in H4; + generalize (Rmult_gt_0_compat (/ INR (S n)) eps H3 H); + intro; unfold Rgt in H5; + generalize (Rmult_lt_compat_l (/ INR (S n) * eps) (/ eps) (INR (S n)) H5 H4); + intro; rewrite (Rmult_assoc (/ INR (S n)) eps (/ eps)) in H6; + rewrite (Rinv_r eps (Rlt_dichotomy_converse eps 0 (or_intror (eps < 0) H))) + in H6; rewrite (let (H1, H2) := Rmult_ne (/ INR (S n)) in H1) in H6; + rewrite (Rmult_comm (/ INR (S n))) in H6; + rewrite (Rmult_assoc eps (/ INR (S n)) (INR (S n))) in H6; + rewrite (Rinv_l (INR (S n)) (not_O_INR (S n) (sym_not_equal (O_S n)))) in H6; + rewrite (let (H1, H2) := Rmult_ne eps in H1) in H6; + assumption. +cut (IZR (up (/ eps - 1)) = IZR (Z_of_nat x)); + [ intro | rewrite H1; trivial ]. +elim (archimed (/ eps - 1)); intros; clear H6; unfold Rgt in H5; + rewrite H4 in H5; rewrite INR_IZR_INZ; assumption. +unfold Rgt in H1; apply Rlt_le; assumption. +unfold Rgt in |- *; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn. +apply (le_O_IZR (up (/ eps - 1))); + apply (Rle_trans 0 (/ eps - 1) (IZR (up (/ eps - 1)))). +generalize (Rnot_gt_le eps 1 b); clear b; unfold Rle in |- *; intro; elim H0; + clear H0; intro. +left; unfold Rgt in H; + generalize (Rmult_lt_compat_l (/ eps) eps 1 (Rinv_0_lt_compat eps H) H0); + rewrite + (Rinv_l eps + (sym_not_eq (Rlt_dichotomy_converse 0 eps (or_introl (0 > eps) H)))) + ; rewrite (let (H1, H2) := Rmult_ne (/ eps) in H1); + intro; fold (/ eps - 1 > 0) in |- *; apply Rgt_minus; + unfold Rgt in |- *; assumption. +right; rewrite H0; rewrite Rinv_1; apply sym_eq; apply Rminus_diag_eq; auto. +elim (archimed (/ eps - 1)); intros; clear H1; unfold Rgt in H0; apply Rlt_le; + assumption. +Qed. + + + + + diff --git a/theories/Reals/Rtrigo_reg.v b/theories/Reals/Rtrigo_reg.v new file mode 100644 index 00000000..9d3b60c6 --- /dev/null +++ b/theories/Reals/Rtrigo_reg.v @@ -0,0 +1,608 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Rtrigo_reg.v,v 1.15.2.1 2004/07/16 19:31:15 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rfunctions. +Require Import SeqSeries. +Require Import Rtrigo. +Require Import Ranalysis1. +Require Import PSeries_reg. +Open Local Scope nat_scope. +Open Local Scope R_scope. + +Lemma CVN_R_cos : + forall fn:nat -> R -> R, + fn = (fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N)) * x ^ (2 * N)) -> + CVN_R fn. +unfold CVN_R in |- *; intros. +cut ((r:R) <> 0). +intro hyp_r; unfold CVN_r in |- *. +apply existT with (fun n:nat => / INR (fact (2 * n)) * r ^ (2 * n)). +cut + (sigT + (fun l:R => + Un_cv + (fun n:nat => + sum_f_R0 (fun k:nat => Rabs (/ INR (fact (2 * k)) * r ^ (2 * k))) + n) l)). +intro; elim X; intros. +apply existT with x. +split. +apply p. +intros; rewrite H; unfold Rdiv in |- *; do 2 rewrite Rabs_mult. +rewrite pow_1_abs; rewrite Rmult_1_l. +cut (0 < / INR (fact (2 * n))). +intro; rewrite (Rabs_right _ (Rle_ge _ _ (Rlt_le _ _ H1))). +apply Rmult_le_compat_l. +left; apply H1. +rewrite <- RPow_abs; apply pow_maj_Rabs. +rewrite Rabs_Rabsolu. +unfold Boule in H0; rewrite Rminus_0_r in H0. +left; apply H0. +apply Rinv_0_lt_compat; apply INR_fact_lt_0. +apply Alembert_C2. +intro; apply Rabs_no_R0. +apply prod_neq_R0. +apply Rinv_neq_0_compat. +apply INR_fact_neq_0. +apply pow_nonzero; assumption. +assert (H0 := Alembert_cos). +unfold cos_n in H0; unfold Un_cv in H0; unfold Un_cv in |- *; intros. +cut (0 < eps / Rsqr r). +intro; elim (H0 _ H2); intros N0 H3. +exists N0; intros. +unfold R_dist in |- *; assert (H5 := H3 _ H4). +unfold R_dist in H5; + replace + (Rabs + (Rabs (/ INR (fact (2 * S n)) * r ^ (2 * S n)) / + Rabs (/ INR (fact (2 * n)) * r ^ (2 * n)))) with + (Rsqr r * + Rabs ((-1) ^ S n / INR (fact (2 * S n)) / ((-1) ^ n / INR (fact (2 * n))))). +apply Rmult_lt_reg_l with (/ Rsqr r). +apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption. +pattern (/ Rsqr r) at 1 in |- *; replace (/ Rsqr r) with (Rabs (/ Rsqr r)). +rewrite <- Rabs_mult; rewrite Rmult_minus_distr_l; rewrite Rmult_0_r; + rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); apply H5. +unfold Rsqr in |- *; apply prod_neq_R0; assumption. +rewrite Rabs_Rinv. +rewrite Rabs_right. +reflexivity. +apply Rle_ge; apply Rle_0_sqr. +unfold Rsqr in |- *; apply prod_neq_R0; assumption. +rewrite (Rmult_comm (Rsqr r)); unfold Rdiv in |- *; repeat rewrite Rabs_mult; + rewrite Rabs_Rabsolu; rewrite pow_1_abs; rewrite Rmult_1_l; + repeat rewrite Rmult_assoc; apply Rmult_eq_compat_l. +rewrite Rabs_Rinv. +rewrite Rabs_mult; rewrite (pow_1_abs n); rewrite Rmult_1_l; + rewrite <- Rabs_Rinv. +rewrite Rinv_involutive. +rewrite Rinv_mult_distr. +rewrite Rabs_Rinv. +rewrite Rinv_involutive. +rewrite (Rmult_comm (Rabs (Rabs (r ^ (2 * S n))))); rewrite Rabs_mult; + rewrite Rabs_Rabsolu; rewrite Rmult_assoc; apply Rmult_eq_compat_l. +rewrite Rabs_Rinv. +do 2 rewrite Rabs_Rabsolu; repeat rewrite Rabs_right. +replace (r ^ (2 * S n)) with (r ^ (2 * n) * r * r). +repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +unfold Rsqr in |- *; ring. +apply pow_nonzero; assumption. +replace (2 * S n)%nat with (S (S (2 * n))). +simpl in |- *; ring. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; + ring. +apply Rle_ge; apply pow_le; left; apply (cond_pos r). +apply Rle_ge; apply pow_le; left; apply (cond_pos r). +apply Rabs_no_R0; apply pow_nonzero; assumption. +apply Rabs_no_R0; apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply Rabs_no_R0; apply Rinv_neq_0_compat; apply INR_fact_neq_0. +apply Rabs_no_R0; apply pow_nonzero; assumption. +apply INR_fact_neq_0. +apply Rinv_neq_0_compat; apply INR_fact_neq_0. +apply prod_neq_R0. +apply pow_nonzero; discrR. +apply Rinv_neq_0_compat; apply INR_fact_neq_0. +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +apply H1. +apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption. +assert (H0 := cond_pos r); red in |- *; intro; rewrite H1 in H0; + elim (Rlt_irrefl _ H0). +Qed. + +(**********) +Lemma continuity_cos : continuity cos. +set (fn := fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N)) * x ^ (2 * N)). +cut (CVN_R fn). +intro; cut (forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)). +intro cv; cut (forall n:nat, continuity (fn n)). +intro; cut (forall x:R, cos x = SFL fn cv x). +intro; cut (continuity (SFL fn cv) -> continuity cos). +intro; apply H1. +apply SFL_continuity; assumption. +unfold continuity in |- *; unfold continuity_pt in |- *; + unfold continue_in in |- *; unfold limit1_in in |- *; + unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; + intros. +elim (H1 x _ H2); intros. +exists x0; intros. +elim H3; intros. +split. +apply H4. +intros; rewrite (H0 x); rewrite (H0 x1); apply H5; apply H6. +intro; unfold cos, SFL in |- *. +case (cv x); case (exist_cos (Rsqr x)); intros. +symmetry in |- *; eapply UL_sequence. +apply u. +unfold cos_in in c; unfold infinit_sum in c; unfold Un_cv in |- *; intros. +elim (c _ H0); intros N0 H1. +exists N0; intros. +unfold R_dist in H1; unfold R_dist, SP in |- *. +replace (sum_f_R0 (fun k:nat => fn k x) n) with + (sum_f_R0 (fun i:nat => cos_n i * Rsqr x ^ i) n). +apply H1; assumption. +apply sum_eq; intros. +unfold cos_n, fn in |- *; apply Rmult_eq_compat_l. +unfold Rsqr in |- *; rewrite pow_sqr; reflexivity. +intro; unfold fn in |- *; + replace (fun x:R => (-1) ^ n / INR (fact (2 * n)) * x ^ (2 * n)) with + (fct_cte ((-1) ^ n / INR (fact (2 * n))) * pow_fct (2 * n))%F; + [ idtac | reflexivity ]. +apply continuity_mult. +apply derivable_continuous; apply derivable_const. +apply derivable_continuous; apply (derivable_pow (2 * n)). +apply CVN_R_CVS; apply X. +apply CVN_R_cos; unfold fn in |- *; reflexivity. +Qed. + +(**********) +Lemma continuity_sin : continuity sin. +unfold continuity in |- *; intro. +assert (H0 := continuity_cos (PI / 2 - x)). +unfold continuity_pt in H0; unfold continue_in in H0; unfold limit1_in in H0; + unfold limit_in in H0; simpl in H0; unfold R_dist in H0; + unfold continuity_pt in |- *; unfold continue_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold R_dist in |- *; intros. +elim (H0 _ H); intros. +exists x0; intros. +elim H1; intros. +split. +assumption. +intros; rewrite <- (cos_shift x); rewrite <- (cos_shift x1); apply H3. +elim H4; intros. +split. +unfold D_x, no_cond in |- *; split. +trivial. +red in |- *; intro; unfold D_x, no_cond in H5; elim H5; intros _ H8; elim H8; + rewrite <- (Ropp_involutive x); rewrite <- (Ropp_involutive x1); + apply Ropp_eq_compat; apply Rplus_eq_reg_l with (PI / 2); + apply H7. +replace (PI / 2 - x1 - (PI / 2 - x)) with (x - x1); [ idtac | ring ]; + rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr'; apply H6. +Qed. + +Lemma CVN_R_sin : + forall fn:nat -> R -> R, + fn = + (fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N + 1)) * x ^ (2 * N)) -> + CVN_R fn. +unfold CVN_R in |- *; unfold CVN_r in |- *; intros fn H r. +apply existT with (fun n:nat => / INR (fact (2 * n + 1)) * r ^ (2 * n)). +cut + (sigT + (fun l:R => + Un_cv + (fun n:nat => + sum_f_R0 + (fun k:nat => Rabs (/ INR (fact (2 * k + 1)) * r ^ (2 * k))) n) + l)). +intro; elim X; intros. +apply existT with x. +split. +apply p. +intros; rewrite H; unfold Rdiv in |- *; do 2 rewrite Rabs_mult; + rewrite pow_1_abs; rewrite Rmult_1_l. +cut (0 < / INR (fact (2 * n + 1))). +intro; rewrite (Rabs_right _ (Rle_ge _ _ (Rlt_le _ _ H1))). +apply Rmult_le_compat_l. +left; apply H1. +rewrite <- RPow_abs; apply pow_maj_Rabs. +rewrite Rabs_Rabsolu; unfold Boule in H0; rewrite Rminus_0_r in H0; left; + apply H0. +apply Rinv_0_lt_compat; apply INR_fact_lt_0. +cut ((r:R) <> 0). +intro; apply Alembert_C2. +intro; apply Rabs_no_R0. +apply prod_neq_R0. +apply Rinv_neq_0_compat; apply INR_fact_neq_0. +apply pow_nonzero; assumption. +assert (H1 := Alembert_sin). +unfold sin_n in H1; unfold Un_cv in H1; unfold Un_cv in |- *; intros. +cut (0 < eps / Rsqr r). +intro; elim (H1 _ H3); intros N0 H4. +exists N0; intros. +unfold R_dist in |- *; assert (H6 := H4 _ H5). +unfold R_dist in H5; + replace + (Rabs + (Rabs (/ INR (fact (2 * S n + 1)) * r ^ (2 * S n)) / + Rabs (/ INR (fact (2 * n + 1)) * r ^ (2 * n)))) with + (Rsqr r * + Rabs + ((-1) ^ S n / INR (fact (2 * S n + 1)) / + ((-1) ^ n / INR (fact (2 * n + 1))))). +apply Rmult_lt_reg_l with (/ Rsqr r). +apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption. +pattern (/ Rsqr r) at 1 in |- *; rewrite <- (Rabs_right (/ Rsqr r)). +rewrite <- Rabs_mult. +rewrite Rmult_minus_distr_l. +rewrite Rmult_0_r; rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; rewrite <- (Rmult_comm eps). +apply H6. +unfold Rsqr in |- *; apply prod_neq_R0; assumption. +apply Rle_ge; left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption. +unfold Rdiv in |- *; rewrite (Rmult_comm (Rsqr r)); repeat rewrite Rabs_mult; + rewrite Rabs_Rabsolu; rewrite pow_1_abs. +rewrite Rmult_1_l. +repeat rewrite Rmult_assoc; apply Rmult_eq_compat_l. +rewrite Rinv_mult_distr. +rewrite Rinv_involutive. +rewrite Rabs_mult. +rewrite Rabs_Rinv. +rewrite pow_1_abs; rewrite Rinv_1; rewrite Rmult_1_l. +rewrite Rinv_mult_distr. +rewrite <- Rabs_Rinv. +rewrite Rinv_involutive. +rewrite Rabs_mult. +do 2 rewrite Rabs_Rabsolu. +rewrite (Rmult_comm (Rabs (r ^ (2 * S n)))). +rewrite Rmult_assoc; apply Rmult_eq_compat_l. +rewrite Rabs_Rinv. +rewrite Rabs_Rabsolu. +repeat rewrite Rabs_right. +replace (r ^ (2 * S n)) with (r ^ (2 * n) * r * r). +do 2 rewrite <- Rmult_assoc. +rewrite <- Rinv_l_sym. +unfold Rsqr in |- *; ring. +apply pow_nonzero; assumption. +replace (2 * S n)%nat with (S (S (2 * n))). +simpl in |- *; ring. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; + ring. +apply Rle_ge; apply pow_le; left; apply (cond_pos r). +apply Rle_ge; apply pow_le; left; apply (cond_pos r). +apply Rabs_no_R0; apply pow_nonzero; assumption. +apply INR_fact_neq_0. +apply Rinv_neq_0_compat; apply INR_fact_neq_0. +apply Rabs_no_R0; apply Rinv_neq_0_compat; apply INR_fact_neq_0. +apply Rabs_no_R0; apply pow_nonzero; assumption. +apply pow_nonzero; discrR. +apply INR_fact_neq_0. +apply pow_nonzero; discrR. +apply Rinv_neq_0_compat; apply INR_fact_neq_0. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption ]. +assert (H0 := cond_pos r); red in |- *; intro; rewrite H1 in H0; + elim (Rlt_irrefl _ H0). +Qed. + +(* (sin h)/h -> 1 when h -> 0 *) +Lemma derivable_pt_lim_sin_0 : derivable_pt_lim sin 0 1. +unfold derivable_pt_lim in |- *; intros. +set + (fn := fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N + 1)) * x ^ (2 * N)). +cut (CVN_R fn). +intro; cut (forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)). +intro cv. +set (r := mkposreal _ Rlt_0_1). +cut (CVN_r fn r). +intro; cut (forall (n:nat) (y:R), Boule 0 r y -> continuity_pt (fn n) y). +intro; cut (Boule 0 r 0). +intro; assert (H2 := SFL_continuity_pt _ cv _ X0 H0 _ H1). +unfold continuity_pt in H2; unfold continue_in in H2; unfold limit1_in in H2; + unfold limit_in in H2; simpl in H2; unfold R_dist in H2. +elim (H2 _ H); intros alp H3. +elim H3; intros. +exists (mkposreal _ H4). +simpl in |- *; intros. +rewrite sin_0; rewrite Rplus_0_l; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r. +cut (Rabs (SFL fn cv h - SFL fn cv 0) < eps). +intro; cut (SFL fn cv 0 = 1). +intro; cut (SFL fn cv h = sin h / h). +intro; rewrite H9 in H8; rewrite H10 in H8. +apply H8. +unfold SFL, sin in |- *. +case (cv h); intros. +case (exist_sin (Rsqr h)); intros. +unfold Rdiv in |- *; rewrite (Rinv_r_simpl_m h x0 H6). +eapply UL_sequence. +apply u. +unfold sin_in in s; unfold sin_n, infinit_sum in s; + unfold SP, fn, Un_cv in |- *; intros. +elim (s _ H10); intros N0 H11. +exists N0; intros. +unfold R_dist in |- *; unfold R_dist in H11. +replace + (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * h ^ (2 * k)) n) + with + (sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i + 1)) * Rsqr h ^ i) n). +apply H11; assumption. +apply sum_eq; intros; apply Rmult_eq_compat_l; unfold Rsqr in |- *; + rewrite pow_sqr; reflexivity. +unfold SFL, sin in |- *. +case (cv 0); intros. +eapply UL_sequence. +apply u. +unfold SP, fn in |- *; unfold Un_cv in |- *; intros; exists 1%nat; intros. +unfold R_dist in |- *; + replace + (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * 0 ^ (2 * k)) n) + with 1. +unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. +rewrite decomp_sum. +simpl in |- *; rewrite Rmult_1_r; unfold Rdiv in |- *; rewrite Rinv_1; + rewrite Rmult_1_r; pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_eq_compat_l. +symmetry in |- *; apply sum_eq_R0; intros. +rewrite Rmult_0_l; rewrite Rmult_0_r; reflexivity. +unfold ge in H10; apply lt_le_trans with 1%nat; [ apply lt_n_Sn | apply H10 ]. +apply H5. +split. +unfold D_x, no_cond in |- *; split. +trivial. +apply (sym_not_eq (A:=R)); apply H6. +unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply H7. +unfold Boule in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; rewrite Rabs_R0; apply (cond_pos r). +intros; unfold fn in |- *; + replace (fun x:R => (-1) ^ n / INR (fact (2 * n + 1)) * x ^ (2 * n)) with + (fct_cte ((-1) ^ n / INR (fact (2 * n + 1))) * pow_fct (2 * n))%F; + [ idtac | reflexivity ]. +apply continuity_pt_mult. +apply derivable_continuous_pt. +apply derivable_pt_const. +apply derivable_continuous_pt. +apply (derivable_pt_pow (2 * n) y). +apply (X r). +apply (CVN_R_CVS _ X). +apply CVN_R_sin; unfold fn in |- *; reflexivity. +Qed. + +(* ((cos h)-1)/h -> 0 when h -> 0 *) +Lemma derivable_pt_lim_cos_0 : derivable_pt_lim cos 0 0. +unfold derivable_pt_lim in |- *; intros. +assert (H0 := derivable_pt_lim_sin_0). +unfold derivable_pt_lim in H0. +cut (0 < eps / 2). +intro; elim (H0 _ H1); intros del H2. +cut (continuity_pt sin 0). +intro; unfold continuity_pt in H3; unfold continue_in in H3; + unfold limit1_in in H3; unfold limit_in in H3; simpl in H3; + unfold R_dist in H3. +cut (0 < eps / 2); [ intro | assumption ]. +elim (H3 _ H4); intros del_c H5. +cut (0 < Rmin del del_c). +intro; set (delta := mkposreal _ H6). +exists delta; intros. +rewrite Rplus_0_l; replace (cos h - cos 0) with (-2 * Rsqr (sin (h / 2))). +unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r. +unfold Rdiv in |- *; do 2 rewrite Ropp_mult_distr_l_reverse. +rewrite Rabs_Ropp. +replace (2 * Rsqr (sin (h * / 2)) * / h) with + (sin (h / 2) * (sin (h / 2) / (h / 2) - 1) + sin (h / 2)). +apply Rle_lt_trans with + (Rabs (sin (h / 2) * (sin (h / 2) / (h / 2) - 1)) + Rabs (sin (h / 2))). +apply Rabs_triang. +rewrite (double_var eps); apply Rplus_lt_compat. +apply Rle_lt_trans with (Rabs (sin (h / 2) / (h / 2) - 1)). +rewrite Rabs_mult; rewrite Rmult_comm; + pattern (Rabs (sin (h / 2) / (h / 2) - 1)) at 2 in |- *; + rewrite <- Rmult_1_r; apply Rmult_le_compat_l. +apply Rabs_pos. +assert (H9 := SIN_bound (h / 2)). +unfold Rabs in |- *; case (Rcase_abs (sin (h / 2))); intro. +pattern 1 at 3 in |- *; rewrite <- (Ropp_involutive 1). +apply Ropp_le_contravar. +elim H9; intros; assumption. +elim H9; intros; assumption. +cut (Rabs (h / 2) < del). +intro; cut (h / 2 <> 0). +intro; assert (H11 := H2 _ H10 H9). +rewrite Rplus_0_l in H11; rewrite sin_0 in H11. +rewrite Rminus_0_r in H11; apply H11. +unfold Rdiv in |- *; apply prod_neq_R0. +apply H7. +apply Rinv_neq_0_compat; discrR. +apply Rlt_trans with (del / 2). +unfold Rdiv in |- *; rewrite Rabs_mult. +rewrite (Rabs_right (/ 2)). +do 2 rewrite <- (Rmult_comm (/ 2)); apply Rmult_lt_compat_l. +apply Rinv_0_lt_compat; prove_sup0. +apply Rlt_le_trans with (pos delta). +apply H8. +unfold delta in |- *; simpl in |- *; apply Rmin_l. +apply Rle_ge; left; apply Rinv_0_lt_compat; prove_sup0. +rewrite <- (Rplus_0_r (del / 2)); pattern del at 1 in |- *; + rewrite (double_var del); apply Rplus_lt_compat_l; + unfold Rdiv in |- *; apply Rmult_lt_0_compat. +apply (cond_pos del). +apply Rinv_0_lt_compat; prove_sup0. +elim H5; intros; assert (H11 := H10 (h / 2)). +rewrite sin_0 in H11; do 2 rewrite Rminus_0_r in H11. +apply H11. +split. +unfold D_x, no_cond in |- *; split. +trivial. +apply (sym_not_eq (A:=R)); unfold Rdiv in |- *; apply prod_neq_R0. +apply H7. +apply Rinv_neq_0_compat; discrR. +apply Rlt_trans with (del_c / 2). +unfold Rdiv in |- *; rewrite Rabs_mult. +rewrite (Rabs_right (/ 2)). +do 2 rewrite <- (Rmult_comm (/ 2)). +apply Rmult_lt_compat_l. +apply Rinv_0_lt_compat; prove_sup0. +apply Rlt_le_trans with (pos delta). +apply H8. +unfold delta in |- *; simpl in |- *; apply Rmin_r. +apply Rle_ge; left; apply Rinv_0_lt_compat; prove_sup0. +rewrite <- (Rplus_0_r (del_c / 2)); pattern del_c at 2 in |- *; + rewrite (double_var del_c); apply Rplus_lt_compat_l. +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +apply H9. +apply Rinv_0_lt_compat; prove_sup0. +rewrite Rmult_minus_distr_l; rewrite Rmult_1_r; unfold Rminus in |- *; + rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; + rewrite (Rmult_comm 2); unfold Rdiv, Rsqr in |- *. +repeat rewrite Rmult_assoc. +repeat apply Rmult_eq_compat_l. +rewrite Rinv_mult_distr. +rewrite Rinv_involutive. +apply Rmult_comm. +discrR. +apply H7. +apply Rinv_neq_0_compat; discrR. +pattern h at 2 in |- *; replace h with (2 * (h / 2)). +rewrite (cos_2a_sin (h / 2)). +rewrite cos_0; unfold Rsqr in |- *; ring. +unfold Rdiv in |- *; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m. +discrR. +unfold Rmin in |- *; case (Rle_dec del del_c); intro. +apply (cond_pos del). +elim H5; intros; assumption. +apply continuity_sin. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +Qed. + +(**********) +Theorem derivable_pt_lim_sin : forall x:R, derivable_pt_lim sin x (cos x). +intro; assert (H0 := derivable_pt_lim_sin_0). +assert (H := derivable_pt_lim_cos_0). +unfold derivable_pt_lim in H0, H. +unfold derivable_pt_lim in |- *; intros. +cut (0 < eps / 2); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply H1 | apply Rinv_0_lt_compat; prove_sup0 ] ]. +elim (H0 _ H2); intros alp1 H3. +elim (H _ H2); intros alp2 H4. +set (alp := Rmin alp1 alp2). +cut (0 < alp). +intro; exists (mkposreal _ H5); intros. +replace ((sin (x + h) - sin x) / h - cos x) with + (sin x * ((cos h - 1) / h) + cos x * (sin h / h - 1)). +apply Rle_lt_trans with + (Rabs (sin x * ((cos h - 1) / h)) + Rabs (cos x * (sin h / h - 1))). +apply Rabs_triang. +rewrite (double_var eps); apply Rplus_lt_compat. +apply Rle_lt_trans with (Rabs ((cos h - 1) / h)). +rewrite Rabs_mult; rewrite Rmult_comm; + pattern (Rabs ((cos h - 1) / h)) at 2 in |- *; rewrite <- Rmult_1_r; + apply Rmult_le_compat_l. +apply Rabs_pos. +assert (H8 := SIN_bound x); elim H8; intros. +unfold Rabs in |- *; case (Rcase_abs (sin x)); intro. +rewrite <- (Ropp_involutive 1). +apply Ropp_le_contravar; assumption. +assumption. +cut (Rabs h < alp2). +intro; assert (H9 := H4 _ H6 H8). +rewrite cos_0 in H9; rewrite Rplus_0_l in H9; rewrite Rminus_0_r in H9; + apply H9. +apply Rlt_le_trans with alp. +apply H7. +unfold alp in |- *; apply Rmin_r. +apply Rle_lt_trans with (Rabs (sin h / h - 1)). +rewrite Rabs_mult; rewrite Rmult_comm; + pattern (Rabs (sin h / h - 1)) at 2 in |- *; rewrite <- Rmult_1_r; + apply Rmult_le_compat_l. +apply Rabs_pos. +assert (H8 := COS_bound x); elim H8; intros. +unfold Rabs in |- *; case (Rcase_abs (cos x)); intro. +rewrite <- (Ropp_involutive 1); apply Ropp_le_contravar; assumption. +assumption. +cut (Rabs h < alp1). +intro; assert (H9 := H3 _ H6 H8). +rewrite sin_0 in H9; rewrite Rplus_0_l in H9; rewrite Rminus_0_r in H9; + apply H9. +apply Rlt_le_trans with alp. +apply H7. +unfold alp in |- *; apply Rmin_l. +rewrite sin_plus; unfold Rminus, Rdiv in |- *; + repeat rewrite Rmult_plus_distr_r; repeat rewrite Rmult_plus_distr_l; + repeat rewrite Rmult_assoc; repeat rewrite Rplus_assoc; + apply Rplus_eq_compat_l. +rewrite (Rplus_comm (sin x * (-1 * / h))); repeat rewrite Rplus_assoc; + apply Rplus_eq_compat_l. +rewrite Ropp_mult_distr_r_reverse; rewrite Ropp_mult_distr_l_reverse; + rewrite Rmult_1_r; rewrite Rmult_1_l; rewrite Ropp_mult_distr_r_reverse; + rewrite <- Ropp_mult_distr_l_reverse; apply Rplus_comm. +unfold alp in |- *; unfold Rmin in |- *; case (Rle_dec alp1 alp2); intro. +apply (cond_pos alp1). +apply (cond_pos alp2). +Qed. + +Lemma derivable_pt_lim_cos : forall x:R, derivable_pt_lim cos x (- sin x). +intro; cut (forall h:R, sin (h + PI / 2) = cos h). +intro; replace (- sin x) with (cos (x + PI / 2) * (1 + 0)). +generalize (derivable_pt_lim_comp (id + fct_cte (PI / 2))%F sin); intros. +cut (derivable_pt_lim (id + fct_cte (PI / 2)) x (1 + 0)). +cut (derivable_pt_lim sin ((id + fct_cte (PI / 2))%F x) (cos (x + PI / 2))). +intros; generalize (H0 _ _ _ H2 H1); + replace (comp sin (id + fct_cte (PI / 2))%F) with + (fun x:R => sin (x + PI / 2)); [ idtac | reflexivity ]. +unfold derivable_pt_lim in |- *; intros. +elim (H3 eps H4); intros. +exists x0. +intros; rewrite <- (H (x + h)); rewrite <- (H x); apply H5; assumption. +apply derivable_pt_lim_sin. +apply derivable_pt_lim_plus. +apply derivable_pt_lim_id. +apply derivable_pt_lim_const. +rewrite sin_cos; rewrite <- (Rplus_comm x); ring. +intro; rewrite cos_sin; rewrite Rplus_comm; reflexivity. +Qed. + +Lemma derivable_pt_sin : forall x:R, derivable_pt sin x. +unfold derivable_pt in |- *; intro. +apply existT with (cos x). +apply derivable_pt_lim_sin. +Qed. + +Lemma derivable_pt_cos : forall x:R, derivable_pt cos x. +unfold derivable_pt in |- *; intro. +apply existT with (- sin x). +apply derivable_pt_lim_cos. +Qed. + +Lemma derivable_sin : derivable sin. +unfold derivable in |- *; intro; apply derivable_pt_sin. +Qed. + +Lemma derivable_cos : derivable cos. +unfold derivable in |- *; intro; apply derivable_pt_cos. +Qed. + +Lemma derive_pt_sin : + forall x:R, derive_pt sin x (derivable_pt_sin _) = cos x. +intros; apply derive_pt_eq_0. +apply derivable_pt_lim_sin. +Qed. + +Lemma derive_pt_cos : + forall x:R, derive_pt cos x (derivable_pt_cos _) = - sin x. +intros; apply derive_pt_eq_0. +apply derivable_pt_lim_cos. +Qed.
\ No newline at end of file diff --git a/theories/Reals/SeqProp.v b/theories/Reals/SeqProp.v new file mode 100644 index 00000000..34f9fd72 --- /dev/null +++ b/theories/Reals/SeqProp.v @@ -0,0 +1,1295 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: SeqProp.v,v 1.13.2.1 2004/07/16 19:31:15 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rfunctions. +Require Import Rseries. +Require Import Classical. +Require Import Max. +Open Local Scope R_scope. + +Definition Un_decreasing (Un:nat -> R) : Prop := + forall n:nat, Un (S n) <= Un n. +Definition opp_seq (Un:nat -> R) (n:nat) : R := - Un n. +Definition has_ub (Un:nat -> R) : Prop := bound (EUn Un). +Definition has_lb (Un:nat -> R) : Prop := bound (EUn (opp_seq Un)). + +(**********) +Lemma growing_cv : + forall Un:nat -> R, + Un_growing Un -> has_ub Un -> sigT (fun l:R => Un_cv Un l). +unfold Un_growing, Un_cv in |- *; intros; + destruct (completeness (EUn Un) H0 (EUn_noempty Un)) as [x [H2 H3]]. + exists x; intros eps H1. + unfold is_upper_bound in H2, H3. +assert (H5 : forall n:nat, Un n <= x). + intro n; apply (H2 (Un n) (Un_in_EUn Un n)). +cut (exists N : nat, x - eps < Un N). +intro H6; destruct H6 as [N H6]; exists N. +intros n H7; unfold R_dist in |- *; apply (Rabs_def1 (Un n - x) eps). +unfold Rgt in H1. + apply (Rle_lt_trans (Un n - x) 0 eps (Rle_minus (Un n) x (H5 n)) H1). +fold Un_growing in H; generalize (growing_prop Un n N H H7); intro H8. + generalize + (Rlt_le_trans (x - eps) (Un N) (Un n) H6 (Rge_le (Un n) (Un N) H8)); + intro H9; generalize (Rplus_lt_compat_l (- x) (x - eps) (Un n) H9); + unfold Rminus in |- *; rewrite <- (Rplus_assoc (- x) x (- eps)); + rewrite (Rplus_comm (- x) (Un n)); fold (Un n - x) in |- *; + rewrite Rplus_opp_l; rewrite (let (H1, H2) := Rplus_ne (- eps) in H2); + trivial. +cut (~ (forall N:nat, Un N <= x - eps)). +intro H6; apply (not_all_not_ex nat (fun N:nat => x - eps < Un N)). + intro H7; apply H6; intro N; apply Rnot_lt_le; apply H7. +intro H7; generalize (Un_bound_imp Un (x - eps) H7); intro H8; + unfold is_upper_bound in H8; generalize (H3 (x - eps) H8); + apply Rlt_not_le; apply tech_Rgt_minus; exact H1. +Qed. + +Lemma decreasing_growing : + forall Un:nat -> R, Un_decreasing Un -> Un_growing (opp_seq Un). +intro. +unfold Un_growing, opp_seq, Un_decreasing in |- *. +intros. +apply Ropp_le_contravar. +apply H. +Qed. + +Lemma decreasing_cv : + forall Un:nat -> R, + Un_decreasing Un -> has_lb Un -> sigT (fun l:R => Un_cv Un l). +intros. +cut (sigT (fun l:R => Un_cv (opp_seq Un) l) -> sigT (fun l:R => Un_cv Un l)). +intro. +apply X. +apply growing_cv. +apply decreasing_growing; assumption. +exact H0. +intro. +elim X; intros. +apply existT with (- x). +unfold Un_cv in p. +unfold R_dist in p. +unfold opp_seq in p. +unfold Un_cv in |- *. +unfold R_dist in |- *. +intros. +elim (p eps H1); intros. +exists x0; intros. +assert (H4 := H2 n H3). +rewrite <- Rabs_Ropp. +replace (- (Un n - - x)) with (- Un n - x); [ assumption | ring ]. +Qed. + +(***********) +Lemma maj_sup : + forall Un:nat -> R, has_ub Un -> sigT (fun l:R => is_lub (EUn Un) l). +intros. +unfold has_ub in H. +apply completeness. +assumption. +exists (Un 0%nat). +unfold EUn in |- *. +exists 0%nat; reflexivity. +Qed. + +(**********) +Lemma min_inf : + forall Un:nat -> R, + has_lb Un -> sigT (fun l:R => is_lub (EUn (opp_seq Un)) l). +intros; unfold has_lb in H. +apply completeness. +assumption. +exists (- Un 0%nat). +exists 0%nat. +reflexivity. +Qed. + +Definition majorant (Un:nat -> R) (pr:has_ub Un) : R := + match maj_sup Un pr with + | existT a b => a + end. + +Definition minorant (Un:nat -> R) (pr:has_lb Un) : R := + match min_inf Un pr with + | existT a b => - a + end. + +Lemma maj_ss : + forall (Un:nat -> R) (k:nat), + has_ub Un -> has_ub (fun i:nat => Un (k + i)%nat). +intros. +unfold has_ub in H. +unfold bound in H. +elim H; intros. +unfold is_upper_bound in H0. +unfold has_ub in |- *. +exists x. +unfold is_upper_bound in |- *. +intros. +apply H0. +elim H1; intros. +exists (k + x1)%nat; assumption. +Qed. + +Lemma min_ss : + forall (Un:nat -> R) (k:nat), + has_lb Un -> has_lb (fun i:nat => Un (k + i)%nat). +intros. +unfold has_lb in H. +unfold bound in H. +elim H; intros. +unfold is_upper_bound in H0. +unfold has_lb in |- *. +exists x. +unfold is_upper_bound in |- *. +intros. +apply H0. +elim H1; intros. +exists (k + x1)%nat; assumption. +Qed. + +Definition sequence_majorant (Un:nat -> R) (pr:has_ub Un) + (i:nat) : R := majorant (fun k:nat => Un (i + k)%nat) (maj_ss Un i pr). + +Definition sequence_minorant (Un:nat -> R) (pr:has_lb Un) + (i:nat) : R := minorant (fun k:nat => Un (i + k)%nat) (min_ss Un i pr). + +Lemma Wn_decreasing : + forall (Un:nat -> R) (pr:has_ub Un), Un_decreasing (sequence_majorant Un pr). +intros. +unfold Un_decreasing in |- *. +intro. +unfold sequence_majorant in |- *. +assert (H := maj_sup (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)). +assert (H0 := maj_sup (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)). +elim H; intros. +elim H0; intros. +cut (majorant (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr) = x); + [ intro Maj1; rewrite Maj1 | idtac ]. +cut (majorant (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr) = x0); + [ intro Maj2; rewrite Maj2 | idtac ]. +unfold is_lub in p. +unfold is_lub in p0. +elim p; intros. +apply H2. +elim p0; intros. +unfold is_upper_bound in |- *. +intros. +unfold is_upper_bound in H3. +apply H3. +elim H5; intros. +exists (1 + x2)%nat. +replace (n + (1 + x2))%nat with (S n + x2)%nat. +assumption. +replace (S n) with (1 + n)%nat; [ ring | ring ]. +cut + (is_lub (EUn (fun k:nat => Un (n + k)%nat)) + (majorant (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr))). +intro. +unfold is_lub in p0; unfold is_lub in H1. +elim p0; intros; elim H1; intros. +assert (H6 := H5 x0 H2). +assert + (H7 := H3 (majorant (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)) H4). +apply Rle_antisym; assumption. +unfold majorant in |- *. +case (maj_sup (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)). +trivial. +cut + (is_lub (EUn (fun k:nat => Un (S n + k)%nat)) + (majorant (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr))). +intro. +unfold is_lub in p; unfold is_lub in H1. +elim p; intros; elim H1; intros. +assert (H6 := H5 x H2). +assert + (H7 := + H3 (majorant (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)) H4). +apply Rle_antisym; assumption. +unfold majorant in |- *. +case (maj_sup (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)). +trivial. +Qed. + +Lemma Vn_growing : + forall (Un:nat -> R) (pr:has_lb Un), Un_growing (sequence_minorant Un pr). +intros. +unfold Un_growing in |- *. +intro. +unfold sequence_minorant in |- *. +assert (H := min_inf (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)). +assert (H0 := min_inf (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)). +elim H; intros. +elim H0; intros. +cut (minorant (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr) = - x); + [ intro Maj1; rewrite Maj1 | idtac ]. +cut (minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr) = - x0); + [ intro Maj2; rewrite Maj2 | idtac ]. +unfold is_lub in p. +unfold is_lub in p0. +elim p; intros. +apply Ropp_le_contravar. +apply H2. +elim p0; intros. +unfold is_upper_bound in |- *. +intros. +unfold is_upper_bound in H3. +apply H3. +elim H5; intros. +exists (1 + x2)%nat. +unfold opp_seq in H6. +unfold opp_seq in |- *. +replace (n + (1 + x2))%nat with (S n + x2)%nat. +assumption. +replace (S n) with (1 + n)%nat; [ ring | ring ]. +cut + (is_lub (EUn (opp_seq (fun k:nat => Un (n + k)%nat))) + (- minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr))). +intro. +unfold is_lub in p0; unfold is_lub in H1. +elim p0; intros; elim H1; intros. +assert (H6 := H5 x0 H2). +assert + (H7 := H3 (- minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)) H4). +rewrite <- + (Ropp_involutive (minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr))) + . +apply Ropp_eq_compat; apply Rle_antisym; assumption. +unfold minorant in |- *. +case (min_inf (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)). +intro; rewrite Ropp_involutive. +trivial. +cut + (is_lub (EUn (opp_seq (fun k:nat => Un (S n + k)%nat))) + (- minorant (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr))). +intro. +unfold is_lub in p; unfold is_lub in H1. +elim p; intros; elim H1; intros. +assert (H6 := H5 x H2). +assert + (H7 := + H3 (- minorant (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)) H4). +rewrite <- + (Ropp_involutive + (minorant (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr))) + . +apply Ropp_eq_compat; apply Rle_antisym; assumption. +unfold minorant in |- *. +case (min_inf (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)). +intro; rewrite Ropp_involutive. +trivial. +Qed. + +(**********) +Lemma Vn_Un_Wn_order : + forall (Un:nat -> R) (pr1:has_ub Un) (pr2:has_lb Un) + (n:nat), sequence_minorant Un pr2 n <= Un n <= sequence_majorant Un pr1 n. +intros. +split. +unfold sequence_minorant in |- *. +cut + (sigT (fun l:R => is_lub (EUn (opp_seq (fun i:nat => Un (n + i)%nat))) l)). +intro. +elim X; intros. +replace (minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)) with (- x). +unfold is_lub in p. +elim p; intros. +unfold is_upper_bound in H. +rewrite <- (Ropp_involutive (Un n)). +apply Ropp_le_contravar. +apply H. +exists 0%nat. +unfold opp_seq in |- *. +replace (n + 0)%nat with n; [ reflexivity | ring ]. +cut + (is_lub (EUn (opp_seq (fun k:nat => Un (n + k)%nat))) + (- minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2))). +intro. +unfold is_lub in p; unfold is_lub in H. +elim p; intros; elim H; intros. +assert (H4 := H3 x H0). +assert + (H5 := H1 (- minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)) H2). +rewrite <- + (Ropp_involutive (minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2))) + . +apply Ropp_eq_compat; apply Rle_antisym; assumption. +unfold minorant in |- *. +case (min_inf (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)). +intro; rewrite Ropp_involutive. +trivial. +apply min_inf. +apply min_ss; assumption. +unfold sequence_majorant in |- *. +cut (sigT (fun l:R => is_lub (EUn (fun i:nat => Un (n + i)%nat)) l)). +intro. +elim X; intros. +replace (majorant (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1)) with x. +unfold is_lub in p. +elim p; intros. +unfold is_upper_bound in H. +apply H. +exists 0%nat. +replace (n + 0)%nat with n; [ reflexivity | ring ]. +cut + (is_lub (EUn (fun k:nat => Un (n + k)%nat)) + (majorant (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1))). +intro. +unfold is_lub in p; unfold is_lub in H. +elim p; intros; elim H; intros. +assert (H4 := H3 x H0). +assert + (H5 := H1 (majorant (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1)) H2). +apply Rle_antisym; assumption. +unfold majorant in |- *. +case (maj_sup (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1)). +intro; trivial. +apply maj_sup. +apply maj_ss; assumption. +Qed. + +Lemma min_maj : + forall (Un:nat -> R) (pr1:has_ub Un) (pr2:has_lb Un), + has_ub (sequence_minorant Un pr2). +intros. +assert (H := Vn_Un_Wn_order Un pr1 pr2). +unfold has_ub in |- *. +unfold bound in |- *. +unfold has_ub in pr1. +unfold bound in pr1. +elim pr1; intros. +exists x. +unfold is_upper_bound in |- *. +intros. +unfold is_upper_bound in H0. +elim H1; intros. +rewrite H2. +apply Rle_trans with (Un x1). +assert (H3 := H x1); elim H3; intros; assumption. +apply H0. +exists x1; reflexivity. +Qed. + +Lemma maj_min : + forall (Un:nat -> R) (pr1:has_ub Un) (pr2:has_lb Un), + has_lb (sequence_majorant Un pr1). +intros. +assert (H := Vn_Un_Wn_order Un pr1 pr2). +unfold has_lb in |- *. +unfold bound in |- *. +unfold has_lb in pr2. +unfold bound in pr2. +elim pr2; intros. +exists x. +unfold is_upper_bound in |- *. +intros. +unfold is_upper_bound in H0. +elim H1; intros. +rewrite H2. +apply Rle_trans with (opp_seq Un x1). +assert (H3 := H x1); elim H3; intros. +unfold opp_seq in |- *; apply Ropp_le_contravar. +assumption. +apply H0. +exists x1; reflexivity. +Qed. + +(**********) +Lemma cauchy_maj : forall Un:nat -> R, Cauchy_crit Un -> has_ub Un. +intros. +unfold has_ub in |- *. +apply cauchy_bound. +assumption. +Qed. + +(**********) +Lemma cauchy_opp : + forall Un:nat -> R, Cauchy_crit Un -> Cauchy_crit (opp_seq Un). +intro. +unfold Cauchy_crit in |- *. +unfold R_dist in |- *. +intros. +elim (H eps H0); intros. +exists x; intros. +unfold opp_seq in |- *. +rewrite <- Rabs_Ropp. +replace (- (- Un n - - Un m)) with (Un n - Un m); + [ apply H1; assumption | ring ]. +Qed. + +(**********) +Lemma cauchy_min : forall Un:nat -> R, Cauchy_crit Un -> has_lb Un. +intros. +unfold has_lb in |- *. +assert (H0 := cauchy_opp _ H). +apply cauchy_bound. +assumption. +Qed. + +(**********) +Lemma maj_cv : + forall (Un:nat -> R) (pr:Cauchy_crit Un), + sigT (fun l:R => Un_cv (sequence_majorant Un (cauchy_maj Un pr)) l). +intros. +apply decreasing_cv. +apply Wn_decreasing. +apply maj_min. +apply cauchy_min. +assumption. +Qed. + +(**********) +Lemma min_cv : + forall (Un:nat -> R) (pr:Cauchy_crit Un), + sigT (fun l:R => Un_cv (sequence_minorant Un (cauchy_min Un pr)) l). +intros. +apply growing_cv. +apply Vn_growing. +apply min_maj. +apply cauchy_maj. +assumption. +Qed. + +Lemma cond_eq : + forall x y:R, (forall eps:R, 0 < eps -> Rabs (x - y) < eps) -> x = y. +intros. +case (total_order_T x y); intro. +elim s; intro. +cut (0 < y - x). +intro. +assert (H1 := H (y - x) H0). +rewrite <- Rabs_Ropp in H1. +cut (- (x - y) = y - x); [ intro; rewrite H2 in H1 | ring ]. +rewrite Rabs_right in H1. +elim (Rlt_irrefl _ H1). +left; assumption. +apply Rplus_lt_reg_r with x. +rewrite Rplus_0_r; replace (x + (y - x)) with y; [ assumption | ring ]. +assumption. +cut (0 < x - y). +intro. +assert (H1 := H (x - y) H0). +rewrite Rabs_right in H1. +elim (Rlt_irrefl _ H1). +left; assumption. +apply Rplus_lt_reg_r with y. +rewrite Rplus_0_r; replace (y + (x - y)) with x; [ assumption | ring ]. +Qed. + +Lemma not_Rlt : forall r1 r2:R, ~ r1 < r2 -> r1 >= r2. +intros r1 r2; generalize (Rtotal_order r1 r2); unfold Rge in |- *. +tauto. +Qed. + +(**********) +Lemma approx_maj : + forall (Un:nat -> R) (pr:has_ub Un) (eps:R), + 0 < eps -> exists k : nat, Rabs (majorant Un pr - Un k) < eps. +intros. +set (P := fun k:nat => Rabs (majorant Un pr - Un k) < eps). +unfold P in |- *. +cut + ((exists k : nat, P k) -> + exists k : nat, Rabs (majorant Un pr - Un k) < eps). +intros. +apply H0. +apply not_all_not_ex. +red in |- *; intro. +2: unfold P in |- *; trivial. +unfold P in H1. +cut (forall n:nat, Rabs (majorant Un pr - Un n) >= eps). +intro. +cut (is_lub (EUn Un) (majorant Un pr)). +intro. +unfold is_lub in H3. +unfold is_upper_bound in H3. +elim H3; intros. +cut (forall n:nat, eps <= majorant Un pr - Un n). +intro. +cut (forall n:nat, Un n <= majorant Un pr - eps). +intro. +cut (forall x:R, EUn Un x -> x <= majorant Un pr - eps). +intro. +assert (H9 := H5 (majorant Un pr - eps) H8). +cut (eps <= 0). +intro. +elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H H10)). +apply Rplus_le_reg_l with (majorant Un pr - eps). +rewrite Rplus_0_r. +replace (majorant Un pr - eps + eps) with (majorant Un pr); + [ assumption | ring ]. +intros. +unfold EUn in H8. +elim H8; intros. +rewrite H9; apply H7. +intro. +assert (H7 := H6 n). +apply Rplus_le_reg_l with (eps - Un n). +replace (eps - Un n + Un n) with eps. +replace (eps - Un n + (majorant Un pr - eps)) with (majorant Un pr - Un n). +assumption. +ring. +ring. +intro. +assert (H6 := H2 n). +rewrite Rabs_right in H6. +apply Rge_le. +assumption. +apply Rle_ge. +apply Rplus_le_reg_l with (Un n). +rewrite Rplus_0_r; + replace (Un n + (majorant Un pr - Un n)) with (majorant Un pr); + [ apply H4 | ring ]. +exists n; reflexivity. +unfold majorant in |- *. +case (maj_sup Un pr). +trivial. +intro. +assert (H2 := H1 n). +apply not_Rlt; assumption. +Qed. + +(**********) +Lemma approx_min : + forall (Un:nat -> R) (pr:has_lb Un) (eps:R), + 0 < eps -> exists k : nat, Rabs (minorant Un pr - Un k) < eps. +intros. +set (P := fun k:nat => Rabs (minorant Un pr - Un k) < eps). +unfold P in |- *. +cut + ((exists k : nat, P k) -> + exists k : nat, Rabs (minorant Un pr - Un k) < eps). +intros. +apply H0. +apply not_all_not_ex. +red in |- *; intro. +2: unfold P in |- *; trivial. +unfold P in H1. +cut (forall n:nat, Rabs (minorant Un pr - Un n) >= eps). +intro. +cut (is_lub (EUn (opp_seq Un)) (- minorant Un pr)). +intro. +unfold is_lub in H3. +unfold is_upper_bound in H3. +elim H3; intros. +cut (forall n:nat, eps <= Un n - minorant Un pr). +intro. +cut (forall n:nat, opp_seq Un n <= - minorant Un pr - eps). +intro. +cut (forall x:R, EUn (opp_seq Un) x -> x <= - minorant Un pr - eps). +intro. +assert (H9 := H5 (- minorant Un pr - eps) H8). +cut (eps <= 0). +intro. +elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H H10)). +apply Rplus_le_reg_l with (- minorant Un pr - eps). +rewrite Rplus_0_r. +replace (- minorant Un pr - eps + eps) with (- minorant Un pr); + [ assumption | ring ]. +intros. +unfold EUn in H8. +elim H8; intros. +rewrite H9; apply H7. +intro. +assert (H7 := H6 n). +unfold opp_seq in |- *. +apply Rplus_le_reg_l with (eps + Un n). +replace (eps + Un n + - Un n) with eps. +replace (eps + Un n + (- minorant Un pr - eps)) with (Un n - minorant Un pr). +assumption. +ring. +ring. +intro. +assert (H6 := H2 n). +rewrite Rabs_left1 in H6. +apply Rge_le. +replace (Un n - minorant Un pr) with (- (minorant Un pr - Un n)); + [ assumption | ring ]. +apply Rplus_le_reg_l with (- minorant Un pr). +rewrite Rplus_0_r; + replace (- minorant Un pr + (minorant Un pr - Un n)) with (- Un n). +apply H4. +exists n; reflexivity. +ring. +unfold minorant in |- *. +case (min_inf Un pr). +intro. +rewrite Ropp_involutive. +trivial. +intro. +assert (H2 := H1 n). +apply not_Rlt; assumption. +Qed. + +(* Unicity of limit for convergent sequences *) +Lemma UL_sequence : + forall (Un:nat -> R) (l1 l2:R), Un_cv Un l1 -> Un_cv Un l2 -> l1 = l2. +intros Un l1 l2; unfold Un_cv in |- *; unfold R_dist in |- *; intros. +apply cond_eq. +intros; cut (0 < eps / 2); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. +elim (H (eps / 2) H2); intros. +elim (H0 (eps / 2) H2); intros. +set (N := max x x0). +apply Rle_lt_trans with (Rabs (l1 - Un N) + Rabs (Un N - l2)). +replace (l1 - l2) with (l1 - Un N + (Un N - l2)); + [ apply Rabs_triang | ring ]. +rewrite (double_var eps); apply Rplus_lt_compat. +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H3; + unfold ge, N in |- *; apply le_max_l. +apply H4; unfold ge, N in |- *; apply le_max_r. +Qed. + +(**********) +Lemma CV_plus : + forall (An Bn:nat -> R) (l1 l2:R), + Un_cv An l1 -> Un_cv Bn l2 -> Un_cv (fun i:nat => An i + Bn i) (l1 + l2). +unfold Un_cv in |- *; unfold R_dist in |- *; intros. +cut (0 < eps / 2); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. +elim (H (eps / 2) H2); intros. +elim (H0 (eps / 2) H2); intros. +set (N := max x x0). +exists N; intros. +replace (An n + Bn n - (l1 + l2)) with (An n - l1 + (Bn n - l2)); + [ idtac | ring ]. +apply Rle_lt_trans with (Rabs (An n - l1) + Rabs (Bn n - l2)). +apply Rabs_triang. +rewrite (double_var eps); apply Rplus_lt_compat. +apply H3; unfold ge in |- *; apply le_trans with N; + [ unfold N in |- *; apply le_max_l | assumption ]. +apply H4; unfold ge in |- *; apply le_trans with N; + [ unfold N in |- *; apply le_max_r | assumption ]. +Qed. + +(**********) +Lemma cv_cvabs : + forall (Un:nat -> R) (l:R), + Un_cv Un l -> Un_cv (fun i:nat => Rabs (Un i)) (Rabs l). +unfold Un_cv in |- *; unfold R_dist in |- *; intros. +elim (H eps H0); intros. +exists x; intros. +apply Rle_lt_trans with (Rabs (Un n - l)). +apply Rabs_triang_inv2. +apply H1; assumption. +Qed. + +(**********) +Lemma CV_Cauchy : + forall Un:nat -> R, sigT (fun l:R => Un_cv Un l) -> Cauchy_crit Un. +intros; elim X; intros. +unfold Cauchy_crit in |- *; intros. +unfold Un_cv in p; unfold R_dist in p. +cut (0 < eps / 2); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. +elim (p (eps / 2) H0); intros. +exists x0; intros. +unfold R_dist in |- *; + apply Rle_lt_trans with (Rabs (Un n - x) + Rabs (x - Un m)). +replace (Un n - Un m) with (Un n - x + (x - Un m)); + [ apply Rabs_triang | ring ]. +rewrite (double_var eps); apply Rplus_lt_compat. +apply H1; assumption. +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H1; assumption. +Qed. + +(**********) +Lemma maj_by_pos : + forall Un:nat -> R, + sigT (fun l:R => Un_cv Un l) -> + exists l : R, 0 < l /\ (forall n:nat, Rabs (Un n) <= l). +intros; elim X; intros. +cut (sigT (fun l:R => Un_cv (fun k:nat => Rabs (Un k)) l)). +intro. +assert (H := CV_Cauchy (fun k:nat => Rabs (Un k)) X0). +assert (H0 := cauchy_bound (fun k:nat => Rabs (Un k)) H). +elim H0; intros. +exists (x0 + 1). +cut (0 <= x0). +intro. +split. +apply Rplus_le_lt_0_compat; [ assumption | apply Rlt_0_1 ]. +intros. +apply Rle_trans with x0. +unfold is_upper_bound in H1. +apply H1. +exists n; reflexivity. +pattern x0 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; + apply Rlt_0_1. +apply Rle_trans with (Rabs (Un 0%nat)). +apply Rabs_pos. +unfold is_upper_bound in H1. +apply H1. +exists 0%nat; reflexivity. +apply existT with (Rabs x). +apply cv_cvabs; assumption. +Qed. + +(**********) +Lemma CV_mult : + forall (An Bn:nat -> R) (l1 l2:R), + Un_cv An l1 -> Un_cv Bn l2 -> Un_cv (fun i:nat => An i * Bn i) (l1 * l2). +intros. +cut (sigT (fun l:R => Un_cv An l)). +intro. +assert (H1 := maj_by_pos An X). +elim H1; intros M H2. +elim H2; intros. +unfold Un_cv in |- *; unfold R_dist in |- *; intros. +cut (0 < eps / (2 * M)). +intro. +case (Req_dec l2 0); intro. +unfold Un_cv in H0; unfold R_dist in H0. +elim (H0 (eps / (2 * M)) H6); intros. +exists x; intros. +apply Rle_lt_trans with + (Rabs (An n * Bn n - An n * l2) + Rabs (An n * l2 - l1 * l2)). +replace (An n * Bn n - l1 * l2) with + (An n * Bn n - An n * l2 + (An n * l2 - l1 * l2)); + [ apply Rabs_triang | ring ]. +replace (Rabs (An n * Bn n - An n * l2)) with + (Rabs (An n) * Rabs (Bn n - l2)). +replace (Rabs (An n * l2 - l1 * l2)) with 0. +rewrite Rplus_0_r. +apply Rle_lt_trans with (M * Rabs (Bn n - l2)). +do 2 rewrite <- (Rmult_comm (Rabs (Bn n - l2))). +apply Rmult_le_compat_l. +apply Rabs_pos. +apply H4. +apply Rmult_lt_reg_l with (/ M). +apply Rinv_0_lt_compat; apply H3. +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; rewrite (Rmult_comm (/ M)). +apply Rlt_trans with (eps / (2 * M)). +apply H8; assumption. +unfold Rdiv in |- *; rewrite Rinv_mult_distr. +apply Rmult_lt_reg_l with 2. +prove_sup0. +replace (2 * (eps * (/ 2 * / M))) with (2 * / 2 * (eps * / M)); + [ idtac | ring ]. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_l; rewrite double. +pattern (eps * / M) at 1 in |- *; rewrite <- Rplus_0_r. +apply Rplus_lt_compat_l; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; assumption ]. +discrR. +discrR. +red in |- *; intro; rewrite H10 in H3; elim (Rlt_irrefl _ H3). +red in |- *; intro; rewrite H10 in H3; elim (Rlt_irrefl _ H3). +rewrite H7; do 2 rewrite Rmult_0_r; unfold Rminus in |- *; + rewrite Rplus_opp_r; rewrite Rabs_R0; reflexivity. +replace (An n * Bn n - An n * l2) with (An n * (Bn n - l2)); [ idtac | ring ]. +symmetry in |- *; apply Rabs_mult. +cut (0 < eps / (2 * Rabs l2)). +intro. +unfold Un_cv in H; unfold R_dist in H; unfold Un_cv in H0; + unfold R_dist in H0. +elim (H (eps / (2 * Rabs l2)) H8); intros N1 H9. +elim (H0 (eps / (2 * M)) H6); intros N2 H10. +set (N := max N1 N2). +exists N; intros. +apply Rle_lt_trans with + (Rabs (An n * Bn n - An n * l2) + Rabs (An n * l2 - l1 * l2)). +replace (An n * Bn n - l1 * l2) with + (An n * Bn n - An n * l2 + (An n * l2 - l1 * l2)); + [ apply Rabs_triang | ring ]. +replace (Rabs (An n * Bn n - An n * l2)) with + (Rabs (An n) * Rabs (Bn n - l2)). +replace (Rabs (An n * l2 - l1 * l2)) with (Rabs l2 * Rabs (An n - l1)). +rewrite (double_var eps); apply Rplus_lt_compat. +apply Rle_lt_trans with (M * Rabs (Bn n - l2)). +do 2 rewrite <- (Rmult_comm (Rabs (Bn n - l2))). +apply Rmult_le_compat_l. +apply Rabs_pos. +apply H4. +apply Rmult_lt_reg_l with (/ M). +apply Rinv_0_lt_compat; apply H3. +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; rewrite (Rmult_comm (/ M)). +apply Rlt_le_trans with (eps / (2 * M)). +apply H10. +unfold ge in |- *; apply le_trans with N. +unfold N in |- *; apply le_max_r. +assumption. +unfold Rdiv in |- *; rewrite Rinv_mult_distr. +right; ring. +discrR. +red in |- *; intro; rewrite H12 in H3; elim (Rlt_irrefl _ H3). +red in |- *; intro; rewrite H12 in H3; elim (Rlt_irrefl _ H3). +apply Rmult_lt_reg_l with (/ Rabs l2). +apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; apply Rlt_le_trans with (eps / (2 * Rabs l2)). +apply H9. +unfold ge in |- *; apply le_trans with N. +unfold N in |- *; apply le_max_l. +assumption. +unfold Rdiv in |- *; right; rewrite Rinv_mult_distr. +ring. +discrR. +apply Rabs_no_R0; assumption. +apply Rabs_no_R0; assumption. +replace (An n * l2 - l1 * l2) with (l2 * (An n - l1)); + [ symmetry in |- *; apply Rabs_mult | ring ]. +replace (An n * Bn n - An n * l2) with (An n * (Bn n - l2)); + [ symmetry in |- *; apply Rabs_mult | ring ]. +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +assumption. +apply Rinv_0_lt_compat; apply Rmult_lt_0_compat; + [ prove_sup0 | apply Rabs_pos_lt; assumption ]. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption + | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat; + [ prove_sup0 | assumption ] ]. +apply existT with l1; assumption. +Qed. + +Lemma tech9 : + forall Un:nat -> R, + Un_growing Un -> forall m n:nat, (m <= n)%nat -> Un m <= Un n. +intros; unfold Un_growing in H. +induction n as [| n Hrecn]. +induction m as [| m Hrecm]. +right; reflexivity. +elim (le_Sn_O _ H0). +cut ((m <= n)%nat \/ m = S n). +intro; elim H1; intro. +apply Rle_trans with (Un n). +apply Hrecn; assumption. +apply H. +rewrite H2; right; reflexivity. +inversion H0. +right; reflexivity. +left; assumption. +Qed. + +Lemma tech10 : + forall (Un:nat -> R) (x:R), Un_growing Un -> is_lub (EUn Un) x -> Un_cv Un x. +intros; cut (bound (EUn Un)). +intro; assert (H2 := Un_cv_crit _ H H1). +elim H2; intros. +case (total_order_T x x0); intro. +elim s; intro. +cut (forall n:nat, Un n <= x). +intro; unfold Un_cv in H3; cut (0 < x0 - x). +intro; elim (H3 (x0 - x) H5); intros. +cut (x1 >= x1)%nat. +intro; assert (H8 := H6 x1 H7). +unfold R_dist in H8; rewrite Rabs_left1 in H8. +rewrite Ropp_minus_distr in H8; unfold Rminus in H8. +assert (H9 := Rplus_lt_reg_r x0 _ _ H8). +assert (H10 := Ropp_lt_cancel _ _ H9). +assert (H11 := H4 x1). +elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H10 H11)). +apply Rle_minus; apply Rle_trans with x. +apply H4. +left; assumption. +unfold ge in |- *; apply le_n. +apply Rgt_minus; assumption. +intro; unfold is_lub in H0; unfold is_upper_bound in H0; elim H0; intros. +apply H4; unfold EUn in |- *; exists n; reflexivity. +rewrite b; assumption. +cut (forall n:nat, Un n <= x0). +intro; unfold is_lub in H0; unfold is_upper_bound in H0; elim H0; intros. +cut (forall y:R, EUn Un y -> y <= x0). +intro; assert (H8 := H6 _ H7). +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H8 r)). +unfold EUn in |- *; intros; elim H7; intros. +rewrite H8; apply H4. +intro; case (Rle_dec (Un n) x0); intro. +assumption. +cut (forall n0:nat, (n <= n0)%nat -> x0 < Un n0). +intro; unfold Un_cv in H3; cut (0 < Un n - x0). +intro; elim (H3 (Un n - x0) H5); intros. +cut (max n x1 >= x1)%nat. +intro; assert (H8 := H6 (max n x1) H7). +unfold R_dist in H8. +rewrite Rabs_right in H8. +unfold Rminus in H8; do 2 rewrite <- (Rplus_comm (- x0)) in H8. +assert (H9 := Rplus_lt_reg_r _ _ _ H8). +cut (Un n <= Un (max n x1)). +intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H10 H9)). +apply tech9; [ assumption | apply le_max_l ]. +apply Rge_trans with (Un n - x0). +unfold Rminus in |- *; apply Rle_ge; do 2 rewrite <- (Rplus_comm (- x0)); + apply Rplus_le_compat_l. +apply tech9; [ assumption | apply le_max_l ]. +left; assumption. +unfold ge in |- *; apply le_max_r. +apply Rplus_lt_reg_r with x0. +rewrite Rplus_0_r; unfold Rminus in |- *; rewrite (Rplus_comm x0); + rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; + apply H4; apply le_n. +intros; apply Rlt_le_trans with (Un n). +case (Rlt_le_dec x0 (Un n)); intro. +assumption. +elim n0; assumption. +apply tech9; assumption. +unfold bound in |- *; exists x; unfold is_lub in H0; elim H0; intros; + assumption. +Qed. + +Lemma tech13 : + forall (An:nat -> R) (k:R), + 0 <= k < 1 -> + Un_cv (fun n:nat => Rabs (An (S n) / An n)) k -> + exists k0 : R, + k < k0 < 1 /\ + (exists N : nat, + (forall n:nat, (N <= n)%nat -> Rabs (An (S n) / An n) < k0)). +intros; exists (k + (1 - k) / 2). +split. +split. +pattern k at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l. +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +apply Rplus_lt_reg_r with k; rewrite Rplus_0_r; replace (k + (1 - k)) with 1; + [ elim H; intros; assumption | ring ]. +apply Rinv_0_lt_compat; prove_sup0. +apply Rmult_lt_reg_l with 2. +prove_sup0. +unfold Rdiv in |- *; rewrite Rmult_1_r; rewrite Rmult_plus_distr_l; + pattern 2 at 1 in |- *; rewrite Rmult_comm; rewrite Rmult_assoc; + rewrite <- Rinv_l_sym; [ idtac | discrR ]; rewrite Rmult_1_r; + replace (2 * k + (1 - k)) with (1 + k); [ idtac | ring ]. +elim H; intros. +apply Rplus_lt_compat_l; assumption. +unfold Un_cv in H0; cut (0 < (1 - k) / 2). +intro; elim (H0 ((1 - k) / 2) H1); intros. +exists x; intros. +assert (H4 := H2 n H3). +unfold R_dist in H4; rewrite <- Rabs_Rabsolu; + replace (Rabs (An (S n) / An n)) with (Rabs (An (S n) / An n) - k + k); + [ idtac | ring ]; + apply Rle_lt_trans with (Rabs (Rabs (An (S n) / An n) - k) + Rabs k). +apply Rabs_triang. +rewrite (Rabs_right k). +apply Rplus_lt_reg_r with (- k); rewrite <- (Rplus_comm k); + repeat rewrite <- Rplus_assoc; rewrite Rplus_opp_l; + repeat rewrite Rplus_0_l; apply H4. +apply Rle_ge; elim H; intros; assumption. +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +apply Rplus_lt_reg_r with k; rewrite Rplus_0_r; elim H; intros; + replace (k + (1 - k)) with 1; [ assumption | ring ]. +apply Rinv_0_lt_compat; prove_sup0. +Qed. + +(**********) +Lemma growing_ineq : + forall (Un:nat -> R) (l:R), + Un_growing Un -> Un_cv Un l -> forall n:nat, Un n <= l. +intros; case (total_order_T (Un n) l); intro. +elim s; intro. +left; assumption. +right; assumption. +cut (0 < Un n - l). +intro; unfold Un_cv in H0; unfold R_dist in H0. +elim (H0 (Un n - l) H1); intros N1 H2. +set (N := max n N1). +cut (Un n - l <= Un N - l). +intro; cut (Un N - l < Un n - l). +intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H3 H4)). +apply Rle_lt_trans with (Rabs (Un N - l)). +apply RRle_abs. +apply H2. +unfold ge, N in |- *; apply le_max_r. +unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- l)); + apply Rplus_le_compat_l. +apply tech9. +assumption. +unfold N in |- *; apply le_max_l. +apply Rplus_lt_reg_r with l. +rewrite Rplus_0_r. +replace (l + (Un n - l)) with (Un n); [ assumption | ring ]. +Qed. + +(* Un->l => (-Un) -> (-l) *) +Lemma CV_opp : + forall (An:nat -> R) (l:R), Un_cv An l -> Un_cv (opp_seq An) (- l). +intros An l. +unfold Un_cv in |- *; unfold R_dist in |- *; intros. +elim (H eps H0); intros. +exists x; intros. +unfold opp_seq in |- *; replace (- An n - - l) with (- (An n - l)); + [ rewrite Rabs_Ropp | ring ]. +apply H1; assumption. +Qed. + +(**********) +Lemma decreasing_ineq : + forall (Un:nat -> R) (l:R), + Un_decreasing Un -> Un_cv Un l -> forall n:nat, l <= Un n. +intros. +assert (H1 := decreasing_growing _ H). +assert (H2 := CV_opp _ _ H0). +assert (H3 := growing_ineq _ _ H1 H2). +apply Ropp_le_cancel. +unfold opp_seq in H3; apply H3. +Qed. + +(**********) +Lemma CV_minus : + forall (An Bn:nat -> R) (l1 l2:R), + Un_cv An l1 -> Un_cv Bn l2 -> Un_cv (fun i:nat => An i - Bn i) (l1 - l2). +intros. +replace (fun i:nat => An i - Bn i) with (fun i:nat => An i + opp_seq Bn i). +unfold Rminus in |- *; apply CV_plus. +assumption. +apply CV_opp; assumption. +unfold Rminus, opp_seq in |- *; reflexivity. +Qed. + +(* Un -> +oo *) +Definition cv_infty (Un:nat -> R) : Prop := + forall M:R, exists N : nat, (forall n:nat, (N <= n)%nat -> M < Un n). + +(* Un -> +oo => /Un -> O *) +Lemma cv_infty_cv_R0 : + forall Un:nat -> R, + (forall n:nat, Un n <> 0) -> cv_infty Un -> Un_cv (fun n:nat => / Un n) 0. +unfold cv_infty, Un_cv in |- *; unfold R_dist in |- *; intros. +elim (H0 (/ eps)); intros N0 H2. +exists N0; intros. +unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; + rewrite (Rabs_Rinv _ (H n)). +apply Rmult_lt_reg_l with (Rabs (Un n)). +apply Rabs_pos_lt; apply H. +rewrite <- Rinv_r_sym. +apply Rmult_lt_reg_l with (/ eps). +apply Rinv_0_lt_compat; assumption. +rewrite Rmult_1_r; rewrite (Rmult_comm (/ eps)); rewrite Rmult_assoc; + rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; apply Rlt_le_trans with (Un n). +apply H2; assumption. +apply RRle_abs. +red in |- *; intro; rewrite H4 in H1; elim (Rlt_irrefl _ H1). +apply Rabs_no_R0; apply H. +Qed. + +(**********) +Lemma decreasing_prop : + forall (Un:nat -> R) (m n:nat), + Un_decreasing Un -> (m <= n)%nat -> Un n <= Un m. +unfold Un_decreasing in |- *; intros. +induction n as [| n Hrecn]. +induction m as [| m Hrecm]. +right; reflexivity. +elim (le_Sn_O _ H0). +cut ((m <= n)%nat \/ m = S n). +intro; elim H1; intro. +apply Rle_trans with (Un n). +apply H. +apply Hrecn; assumption. +rewrite H2; right; reflexivity. +inversion H0; [ right; reflexivity | left; assumption ]. +Qed. + +(* |x|^n/n! -> 0 *) +Lemma cv_speed_pow_fact : + forall x:R, Un_cv (fun n:nat => x ^ n / INR (fact n)) 0. +intro; + cut + (Un_cv (fun n:nat => Rabs x ^ n / INR (fact n)) 0 -> + Un_cv (fun n:nat => x ^ n / INR (fact n)) 0). +intro; apply H. +unfold Un_cv in |- *; unfold R_dist in |- *; intros; case (Req_dec x 0); + intro. +exists 1%nat; intros. +rewrite H1; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; + rewrite Rabs_R0; rewrite pow_ne_zero; + [ unfold Rdiv in |- *; rewrite Rmult_0_l; rewrite Rabs_R0; assumption + | red in |- *; intro; rewrite H3 in H2; elim (le_Sn_n _ H2) ]. +assert (H2 := Rabs_pos_lt x H1); set (M := up (Rabs x)); cut (0 <= M)%Z. +intro; elim (IZN M H3); intros M_nat H4. +set (Un := fun n:nat => Rabs x ^ (M_nat + n) / INR (fact (M_nat + n))). +cut (Un_cv Un 0); unfold Un_cv in |- *; unfold R_dist in |- *; intros. +elim (H5 eps H0); intros N H6. +exists (M_nat + N)%nat; intros; + cut (exists p : nat, (p >= N)%nat /\ n = (M_nat + p)%nat). +intro; elim H8; intros p H9. +elim H9; intros; rewrite H11; unfold Un in H6; apply H6; assumption. +exists (n - M_nat)%nat. +split. +unfold ge in |- *; apply (fun p n m:nat => plus_le_reg_l n m p) with M_nat; + rewrite <- le_plus_minus. +assumption. +apply le_trans with (M_nat + N)%nat. +apply le_plus_l. +assumption. +apply le_plus_minus; apply le_trans with (M_nat + N)%nat; + [ apply le_plus_l | assumption ]. +set (Vn := fun n:nat => Rabs x * (Un 0%nat / INR (S n))). +cut (1 <= M_nat)%nat. +intro; cut (forall n:nat, 0 < Un n). +intro; cut (Un_decreasing Un). +intro; cut (forall n:nat, Un (S n) <= Vn n). +intro; cut (Un_cv Vn 0). +unfold Un_cv in |- *; unfold R_dist in |- *; intros. +elim (H10 eps0 H5); intros N1 H11. +exists (S N1); intros. +cut (forall n:nat, 0 < Vn n). +intro; apply Rle_lt_trans with (Rabs (Vn (pred n) - 0)). +repeat rewrite Rabs_right. +unfold Rminus in |- *; rewrite Ropp_0; do 2 rewrite Rplus_0_r; + replace n with (S (pred n)). +apply H9. +inversion H12; simpl in |- *; reflexivity. +apply Rle_ge; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; left; + apply H13. +apply Rle_ge; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; left; + apply H7. +apply H11; unfold ge in |- *; apply le_S_n; replace (S (pred n)) with n; + [ unfold ge in H12; exact H12 | inversion H12; simpl in |- *; reflexivity ]. +intro; apply Rlt_le_trans with (Un (S n0)); [ apply H7 | apply H9 ]. +cut (cv_infty (fun n:nat => INR (S n))). +intro; cut (Un_cv (fun n:nat => / INR (S n)) 0). +unfold Un_cv, R_dist in |- *; intros; unfold Vn in |- *. +cut (0 < eps1 / (Rabs x * Un 0%nat)). +intro; elim (H11 _ H13); intros N H14. +exists N; intros; + replace (Rabs x * (Un 0%nat / INR (S n)) - 0) with + (Rabs x * Un 0%nat * (/ INR (S n) - 0)); + [ idtac | unfold Rdiv in |- *; ring ]. +rewrite Rabs_mult; apply Rmult_lt_reg_l with (/ Rabs (Rabs x * Un 0%nat)). +apply Rinv_0_lt_compat; apply Rabs_pos_lt. +apply prod_neq_R0. +apply Rabs_no_R0; assumption. +assert (H16 := H7 0%nat); red in |- *; intro; rewrite H17 in H16; + elim (Rlt_irrefl _ H16). +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_l. +replace (/ Rabs (Rabs x * Un 0%nat) * eps1) with (eps1 / (Rabs x * Un 0%nat)). +apply H14; assumption. +unfold Rdiv in |- *; rewrite (Rabs_right (Rabs x * Un 0%nat)). +apply Rmult_comm. +apply Rle_ge; apply Rmult_le_pos. +apply Rabs_pos. +left; apply H7. +apply Rabs_no_R0. +apply prod_neq_R0; + [ apply Rabs_no_R0; assumption + | assert (H16 := H7 0%nat); red in |- *; intro; rewrite H17 in H16; + elim (Rlt_irrefl _ H16) ]. +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +assumption. +apply Rinv_0_lt_compat; apply Rmult_lt_0_compat. +apply Rabs_pos_lt; assumption. +apply H7. +apply (cv_infty_cv_R0 (fun n:nat => INR (S n))). +intro; apply not_O_INR; discriminate. +assumption. +unfold cv_infty in |- *; intro; case (total_order_T M0 0); intro. +elim s; intro. +exists 0%nat; intros. +apply Rlt_trans with 0; [ assumption | apply lt_INR_0; apply lt_O_Sn ]. +exists 0%nat; intros; rewrite b; apply lt_INR_0; apply lt_O_Sn. +set (M0_z := up M0). +assert (H10 := archimed M0). +cut (0 <= M0_z)%Z. +intro; elim (IZN _ H11); intros M0_nat H12. +exists M0_nat; intros. +apply Rlt_le_trans with (IZR M0_z). +elim H10; intros; assumption. +rewrite H12; rewrite <- INR_IZR_INZ; apply le_INR. +apply le_trans with n; [ assumption | apply le_n_Sn ]. +apply le_IZR; left; simpl in |- *; unfold M0_z in |- *; + apply Rlt_trans with M0; [ assumption | elim H10; intros; assumption ]. +intro; apply Rle_trans with (Rabs x * Un n * / INR (S n)). +unfold Un in |- *; replace (M_nat + S n)%nat with (M_nat + n + 1)%nat. +rewrite pow_add; replace (Rabs x ^ 1) with (Rabs x); + [ idtac | simpl in |- *; ring ]. +unfold Rdiv in |- *; rewrite <- (Rmult_comm (Rabs x)); + repeat rewrite Rmult_assoc; repeat apply Rmult_le_compat_l. +apply Rabs_pos. +left; apply pow_lt; assumption. +replace (M_nat + n + 1)%nat with (S (M_nat + n)). +rewrite fact_simpl; rewrite mult_comm; rewrite mult_INR; + rewrite Rinv_mult_distr. +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red in |- *; + intro; assert (H10 := sym_eq H9); elim (fact_neq_0 _ H10). +left; apply Rinv_lt_contravar. +apply Rmult_lt_0_compat; apply lt_INR_0; apply lt_O_Sn. +apply lt_INR; apply lt_n_S. +pattern n at 1 in |- *; replace n with (0 + n)%nat; [ idtac | reflexivity ]. +apply plus_lt_compat_r. +apply lt_le_trans with 1%nat; [ apply lt_O_Sn | assumption ]. +apply INR_fact_neq_0. +apply not_O_INR; discriminate. +apply INR_eq; rewrite S_INR; do 3 rewrite plus_INR; reflexivity. +apply INR_eq; do 3 rewrite plus_INR; do 2 rewrite S_INR; ring. +unfold Vn in |- *; rewrite Rmult_assoc; unfold Rdiv in |- *; + rewrite (Rmult_comm (Un 0%nat)); rewrite (Rmult_comm (Un n)). +repeat apply Rmult_le_compat_l. +apply Rabs_pos. +left; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn. +apply decreasing_prop; [ assumption | apply le_O_n ]. +unfold Un_decreasing in |- *; intro; unfold Un in |- *. +replace (M_nat + S n)%nat with (M_nat + n + 1)%nat. +rewrite pow_add; unfold Rdiv in |- *; rewrite Rmult_assoc; + apply Rmult_le_compat_l. +left; apply pow_lt; assumption. +replace (Rabs x ^ 1) with (Rabs x); [ idtac | simpl in |- *; ring ]. +replace (M_nat + n + 1)%nat with (S (M_nat + n)). +apply Rmult_le_reg_l with (INR (fact (S (M_nat + n)))). +apply lt_INR_0; apply neq_O_lt; red in |- *; intro; assert (H9 := sym_eq H8); + elim (fact_neq_0 _ H9). +rewrite (Rmult_comm (Rabs x)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. +rewrite Rmult_1_l. +rewrite fact_simpl; rewrite mult_INR; rewrite Rmult_assoc; + rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; apply Rle_trans with (INR M_nat). +left; rewrite INR_IZR_INZ. +rewrite <- H4; assert (H8 := archimed (Rabs x)); elim H8; intros; assumption. +apply le_INR; apply le_trans with (S M_nat); + [ apply le_n_Sn | apply le_n_S; apply le_plus_l ]. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply INR_eq; rewrite S_INR; do 3 rewrite plus_INR; reflexivity. +apply INR_eq; do 3 rewrite plus_INR; do 2 rewrite S_INR; ring. +intro; unfold Un in |- *; unfold Rdiv in |- *; apply Rmult_lt_0_compat. +apply pow_lt; assumption. +apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red in |- *; intro; + assert (H8 := sym_eq H7); elim (fact_neq_0 _ H8). +clear Un Vn; apply INR_le; simpl in |- *. +induction M_nat as [| M_nat HrecM_nat]. +assert (H6 := archimed (Rabs x)); fold M in H6; elim H6; intros. +rewrite H4 in H7; rewrite <- INR_IZR_INZ in H7. +simpl in H7; elim (Rlt_irrefl _ (Rlt_trans _ _ _ H2 H7)). +replace 1 with (INR 1); [ apply le_INR | reflexivity ]; apply le_n_S; + apply le_O_n. +apply le_IZR; simpl in |- *; left; apply Rlt_trans with (Rabs x). +assumption. +elim (archimed (Rabs x)); intros; assumption. +unfold Un_cv in |- *; unfold R_dist in |- *; intros; elim (H eps H0); intros. +exists x0; intros; + apply Rle_lt_trans with (Rabs (Rabs x ^ n / INR (fact n) - 0)). +unfold Rminus in |- *; rewrite Ropp_0; do 2 rewrite Rplus_0_r; + rewrite (Rabs_right (Rabs x ^ n / INR (fact n))). +unfold Rdiv in |- *; rewrite Rabs_mult; rewrite (Rabs_right (/ INR (fact n))). +rewrite RPow_abs; right; reflexivity. +apply Rle_ge; left; apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; + red in |- *; intro; assert (H4 := sym_eq H3); elim (fact_neq_0 _ H4). +apply Rle_ge; unfold Rdiv in |- *; apply Rmult_le_pos. +case (Req_dec x 0); intro. +rewrite H3; rewrite Rabs_R0. +induction n as [| n Hrecn]; + [ simpl in |- *; left; apply Rlt_0_1 + | simpl in |- *; rewrite Rmult_0_l; right; reflexivity ]. +left; apply pow_lt; apply Rabs_pos_lt; assumption. +left; apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red in |- *; + intro; assert (H4 := sym_eq H3); elim (fact_neq_0 _ H4). +apply H1; assumption. +Qed. diff --git a/theories/Reals/SeqSeries.v b/theories/Reals/SeqSeries.v new file mode 100644 index 00000000..deb98492 --- /dev/null +++ b/theories/Reals/SeqSeries.v @@ -0,0 +1,417 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: SeqSeries.v,v 1.14.2.1 2004/07/16 19:31:15 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rfunctions. +Require Import Max. +Require Export Rseries. +Require Export SeqProp. +Require Export Rcomplete. +Require Export PartSum. +Require Export AltSeries. +Require Export Binomial. +Require Export Rsigma. +Require Export Rprod. +Require Export Cauchy_prod. +Require Export Alembert. +Open Local Scope R_scope. + +(**********) +Lemma sum_maj1 : + forall (fn:nat -> R -> R) (An:nat -> R) (x l1 l2:R) + (N:nat), + Un_cv (fun n:nat => SP fn n x) l1 -> + Un_cv (fun n:nat => sum_f_R0 An n) l2 -> + (forall n:nat, Rabs (fn n x) <= An n) -> + Rabs (l1 - SP fn N x) <= l2 - sum_f_R0 An N. +intros; + cut + (sigT + (fun l:R => + Un_cv (fun n:nat => sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n) l)). +intro; + cut + (sigT + (fun l:R => + Un_cv (fun n:nat => sum_f_R0 (fun l:nat => An (S N + l)%nat) n) l)). +intro; elim X; intros l1N H2. +elim X0; intros l2N H3. +cut (l1 - SP fn N x = l1N). +intro; cut (l2 - sum_f_R0 An N = l2N). +intro; rewrite H4; rewrite H5. +apply sum_cv_maj with + (fun l:nat => An (S N + l)%nat) (fun (l:nat) (x:R) => fn (S N + l)%nat x) x. +unfold SP in |- *; apply H2. +apply H3. +intros; apply H1. +symmetry in |- *; eapply UL_sequence. +apply H3. +unfold Un_cv in H0; unfold Un_cv in |- *; intros; elim (H0 eps H5); + intros N0 H6. +unfold R_dist in H6; exists N0; intros. +unfold R_dist in |- *; + replace (sum_f_R0 (fun l:nat => An (S N + l)%nat) n - (l2 - sum_f_R0 An N)) + with (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n - l2); + [ idtac | ring ]. +replace (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n) with + (sum_f_R0 An (S (N + n))). +apply H6; unfold ge in |- *; apply le_trans with n. +apply H7. +apply le_trans with (N + n)%nat. +apply le_plus_r. +apply le_n_Sn. +cut (0 <= N)%nat. +cut (N < S (N + n))%nat. +intros; assert (H10 := sigma_split An H9 H8). +unfold sigma in H10. +do 2 rewrite <- minus_n_O in H10. +replace (sum_f_R0 An (S (N + n))) with + (sum_f_R0 (fun k:nat => An (0 + k)%nat) (S (N + n))). +replace (sum_f_R0 An N) with (sum_f_R0 (fun k:nat => An (0 + k)%nat) N). +cut ((S (N + n) - S N)%nat = n). +intro; rewrite H11 in H10. +apply H10. +apply INR_eq; rewrite minus_INR. +do 2 rewrite S_INR; rewrite plus_INR; ring. +apply le_n_S; apply le_plus_l. +apply sum_eq; intros. +reflexivity. +apply sum_eq; intros. +reflexivity. +apply le_lt_n_Sm; apply le_plus_l. +apply le_O_n. +symmetry in |- *; eapply UL_sequence. +apply H2. +unfold Un_cv in H; unfold Un_cv in |- *; intros. +elim (H eps H4); intros N0 H5. +unfold R_dist in H5; exists N0; intros. +unfold R_dist, SP in |- *; + replace + (sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n - + (l1 - sum_f_R0 (fun k:nat => fn k x) N)) with + (sum_f_R0 (fun k:nat => fn k x) N + + sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n - l1); + [ idtac | ring ]. +replace + (sum_f_R0 (fun k:nat => fn k x) N + + sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n) with + (sum_f_R0 (fun k:nat => fn k x) (S (N + n))). +unfold SP in H5; apply H5; unfold ge in |- *; apply le_trans with n. +apply H6. +apply le_trans with (N + n)%nat. +apply le_plus_r. +apply le_n_Sn. +cut (0 <= N)%nat. +cut (N < S (N + n))%nat. +intros; assert (H9 := sigma_split (fun k:nat => fn k x) H8 H7). +unfold sigma in H9. +do 2 rewrite <- minus_n_O in H9. +replace (sum_f_R0 (fun k:nat => fn k x) (S (N + n))) with + (sum_f_R0 (fun k:nat => fn (0 + k)%nat x) (S (N + n))). +replace (sum_f_R0 (fun k:nat => fn k x) N) with + (sum_f_R0 (fun k:nat => fn (0 + k)%nat x) N). +cut ((S (N + n) - S N)%nat = n). +intro; rewrite H10 in H9. +apply H9. +apply INR_eq; rewrite minus_INR. +do 2 rewrite S_INR; rewrite plus_INR; ring. +apply le_n_S; apply le_plus_l. +apply sum_eq; intros. +reflexivity. +apply sum_eq; intros. +reflexivity. +apply le_lt_n_Sm. +apply le_plus_l. +apply le_O_n. +apply existT with (l2 - sum_f_R0 An N). +unfold Un_cv in H0; unfold Un_cv in |- *; intros. +elim (H0 eps H2); intros N0 H3. +unfold R_dist in H3; exists N0; intros. +unfold R_dist in |- *; + replace (sum_f_R0 (fun l:nat => An (S N + l)%nat) n - (l2 - sum_f_R0 An N)) + with (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n - l2); + [ idtac | ring ]. +replace (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n) with + (sum_f_R0 An (S (N + n))). +apply H3; unfold ge in |- *; apply le_trans with n. +apply H4. +apply le_trans with (N + n)%nat. +apply le_plus_r. +apply le_n_Sn. +cut (0 <= N)%nat. +cut (N < S (N + n))%nat. +intros; assert (H7 := sigma_split An H6 H5). +unfold sigma in H7. +do 2 rewrite <- minus_n_O in H7. +replace (sum_f_R0 An (S (N + n))) with + (sum_f_R0 (fun k:nat => An (0 + k)%nat) (S (N + n))). +replace (sum_f_R0 An N) with (sum_f_R0 (fun k:nat => An (0 + k)%nat) N). +cut ((S (N + n) - S N)%nat = n). +intro; rewrite H8 in H7. +apply H7. +apply INR_eq; rewrite minus_INR. +do 2 rewrite S_INR; rewrite plus_INR; ring. +apply le_n_S; apply le_plus_l. +apply sum_eq; intros. +reflexivity. +apply sum_eq; intros. +reflexivity. +apply le_lt_n_Sm. +apply le_plus_l. +apply le_O_n. +apply existT with (l1 - SP fn N x). +unfold Un_cv in H; unfold Un_cv in |- *; intros. +elim (H eps H2); intros N0 H3. +unfold R_dist in H3; exists N0; intros. +unfold R_dist, SP in |- *. +replace + (sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n - + (l1 - sum_f_R0 (fun k:nat => fn k x) N)) with + (sum_f_R0 (fun k:nat => fn k x) N + + sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n - l1); + [ idtac | ring ]. +replace + (sum_f_R0 (fun k:nat => fn k x) N + + sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n) with + (sum_f_R0 (fun k:nat => fn k x) (S (N + n))). +unfold SP in H3; apply H3. +unfold ge in |- *; apply le_trans with n. +apply H4. +apply le_trans with (N + n)%nat. +apply le_plus_r. +apply le_n_Sn. +cut (0 <= N)%nat. +cut (N < S (N + n))%nat. +intros; assert (H7 := sigma_split (fun k:nat => fn k x) H6 H5). +unfold sigma in H7. +do 2 rewrite <- minus_n_O in H7. +replace (sum_f_R0 (fun k:nat => fn k x) (S (N + n))) with + (sum_f_R0 (fun k:nat => fn (0 + k)%nat x) (S (N + n))). +replace (sum_f_R0 (fun k:nat => fn k x) N) with + (sum_f_R0 (fun k:nat => fn (0 + k)%nat x) N). +cut ((S (N + n) - S N)%nat = n). +intro; rewrite H8 in H7. +apply H7. +apply INR_eq; rewrite minus_INR. +do 2 rewrite S_INR; rewrite plus_INR; ring. +apply le_n_S; apply le_plus_l. +apply sum_eq; intros. +reflexivity. +apply sum_eq; intros. +reflexivity. +apply le_lt_n_Sm. +apply le_plus_l. +apply le_O_n. +Qed. + +(* Comparaison of convergence for series *) +Lemma Rseries_CV_comp : + forall An Bn:nat -> R, + (forall n:nat, 0 <= An n <= Bn n) -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 Bn N) l) -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l). +intros; apply cv_cauchy_2. +assert (H0 := cv_cauchy_1 _ X). +unfold Cauchy_crit_series in |- *; unfold Cauchy_crit in |- *. +intros; elim (H0 eps H1); intros. +exists x; intros. +cut + (R_dist (sum_f_R0 An n) (sum_f_R0 An m) <= + R_dist (sum_f_R0 Bn n) (sum_f_R0 Bn m)). +intro; apply Rle_lt_trans with (R_dist (sum_f_R0 Bn n) (sum_f_R0 Bn m)). +assumption. +apply H2; assumption. +assert (H5 := lt_eq_lt_dec n m). +elim H5; intro. +elim a; intro. +rewrite (tech2 An n m); [ idtac | assumption ]. +rewrite (tech2 Bn n m); [ idtac | assumption ]. +unfold R_dist in |- *; unfold Rminus in |- *; do 2 rewrite Ropp_plus_distr; + do 2 rewrite <- Rplus_assoc; do 2 rewrite Rplus_opp_r; + do 2 rewrite Rplus_0_l; do 2 rewrite Rabs_Ropp; repeat rewrite Rabs_right. +apply sum_Rle; intros. +elim (H (S n + n0)%nat); intros. +apply H8. +apply Rle_ge; apply cond_pos_sum; intro. +elim (H (S n + n0)%nat); intros. +apply Rle_trans with (An (S n + n0)%nat); assumption. +apply Rle_ge; apply cond_pos_sum; intro. +elim (H (S n + n0)%nat); intros; assumption. +rewrite b; unfold R_dist in |- *; unfold Rminus in |- *; + do 2 rewrite Rplus_opp_r; rewrite Rabs_R0; right; + reflexivity. +rewrite (tech2 An m n); [ idtac | assumption ]. +rewrite (tech2 Bn m n); [ idtac | assumption ]. +unfold R_dist in |- *; unfold Rminus in |- *; do 2 rewrite Rplus_assoc; + rewrite (Rplus_comm (sum_f_R0 An m)); rewrite (Rplus_comm (sum_f_R0 Bn m)); + do 2 rewrite Rplus_assoc; do 2 rewrite Rplus_opp_l; + do 2 rewrite Rplus_0_r; repeat rewrite Rabs_right. +apply sum_Rle; intros. +elim (H (S m + n0)%nat); intros; apply H8. +apply Rle_ge; apply cond_pos_sum; intro. +elim (H (S m + n0)%nat); intros. +apply Rle_trans with (An (S m + n0)%nat); assumption. +apply Rle_ge. +apply cond_pos_sum; intro. +elim (H (S m + n0)%nat); intros; assumption. +Qed. + +(* Cesaro's theorem *) +Lemma Cesaro : + forall (An Bn:nat -> R) (l:R), + Un_cv Bn l -> + (forall n:nat, 0 < An n) -> + cv_infty (fun n:nat => sum_f_R0 An n) -> + Un_cv (fun n:nat => sum_f_R0 (fun k:nat => An k * Bn k) n / sum_f_R0 An n) + l. +Proof with trivial. +unfold Un_cv in |- *; intros; assert (H3 : forall n:nat, 0 < sum_f_R0 An n)... +intro; apply tech1... +assert (H4 : forall n:nat, sum_f_R0 An n <> 0)... +intro; red in |- *; intro; assert (H5 := H3 n); rewrite H4 in H5; + elim (Rlt_irrefl _ H5)... +assert (H5 := cv_infty_cv_R0 _ H4 H1); assert (H6 : 0 < eps / 2)... +unfold Rdiv in |- *; apply Rmult_lt_0_compat... +apply Rinv_0_lt_compat; prove_sup... +elim (H _ H6); clear H; intros N1 H; + set (C := Rabs (sum_f_R0 (fun k:nat => An k * (Bn k - l)) N1)); + assert + (H7 : + exists N : nat, + (forall n:nat, (N <= n)%nat -> C / sum_f_R0 An n < eps / 2))... +case (Req_dec C 0); intro... +exists 0%nat; intros... +rewrite H7; unfold Rdiv in |- *; rewrite Rmult_0_l; apply Rmult_lt_0_compat... +apply Rinv_0_lt_compat; prove_sup... +assert (H8 : 0 < eps / (2 * Rabs C))... +unfold Rdiv in |- *; apply Rmult_lt_0_compat... +apply Rinv_0_lt_compat; apply Rmult_lt_0_compat... +prove_sup... +apply Rabs_pos_lt... +elim (H5 _ H8); intros; exists x; intros; assert (H11 := H9 _ H10); + unfold R_dist in H11; unfold Rminus in H11; rewrite Ropp_0 in H11; + rewrite Rplus_0_r in H11... +apply Rle_lt_trans with (Rabs (C / sum_f_R0 An n))... +apply RRle_abs... +unfold Rdiv in |- *; rewrite Rabs_mult; apply Rmult_lt_reg_l with (/ Rabs C)... +apply Rinv_0_lt_compat; apply Rabs_pos_lt... +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym... +rewrite Rmult_1_l; replace (/ Rabs C * (eps * / 2)) with (eps / (2 * Rabs C))... +unfold Rdiv in |- *; rewrite Rinv_mult_distr... +ring... +discrR... +apply Rabs_no_R0... +apply Rabs_no_R0... +elim H7; clear H7; intros N2 H7; set (N := max N1 N2); exists (S N); intros; + unfold R_dist in |- *; + replace (sum_f_R0 (fun k:nat => An k * Bn k) n / sum_f_R0 An n - l) with + (sum_f_R0 (fun k:nat => An k * (Bn k - l)) n / sum_f_R0 An n)... +assert (H9 : (N1 < n)%nat)... +apply lt_le_trans with (S N)... +apply le_lt_n_Sm; unfold N in |- *; apply le_max_l... +rewrite (tech2 (fun k:nat => An k * (Bn k - l)) _ _ H9); unfold Rdiv in |- *; + rewrite Rmult_plus_distr_r; + apply Rle_lt_trans with + (Rabs (sum_f_R0 (fun k:nat => An k * (Bn k - l)) N1 / sum_f_R0 An n) + + Rabs + (sum_f_R0 (fun i:nat => An (S N1 + i)%nat * (Bn (S N1 + i)%nat - l)) + (n - S N1) / sum_f_R0 An n))... +apply Rabs_triang... +rewrite (double_var eps); apply Rplus_lt_compat... +unfold Rdiv in |- *; rewrite Rabs_mult; fold C in |- *; rewrite Rabs_right... +apply (H7 n); apply le_trans with (S N)... +apply le_trans with N; [ unfold N in |- *; apply le_max_r | apply le_n_Sn ]... +apply Rle_ge; left; apply Rinv_0_lt_compat... + +unfold R_dist in H; unfold Rdiv in |- *; rewrite Rabs_mult; + rewrite (Rabs_right (/ sum_f_R0 An n))... +apply Rle_lt_trans with + (sum_f_R0 (fun i:nat => Rabs (An (S N1 + i)%nat * (Bn (S N1 + i)%nat - l))) + (n - S N1) * / sum_f_R0 An n)... +do 2 rewrite <- (Rmult_comm (/ sum_f_R0 An n)); apply Rmult_le_compat_l... +left; apply Rinv_0_lt_compat... +apply + (Rsum_abs (fun i:nat => An (S N1 + i)%nat * (Bn (S N1 + i)%nat - l)) + (n - S N1))... +apply Rle_lt_trans with + (sum_f_R0 (fun i:nat => An (S N1 + i)%nat * (eps / 2)) (n - S N1) * + / sum_f_R0 An n)... +do 2 rewrite <- (Rmult_comm (/ sum_f_R0 An n)); apply Rmult_le_compat_l... +left; apply Rinv_0_lt_compat... +apply sum_Rle; intros; rewrite Rabs_mult; + pattern (An (S N1 + n0)%nat) at 2 in |- *; + rewrite <- (Rabs_right (An (S N1 + n0)%nat))... +apply Rmult_le_compat_l... +apply Rabs_pos... +left; apply H; unfold ge in |- *; apply le_trans with (S N1); + [ apply le_n_Sn | apply le_plus_l ]... +apply Rle_ge; left... +rewrite <- (scal_sum (fun i:nat => An (S N1 + i)%nat) (n - S N1) (eps / 2)); + unfold Rdiv in |- *; repeat rewrite Rmult_assoc; apply Rmult_lt_compat_l... +pattern (/ 2) at 2 in |- *; rewrite <- Rmult_1_r; apply Rmult_lt_compat_l... +apply Rinv_0_lt_compat; prove_sup... +rewrite Rmult_comm; apply Rmult_lt_reg_l with (sum_f_R0 An n)... +rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym... +rewrite Rmult_1_l; rewrite Rmult_1_r; rewrite (tech2 An N1 n)... +rewrite Rplus_comm; + pattern (sum_f_R0 (fun i:nat => An (S N1 + i)%nat) (n - S N1)) at 1 in |- *; + rewrite <- Rplus_0_r; apply Rplus_lt_compat_l... +apply Rle_ge; left; apply Rinv_0_lt_compat... +replace (sum_f_R0 (fun k:nat => An k * (Bn k - l)) n) with + (sum_f_R0 (fun k:nat => An k * Bn k) n + + sum_f_R0 (fun k:nat => An k * - l) n)... +rewrite <- (scal_sum An n (- l)); field... +rewrite <- plus_sum; apply sum_eq; intros; ring... +Qed. + +Lemma Cesaro_1 : + forall (An:nat -> R) (l:R), + Un_cv An l -> Un_cv (fun n:nat => sum_f_R0 An (pred n) / INR n) l. +Proof with trivial. +intros Bn l H; set (An := fun _:nat => 1)... +assert (H0 : forall n:nat, 0 < An n)... +intro; unfold An in |- *; apply Rlt_0_1... +assert (H1 : forall n:nat, 0 < sum_f_R0 An n)... +intro; apply tech1... +assert (H2 : cv_infty (fun n:nat => sum_f_R0 An n))... +unfold cv_infty in |- *; intro; case (Rle_dec M 0); intro... +exists 0%nat; intros; apply Rle_lt_trans with 0... +assert (H2 : 0 < M)... +auto with real... +clear n; set (m := up M); elim (archimed M); intros; + assert (H5 : (0 <= m)%Z)... +apply le_IZR; unfold m in |- *; simpl in |- *; left; apply Rlt_trans with M... +elim (IZN _ H5); intros; exists x; intros; unfold An in |- *; rewrite sum_cte; + rewrite Rmult_1_l; apply Rlt_trans with (IZR (up M))... +apply Rle_lt_trans with (INR x)... +rewrite INR_IZR_INZ; fold m in |- *; rewrite <- H6; right... +apply lt_INR; apply le_lt_n_Sm... +assert (H3 := Cesaro _ _ _ H H0 H2)... +unfold Un_cv in |- *; unfold Un_cv in H3; intros; elim (H3 _ H4); intros; + exists (S x); intros; unfold R_dist in |- *; unfold R_dist in H5; + apply Rle_lt_trans with + (Rabs + (sum_f_R0 (fun k:nat => An k * Bn k) (pred n) / sum_f_R0 An (pred n) - l))... +right; + replace (sum_f_R0 Bn (pred n) / INR n - l) with + (sum_f_R0 (fun k:nat => An k * Bn k) (pred n) / sum_f_R0 An (pred n) - l)... +unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- l)); + apply Rplus_eq_compat_l... +unfold An in |- *; + replace (sum_f_R0 (fun k:nat => 1 * Bn k) (pred n)) with + (sum_f_R0 Bn (pred n))... +rewrite sum_cte; rewrite Rmult_1_l; replace (S (pred n)) with n... +apply S_pred with 0%nat; apply lt_le_trans with (S x)... +apply lt_O_Sn... +apply sum_eq; intros; ring... +apply H5; unfold ge in |- *; apply le_S_n; replace (S (pred n)) with n... +apply S_pred with 0%nat; apply lt_le_trans with (S x)... +apply lt_O_Sn... +Qed. diff --git a/theories/Reals/SplitAbsolu.v b/theories/Reals/SplitAbsolu.v new file mode 100644 index 00000000..b4026e67 --- /dev/null +++ b/theories/Reals/SplitAbsolu.v @@ -0,0 +1,25 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: SplitAbsolu.v,v 1.6.2.1 2004/07/16 19:31:15 herbelin Exp $ i*) + +Require Import Rbasic_fun. + +Ltac split_case_Rabs := + match goal with + | |- context [(Rcase_abs ?X1)] => + case (Rcase_abs X1); try split_case_Rabs + end. + + +Ltac split_Rabs := + match goal with + | id:context [(Rabs _)] |- _ => generalize id; clear id; try split_Rabs + | |- context [(Rabs ?X1)] => + unfold Rabs in |- *; try split_case_Rabs; intros + end.
\ No newline at end of file diff --git a/theories/Reals/SplitRmult.v b/theories/Reals/SplitRmult.v new file mode 100644 index 00000000..19df2afa --- /dev/null +++ b/theories/Reals/SplitRmult.v @@ -0,0 +1,20 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: SplitRmult.v,v 1.7.2.1 2004/07/16 19:31:15 herbelin Exp $ i*) + +(*i Lemma mult_non_zero :(r1,r2:R)``r1<>0`` /\ ``r2<>0`` -> ``r1*r2<>0``. i*) + + +Require Import Rbase. + +Ltac split_Rmult := + match goal with + | |- ((?X1 * ?X2)%R <> 0%R) => + apply Rmult_integral_contrapositive; split; try split_Rmult + end. diff --git a/theories/Reals/Sqrt_reg.v b/theories/Reals/Sqrt_reg.v new file mode 100644 index 00000000..b11e51f0 --- /dev/null +++ b/theories/Reals/Sqrt_reg.v @@ -0,0 +1,351 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Sqrt_reg.v,v 1.9.2.1 2004/07/16 19:31:15 herbelin Exp $ i*) + +Require Import Rbase. +Require Import Rfunctions. +Require Import Ranalysis1. +Require Import R_sqrt. Open Local Scope R_scope. + +(**********) +Lemma sqrt_var_maj : + forall h:R, Rabs h <= 1 -> Rabs (sqrt (1 + h) - 1) <= Rabs h. +intros; cut (0 <= 1 + h). +intro; apply Rle_trans with (Rabs (sqrt (Rsqr (1 + h)) - 1)). +case (total_order_T h 0); intro. +elim s; intro. +repeat rewrite Rabs_left. +unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (-1)). +do 2 rewrite Ropp_plus_distr; rewrite Ropp_involutive; + apply Rplus_le_compat_l. +apply Ropp_le_contravar; apply sqrt_le_1. +apply Rle_0_sqr. +apply H0. +pattern (1 + h) at 2 in |- *; rewrite <- Rmult_1_r; unfold Rsqr in |- *; + apply Rmult_le_compat_l. +apply H0. +pattern 1 at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; + assumption. +apply Rplus_lt_reg_r with 1; rewrite Rplus_0_r; rewrite Rplus_comm; + unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_l; + rewrite Rplus_0_r. +pattern 1 at 2 in |- *; rewrite <- sqrt_1; apply sqrt_lt_1. +apply Rle_0_sqr. +left; apply Rlt_0_1. +pattern 1 at 2 in |- *; rewrite <- Rsqr_1; apply Rsqr_incrst_1. +pattern 1 at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; + assumption. +apply H0. +left; apply Rlt_0_1. +apply Rplus_lt_reg_r with 1; rewrite Rplus_0_r; rewrite Rplus_comm; + unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_l; + rewrite Rplus_0_r. +pattern 1 at 2 in |- *; rewrite <- sqrt_1; apply sqrt_lt_1. +apply H0. +left; apply Rlt_0_1. +pattern 1 at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; + assumption. +rewrite b; rewrite Rplus_0_r; rewrite Rsqr_1; rewrite sqrt_1; right; + reflexivity. +repeat rewrite Rabs_right. +unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (-1)); + apply Rplus_le_compat_l. +apply sqrt_le_1. +apply H0. +apply Rle_0_sqr. +pattern (1 + h) at 1 in |- *; rewrite <- Rmult_1_r; unfold Rsqr in |- *; + apply Rmult_le_compat_l. +apply H0. +pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; + assumption. +apply Rle_ge; apply Rplus_le_reg_l with 1. +rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *; + rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r. +pattern 1 at 1 in |- *; rewrite <- sqrt_1; apply sqrt_le_1. +left; apply Rlt_0_1. +apply Rle_0_sqr. +pattern 1 at 1 in |- *; rewrite <- Rsqr_1; apply Rsqr_incr_1. +pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; + assumption. +left; apply Rlt_0_1. +apply H0. +apply Rle_ge; left; apply Rplus_lt_reg_r with 1. +rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *; + rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r. +pattern 1 at 1 in |- *; rewrite <- sqrt_1; apply sqrt_lt_1. +left; apply Rlt_0_1. +apply H0. +pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; + assumption. +rewrite sqrt_Rsqr. +replace (1 + h - 1) with h; [ right; reflexivity | ring ]. +apply H0. +case (total_order_T h 0); intro. +elim s; intro. +rewrite (Rabs_left h a) in H. +apply Rplus_le_reg_l with (- h). +rewrite Rplus_0_r; rewrite Rplus_comm; rewrite Rplus_assoc; + rewrite Rplus_opp_r; rewrite Rplus_0_r; exact H. +left; rewrite b; rewrite Rplus_0_r; apply Rlt_0_1. +left; apply Rplus_lt_0_compat. +apply Rlt_0_1. +apply r. +Qed. + +(* sqrt is continuous in 1 *) +Lemma sqrt_continuity_pt_R1 : continuity_pt sqrt 1. +unfold continuity_pt in |- *; unfold continue_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; + intros. +set (alpha := Rmin eps 1). +exists alpha; intros. +split. +unfold alpha in |- *; unfold Rmin in |- *; case (Rle_dec eps 1); intro. +assumption. +apply Rlt_0_1. +intros; elim H0; intros. +rewrite sqrt_1; replace x with (1 + (x - 1)); [ idtac | ring ]; + apply Rle_lt_trans with (Rabs (x - 1)). +apply sqrt_var_maj. +apply Rle_trans with alpha. +left; apply H2. +unfold alpha in |- *; apply Rmin_r. +apply Rlt_le_trans with alpha; + [ apply H2 | unfold alpha in |- *; apply Rmin_l ]. +Qed. + +(* sqrt is continuous forall x>0 *) +Lemma sqrt_continuity_pt : forall x:R, 0 < x -> continuity_pt sqrt x. +intros; generalize sqrt_continuity_pt_R1. +unfold continuity_pt in |- *; unfold continue_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; + intros. +cut (0 < eps / sqrt x). +intro; elim (H0 _ H2); intros alp_1 H3. +elim H3; intros. +set (alpha := alp_1 * x). +exists (Rmin alpha x); intros. +split. +change (0 < Rmin alpha x) in |- *; unfold Rmin in |- *; + case (Rle_dec alpha x); intro. +unfold alpha in |- *; apply Rmult_lt_0_compat; assumption. +apply H. +intros; replace x0 with (x + (x0 - x)); [ idtac | ring ]; + replace (sqrt (x + (x0 - x)) - sqrt x) with + (sqrt x * (sqrt (1 + (x0 - x) / x) - sqrt 1)). +rewrite Rabs_mult; rewrite (Rabs_right (sqrt x)). +apply Rmult_lt_reg_l with (/ sqrt x). +apply Rinv_0_lt_compat; apply sqrt_lt_R0; assumption. +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; rewrite Rmult_comm. +unfold Rdiv in H5. +case (Req_dec x x0); intro. +rewrite H7; unfold Rminus, Rdiv in |- *; rewrite Rplus_opp_r; + rewrite Rmult_0_l; rewrite Rplus_0_r; rewrite Rplus_opp_r; + rewrite Rabs_R0. +apply Rmult_lt_0_compat. +assumption. +apply Rinv_0_lt_compat; rewrite <- H7; apply sqrt_lt_R0; assumption. +apply H5. +split. +unfold D_x, no_cond in |- *. +split. +trivial. +red in |- *; intro. +cut ((x0 - x) * / x = 0). +intro. +elim (Rmult_integral _ _ H9); intro. +elim H7. +apply (Rminus_diag_uniq_sym _ _ H10). +assert (H11 := Rmult_eq_0_compat_r _ x H10). +rewrite <- Rinv_l_sym in H11. +elim R1_neq_R0; exact H11. +red in |- *; intro; rewrite H12 in H; elim (Rlt_irrefl _ H). +symmetry in |- *; apply Rplus_eq_reg_l with 1; rewrite Rplus_0_r; + unfold Rdiv in H8; exact H8. +unfold Rminus in |- *; rewrite Rplus_comm; rewrite <- Rplus_assoc; + rewrite Rplus_opp_l; rewrite Rplus_0_l; elim H6; intros. +unfold Rdiv in |- *; rewrite Rabs_mult. +rewrite Rabs_Rinv. +rewrite (Rabs_right x). +rewrite Rmult_comm; apply Rmult_lt_reg_l with x. +apply H. +rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. +rewrite Rmult_1_l; rewrite Rmult_comm; fold alpha in |- *. +apply Rlt_le_trans with (Rmin alpha x). +apply H9. +apply Rmin_l. +red in |- *; intro; rewrite H10 in H; elim (Rlt_irrefl _ H). +apply Rle_ge; left; apply H. +red in |- *; intro; rewrite H10 in H; elim (Rlt_irrefl _ H). +assert (H7 := sqrt_lt_R0 x H). +red in |- *; intro; rewrite H8 in H7; elim (Rlt_irrefl _ H7). +apply Rle_ge; apply sqrt_positivity. +left; apply H. +unfold Rminus in |- *; rewrite Rmult_plus_distr_l; + rewrite Ropp_mult_distr_r_reverse; repeat rewrite <- sqrt_mult. +rewrite Rmult_1_r; rewrite Rmult_plus_distr_l; rewrite Rmult_1_r; + unfold Rdiv in |- *; rewrite Rmult_comm; rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; reflexivity. +red in |- *; intro; rewrite H7 in H; elim (Rlt_irrefl _ H). +left; apply H. +left; apply Rlt_0_1. +left; apply H. +elim H6; intros. +case (Rcase_abs (x0 - x)); intro. +rewrite (Rabs_left (x0 - x) r) in H8. +rewrite Rplus_comm. +apply Rplus_le_reg_l with (- ((x0 - x) / x)). +rewrite Rplus_0_r; rewrite <- Rplus_assoc; rewrite Rplus_opp_l; + rewrite Rplus_0_l; unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse. +apply Rmult_le_reg_l with x. +apply H. +rewrite Rmult_1_r; rewrite Rmult_comm; rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; left; apply Rlt_le_trans with (Rmin alpha x). +apply H8. +apply Rmin_r. +red in |- *; intro; rewrite H9 in H; elim (Rlt_irrefl _ H). +apply Rplus_le_le_0_compat. +left; apply Rlt_0_1. +unfold Rdiv in |- *; apply Rmult_le_pos. +apply Rge_le; exact r. +left; apply Rinv_0_lt_compat; apply H. +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +apply H1. +apply Rinv_0_lt_compat; apply sqrt_lt_R0; apply H. +Qed. + +(* sqrt is derivable for all x>0 *) +Lemma derivable_pt_lim_sqrt : + forall x:R, 0 < x -> derivable_pt_lim sqrt x (/ (2 * sqrt x)). +intros; set (g := fun h:R => sqrt x + sqrt (x + h)). +cut (continuity_pt g 0). +intro; cut (g 0 <> 0). +intro; assert (H2 := continuity_pt_inv g 0 H0 H1). +unfold derivable_pt_lim in |- *; intros; unfold continuity_pt in H2; + unfold continue_in in H2; unfold limit1_in in H2; + unfold limit_in in H2; simpl in H2; unfold R_dist in H2. +elim (H2 eps H3); intros alpha H4. +elim H4; intros. +set (alpha1 := Rmin alpha x). +cut (0 < alpha1). +intro; exists (mkposreal alpha1 H7); intros. +replace ((sqrt (x + h) - sqrt x) / h) with (/ (sqrt x + sqrt (x + h))). +unfold inv_fct, g in H6; replace (2 * sqrt x) with (sqrt x + sqrt (x + 0)). +apply H6. +split. +unfold D_x, no_cond in |- *. +split. +trivial. +apply (sym_not_eq (A:=R)); exact H8. +unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; + apply Rlt_le_trans with alpha1. +exact H9. +unfold alpha1 in |- *; apply Rmin_l. +rewrite Rplus_0_r; ring. +cut (0 <= x + h). +intro; cut (0 < sqrt x + sqrt (x + h)). +intro; apply Rmult_eq_reg_l with (sqrt x + sqrt (x + h)). +rewrite <- Rinv_r_sym. +rewrite Rplus_comm; unfold Rdiv in |- *; rewrite <- Rmult_assoc; + rewrite Rsqr_plus_minus; repeat rewrite Rsqr_sqrt. +rewrite Rplus_comm; unfold Rminus in |- *; rewrite Rplus_assoc; + rewrite Rplus_opp_r; rewrite Rplus_0_r; rewrite <- Rinv_r_sym. +reflexivity. +apply H8. +left; apply H. +assumption. +red in |- *; intro; rewrite H12 in H11; elim (Rlt_irrefl _ H11). +red in |- *; intro; rewrite H12 in H11; elim (Rlt_irrefl _ H11). +apply Rplus_lt_le_0_compat. +apply sqrt_lt_R0; apply H. +apply sqrt_positivity; apply H10. +case (Rcase_abs h); intro. +rewrite (Rabs_left h r) in H9. +apply Rplus_le_reg_l with (- h). +rewrite Rplus_0_r; rewrite Rplus_comm; rewrite Rplus_assoc; + rewrite Rplus_opp_r; rewrite Rplus_0_r; left; apply Rlt_le_trans with alpha1. +apply H9. +unfold alpha1 in |- *; apply Rmin_r. +apply Rplus_le_le_0_compat. +left; assumption. +apply Rge_le; apply r. +unfold alpha1 in |- *; unfold Rmin in |- *; case (Rle_dec alpha x); intro. +apply H5. +apply H. +unfold g in |- *; rewrite Rplus_0_r. +cut (0 < sqrt x + sqrt x). +intro; red in |- *; intro; rewrite H2 in H1; elim (Rlt_irrefl _ H1). +apply Rplus_lt_0_compat; apply sqrt_lt_R0; apply H. +replace g with (fct_cte (sqrt x) + comp sqrt (fct_cte x + id))%F; + [ idtac | reflexivity ]. +apply continuity_pt_plus. +apply continuity_pt_const; unfold constant, fct_cte in |- *; intro; + reflexivity. +apply continuity_pt_comp. +apply continuity_pt_plus. +apply continuity_pt_const; unfold constant, fct_cte in |- *; intro; + reflexivity. +apply derivable_continuous_pt; apply derivable_pt_id. +apply sqrt_continuity_pt. +unfold plus_fct, fct_cte, id in |- *; rewrite Rplus_0_r; apply H. +Qed. + +(**********) +Lemma derivable_pt_sqrt : forall x:R, 0 < x -> derivable_pt sqrt x. +unfold derivable_pt in |- *; intros. +apply existT with (/ (2 * sqrt x)). +apply derivable_pt_lim_sqrt; assumption. +Qed. + +(**********) +Lemma derive_pt_sqrt : + forall (x:R) (pr:0 < x), + derive_pt sqrt x (derivable_pt_sqrt _ pr) = / (2 * sqrt x). +intros. +apply derive_pt_eq_0. +apply derivable_pt_lim_sqrt; assumption. +Qed. + +(* We show that sqrt is continuous for all x>=0 *) +(* Remark : by definition of sqrt (as extension of Rsqrt on |R), *) +(* we could also show that sqrt is continuous for all x *) +Lemma continuity_pt_sqrt : forall x:R, 0 <= x -> continuity_pt sqrt x. +intros; case (Rtotal_order 0 x); intro. +apply (sqrt_continuity_pt x H0). +elim H0; intro. +unfold continuity_pt in |- *; unfold continue_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold R_dist in |- *; intros. +exists (Rsqr eps); intros. +split. +change (0 < Rsqr eps) in |- *; apply Rsqr_pos_lt. +red in |- *; intro; rewrite H3 in H2; elim (Rlt_irrefl _ H2). +intros; elim H3; intros. +rewrite <- H1; rewrite sqrt_0; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; rewrite <- H1 in H5; unfold Rminus in H5; + rewrite Ropp_0 in H5; rewrite Rplus_0_r in H5. +case (Rcase_abs x0); intro. +unfold sqrt in |- *; case (Rcase_abs x0); intro. +rewrite Rabs_R0; apply H2. +assert (H6 := Rge_le _ _ r0); elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H6 r)). +rewrite Rabs_right. +apply Rsqr_incrst_0. +rewrite Rsqr_sqrt. +rewrite (Rabs_right x0 r) in H5; apply H5. +apply Rge_le; exact r. +apply sqrt_positivity; apply Rge_le; exact r. +left; exact H2. +apply Rle_ge; apply sqrt_positivity; apply Rge_le; exact r. +elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H1 H)). +Qed.
\ No newline at end of file diff --git a/theories/Reals/intro.tex b/theories/Reals/intro.tex new file mode 100644 index 00000000..43317258 --- /dev/null +++ b/theories/Reals/intro.tex @@ -0,0 +1,4 @@ +\section{Reals}\label{Reals} + +This library contains an axiomatization of real numbers. +The main file is \texttt{Reals.v}. |