Require Export Reals. Require Export Field. Require Export ZArith. Require Export Fourier. Require Export Zwf. Ltac caseEq f := generalize (refl_equal f); pattern f at -1; case f. Theorem nonz_2 : (2<>0)%R. apply (not_O_IZR 2). omega. Qed. Theorem nonz_4 : (4<>0)%R. replace 4%R with (IZR 4). apply not_O_IZR; omega. simpl; ring. Qed. Theorem IZR4 : 4%R=IZR 4. simpl; field. Qed. Hint Resolve nonz_2 nonz_4 prod_neq_R0 : real1. Theorem half_plus_distr : forall x y, ((x+y)/2 = x/2 + y/2)%R. intros; field. auto with real1. Qed. Theorem Rle_1_split : forall a b, (a <= 1 -> b <= 1 -> a/2 + b/2 <= 1)%R. intros. replace (a/2)%R with (1/2*a)%R;[idtac | field; auto with real1]. replace (b/2)%R with (1/2*b)%R;[idtac | field; auto with real1]. fourier. Qed. Theorem Rle_half : forall a, (0 <= a -> 1/2 <= a/2 + 1/2)%R. intros. replace (a/2)%R with (1/2*a)%R;[idtac | field; auto with real1]. fourier. Qed. Ltac dec_tac := match goal with id: (_ <= _ <= _)%R |- _ => decompose [and] id; clear id; dec_tac |id: (_ < _ <= _)%R |- _ => decompose [and] id; clear id; dec_tac |id: (_ < _ < _)%R |- _ => decompose [and] id; clear id; dec_tac |id: (_ < _ <= _)%R |- _ => decompose [and] id; clear id; dec_tac | |- _ => idtac end. Hint Extern 4 (_ <= _)%R => fourier : real1. Theorem Rle_half' : forall x y, (x <= y -> x/2 <= y/2)%R. intros; replace (x/2)%R with (1/2*x)%R;[idtac | field;auto with real1]. intros; replace (y/2)%R with (1/2*y)%R;[idtac | field;auto with real1]. fourier. Qed. Hint Resolve Rle_half' : real1. Theorem half_pos : forall x, (0 <= x -> 0 <= x/2)%R. intros; replace (x/2)%R with (1/2*x)%R;[fourier | field; auto with real1]. Qed. Hint Resolve half_pos : real1. Theorem fourth_plus_distr : forall x y, ((x + y)/4 = 1/4*x + 1/4*y)%R. intros; field; auto with real1. Qed. Theorem half_half : forall x, (x/ 2 / 2 = 1/4 * x)%R. intros; field; auto with real1. Qed. Theorem simpl_div2 : forall x, ((2*(x/2))=x)%R. intros; field; auto with real1. Qed. Theorem simpl_div4 : forall x, ((1/4 * (2 * x)) = 1/2* x)%R. intros; field; auto with real1. Qed. Theorem combine_halves : forall x, (1/2 * (1/2 *x) = 1/4*x)%R. intros; field; auto with real1. Qed. Theorem half_half2 : forall x, (1/2 * x/2 = 1/4 * x)%R. intros;field; auto with real1. Qed. Theorem half_half2' : forall x, (1/2 * (x/2) = 1/4 * x)%R. intros;field; auto with real1. Qed. Theorem Rmult_distr_half : forall x y, (1/2*(x+y) = 1/2*x+1/2*y)%R. intros; apply Rmult_plus_distr_l. Qed. Theorem Rmult_distr_fourth : forall x y, (1/4*(x+y) = 1/4*x+1/4*y)%R. intros; apply Rmult_plus_distr_l. Qed. Theorem double_distr_halves : forall x y, 2*(x/2+y/2)=x+y. intros; field; auto with real1. Qed. Theorem double_fourth : forall x, 2*(1/4*x)=1/2*x. intros; field; auto with real1. Qed. Theorem double_fourth' : forall x, 2*(1/(2*1+2*1)*x)=1/2 * x. intros; field. apply prod_neq_R0; auto with real1. apply tech_Rplus; auto with real. Qed. Theorem Rdiv_0 : forall x, (0 / x) = 0. intros; unfold Rdiv; apply Rmult_0_l. Qed. Theorem double_fourth_plus : forall x y, 2*(1/4*x + y) = 1/2*x+2*y. intros; field; auto with real1. Qed. Theorem double_plus_minus : forall x y z, 2*(x + y - z) = 2*x + (2* y - 2* z). intros; ring. Qed. Theorem double_plus_plus : forall x y z, 2*(x + y + z) = 2*x + (2* y + 2* z). intros; ring. Qed. Hint Rewrite half_half half_half2' half_half2 combine_halves simpl_div4 simpl_div2 fourth_plus_distr half_plus_distr Rmult_distr_half double_fourth double_fourth' double_distr_halves Rdiv_0 Rmult_0_r Rplus_0_l Rplus_0_r double_fourth_plus double_plus_minus double_plus_plus: real1. Lemma pow2_larger : forall n, (INR n <= 2^n)%R. induction n. simpl; fourier. replace (S n) with (1+n)%nat. rewrite pow_add; rewrite pow_1. assert (Hlem: (forall a b, 1<= b -> a<=b -> 1+a<= 2*b)%R). intros; fourier. rewrite plus_INR; simpl (INR 1). apply Hlem; auto. apply pow_R1_Rle;fourier. omega. Qed. Open Scope Z_scope. Theorem INR_Zabs_nat_eq : forall z, 0 <= z -> (IZR z = INR(Zabs_nat z))%R. unfold Zabs_nat. intros z; case z. simpl. intros; auto. unfold IZR. intros; auto. compute. intros x H'; elim H'; auto. Qed. Lemma Rlt_neq_0 : forall r, (0 < r)%R -> (r <> 0)%R. intros r Hpos; replace r with (0 + r)%R. apply tech_Rplus. fourier. auto. field. Qed. Lemma pow_half_smaller : forall r, (0 < r)%R -> (1/(2^(Zabs_nat(up (1/r)))) <= r)%R. intros r Hpos. elim (archimed (1/r)); intros Harc1 Harc2. apply (Rmult_le_reg_l (2^(Zabs_nat (up (1/r))))). apply pow_lt. fourier. replace (2 ^ Zabs_nat (up (1 / r)) * (1 / 2 ^ Zabs_nat (up (1 / r))))%R with 1%R. apply Rle_trans with ((INR (Zabs_nat (up (1/r))))*r)%R. rewrite <- INR_Zabs_nat_eq. pattern 1%R at 1; replace 1%R with (1/r * r)%R. apply Rmult_le_compat_r. fourier. fourier. field. apply Rlt_neq_0; assumption. apply le_IZR. apply Rle_trans with (1/r)%R. replace (1/r)%R with (/r)%R. simpl IZR. assert (0 < / r)%R. apply Rinv_0_lt_compat; auto. fourier. field. apply Rlt_neq_0; auto. fourier. apply Rmult_le_compat_r. fourier. apply pow2_larger. field. apply pow_nonzero. apply (not_O_IZR 2);omega. Qed. Lemma Zmult_non0 : forall x y, x <> 0-> y<> 0 -> x*y <> 0. intros x y H H1 H2; elim (Zmult_integral _ _ H2); intuition. Qed. Lemma Zmult_non_0_r : forall x y, x*y <> 0 -> y <> 0. intros x y H H1; apply H; rewrite H1; ring. Qed. Lemma Zpower_not_0 : forall x n, 0 <= n -> x <> 0 -> x ^ n <> 0. intros x n; elim n using (well_founded_ind (Zwf_well_founded 0)). clear n; intros n Hrec Hpos Hn0; elim (Z_le_gt_dec n 0). intros Hneg. replace n with 0; simpl; omega. intros Hgt; replace n with ((n-1)+1);[idtac|ring]. rewrite Zpower_exp; try omega. replace (x ^ 1) with x. apply Zmult_non0. apply Hrec. unfold Zwf; omega. omega. assumption. assumption. unfold Zpower, Zpower_pos, iter_pos; ring. Qed. Theorem Rle_plus_minus : forall a b c, (a <= b + c -> a - b <= c)%R. intros; fourier. Qed. Theorem simpl_div2' : forall x, (2*x/2 = x)%R. intros; field; auto with real1. Qed. Theorem simpl_div2'' : forall x, (2*(1/2*x) = x)%R. intros; field; auto with real1. Qed. Theorem simpl_double_fourth : forall x, (2*(1/4*x) = 1/2*x)%R. intros; field; auto with real1. Qed. Theorem half_minus_distr : forall x y, ((x-y)/2=x/2-y/2)%R. intros; field; auto with real1. Qed. Theorem double_minus_distr : forall x y, (2*(x - y) = 2*x -2*y)%R. intros; apply Rmult_minus_distr_l. Qed. Theorem double_plus_distr : forall x y, (2*(x + y) = 2*x + 2*y)%R. intros; apply Rmult_plus_distr_l. Qed. Theorem fourth_double : forall x, (1/4*(2*x) = 1/2*x)%R. intros; field; auto with real1. Qed. Hint Rewrite half_minus_distr simpl_div2' simpl_div2'' simpl_double_fourth fourth_double : real1. Hint Rewrite double_minus_distr double_plus_distr : real2. Theorem infinit_sum_cv : forall An l, infinit_sum An l -> Un_cv (fun n => sum_f_R0 An n) l. unfold infinit_sum, Un_cv; auto. Qed. Theorem sum_cv_infinit_sum : forall An l, Un_cv (fun n => sum_f_R0 An n) l -> infinit_sum An l. unfold infinit_sum, Un_cv; auto. Qed. Theorem infinit_sum_ext : forall (An Bn : nat -> Rdefinitions.R) (l:Rdefinitions.R), (forall n, An n = Bn n) -> infinit_sum An l -> infinit_sum Bn l. unfold infinit_sum. intros An Bn l Hext Hinf. intros eps Hepspos; elim (Hinf eps Hepspos); intros n Hdist. exists n; intros p Hpgen; apply Rle_lt_trans with (2:=Hdist p Hpgen). rewrite (sum_eq An Bn p);auto with real. Qed. Theorem infinit_sum_step : forall (An : nat -> Rdefinitions.R) (l:Rdefinitions.R), infinit_sum An l -> infinit_sum (fun i => An (i+1)%nat) (l-An 0%nat)%R. unfold infinit_sum. intros An l H. intros eps Hepspos; elim (H eps Hepspos); intros n Hdist. exists (n+1)%nat; intros p Hpgen; generalize (Hdist (p+1)%nat). rewrite (tech2 An 0 (p+1)%nat). simpl sum_f_R0. unfold R_dist. replace (sum_f_R0 (fun i : nat => An (S i)) (p + 1 - 1)%nat) with (sum_f_R0 (fun i => An (i+1)%nat) p). replace (p + 1 - 1)%nat with p. match goal with |- (_ -> (Rabs ?x < eps)%R) -> (Rabs ?y < eps)%R => replace x with y;[intros H'; apply H'; clear H'| ring] end. omega. rewrite plus_comm; rewrite minus_plus;auto. rewrite plus_comm; rewrite minus_plus. apply (sum_eq (fun i => An (i+1)%nat) (fun i => An (S i)) p). intros; replace (S i) with (i+1)%nat; auto; ring. omega. Qed. Theorem infinit_sum_bound : forall An Bn l1 l2, (forall n, (An n <= Bn n)%R) -> infinit_sum An l1 -> infinit_sum Bn l2 -> (l1 <= l2)%R. intros An Bn l1 l2 Hextle Hinf1 Hinf2. apply Rle_cv_lim with (fun i => sum_f_R0 An i)(fun i => sum_f_R0 Bn i). intros n; apply sum_Rle. intros; apply Hextle. apply infinit_sum_cv;assumption. apply infinit_sum_cv;assumption. Qed. Theorem bound_infinit_sum : forall An Bn l, (forall n, 0 <= An n <= Bn n)%R -> infinit_sum Bn l -> (exists l2, infinit_sum An l2 /\ (0 <= l2 <= l)%R). intros An Bn l H Hinf. assert (Hcv1 := infinit_sum_cv Bn l Hinf). assert (Hcv := Rseries_CV_comp An Bn H (existT (fun l => Un_cv (fun i => sum_f_R0 Bn i) l) l Hcv1)). destruct Hcv as [l2 Hcv]. exists l2; split. apply sum_cv_infinit_sum; assumption. split. apply infinit_sum_bound with (fun i:nat => 0%R) (fun i => An i). intros n; elim (H n);intros; assumption. intros eps; exists 0%nat. intros. rewrite sum_eq_R0. rewrite R_dist_eq. fourier. auto. apply infinit_sum_ext with An. auto. apply sum_cv_infinit_sum; auto. apply infinit_sum_bound with An Bn. intros n; elim (H n); auto. apply sum_cv_infinit_sum;auto. apply sum_cv_infinit_sum;auto. Qed. Lemma tech_div : forall x y, x<> 0%R -> (x * y * (1/x) = y)%R. intros; field; auto. Qed. Theorem Z_of_nat_Zabs_nat : forall x, 0 <= x -> Z_of_nat(Zabs_nat x) = x. intros x Hle;destruct x. auto. unfold Zabs_nat. rewrite Zpos_eq_Z_of_nat_o_nat_of_P. auto. assert False. apply Hle; auto. contradiction. Qed. Theorem Zabs_nat_1 : Zabs_nat 1 = 1%nat. auto. Qed. Theorem Zabs_nat_le : forall x y, 0 <= x <= y -> (Zabs_nat x <= Zabs_nat y)%nat. intros x y [Hx Hxy]. assert (Hy:0 <= y). omega. destruct x. auto with arith. destruct y. elim Hxy; auto. unfold Zabs_nat. assert (Hxy' : ~Zpos p0 < Zpos p). omega. unfold Zlt, Zcompare in Hxy'. elim (le_lt_dec (nat_of_P p)(nat_of_P p0)). auto. intros Hlt. unfold Zle, Zcompare in Hxy. rewrite (nat_of_P_lt_Lt_compare_complement_morphism _ _ Hlt) in Hxy'. elim Hxy';auto. elim Hxy;auto. elim Hx;auto. Qed. Theorem Zabs_nat_plus : forall x y, 0 <= x -> 0 <= y -> (Zabs_nat (x + y) = Zabs_nat x + Zabs_nat y)%nat. intros; unfold Zabs_nat, Zplus. destruct x. auto. destruct y. ring_nat. apply nat_of_P_plus_morphism. elim H0;auto. elim H;auto. Qed. Theorem Zabs_nat_mult : forall x y, Zabs_nat (x * y) = (Zabs_nat x * Zabs_nat y)%nat. intros; unfold Zabs_nat, Zmult. destruct x. ring_nat. destruct y. ring_nat. apply nat_of_P_mult_morphism. apply nat_of_P_mult_morphism. destruct y. ring_nat. apply nat_of_P_mult_morphism. apply nat_of_P_mult_morphism. Qed. Theorem Zabs_nat_minus : forall n p, 0 < n < p -> Zabs_nat (p - n) = (Zabs_nat p - Zabs_nat n)%nat. intros n p H. assert (0 < p - n). omega. assert (0 < p). omega. decompose [and] H. caseEq (p - n). intros; assert (False). omega. contradiction. caseEq p. intros; assert (False). omega. contradiction. caseEq n. intros; assert (False). omega. contradiction. simpl. intros n' Heqn' p' Heqp' v Heqv. assert (H' : p > n). omega. rewrite Heqn' in H'; rewrite Heqp' in H'. unfold Zgt in H'; simpl in H'. rewrite H' in Heqv. injection Heqv; intros; subst v. apply nat_of_P_minus_morphism. assumption. intros n' Hneg; rewrite Hneg in H2;inversion H2. intros p' Hneg; rewrite Hneg in H1;inversion H1. intros p' Hneg; rewrite Hneg in H0;inversion H0. Qed. Theorem Zpower_le_0_compat : forall k i, 0 <= k -> 0 <= k ^ i. intros k i Hkpos;elim i using (well_founded_ind (Zwf_well_founded 0)). clear i; intros i IHi. destruct (Z_le_gt_dec 0 i) as [Hipos | Hineg]. destruct (Z_eq_dec i 0) as [Hi0 | Hin0]. subst i; compute; intros; discriminate. replace i with (1+(i-1))%Z. rewrite Zpower_exp. replace (k^1) with k. apply Zmult_le_0_compat. assumption. apply IHi. unfold Zwf; omega. simpl; unfold Zpower_pos; simpl; ring. omega. omega. ring. destruct i. discriminate Hineg. discriminate Hineg. simpl; auto with zarith. Qed. Theorem power_IZR : forall k i, IZR (k ^ Z_of_nat i) = (IZR k ^ i)%R. intros k; induction i. auto. simpl pow. replace (Z_of_nat (S i)) with (1+Z_of_nat i)%Z. rewrite Zpower_exp. replace (k ^ 1) with k. rewrite mult_IZR; rewrite IHi; auto. simpl; unfold Zpower_pos; simpl;ring. omega. omega. replace (S i) with (1 + i)%nat. rewrite inj_plus;auto. ring_nat. Qed. Theorem Rdiv_pow : forall a b i, b <> 0%R -> ((a/b)^i = a^i/b^i)%R. intros a b i H; induction i. simpl; field; auto with real. simpl; rewrite IHi; field. repeat apply prod_neq_R0; try apply pow_nonzero; try assumption. Qed. Theorem tech_inv_IZR : forall k, k <> 0 -> k <> 1 -> (1/IZR k <> 1)%R. intros. intro H'. generalize (Rinv_r (IZR k) (not_O_IZR k H)). unfold Rdiv in H';rewrite Rmult_1_l in H';rewrite H'. rewrite Rmult_1_r; intros H1; generalize (eq_IZR _ 1 H1);intros;omega. Qed. Theorem tech_exp : forall p k n, 1 < k -> (0 < p -> sum_f_R0 (fun i => (1/(p * (IZR(k^Z_of_nat i))))%R) n <= (1/p*(IZR k/(IZR k - 1))))%R. intros p k n Hk Hp. rewrite <- (sum_eq (fun i => (((1/IZR k)^ i)*(1/p))%R)). rewrite <- (scal_sum (fun i => ((1/IZR k)^ i)%R)). rewrite tech3. apply Rmult_le_compat_l. unfold Rdiv; apply Rle_mult_inv_pos. fourier. assumption. replace ((1 - (1/IZR k)^S n)/(1-1/IZR k))%R with (IZR k/(IZR k - 1) - 1/((IZR k - 1)*(IZR k)^n))%R. unfold Rminus. match goal with |- (_ <= ?x)%R => pattern x at 2;replace x with (x+0)%R end. apply Rplus_le_compat_l. replace 0%R with (-0)%R. apply Ropp_le_contravar. unfold Rdiv; apply Rle_mult_inv_pos. fourier. apply Rmult_lt_0_compat. replace (-1)%R with (IZR (-1)). rewrite <- plus_IZR. apply (IZR_lt 0). omega. apply (Ropp_Ropp_IZR 1). apply pow_lt. apply (IZR_lt 0). omega. ring. ring. simpl. rewrite Rdiv_pow. rewrite pow1. assert ((IZR k <> 0)%R). apply not_O_IZR. omega. assert (((IZR k + -1) <> 0)%R). replace (-1)%R with (IZR (- 1)). rewrite <- plus_IZR. apply not_O_IZR. omega. apply (Ropp_Ropp_IZR 1). assert ((IZR k ^ n <> 0)%R). apply pow_nonzero; auto. field; auto with real. repeat apply prod_neq_R0; auto with real. fold (Rminus 1 (1*/IZR k)). apply Rminus_eq_contra. fold (Rdiv 1 (IZR k)). apply sym_not_eq. apply tech_inv_IZR; omega. apply not_O_IZR;omega. apply tech_inv_IZR; omega. intros i _; rewrite Rdiv_pow. rewrite (power_IZR k i). rewrite pow1. field. assert ((p <> 0)%R). apply sym_not_equal; apply Rlt_not_eq;assumption. assert ((IZR k ^ i)%R <> 0%R). apply pow_nonzero. apply not_O_IZR;omega. repeat apply prod_neq_R0; assumption. apply not_O_IZR;omega. Qed. Theorem tech_le : forall a b c, 0< a -> 0 < b -> a*c <= b -> (IZR c * (1/IZR b) <= 1/IZR a)%R. intros; apply Rmult_le_reg_l with (IZR a * IZR b)%R. rewrite <- mult_IZR;apply (IZR_lt 0); apply Zmult_lt_O_compat;assumption. replace (IZR a * IZR b * (IZR c * (1/IZR b)))%R with (IZR a * IZR c)%R. replace (IZR a * IZR b * (1/IZR a))%R with (IZR b). rewrite <- mult_IZR; apply IZR_le; assumption. field;apply Rlt_neq_0; apply (IZR_lt 0);assumption. field;apply Rlt_neq_0; apply (IZR_lt 0);assumption. Qed. Hint Resolve Rplus_le_le_0_compat Rmult_le_pos Rlt_le : real2. Theorem cv_ext : forall f g : nat -> Rdefinitions.R, (forall n, f n = g n) -> forall l, Un_cv f l -> Un_cv g l. intros f g Hext l; unfold Un_cv. intros Hcv1 eps Hpos; destruct (Hcv1 eps Hpos) as [n H];exists n. intros n'; rewrite <- Hext; auto. Qed. Theorem Zmax_le1 : forall a b, a <= b -> Zmax a b = b. intros a b Hle; unfold Zmax. generalize (Zcompare_elim (a=b) True False a b); case (Zcompare a b); intuition. Qed. Theorem Zmax_le2 : forall a b, b <= a -> Zmax a b = a. intros a b Hle; unfold Zmax. generalize (Zcompare_elim (a=b) False True a b); case (Zcompare a b); intuition. Qed. Theorem Rdiv_le_0_compat : forall x y, (0 <= x -> 0 < y -> 0 <= x / y)%R. intros x y H H1; replace (x / y)%R with (x * /y)%R. apply Rmult_le_pos. assumption. assert (0 < /y)%R. apply Rinv_0_lt_compat;auto. fourier. field. apply Rlt_neq_0;auto. Qed. Theorem Rmult_div_assoc : forall a b c, (c <> 0 -> a * (b/c) = a*b /c)%R. intros; field; auto. Qed.