Library Coqtail.Reals.Rpow_facts

Require Import Reals MyRIneq Fourier.
Require Import Rsequence_usual_facts.

Open Local Scope R_scope.

Lemma pow_lt_compat : x y, 0 xx < y
   n, (1 n)%natx ^ n < y ^ n.
Proof.
intros x y x_pos x_lt_y n n_lb.
 induction n.
 apply False_ind ; intuition.
 destruct n.
 simpl ; repeat (rewrite Rmult_1_r) ; assumption.
 assert (Hrew : a n, a ^ S (S n) = a × a ^ S n).
  intros a m ; simpl ; reflexivity.
 destruct x_pos as [x_pos | x_null].
 do 2 rewrite Hrew.
  repeat (rewrite Hrew) ; apply Rmult_gt_0_lt_compat ; [apply pow_lt | | | apply IHn] ; intuition.
  apply Rlt_gt ; transitivity x ; assumption.
 rewrite Hrew, <- x_null, Rmult_0_l ; apply pow_lt ;
  apply Rle_lt_trans with x ; [right |] ; auto.
Qed.

Lemma pow_le_compat : x y, 0 xx y
  n, x ^ n y ^ n.
Proof.
intros x y x_pos x_lt_y n.
induction n.
simpl ; apply Req_le ; reflexivity.
simpl ; apply Rmult_le_compat ; [| apply pow_le | |] ; assumption.
Qed.

Lemma pow2_sqr : r, r² = r ^ 2.
Proof.
intros ; rewrite <- (mult_1_r 2), pow_Rsqr, pow_1 ; reflexivity.
Qed.

Lemma pow2_pos : r, 0 r ^ 2.
Proof.
intro r ; rewrite <- pow2_sqr ; apply Rle_0_sqr.
Qed.

Lemma Rsqrt_sqr : x (y : nonnegreal),
  0 x → (x ^ 2 = y)%RRsqrt y = x.
Proof.
intros x y x_pos Heq ; unfold Rsqrt.
 destruct (Rsqrt_exists y (cond_nonneg y)) as [z [z_pos Hz]].
 apply Rsqr_inj ; try assumption.
 symmetry ; rewrite pow2_sqr, Heq ; apply Hz.
Qed.

Lemma Rsqr_Rsqrt : x, Rsqrt x ^ 2 = x.
Proof.
intro ; simpl ; rewrite <- Rmult_assoc, Rsqrt_Rsqrt ; apply Rmult_1_r.
Qed.

Lemma Rsqrt_mult_distr : (x y z : nonnegreal), x × y = z
  Rsqrt z = Rsqrt x × Rsqrt y.
Proof.
intros x y z Heq ; apply Rsqr_inj.
 apply Rsqrt_positivity.
 apply Rmult_le_pos ; apply Rsqrt_positivity.
 rewrite Rsqr_mult.
 unfold Rsqr ; do 3 rewrite Rsqrt_Rsqrt ; auto.
Qed.

Lemma Rsqrt_pow_even : r n, Rsqrt r ^ (2 × n) = r ^ n.
Proof.
intros r n ; rewrite pow_sqr, Rsqrt_Rsqrt ; reflexivity.
Qed.

Lemma sum_pow : (q : R) (m k : nat),
  q 1 →
  sum_f_R0 (fun i : natq ^ (m + i)) k = q^m × (1 - q ^ S k) / (1 - q).
Proof.
intros q m k q_neq_1.
 induction m.
  assert (H := tech3 q k q_neq_1) ; rewrite Rmult_1_l ; rewrite <- H ; unfold pow ; simpl ;
  apply sum_eq ; intros i i_ub ; intuition.
 replace (sum_f_R0 (fun i : natpow q (S m + i)) k) with (q × (sum_f_R0 (fun i : natpow q (m + i)) k)).
 rewrite IHm ; simpl ; unfold Rdiv ; repeat (rewrite Rmult_assoc) ; repeat (apply Rmult_eq_compat_l) ;
 reflexivity.
 clear ; induction k.
 simpl ; intuition.
 simpl ; rewrite Rmult_plus_distr_l ; rewrite IHk ; apply Rplus_eq_compat_l ; apply Rmult_eq_compat_l.
 unfold pow ; replace (k + S m)%nat with (S (k + m))%nat by intuition ; simpl ; reflexivity.
Qed.

Lemma Rpser_cv_speed_pow_id : x : R, Rabs x < 1 →
     Un_cv (fun n : natINR (S n) × x ^ S n) 0.
Proof.
intros x x_bd eps eps_pos.
 case (Req_or_neq x) ; intro Hx.
   0%nat ; intros ; unfold R_dist ; rewrite Rminus_0_r ;
  rewrite Hx ; rewrite pow_i ; [| intuition] ; rewrite Rmult_0_r ; rewrite Rabs_R0 ;
  assumption.
 assert (H : Un_cv (fun n/INR (S n)) 0).
  apply cv_infty_cv_R0.
  intros n Hf ; replace 0 with (INR 0) in Hf by intuition.
  discriminate (INR_eq _ _ Hf).
  intro B ; assert (0 IZR (up (Rabs B))).
  apply Rle_trans with (Rabs B) ; [apply Rabs_pos |] ;
  apply Rge_le ; left ; apply (proj1 (archimed (Rabs B))).
  assert (H1 : (0 up (Rabs B))%Z).
  apply le_IZR ; assumption.
  destruct (IZN (up (Rabs B)) H1) as (N, HN) ; N ;
  intros n n_lb ; apply Rlt_le_trans with (INR (S N)).
  apply Rlt_trans with (IZR (up (Rabs B))).
  apply Rle_lt_trans with (Rabs B) ; [apply RRle_abs |] ;
  apply (proj1 (archimed (Rabs B))).
  rewrite HN.
  rewrite <- INR_IZR_INZ.
  intuition.
  intuition.
  assert (Rinv_r_pos : 0 < (1 + 1 / Rabs x) / 2 - 1).
   apply Rlt_Rminus ; apply Rle_lt_trans with ((1 + 1)/2).
   right ; field.
   unfold Rdiv ; apply Rmult_lt_compat_r.
   apply Rinv_0_lt_compat ; intuition.
   apply Rplus_lt_compat_l ; rewrite Rmult_1_l ; rewrite <- Rinv_1 ;
   apply Rinv_lt_contravar.
   rewrite Rmult_1_r ; apply Rabs_pos_lt ; assumption.
   assumption.
   pose (k := (1 + Rabs x) / 2).
   assert (k_pos : 0 k).
    unfold k ; replace 0 with (0/2) by field ; unfold Rdiv ; apply Rmult_le_compat_r.
    left ; apply Rinv_0_lt_compat ; intuition.
    apply Rle_zero_pos_plus1 ; apply Rabs_pos.
 assert (k_lt_1 : ((1 + Rabs x) / 2) < 1).
  apply Rlt_le_trans with ((1 + 1) /2).
  unfold Rdiv ; apply Rmult_lt_compat_r.
  apply Rinv_0_lt_compat ; intuition.
  apply Rplus_lt_compat_l ; assumption.
  right ; field.
  assert (Main : M eps, 0 < eps → 0 < M N, n, (n N)%nat
             M × ((1 + Rabs x) / 2) ^ n < eps).
   clear -k_lt_1 k_pos ; intros M eps eps_pos M_pos ;
   assert (r_bd : 0 (1 + Rabs x) / 2 < 1) by intuition ;
   destruct (Rseq_pow_lt_1_cv ((1 + Rabs x) / 2) r_bd (eps / M)) as (N, HN).
   unfold Rdiv ; apply Rmult_lt_0_compat ; [| apply Rinv_0_lt_compat] ; assumption.
    N ; intros n n_lb.
   apply Rlt_le_trans with (M × (eps / M)).
   apply Rmult_lt_compat_l.
   assumption.
   replace (((1 + Rabs x) / 2) ^ n) with (Rabs (((1 + Rabs x) / 2) ^ n - 0)).
   apply HN ; assumption.
   rewrite Rminus_0_r ; apply Rabs_right.
   apply Rle_ge ; apply pow_le ; assumption.
   right ; field ; apply Rgt_not_eq ; assumption.
   destruct (H ((1 + 1 / Rabs x) / 2 - 1) Rinv_r_pos) as (N, HN).
assert (Temp : M i : nat, (M S N)%natRabs (INR (i + S M) × x ^ (i + S M)) <
        (1 + Rabs x) / 2 × Rabs (INR (i + M) × x ^ (i + M))).
 intros M i M_lb.
 apply Rle_lt_trans with (Rabs ((INR (i + S M) / (INR (i + M))) × ((INR (i + M)) × x ^ (i + S M)))).
 right ; apply Rabs_eq_compat ; field ; apply Rgt_not_eq ; intuition.
 replace (i + S M)%nat with (S (i + M))%nat by intuition ;
 rewrite <- tech_pow_Rmult.
 repeat (rewrite Rabs_mult ; rewrite <- Rmult_assoc).
 apply Rmult_lt_compat_r.
 apply Rabs_pos_lt ; apply pow_nonzero ; assumption.
 rewrite Rmult_comm, <- Rmult_assoc.
 apply Rmult_lt_compat_r.
 apply Rabs_pos_lt ; apply Rgt_not_eq ; intuition.
 replace (INR (S (i + M)) / INR (i + M)) with (1 + / INR (i + M)).
 apply Rlt_le_trans with (Rabs x × (1 + 1 / Rabs x) / 2).
 unfold Rdiv ; rewrite Rmult_assoc ; apply Rmult_lt_compat_l.
 apply Rabs_pos_lt ; assumption.
 rewrite Rabs_right.
 assert (Temp : a b c, b < c - aa + b < c).
  clear ; intros ; fourier.
 apply Temp.
 replace (/INR (i + M)) with (R_dist (/INR (S (i + pred M))) 0).
 apply HN ; intuition.
 unfold R_dist ; rewrite Rminus_0_r ; replace (S (i + pred M))%nat with (i + M)%nat.
 apply Rabs_right ; left ; apply Rinv_0_lt_compat ; intuition.
 intuition.
 apply Rle_ge ; apply Rle_zero_pos_plus1.
 left ; apply Rinv_0_lt_compat ; intuition.
 right ; field.
 apply Rgt_not_eq ; apply Rabs_pos_lt ; assumption.
 replace (INR (S (i + M))) with (1 + INR (i + M)).
 field ; apply Rgt_not_eq ; intuition.
 replace (S (i + M)) with (1 + (i + M))%nat by intuition ; rewrite S_O_plus_INR.
 intuition.
 pose (An_0 := Rabs (INR (S N))).
 assert (An_0_pos : 0 < An_0 × Rabs x ^ (S N)).
  apply Rmult_lt_0_compat.
  unfold An_0 ; apply Rabs_pos_lt ; apply Rgt_not_eq ; intuition.
  apply pow_lt ; apply Rabs_pos_lt ; assumption.
 destruct (Main (An_0 × Rabs x ^ (S N)) eps eps_pos An_0_pos) as (N2, HN2).
  (N2 + S N)%nat ; intros n n_lb.
 fold k in Temp.
 assert (Temp2 : i : nat,
      (fun i0 : natRabs (INR (i0 + S N) × x ^ (i0 + S N))) (S i) <
      k × (fun i0 : natRabs (INR (i0 + S N) × x ^ (i0 + S N))) i).
 intro i.
 replace (S i + S N)%nat with (i + S (S N))%nat by ring.
 apply Temp ; intuition.
 clear Temp.
 unfold R_dist, Rminus ; rewrite Ropp_0 ; rewrite Rplus_0_r.
 assert (Temp : m n, (m n)%nat{p | (m = n + p)%nat}).
   clear ; intros m n ; induction n ; intro H.
    m ; intuition.
   case (le_lt_eq_dec _ _ H) ; clear H ; intro H.
   assert (H' : (m n)%nat) by intuition.
   destruct (IHn H') as (p, Hp) ; destruct p.
    0%nat ; apply False_ind ; intuition.
    p ; intuition.
    0%nat ; intuition.
  destruct (Temp n (N2 + S N)%nat n_lb) as (p,Hp).
  rewrite Hp. replace (S (N2 + S N + p))%nat with ((S N2 + p) + S N)%nat by intuition.
 assert (H' := tech4 (fun i : natRabs (INR (i + S N) × x ^ (i + S N))) k
             (S N2 + p) k_pos Temp2).
 apply Rle_lt_trans with (Rabs (INR (0 + S N) × x ^ (0 + S N)) × k ^ (S N2 + p)).
 apply H'.
 simpl (0 + S N)%nat ; rewrite Rabs_mult ; fold An_0 ; unfold k ; rewrite <- RPow_abs ;
 apply HN2.
 intuition.
Qed.