(*
(C) Copyright 2010, COQTAIL team

Project Info: http://sourceforge.net/projects/coqtail/

This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Lesser General Public License as published by
the Free Software Foundation; either version 2.1 of the License, or
(at your option) any later version.

This library is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301,
USA.
*)

Require Import Ranalysis_def.
Require Import Rpser_def.
Require Import Rpser_facts.
Require Import Rsequence.
Require Import Rsequence_facts.
Require Import Rseries_def.
Require Import Rseries_facts.
Require Import RFsequence_facts.

Require Import Cpser_def.
Require Import CFsequence.
Require Import CFsequence_facts.
Require Import Csequence.
Require Import Csequence_facts.
Require Import Cmet.
Require Import Cnorm.
Require Import Cprop_base.

Require Import Canalysis_def.
Require Import Canalysis_cont.
Require Import Canalysis_deriv.
Require Import Canalysis_basic_facts.

Open Local Scope C_scope.

Lemma Rseq_norm_abs_Cre :
forall (An : nat -> C), {l | Rseq_cv (fun n => sum_f_R0 (fun n =>(Cnorm (An n))) n) l} ->
{l | Rseq_cv (fun n => sum_f_R0 (fun n =>(Rabs (Cre (An n))))n) l}.
Proof.
intros An H.
apply Rseries_CV_comp with (fun n0 : nat => Cnorm (An n0)) .
intros n. split.
apply Rabs_pos.
apply Cre_le_Cnorm.
exact H.
Qed.

Lemma Rseq_norm_abs_Cim :
forall (An : nat -> C), {l | Rseq_cv (fun n => sum_f_R0 (fun n =>(Cnorm (An n)))n) l} ->
{l | Rseq_cv (fun n => sum_f_R0 (fun n =>(Rabs (Cim (An n))))n) l}.
Proof.
intros An H.
apply Rseries_CV_comp with (fun n0 : nat => Cnorm (An n0)) .
intros n. split.
apply Rabs_pos.
apply Cim_le_Cnorm.
exact H.
Qed.

Lemma Cseq_norm_Rseq :
forall (An : nat -> C), {l | Rseq_cv (fun n => sum_f_R0 (fun n =>(Cnorm (An n)))n) l} ->
{l | Cseq_cv (fun n => sum_f_C0 (fun n =>((An n)))n) l}.
Proof.
intros An H.
generalize (Rseq_norm_abs_Cim An H).
generalize (Rseq_norm_abs_Cre An H).
intros Hre Him.
assert ( H1 : {l : R |
      Rseq_cv
        (fun n : nat => sum_f_R0 (fun n0 : nat => Cim (An n0)) n) l}).
apply (Rser_abs_cv_cv  (fun n0 : nat => Cim (An n0))).
unfold Rser_abs_cv.
unfold Rseq_abs.
apply Him.
assert ( H2 : {l : R |
      Rseq_cv
        (fun n : nat => sum_f_R0 (fun n0 : nat => Cre (An n0)) n) l}).
apply (Rser_abs_cv_cv  (fun n0 : nat => Cre (An n0))).
unfold Rser_abs_cv.
unfold Rseq_abs.
apply Hre.
destruct H1 as (lim, H1).
destruct H2 as (lre, H2).
exists (lre +i lim).
apply <- Cseq_Rseq_Rseq_equiv.
split. simpl.
assert ((fun n : nat => Cre (sum_f_C0 (fun n0 : nat => An n0) n)) ==
(fun n : nat => sum_f_R0 (fun n0 : nat => Cre (An n0)) n)).
unfold "==".
intros n. rewrite <- sum_f_C0_Cre_compat. reflexivity.
apply (Rseq_cv_eq_compat (fun n : nat => sum_f_R0 (fun n0 : nat => Cre (An n0)) n)
(fun n : nat => Cre (sum_f_C0 (fun n0 : nat => An n0) n))).
apply Rseq_eq_sym. assumption.
assumption.
assert ((fun n : nat => Cim (sum_f_C0 (fun n0 : nat => An n0) n)) ==
(fun n : nat => sum_f_R0 (fun n0 : nat => Cim (An n0)) n)).
unfold "==".
intros n. rewrite <- sum_f_C0_Cim_compat. reflexivity.
apply (Rseq_cv_eq_compat (fun n : nat => sum_f_R0 (fun n0 : nat => Cim (An n0)) n)
(fun n : nat => Cim (sum_f_C0 (fun n0 : nat => An n0) n))).
apply Rseq_eq_sym. assumption.
assumption.
Qed.

Lemma Cpser_abel : forall (An : nat -> C) (r : R),
     Cv_radius_weak An r -> forall x, Cnorm x < r -> {l | Pser An x l}.
Proof.
intros An r Rho x x_ub.
 case (Req_or_neq r) ; intro r_0.
 exists 0 ; apply False_ind ; rewrite r_0 in x_ub ; assert (0 <= Cnorm x). apply Cnorm_pos. fourier.
assert (Hrew_abs : (Cnorm (x / r) = Cnorm x / r)%R).
 unfold Cdiv, Rdiv ; rewrite Cnorm_Cmult ; apply Rmult_eq_compat_l ;
 replace (/r) with (IRC (/r)). rewrite Cnorm_IRC_Rabs.
 apply Rabs_right.
 left ; apply Rinv_0_lt_compat ; apply Rle_lt_trans with (Cnorm x) ;
 [apply Cnorm_pos | assumption].
 CusingR_f ; assumption.
assert (Rabsx_r_lt_1 : Cnorm x / r < 1).
 apply Rle_lt_trans with (Cnorm x / r * (r / r))%R.
 right ; field ; assumption.
 replace 1%R with (r / r)%R by (field ; assumption).
 unfold Rdiv ; rewrite <- Rmult_assoc.
 apply Rmult_lt_compat_r.
 apply Rinv_0_lt_compat ; apply Rle_lt_trans with (Cnorm x) ;
 [apply Cnorm_pos | assumption].
 rewrite Rmult_assoc ; rewrite Rinv_l ; [| assumption] ; rewrite Rmult_1_r ; assumption.

 assert (Rho' : Rpser_def.Cv_radius_weak (fun n : nat => Cnorm (An n)) r).
 destruct Rho as [M HM] ; exists M.
 intros u [n Hn] ; rewrite Hn ; unfold gt_abs_Pser.
 unfold gt_norm_Pser in HM.
 replace (Rabs (Cnorm (An n) * r ^ n))%R with (Cnorm (An n * r ^ n))%R.
 apply HM ; exists n ; reflexivity.
 rewrite Rabs_mult ; replace (Rabs (r ^ n))%R with (Rabs (Cnorm r ^ n))%R.
 rewrite <- Rabs_mult, <- Cnorm_pow, <- Cnorm_Cmult, Rabs_Cnorm ; reflexivity.
 rewrite <- Cnorm_pow, IRC_pow_compat, Cnorm_IRC_Rabs, Rabs_Rabsolu ;
 reflexivity.
 rewrite <- Rabs_Cnorm in x_ub.
 assert (Cnorm_cauchy := Cauchy_crit_partial_sum
    (fun n => Cnorm (An n)) r Rho' (Cnorm x) x_ub).

assert (T : Rseries.Cauchy_crit (sum_f_R0 (fun n : nat => Cnorm (An n * x ^ n)))).
 intros eps eps_pos ; destruct (Cnorm_cauchy eps eps_pos) as [N HN] ;
 exists N ; intros m n m_lb n_lb.

assert (Hrew : forall An x n, sum_f_R0 (fun n0 : nat => Cnorm (An n0 * x ^ n0)) n
      = sum_f_R0 (Rpser_def.gt_Pser (fun n0 : nat => Cnorm (An n0)) (Cnorm x)) n).
 clear ; intros An x n ; induction n.
 unfold Rpser_def.gt_Pser ; simpl ; rewrite Cnorm_Cmult, Cnorm_C1 ;
 reflexivity.
 simpl sum_f_R0 ; rewrite IHn ; apply Rplus_eq_compat_l ;
 unfold Rpser_def.gt_Pser ; simpl ; repeat rewrite Cnorm_Cmult ;
 rewrite Cnorm_pow ; reflexivity.
repeat rewrite Hrew ; rewrite R_dist_sym ; apply HN ; assumption.

 destruct (Cseq_norm_Rseq (fun n => An n * x ^ n) (R_complete _ T)) as [l Hl] ;
 exists l ; apply Hl.
Qed.

(** Definition of the sum of a power serie (0 outside the cv-disc) and proof that it's really the sum *)

Definition weaksum_r (An : nat -> C) (r : R) (Pr : Cv_radius_weak An r) : C -> C.
Proof.
intros An r Rho x.
 case (Rlt_le_dec (Cnorm x) r) ; intro x_bd.
 elim (Cpser_abel _ _ Rho _ x_bd) ; intros y Hy ; exact y.
 exact 0.
Defined.

Lemma weaksum_r_sums : forall (An : nat -> C) (r : R) (Pr : Cv_radius_weak An r) (x : C),
      Cnorm x < r -> Pser An x (weaksum_r An r Pr x).
Proof.
intros An r Pr x x_bd.
 unfold weaksum_r ; case (Rlt_le_dec (Cnorm x) r) ; intro s.
 destruct (Cpser_abel An r Pr x s) as (l,Hl) ; simpl ; assumption.
 apply False_ind ; fourier.
Qed.

Lemma weaksum_r_unique : forall (An : nat -> C) (r : R) (Pr1 Pr2 : Cv_radius_weak An r) (x : C),
     Cnorm x < r -> weaksum_r An r Pr1 x = weaksum_r An r Pr2 x.
Proof.
intros An r Pr1 Pr2 x x_bd ;
 assert (T1 := weaksum_r_sums _ _ Pr1 _ x_bd) ;
 assert (T2 := weaksum_r_sums _ _ Pr2 _ x_bd) ;
 eapply Pser_unique ; eassumption.
Qed.

Lemma weaksum_r_unique_strong : forall (An : nat -> C) (r1 r2 : R) (Pr1 : Cv_radius_weak An r1)
     (Pr2 : Cv_radius_weak An r2) (x : C), Cnorm x < r1 -> Cnorm x < r2 ->
     weaksum_r An r1 Pr1 x = weaksum_r An r2 Pr2 x.
Proof.
intros An r1 r2 Pr1 Pr2 x x_bd1 x_bd2.
  assert (T1 := weaksum_r_sums _ _ Pr1 _ x_bd1) ;
  assert (T2 := weaksum_r_sums _ _ Pr2 _ x_bd2) ;
 eapply Pser_unique ; eassumption.
Qed.

Definition sum_r (An : nat -> C) (r : R) (Pr : finite_cv_radius An r) : C -> C.
Proof.
intros An r Pr x.
 case (Rlt_le_dec (Cnorm x) r) ; intro x_bd.
  assert (rho : Cv_radius_weak An (middle (Cnorm x) r)).
  apply Pr; split.
  apply Rle_trans with (Cnorm x).
   apply Cnorm_pos.
   left ; apply (proj1 (middle_is_in_the_middle _ _ x_bd)).
   apply (proj2 (middle_is_in_the_middle _ _ x_bd)).
 apply (weaksum_r An (middle (Cnorm x) r) rho x).
 exact 0.
Defined.

Lemma sum_r_sums : forall  (An : nat -> C) (r : R) (Pr : finite_cv_radius An r),
      forall x, Cnorm x < r -> Pser An x (sum_r An r Pr x).
Proof.
intros An r Pr x x_ub.
 unfold sum_r ; destruct (Rlt_le_dec (Cnorm x) r) as [x_bd | x_nbd].
 apply weaksum_r_sums.
 apply (proj1 (middle_is_in_the_middle _ _ x_bd)).
  apply False_ind ; fourier.
Qed.

Lemma sum_r_unique : forall (An : nat -> C) (r : R) (Pr1 Pr2 : finite_cv_radius An r) (x : C),
     Cnorm x < r -> sum_r An r Pr1 x = sum_r An r Pr2 x.
Proof.
intros An r Pr1 Pr2 x x_bd ;
 assert (T1 := sum_r_sums _ _ Pr1 _ x_bd) ;
 assert (T2 := sum_r_sums _ _ Pr2 _ x_bd) ;
 eapply Pser_unique ; eassumption.
Qed.

Lemma sum_r_unique_strong : forall (An : nat -> C) (r1 r2 : R) (Pr1 : finite_cv_radius An r1)
     (Pr2 : finite_cv_radius An r2) (x : C), Cnorm x < r1 -> Cnorm x < r2 ->
     sum_r An r1 Pr1 x = sum_r An r2 Pr2 x.
Proof.
intros An r1 r2 Pr1 Pr2 x x_bd1 x_bd2 ;
 assert (T1 := sum_r_sums _ _ Pr1 _ x_bd1) ;
 assert (T2 := sum_r_sums _ _ Pr2 _ x_bd2) ;
 eapply Pser_unique ; eassumption.
Qed.

Definition sum (An : nat -> C) (Pr : infinite_cv_radius An) : C -> C.
Proof.
intros An Pr r.
 apply (weaksum_r An (Cnorm r +1) (Pr (Cnorm r + 1)%R) r).
Defined.

Lemma sum_sums : forall  (An : nat -> C) (Pr : infinite_cv_radius An),
      forall x, Pser An x (sum An Pr x).
Proof.
intros An Pr x.
 apply weaksum_r_sums ; intuition.
Qed.

Lemma sum_unique : forall (An : nat -> C) (Pr1 Pr2 : infinite_cv_radius An) (x : C),
      sum An Pr1 x = sum An Pr2 x.
Proof.
intros An Pr1 Pr2 x ;
 assert (T1 := sum_sums  _ Pr1 x) ;
 assert (T2 := sum_sums  _ Pr2 x) ;
 eapply Pser_unique ; eassumption.
Qed.

(** Abel's lemma : Normal convergence of the power serie *)

Lemma Cpser_abel2_prelim : forall (An : nat -> C) (r : R),
     Cv_radius_weak An r -> forall x, Cnorm x < r ->
     { l | Pser_norm An x l}.
Proof.
intros An r Rho x x_bd.
 assert (Rho' : Rpser_def.Cv_radius_weak (fun n => Cnorm (An n)) r).
  destruct Rho as [B HB] ; exists B ; intros u [n Hn] ; rewrite Hn ; apply HB ;
  exists n ; unfold gt_abs_Pser, gt_norm_Pser.
  rewrite Rabs_mult, Cnorm_Cmult, Rabs_Cnorm ; apply Rmult_eq_compat_l ;
  rewrite IRC_pow_compat, Cnorm_IRC_Rabs ; reflexivity.
 rewrite <- Rabs_Cnorm in x_bd ; pose (l := Rpser_facts.weaksum_r _ _ Rho' (Cnorm x)) ;
 exists l ; unfold Pser_norm, Pser, infinite_sum.
 assert (Hl := Rpser_facts.weaksum_r_sums _ _ Rho' (Cnorm x) x_bd) ;
 unfold Rseries.Pser, Rfunctions.infinite_sum in Hl.

 assert (Hrew : forall n, IRC (sum_f_R0 (fun n0 : nat => (Cnorm (An n0) * Cnorm x ^ n0)%R) n) =
                  sum_f_C0 (fun n0 : nat => Cnorm (An n0) * Cnorm x ^ n0) n).
 clear ; intro n ; induction n.
  simpl ; rewrite Cmult_1_r, Rmult_1_r ; reflexivity.
  simpl ; rewrite <- IHn.
  rewrite Cadd_IRC_Rplus ; apply Cadd_eq_compat_l.
  repeat (rewrite Cmult_IRC_Rmult ; apply Cmult_eq_compat_l).
  rewrite IRC_pow_compat ; reflexivity.
  intros eps eps_pos ; destruct (Hl _ eps_pos) as [N HN] ;
  exists N ; intros n n_lb ; simpl ; unfold C_dist.
  rewrite <- Hrew, <- Cminus_IRC_Rminus, Cnorm_IRC_Rabs ;
  apply HN ; assumption.
Qed.

Lemma Cpser_abel2 : forall (An : nat -> C) (r : R),
     Cv_radius_weak An r -> forall r0 : posreal, r0 < r ->
     CVN_r (fun n x => gt_Pser An x n) r0.
Proof.
intros An r Pr r0 r0_ub.
 destruct r0 as (a,a_pos).
 assert (a_bd : Rabs a < r).
  rewrite Rabs_right ; [| apply Rgt_ge ; apply Rlt_gt] ; assumption.
 assert (r_pos : 0 < r).
  apply Rlt_trans with a ; assumption.
 assert (r'_bd : Rabs ((a + r) / 2) < r).
  rewrite Rabs_right.
  assert (Hrew : r = ((r+r)/2)%R) by field ; rewrite Hrew at 2; unfold Rdiv ;
  apply Rmult_lt_compat_r ; [apply Rinv_0_lt_compat ; intuition |] ;
  apply Rplus_lt_compat_r ; rewrite Rabs_right in a_bd ; intuition.
  apply Rle_ge ; unfold Rdiv ; replace 0%R with (0 * /2)%R by field ;
  apply Rmult_le_compat_r ; fourier.
 assert (r'_bd2 : Cnorm (Rabs ((a + r) / 2)) < r).
 rewrite Cnorm_IRC_Rabs, Rabs_Rabsolu ; assumption.
 assert (Pr' := Cv_radius_weak_Cnorm_compat2 _ _ Pr).
 exists (gt_abs_Pser (fun n => Cnorm (An n)) ((a+r)/2)).
 exists (Rpser_facts.weaksum_r (fun n => Cnorm (An n)) r Pr' (Rabs ((a+r)/2))) ; split.
 rewrite Cnorm_IRC_Rabs in r'_bd2 ;
 assert (H := Rpser_facts.weaksum_r_sums (fun n => Cnorm (An n)) r Pr' (Rabs ((a + r) / 2)) r'_bd2).
 assert (Main := Pser_Rseqcv_link _ _ _ H).
 intros eps eps_pos ; destruct (Main eps eps_pos) as (N, HN) ; exists N.
  assert (Hrew : forall k, Cnorm (gt_abs_Pser (fun n => Cnorm (An n)) ((a + r) / 2) k)
  = Rpser_def.gt_Pser (fun n0 : nat => Cnorm (An n0)) (Rabs ((a + r) / 2)) k).
   intro k ; unfold gt_abs_Pser, Rpser_def.gt_Pser.
   rewrite Cnorm_IRC_Rabs, Rabs_Rabsolu, Rabs_mult, <- RPow_abs, Rabs_Cnorm ;
   reflexivity.
 assert (Temp : forall n, sum_f_R0 (fun k : nat =>
             Cnorm (gt_abs_Pser (fun n0 : nat => Cnorm (An n0)) ((a + r) / 2) k)) n
            = sum_f_R0 (Rpser_def.gt_Pser (fun n0 : nat => Cnorm (An n0)) (Rabs ((a + r) / 2))) n).
   intros n ; clear -Hrew ; induction n ; simpl ; rewrite Hrew ; [| rewrite IHn] ; reflexivity.
  intros n n_lb ; rewrite Temp ; apply HN ; assumption.
 intros n y Hyp ; unfold gt_Pser, gt_abs_Pser.
 rewrite Rabs_mult, Rabs_Cnorm ; repeat rewrite Cnorm_Cmult, Cnorm_IRC_Rabs,
 Rabs_mult, Rabs_right.
 apply Rmult_le_compat_l.
 apply Cnorm_pos.
 rewrite Rabs_Rabsolu.
 rewrite <- Cnorm_IRC_Rabs ; rewrite <- IRC_pow_compat ;
 repeat rewrite Cnorm_pow ; apply pow_incr ; split ; [apply Cnorm_pos |].
 unfold Boule in Hyp ; simpl in Hyp ; unfold C_dist in Hyp ;
 rewrite Cnorm_minus_sym, Cminus_0_r in Hyp.
 apply Rle_trans with a ; [left ; assumption |].
 rewrite Cnorm_IRC_Rabs, Rabs_right.
 apply Rle_trans with ((a + a) / 2)%R ; [right ; field | unfold Rdiv ;
 apply Rmult_le_compat_r ; [fourier | apply Rplus_le_compat_l ; left ; assumption]].
 unfold Rdiv ; apply Rle_ge ; apply Rle_mult_inv_pos ; fourier.
 apply Rle_ge ; apply Cnorm_pos.
Qed.

Lemma Rminus_Rlt : forall a b, 0 < a - b -> b < a.
Proof.
intros a b H.
 replace b with (b + 0)%R by ring.
 replace a with (b + (a - b))%R by ring.
 apply Rplus_lt_compat_l ; assumption.
Qed.

Lemma Cpser_alembert_prelim : forall (An : nat -> C) (M : R),
       0 < M -> (forall n : nat, An n <> C0) ->
       Cseq_bound (fun n => (An (S n) / An n)) M -> forall r,
       Rabs r < / M -> Cv_radius_weak An r.
Proof.
intros An M M_pos An_neq An_frac_ub r r_bd.
 assert (r_lb := Rabs_pos r) ; case r_lb ; clear r_lb ; intro rabs_lb.
 assert (my_lam : 0 < /Rabs r - M).
 apply Rgt_minus ; rewrite <- Rinv_involutive.
 apply Rinv_lt_contravar.
 apply Rmult_lt_0_compat ; [| apply Rlt_trans with (Rabs r)] ; assumption.
 assumption.
 apply Rgt_not_eq ; assumption.
 exists (Cnorm (An 0%nat)) ; intros x Hyp ;
  elim Hyp ; intros n Hn ; rewrite Hn ;
  unfold gt_norm_Pser ; rewrite Cnorm_Cmult.
  clear Hn ; induction n.
  simpl ; rewrite Cnorm_C1 ; rewrite Rmult_1_r ; right ; reflexivity.
  apply Rle_trans with (Cnorm (An (S n) / (An n)) * Cnorm (An n) * Cnorm (r ^ S n))%R.
  right ; repeat rewrite <- Cnorm_Cmult ; apply Cnorm_eq_compat ;
  field ; apply An_neq.
  apply Rle_trans with (M * Cnorm (An n) * Cnorm (r ^ S n))%R.
  repeat apply Rmult_le_compat_r ; [| | apply An_frac_ub] ; apply Cnorm_pos.
  simpl ; rewrite Cnorm_Cmult.
  apply Rle_trans with (M * Cnorm (An n) * (/M * Cnorm (r ^ n)))%R.
  repeat rewrite <- Rmult_assoc ; apply Rmult_le_compat_r ; [apply Cnorm_pos |
  repeat rewrite Rmult_assoc ; repeat apply Rmult_le_compat_l].
  left ; assumption.
  apply Cnorm_pos.
  rewrite Cnorm_IRC_Rabs ; left ; assumption.
  apply Rle_trans with (Cnorm (An n) * Cnorm (r ^ n))%R ; [right ; field ;
  apply Rgt_not_eq |] ; assumption.
 exists (Cnorm (An 0%nat)).
  intros x Hx ; destruct Hx as (n,Hn) ; rewrite Hn ; unfold gt_abs_Pser ; destruct n.
  right ; apply Cnorm_eq_compat ; ring.
  destruct (Req_dec r 0) as [Hr | Hf].
  rewrite Hr ; unfold gt_norm_Pser ; rewrite Cnorm_Cmult, Cnorm_pow,
  Cnorm_IRC_Rabs, RPow_abs, pow_i, Rabs_R0, Rmult_0_r ;
  [apply Cnorm_pos | intuition].
  apply False_ind ; assert (T := Rabs_no_R0 _ Hf) ;
  apply T ; symmetry ; assumption.
Qed.

Lemma Cpser_alembert_prelim2 : forall (An : nat -> C) (M : R),
       0 < M -> (forall n : nat, An n <> C0) ->
       Cseq_eventually (fun Un => Cseq_bound Un M) (fun n => (An (S n) / An n)) ->
       forall r, Rabs r < / M -> Cv_radius_weak An r.
Proof.
intros An M M_pos An_neq An_frac_event r r_bd.
destruct An_frac_event as [N HN].
 assert (Rho : Cv_radius_weak (fun n => (An (N + n)%nat)) r).
  apply Cpser_alembert_prelim with M.
  assumption.
  intro n ; apply An_neq.
  intro n ; replace (N + S n)%nat with (S (N + n)) by intuition ; apply HN.
  assumption.
 apply Cv_radius_weak_padding_neg_compat with N ;
 destruct Rho as [T HT] ; exists T ; intros u Hu ; destruct Hu as [n Hn] ;
 rewrite Hn ; unfold gt_norm_Pser ; rewrite plus_comm ; apply HT ;
 exists n ; reflexivity.
Qed.

Lemma Cpser_alembert_prelim3 : forall (An : nat -> C) (lambda : C),
       0 < Cnorm (lambda) -> (forall n : nat, An n <> C0) ->
       Rseq_cv (fun n : nat => Cnorm (An (S n) / An n)) (Cnorm lambda) -> forall r,
       Rabs r < / (Cnorm lambda) -> Cv_radius_weak An r.
Proof.
intros An lam lam_pos An_neq An_frac_cv r r_bd.
 assert (middle_lb := proj1 (middle_is_in_the_middle _ _ r_bd)).
 assert (middle_ub := proj2 (middle_is_in_the_middle _ _ r_bd)).
 assert (middle_pos : 0 < middle (Rabs r) (/Cnorm lam)).
  apply Rle_lt_trans with (Rabs r) ; [apply Rabs_pos | assumption].
 pose (eps := (/ (middle (Rabs r) (/ Cnorm lam)) - Cnorm lam)%R).
 assert (eps_pos : 0 < eps).
  apply Rgt_minus ; rewrite <- Rinv_involutive.
  apply Rinv_lt_contravar.
  apply Rmult_lt_0_compat ; [| apply Rinv_0_lt_compat] ; assumption.
  assumption.
  apply Rgt_not_eq ; assumption.
 apply Cpser_alembert_prelim2 with (Cnorm lam + eps)%R.
 fourier.
 apply An_neq.
 destruct (An_frac_cv (/ (middle (Rabs r) (/ Cnorm lam)) - Cnorm lam))%R as [N HN].
 assumption.
 exists N ; intro n.
 apply Rle_trans with (Cnorm lam + (Cnorm (An (S (N + n)) / An (N + n)%nat)
      - Cnorm lam))%R.
 right ; ring.
 apply Rplus_le_compat_l ; apply Rle_trans with
   (R_dist (Cnorm (An (S (N + n)) / An (N + n)%nat)) (Cnorm lam))%R.
 apply RRle_abs.
 left ; apply HN ; intuition.
 replace (Cnorm lam + eps)%R with (/ (middle (Rabs r) (/ Cnorm lam)))%R.
 rewrite Rinv_involutive ; [| apply Rgt_not_eq] ; assumption.
 unfold eps ; ring.
Qed.

Lemma Cpser_alembert_prelim4 : forall (An : nat -> C),
       (forall n : nat, An n <> C0) ->
       Rseq_cv (fun n : nat => Cnorm (An (S n) / An n)) R0 ->
       infinite_cv_radius An.
Proof.
intros An An_neq An_frac_0 r.
 assert (eps_pos : 0 < /(Rabs r + 1)).
  apply Rinv_0_lt_compat ; apply Rplus_le_lt_0_compat ; [apply Rabs_pos |
  apply Rlt_0_1].
 apply Cpser_alembert_prelim2 with (/(Rabs r + 1))%R.
 assumption.
 apply An_neq.
 destruct (An_frac_0 (/ (Rabs r + 1))%R eps_pos) as [N HN] ; exists N ; intro n.
 apply Rle_trans with (R_dist (Cnorm (An (S (N + n)) / An (N + n)%nat)) 0) ; [right |].
 unfold R_dist in |-* ; rewrite Rminus_0_r, Rabs_right ; [reflexivity | apply Rle_ge ;
 apply Cnorm_pos].
 left ; apply HN ; intuition.
 rewrite Rinv_involutive ; [fourier |] ; apply Rgt_not_eq ;
 apply Rplus_le_lt_0_compat ; [apply Rabs_pos | apply Rlt_0_1].
Qed.

Lemma Cpser_bound_criteria (An : nat -> C) (z l : C) :
    Pser An z l -> Cv_radius_weak An (Cnorm z).
Proof.
intros An z l Hzl.
 destruct Hzl with R1 as (N, HN) ; [fourier |].
 assert (H1 : forall n :  nat, (n >= S N)%nat -> gt_norm_Pser An z n
    <= Rmax 2 (Cnorm (An 0%nat) + 1)).
  intros n Hn ; case_eq n ; unfold gt_norm_Pser.
  intro H ; simpl ; rewrite Cmult_1_r ; apply Rle_trans with (Cnorm (An 0%nat) +1)%R ;
   [intuition | apply RmaxLess2].
   intros m Hrew ; replace (Cnorm (An (S m) * z ^ S m)) with
         (Cnorm ((sum_f_C0 (fun n0 : nat => An n0 * z ^ n0) (S m) - l) +
         (l - sum_f_C0 (fun n0 : nat => An n0 * z ^ n0) m))).
    apply Rle_trans with (Rplus (Cnorm (sum_f_C0 (fun n0 : nat => An n0 * z ^ n0)%C (S m) - l))
          (Cnorm (l - sum_f_C0 (fun n0 : nat => An n0 * z ^ n0) m))).
  apply Cnorm_triang.
   apply Rle_trans with 2 ; [|apply RmaxLess1] ; apply Rlt_le ; apply Rplus_lt_compat ;
   [| rewrite Cnorm_minus_sym].
   apply Rle_lt_trans with (dist C_met (sum_f_C0 (fun n0 : nat => An n0 * z ^ n0)
         (S m)) l).
  right ; simpl ; unfold C_dist ; reflexivity.
  apply HN ; intuition.
  apply Rle_lt_trans with (dist C_met (sum_f_C0 (fun n0 : nat => An n0 * z ^ n0) m) l).
  right ; simpl ; unfold C_dist ; reflexivity.
  apply HN ; intuition.
   simpl sum_f_C0 ; apply Cnorm_eq_compat.
   simpl ; ring.
   destruct (Cseq_partial_bound (gt_Pser An z) (S N)) as (B,HB).
   exists (Rmax B (Rmax 2 (Cnorm (An 0%nat) + 1))).
   intros y Hy ; destruct Hy as [u Hu] ; rewrite Hu.
   case (le_lt_dec u (S N)) ; intro Hu_b.
   apply Rle_trans with B.
   unfold gt_norm_Pser ; rewrite Cnorm_Cmult, Cnorm_pow, Cnorm_invol.
   rewrite <- Cnorm_pow. rewrite <- Cnorm_Cmult.
   apply HB ; assumption.
   apply RmaxLess1.
   unfold gt_norm_Pser ; rewrite Cnorm_Cmult.
   rewrite Cnorm_pow, Cnorm_invol, <- Cnorm_pow, <- Cnorm_Cmult.
   apply Rle_trans with (Rmax 2 (Cnorm (An 0%nat) + 1)) ; [apply H1 | apply RmaxLess2] ; intuition.
Qed.

(** A sufficient condition for the radius of convergence*)
Lemma Cpser_finite_cv_radius_caracterization (An : nat -> C) (z l : C) :
   Pser An z l -> (forall l' : R, ~ Pser_norm An z l')  -> finite_cv_radius An (Cnorm z).
Proof.
intros An z l Hcv Hncv.
split; intros x Hx.

 apply Cv_radius_weak_le_compat with (Cnorm z).
 rewrite Rabs_Cnorm ; rewrite Rabs_right ; intuition.

  apply (Cpser_bound_criteria _ _ l Hcv).

 intro Hf.
 destruct (Cpser_abel2_prelim An x Hf z) as [l' Hl'].
 assumption.
 apply Hncv with l' ; assumption.
Qed.

Lemma Cpser_infinite_cv_radius_caracterization An : (forall x, {l | Pser An x l}) ->
     infinite_cv_radius An.
Proof.
intros An weaksum r ; destruct (weaksum r) as (l, Hl).
 assert (H := Cpser_bound_criteria An r l Hl).
 rewrite Cnorm_IRC_Rabs in H.
 apply Cv_radius_weak_le_compat with (Rabs r).
 rewrite Rabs_Rabsolu ; right ; reflexivity.
 assumption.
Qed.

Lemma Cv_radius_weak_derivable_compat : forall An r,
         Cv_radius_weak An r -> forall r', Rabs r' < Rabs r ->
         Cv_radius_weak (An_deriv An) r'.
Proof.
intros An r rho r' r'_bd.
 assert (Rabsr_pos : 0 < Rabs r).
  apply Rle_lt_trans with (Rabs r') ; [apply Rabs_pos | assumption].
 assert (x_lt_1 : Rabs (r'/ r) < 1).
  unfold Rdiv ; rewrite Rabs_mult ; rewrite Rabs_Rinv.
  replace R1 with (Rabs r *  / Rabs r)%R.
  apply Rmult_lt_compat_r ; [apply Rinv_0_lt_compat |] ; assumption.
  apply Rinv_r ; apply Rgt_not_eq ; assumption.
  intro Hf ; rewrite Hf, Rabs_R0 in Rabsr_pos ; apply (Rlt_irrefl _ Rabsr_pos).
  destruct rho as (B,HB).
  case (Req_or_neq r') ; intro r'_lb.
  exists (Cnorm (An 1%nat)) ; intros x Hx ; destruct Hx as (i, Hi) ;
 rewrite Hi ; unfold gt_norm_Pser, An_deriv.
 destruct i.
 simpl ; rewrite Cmult_1_l, Cmult_1_r ; apply Rle_refl.
 rewrite r'_lb ; rewrite IRC_pow_compat, pow_i ; [| intuition] ;
 repeat rewrite Cmult_0_r, Cnorm_C0 ; apply Cnorm_pos.
 assert (Rabsr'_pos : 0 < Rabs r') by (apply Rabs_pos_lt ; assumption).
 destruct (Rpser_cv_speed_pow_id (r' / r) x_lt_1 (Rabs r') Rabsr'_pos) as (N, HN).
 destruct (Rseq_partial_bound (gt_norm_Pser (An_deriv An) r') N) as (B2, HB2).
 exists (Rmax B B2) ; intros x Hx ; destruct Hx as (i, Hi) ;
 rewrite Hi ; unfold gt_norm_Pser in * ; case (le_lt_dec i N) ; intro H.
 apply Rle_trans with B2 ; [rewrite <- Rabs_Cnorm ; apply HB2 | apply RmaxLess2] ;
 assumption.
 apply Rle_trans with (Cnorm (/r' * (INC (S i) * (r' / r) ^ S i) * An (S i) * r ^ S i)).
 right ; apply Cnorm_eq_compat ; unfold An_deriv ; field_simplify.
 unfold Cdiv ; repeat (rewrite Cmult_assoc) ; repeat (apply Cmult_eq_compat_l).
  rewrite Cpow_mul_distr_l.
 rewrite Cinv_1 ; rewrite Cmult_1_r.
 rewrite Cmult_assoc.
 replace ((/ r) ^ S i * (r ^ S i * / r')) with (/ r').
 simpl ; field ; auto with complex.
 assert (r_neq : r <> R0).
  intro Hf ; rewrite Hf, Rabs_R0 in Rabsr_pos ; elim (Rlt_irrefl _ Rabsr_pos).
 rewrite <- Cpow_inv.
 rewrite <- Cmult_assoc.
 field ; split.
 auto with complex.
 apply Cpow_neq_compat ; auto with complex.
  auto with complex.
 auto with complex.
 apply Rle_trans with (Cnorm (/ r' * (INC (S i) * (r' / r) ^ S i)) * B)%R.
 rewrite Cmult_assoc, Cnorm_Cmult ; apply Rmult_le_compat_l ;
 [apply Cnorm_pos |] ; apply HB ; exists (S i) ; reflexivity.
 apply Rle_trans with (1*B)%R ; [| rewrite Rmult_1_l ; apply RmaxLess1].
 apply Rmult_le_compat_r.
 apply Rle_trans with (Cnorm (An 0%nat * r ^ 0)) ; [apply Cnorm_pos |] ;
 apply HB ; exists 0%nat ; reflexivity.
 rewrite Cnorm_Cmult ; apply Rle_trans with (Cnorm (/r') * Cnorm r')%R.
 apply Rmult_le_compat_l.
 apply Cnorm_pos.
 apply Rle_trans with (Cnorm ((INC (S i) * (r' / r) ^ S i) - 0)).
 right ; rewrite Cminus_0_r ; reflexivity.
 apply Rle_trans with (R_dist (INR (S i) * (r' / r) ^ S i) 0)%R.
 right ; unfold R_dist ; rewrite <- Cnorm_IRC_Rabs ; apply Cnorm_eq_compat.
 rewrite Cminus_IRC_Rminus ; unfold Rminus ; apply Cadd_eq_compat_r.
 rewrite Cmult_IRC_Rmult, IRC_INR_INC ; apply Cmult_eq_compat_l.
 rewrite <- IRC_pow_compat, Cdiv_IRC_Rdiv.
 reflexivity.
  intro Hf ; rewrite Hf, Rabs_R0 in Rabsr_pos ; elim (Rlt_irrefl _ Rabsr_pos).
  rewrite Cnorm_IRC_Rabs ; left ; apply HN ; intuition.
 rewrite <- Cnorm_Cmult ; rewrite Cinv_l ; [| auto with complex] ; rewrite Cnorm_C1 ; right ; trivial.
Qed.

(** Derivability of partial sums *)

Definition Cpser_partial_sum_derive An n x := match n with
     | 0%nat => C0
     | S _      => sum_f_C0 (gt_Pser (An_deriv An) x) (pred n)
end.

Lemma Cpser_derive_finite_sum : forall An n x,
       derivable_pt_lim (fun x => sum_f_C0 (gt_Pser An x) n) x (Cpser_partial_sum_derive An n x).
Proof.
intros An n x ;
 unfold Cpser_partial_sum_derive, gt_Pser, An_deriv ;
 apply (derivable_pt_lim_partial_sum An x n).
Qed.

(** Sum of the formal derivative *)

Definition weaksum_r_derive (An : nat -> C) (r : R) (Rho : Cv_radius_weak An r) (z : C) : C.
Proof.
intros An r Rho z ; case (Rlt_le_dec (Cnorm z) r) ; intro z_bd.
 pose (r' := middle (Cnorm z)  (Rabs r)).
 assert (r_pos : Rabs r = r).
  apply Rabs_right ; left ; apply Rle_lt_trans with (Cnorm z) ;
  [apply Cnorm_pos | assumption].
 assert (r'_bd : Rabs r' < Rabs r).
  assert (H := proj2 (middle_is_in_the_middle _ _ z_bd)).
  rewrite <- r_pos in H.
  apply Rle_lt_trans with r'.
  right ; apply Rabs_right ; apply Rle_ge ; apply Rle_trans with (Cnorm z) ;
  rewrite <- r_pos in z_bd ;  [apply Cnorm_pos | left ;
  apply (proj1 (middle_is_in_the_middle _ _ z_bd))].
  apply H.
 apply (weaksum_r (An_deriv An) r'
      (Cv_radius_weak_derivable_compat An r Rho r' r'_bd) z).
apply C0.
Defined.

Definition sum_r_derive (An : nat -> C) (r : R) (Rho : finite_cv_radius An r) (z : C) : C.
Proof.
intros An r Rho z.
 destruct (Rlt_le_dec (Cnorm z) r) as [z_bd | z_gt].
 assert (H : 0 <= middle (Cnorm z) r < r).
  split.
  left ; apply middle_le_lt_pos ; [| apply Rle_lt_trans with (Cnorm z) ; [| assumption]] ;
  apply Cnorm_pos.
  apply (middle_is_in_the_middle _ _ z_bd).
 apply (weaksum_r_derive _ _ (proj1 Rho (middle (Cnorm z) r) H) z).
 apply 0.
Defined.

Definition sum_derive (An : nat -> C) (Rho : infinite_cv_radius An) (z : C) : C.
Proof.
 intros An Rho z ; apply (weaksum_r_derive _ _ (Rho (Cnorm z + 1)%R) z).
Defined.

Lemma weaksum_r_derive_sums : forall (An : nat -> C) (r : R) (Pr : Cv_radius_weak An r) (z : C),
      Cnorm z < r -> Pser (An_deriv An) z (weaksum_r_derive An r Pr z).
Proof.
intros An r Pr z z_bd.
 unfold weaksum_r_derive ; case (Rlt_le_dec (Cnorm z) r) ; intro s.
 rewrite <- Rabs_right in z_bd.
 apply weaksum_r_sums ; apply (proj1 (middle_is_in_the_middle _ _ z_bd)).
 apply Rle_ge ; apply Rle_trans with (Cnorm z) ; [apply Cnorm_pos | left ; assumption].
 assert (H : Cnorm z < Cnorm z) by (apply Rlt_le_trans with r ; assumption) ;
 elim (Rlt_irrefl _ H).
Qed.

Lemma weaksum_r_derive_unique : forall (An : nat -> C) (r : R) (Pr1 Pr2 : Cv_radius_weak An r) (z : C),
      Cnorm z < r -> weaksum_r_derive An r Pr1 z = weaksum_r_derive An r Pr2 z .
Proof.
intros An r Pr1 Pr2 z z_bd ;
 assert (T1 := weaksum_r_derive_sums _ _ Pr1 _ z_bd) ;
 assert (T2 := weaksum_r_derive_sums _ _ Pr2 _ z_bd).
 eapply Pser_unique ; eassumption.
Qed.

Lemma sum_r_derive_sums : forall (An : nat -> C) (r : R) (Pr : finite_cv_radius An r) (z : C),
      Cnorm z < r -> Pser (An_deriv An) z (sum_r_derive An r Pr z).
Proof.
intros An r Pr z z_bd ; unfold sum_r_derive ;
 destruct (Rlt_le_dec (Cnorm z) r) as [z_bd2 | Hf].
 apply weaksum_r_derive_sums ; apply (middle_is_in_the_middle _ _ z_bd).
 assert (F : r < r) by (apply Rle_lt_trans with (Cnorm z) ; assumption) ;
 destruct (Rlt_irrefl _ F).
Qed.

Lemma sum_r_derive_unique : forall (An : nat -> C) (r : R) (Pr1 Pr2 : finite_cv_radius An r) (z : C),
      Cnorm z < r -> sum_r_derive An r Pr1 z = sum_r_derive An r Pr2 z .
Proof.
intros An r Pr1 Pr2 z z_bd ;
 assert (T1 := sum_r_derive_sums _ _ Pr1 _ z_bd) ;
 assert (T2 := sum_r_derive_sums _ _ Pr2 _ z_bd).
 eapply Pser_unique ; eassumption.
Qed.

Lemma sum_derive_sums : forall (An : nat -> C) (Pr : infinite_cv_radius An) (z : C),
      Pser (An_deriv An) z (sum_derive An Pr z).
Proof.
intros An Pr z ; unfold sum_derive ; apply weaksum_r_derive_sums ; intuition.
Qed.

Lemma sum_derive_unique : forall (An : nat -> C) (Pr1 Pr2 : infinite_cv_radius An) (z : C),
      sum_derive An Pr1 z = sum_derive An Pr2 z .
Proof.
intros An Pr1 Pr2 z ;
 assert (T1 := sum_derive_sums _ Pr1 z) ;
 assert (T2 := sum_derive_sums _ Pr2 z).
 eapply Pser_unique ; eassumption.
Qed.

Lemma derivable_pt_lim_weaksum_r (An:nat->C) (r:R) (Pr : Cv_radius_weak An r) : forall z,
      Cnorm z < r -> derivable_pt_lim (weaksum_r An r Pr) z (weaksum_r_derive An r Pr z).
Proof.
intros An r rho z z_bd.
 assert (r_pos : 0 < r) by (apply Rle_lt_trans with (Cnorm z) ; [apply Cnorm_pos | assumption]).
 pose (midd := middle (Cnorm z) r) ; assert (midd_pos : 0 < midd).
  unfold midd ; apply middle_le_lt_pos ; [apply Cnorm_pos | assumption].
 pose (r' := mkposreal midd midd_pos).
 assert (z_bd' : Cnorm z < midd).
  apply (middle_is_in_the_middle _ _ z_bd).
 assert (r'_ub : r' < r).
  apply (proj2 (middle_is_in_the_middle _ _ z_bd)).

 pose (fn := fun N z => sum_f_C0 (gt_Pser An z) N) ;
 pose (fn' := fun N z => Cpser_partial_sum_derive An N z) ;
 pose (f := weaksum_r An r rho) ;
 pose (g := weaksum_r_derive An r rho).

 assert (z_in : Boule 0 r' z).
  unfold Boule ; simpl ; unfold C_dist ; rewrite Cnorm_minus_sym,
   Cminus_0_r ; assumption.

 assert (fn_deriv : forall (x : C) (n : nat), Boule 0 r' x -> derivable_pt_lim (fn n) x (fn' n x)).
  intros ; apply Cpser_derive_finite_sum.

 assert (fn_cv : CFseq_cv_boule fn f 0 r').
  intros a a_in.
   assert (a_bd : Cnorm a < r).
    unfold Boule in a_in ; simpl in a_in ; unfold C_dist in a_in ;
    rewrite Cnorm_minus_sym, Cminus_0_r in a_in.
    apply Rlt_trans with midd ; assumption.
  assert (H := weaksum_r_sums An r rho a a_bd).
  intros eps eps_pos ; destruct (H eps eps_pos) as [N HN] ; exists N ;
  intros n n_lb ; unfold fn, f ; simpl in HN ; unfold C_dist in HN.
  apply HN ; assumption.

assert (cv : forall z : C, Boule 0 r' z ->  {l : C |  Cseq_cv (fun N : nat =>
                    CFpartial_sum (fun n : nat => (fun (n0 : nat) (z0 : C) =>
                        gt_Pser (An_deriv An) z0 n0) n z) N) l}).
  intros a a_in.
   exists (weaksum_r_derive An r rho a).
   apply Pser_Cseqcv_link ; apply weaksum_r_derive_sums.
   apply Rlt_trans with r' ; [unfold Boule in a_in ; simpl in a_in ; unfold C_dist in a_in ;
   rewrite Cminus_0_l, Cnorm_opp in a_in ; apply a_in | assumption].

  assert (r''_comp : Rabs (middle r' r) < Rabs r).
  rewrite Rabs_right ; [rewrite Rabs_right |].
  apply (proj2 (middle_is_in_the_middle _ _ r'_ub)).
  left ; assumption.
  left ; apply middle_le_lt_pos.
  left ; unfold r' ; apply middle_le_lt_pos ; [apply Cnorm_pos | assumption].
  assumption.

  assert (rho_An' := Cv_radius_weak_derivable_compat An r rho (middle r' r) r''_comp).
  assert (cvn_r : CVN_r (fun (n : nat) (z : C) => gt_Pser (An_deriv An) z n) r').
   apply Cpser_abel2 with (middle r' r).
   assumption.
   apply (proj1 (middle_is_in_the_middle _ _  r'_ub)).
 assert (fn'_cvu := CVN_CVU_boule (fun n z => gt_Pser (An_deriv An) z n) r' cv cvn_r).
 assert (fn'_cvu2 : CFseq_cvu fn' g 0 r').
 unfold fn', g.
 intros eps eps_pos ; destruct (fn'_cvu _ eps_pos) as [N HN] ; exists (S N) ;
 clear fn'_cvu fn_deriv rho_An' ; intros n y n_lb y_bd.
 assert (H : n = S (pred n)) by intuition ; rewrite H ; clear H ; simpl.
 unfold CFseq_cvu, SFL_interv, CFpartial_sum in HN.
 assert (predn_lb : (N <= pred n)%nat) by intuition.
 assert (Temp := HN (pred n) y predn_lb y_bd).
 destruct (Rlt_le_dec (Cnorm (0 - y)) r') as [H | Hf].
 destruct (cv y H) as [l Hl].
 assert (Hrew : l = weaksum_r_derive An r rho y).
  eapply Cseq_cv_unique ; [apply Hl |] ;
  apply Pser_Cseqcv_link ; apply weaksum_r_derive_sums.
  apply Rlt_trans with r' ; [rewrite Cminus_0_l, Cnorm_opp in H |] ;
  assumption.
  rewrite <- Hrew ; assumption.
  clear - y_bd Hf ; assert (Hf2 : Cnorm (0 - y) < Cnorm (0 - y)) by
  (apply Rlt_le_trans with r' ; assumption) ; elim (Rlt_irrefl _ Hf2).

 assert (g_cont : (forall x : C, Boule 0 r' x -> continuity_pt g x)).
  intros a a_in ; apply CVU_continuity_boule with fn' 0 r'.
  apply fn'_cvu2.
  intros N y y_in ; unfold fn'.
  unfold Cpser_partial_sum_derive ; induction N.
  apply continuity_pt_const ; unfold constant ; intros ; trivial.
  destruct N ; simpl ; [unfold gt_Pser, An_deriv |].
  intros eps eps_pos ; exists R1 ; split ; [apply Rlt_0_1 |] ; intros x [_ Hx] ;
  simpl ; unfold C_dist ; repeat rewrite Cpow_0.
  unfold Cminus ; rewrite Cadd_opp_r, Cnorm_C0 ; assumption.
  apply continuity_pt_add ; [assumption |].
  unfold gt_Pser.
  apply continuity_pt_mult.
  apply continuity_pt_const.
  intros r1 r2 ; unfold An_deriv ; reflexivity.
  apply derivable_continuous ; apply derivable_Cpow.
  assumption.

 exact (CFseq_cvu_derivable fn fn' f g z 0 r' z_in fn_deriv fn_cv fn'_cvu2 g_cont).
Qed.

Lemma derivable_pt_lim_sum_r (An:nat->C) (r:R) (Pr : finite_cv_radius An r) : forall z,
      Cnorm z < r -> derivable_pt_lim (sum_r An r Pr) z (sum_r_derive An r Pr z).
Proof.
intros An r Pr z z_bd eps eps_pos.
 assert (H : 0 <= middle (Cnorm z) r < r).
  split.
  left ; apply middle_le_lt_pos ; [| apply Rle_lt_trans with (Cnorm z) ; [| assumption]] ;
  apply Cnorm_pos.
  apply (middle_is_in_the_middle _ _ z_bd).
 destruct (derivable_pt_lim_weaksum_r _ _ (proj1 Pr (middle (Cnorm z) r) H) _
 (proj1 (middle_is_in_the_middle _ _ z_bd)) _ eps_pos) as [delta Hdelta].
 pose (delta' := Rmin delta (((middle (Cnorm z) r) - Cnorm z) / 2)%R) ;
 assert (delta'_pos : 0 < delta').
  apply Rmin_pos.
   apply delta.
   apply ub_lt_2_pos with (middle (Cnorm z) (middle (Cnorm z) r)) ;
   apply (middle_is_in_the_middle _ _ (proj1 (middle_is_in_the_middle _ _ z_bd))).
  exists (mkposreal delta' delta'_pos) ; intros h h_neq h_bd.

 replace (sum_r An r Pr (z + h)) with (weaksum_r An (middle (Cnorm z) r)
               (proj1 Pr (middle (Cnorm z) r) H) (z + h)).
 replace (sum_r An r Pr z) with (weaksum_r An (middle (Cnorm z) r)
               (proj1 Pr (middle (Cnorm z) r) H) z).
 replace (sum_r_derive An r Pr z) with (weaksum_r_derive An (middle (Cnorm z) r)
              (proj1 Pr (middle (Cnorm z) r) H) z).
 apply Hdelta ; [assumption | apply Rlt_le_trans with delta'] ;
 [assumption | apply Rmin_l].

 unfold sum_r_derive ; destruct (Rlt_le_dec (Cnorm z) r) as [z_bd2 | Hf].
 apply weaksum_r_derive_unique ; apply (middle_is_in_the_middle _ _ z_bd).
 assert (F : r < r) by (apply Rle_lt_trans with (Cnorm z) ; assumption) ;
 destruct (Rlt_irrefl _ F).

 unfold sum_r ; destruct (Rlt_le_dec (Cnorm z) r) as [z_bd2 | Hf].
 apply weaksum_r_unique ; apply (middle_is_in_the_middle _ _ z_bd).
 assert (F : r < r) by (apply Rle_lt_trans with (Cnorm z) ; assumption) ;
 destruct (Rlt_irrefl _ F).

 unfold sum_r ; destruct (Rlt_le_dec (Cnorm (z + h)) r) as [z_bd2 | Hf].
 apply weaksum_r_unique_strong.
 apply Rle_lt_trans with (Cnorm z + Cnorm h)%R.
 apply Cnorm_triang.
 apply Rlt_le_trans with (Cnorm z + ((middle (Cnorm z) r - Cnorm z) / 2))%R.
 apply Rplus_lt_compat_l ; apply Rlt_le_trans with delta' ; [assumption | apply Rmin_r].
 unfold Rminus ; field_simplify ; unfold Rdiv ; rewrite Rinv_1, Rmult_1_r.
 left ; do 2 eapply middle_is_in_the_middle ; assumption.
 eapply middle_is_in_the_middle ; assumption.
 assert (F : r < r).
  apply Rlt_trans with (middle (Cnorm z) r).
  apply Rle_lt_trans with (Cnorm (z + h)).
  assumption.
  apply Rle_lt_trans with (Cnorm z + Cnorm h)%R.
  apply Cnorm_triang.
  apply Rlt_trans with (Cnorm z + ((middle (Cnorm z) r - Cnorm z) / 2))%R.
  apply Rplus_lt_compat_l ; apply Rlt_le_trans with delta' ; [intuition | apply Rmin_r].
  unfold middle ; field_simplify.
  apply Rlt_le_trans with ((2 * Cnorm z + r + r) / 4)%R.
  unfold Rdiv ; apply Rmult_lt_compat_r ; [fourier |].
  apply Rplus_lt_compat_r.
  apply Rle_lt_trans with (2 * Cnorm z + Cnorm z)%R.
  right ; ring.
  apply Rplus_lt_compat_l ; assumption.
  right ; field.
  eapply middle_is_in_the_middle ; assumption.
  destruct (Rlt_irrefl _ F).
Qed.

Lemma derivable_pt_lim_sum (An:nat->C) (Pr : infinite_cv_radius An) : forall z,
      derivable_pt_lim (sum An Pr) z (sum_derive An Pr z).
Proof.
intros An Pr z eps eps_pos.
 assert (H : 0 <= Cnorm z < Cnorm z + 1).
  split ; [apply Cnorm_pos |] ; intuition.
 destruct (derivable_pt_lim_weaksum_r _ _ (Pr (Cnorm z + 1)%R) z (proj2 H) _ eps_pos) as [delta Hdelta].

 pose (delta' := Rmin delta 1) ; assert (delta'_pos : 0 < delta').
  apply Rmin_pos ; [apply delta | apply Rlt_0_1].
 exists (mkposreal _ delta'_pos) ; intros h h_neq h_bd.

 replace (sum An Pr (z + h)) with (weaksum_r An (Cnorm z + 1) (Pr (Cnorm z + 1)%R) (z + h)).
 apply Hdelta.
 assumption.
 apply Rlt_le_trans with delta' ; [assumption | apply Rmin_l].

 unfold sum.
 apply weaksum_r_unique_strong.
 apply Rle_lt_trans with (Cnorm z + Cnorm h)%R.
 apply Cnorm_triang.
 apply Rplus_lt_compat_l ; apply Rlt_le_trans with delta' ;
 [intuition | apply Rmin_r].
 intuition.
Qed.


(**
CoLoR, a Coq library on rewriting and termination.
See the COPYRIGHTS and LICENSE files.

- Frederic Blanqui, 2009-03-25 (setoid)
- Adam Koprowski and Johannes Waldmann, 2008-01
*)

Set Implicit Arguments.

Require Import AMonAlg2 OrdSemiRing2 ATrs LogicUtil RelUtil NatUtil
  AWFMInterpretation Max VecEq Setoid VecOrd Matrix2 VecUtil
  VecArith2.

(***********************************************************************)
(** ** Matrix interpretation over domain tropical. *)

Section MatrixLinearFunction_tropic.

  Variables (matrix_trop : nat -> nat -> Type) (dim argCnt : nat).

  (** [const_trop] being a constant vector of the interpretation of
     size [dim] and [args_trop] representing coefficients for the
     arguments with a [dim x dim] matrix per argument. *)

  Record matrixInt_trop : Type := mkMatrixInt_trop {
    const_trop : vector At dim;
    args_trop : vector (matrix_trop dim dim) argCnt
  }.

End MatrixLinearFunction_tropic.

Implicit Arguments mkMatrixInt_trop [matrix_trop dim argCnt].

Section S.

  Variable Sig: Signature.
  Variable dim : nat.
  Parameter dim_pos : dim > 0.

  (** Matrix based int over domain tropical. *)

  Section Tropical_Dom.

    Notation matrixInt := (matrixInt_trop matrix_trop).

    (* TODO: missing trsInt_ok *)

    Record MatrixMethodConf_trop : Type := mkMatrixMethodConf_trop {
      trsInt_trop : forall f : Sig, matrixInt dim (ASignature.arity f)
    }.

    Notation vec := (vector At dim).
    Definition vec_at0_trop (v : vec) := Vnth v dim_pos .

    Notation "x >> y" := (gtt x y) (at level 70).

    Definition vec_invariant_trop (v : vec) := A0t >> vec_at0_trop v.

    Parameter inv_id_matrix_trop :
      vec_invariant_trop (Vreplace (Vconst A0t dim) dim_pos A1t).

    Section MatrixBasedInt_trop.

      Notation A := At.
      Notation A0 := A0t.
      Notation A1 := A1t.
      Notation eqA := eqAt.
      Notation sid_theoryA := sid_theoryAt.
      Notation ge := get.
      Notation ge_refl := ge_reflt.
      Notation ge_trans := ge_transt.

        (* Define Morphism [vector_plus_mor] to be able to use
           [rewrite] at the Lemma [mint_eval_var_aux] later. *)

      Add Parametric Morphism n : (@vector_plus_trop n) with
        signature (@eq_vec_trop n) ==> (@eq_vec_trop n) ==>
        (@eq_vec_trop n) as vector_plus_mor_trop.

      Proof.
        intros. apply Vforall2n_intro. intros. unfold vector_plus_trop.
        repeat rewrite Vnth_map2.
          (*FIXME: rewrite H does not work even if Vnth is declared as morphism *)
        apply Aplus_mort; apply (Vnth_mor eqAt); hyp.
      Qed.

        (* Add new setoid to be able to use [sym] at [eqA] use later
        in some lemmas. *)

      Add Setoid A eqA sid_theoryA as A_Setoid_trop.

        (* Define [ge] relation to be able to use [trans] for morphism
        of [vec_ge_mor]. *)

      Add Relation A ge
      reflexivity proved by ge_refl
      transitivity proved by ge_trans
        as ge_rel_trop.

        (* Define morphism to be able to rewrite [vec_ge_mor]
        later. *)

      Add Parametric Morphism n : (@vec_ge_trop n) with signature
        (@eq_vec_trop n) ==> (@eq_vec_trop n) ==> iff as
          vec_ge_mor_troptrop.

      Proof.
        unfold vec_ge_trop. intros.
        apply (Vforall2n_mor sid_theoryAt). intuition.
        trans a1. apply eq_ge_compatt. sym. hyp.
        trans a2. hyp. apply eq_ge_compatt. hyp.
        trans a1'. apply eq_ge_compatt. hyp.
        trans a2'. hyp. apply eq_ge_compatt. sym. hyp.
        hyp. hyp.
      Qed.

      Implicit Arguments vec_ge_mor_trop [n x y x0 y0].

        (* Define this relation on [vec_eq] to be able to use
           [symm], etc. *)

      Add Parametric Relation n : (vector At n) (@eq_vec_trop n)
        reflexivity proved by (@eq_vec_refl A eqA sid_theoryA n)
        symmetry proved by (@eq_vec_sym A eqA sid_theoryA n)
          transitivity proved by (@eq_vec_trans A eqA sid_theoryA n)
            as eq_vec_rel_trop.

        (* Add these relations and morphisms to be able to use it rewriting
           and [trans], etc later for matrix.
           Add [mat_eqA] to be able to use rewrite [mat_mult_id_l] *)

      Add Parametric Relation m n : (matrix_trop m n) (@mat_eqA_trop
        m n) reflexivity proved by (@mat_eqA_refl_trop m n) symmetry
      proved by (@mat_eqA_sym_trop m n) transitivity proved by
        (@mat_eqA_trans_trop m n) as mat_eqA_rel_trop.

        (* Define this morphism to be able to use rewrite
        [zero_matrix_mult_l]. *)

      Add Parametric Morphism m n i (h:i<n) : (fun M =>
        @get_col_trop m n M i h) with signature (@mat_eqA_trop m n)
      ==> (@eq_vec_trop m) as get_col_mor_trop.

      Proof.
        intros. unfold eq_vec_trop. apply Vforall2n_intro. intros.
        repeat rewrite <- get_elem_swap_trop. apply H.
      Qed.

        (* Define this morphism to be able to use [rewrite H0] in
        [mat_vec_prod_mor]. *)

      Add Parametric Morphism n : (@vec_to_col_mat_trop n) with
        signature (@eq_vec_trop n) ==> (@mat_eqA_trop n 1) as
          vec_to_col_mat_mor_trop.

      Proof.
        unfold vec_to_col_mat_trop, mat_eqA_trop,
          get_elem_trop. intros.
        repeat rewrite get_elem_swap_trop.
        unfold get_col_trop. repeat rewrite Vnth_map.
        apply (Vnth_mor eqA). rewrite (eq_vec_cons eqA). intuition.
        apply (Vnth_mor eqA). hyp.
      Qed.

        (* Define this morphism to be able to use [rewrite H] for
        [mat_vec_prod_mor]. *)

      Add Parametric Morphism m n p : (@mat_mult_trop m n p) with
        signature (@mat_eqA_trop m n) ==> (@mat_eqA_trop n p) ==>
        (@mat_eqA_trop m p) as mat_mult_mor_trop.

      Proof.
        unfold mat_mult_trop. intros. unfold mat_eqA_trop. intros.
        repeat rewrite mat_build_elem_trop. apply dot_product_mor_trop.
        apply get_row_mor_trop. hyp. apply get_col_mor_trop. hyp.
      Qed.

        (* Define this morphism to be able to rewrite
        [mat_vec_prod_distr_vec] later. *)

      Add Parametric Morphism m n : (@mat_vec_prod_trop m n) with
        signature (@mat_eqA_trop m n) ==> (@eq_vec_trop n) ==>
        (@eq_vec_trop m) as mat_vec_prod_mor_trop.

      Proof.
        unfold mat_vec_prod_trop.
        intros. apply get_col_mor_trop. rewrite H. rewrite H0.
        refl.
      Qed.

        (* Adding notations *)

      Notation vec := (vector At dim).
      Notation eq_vec_st := (@eq_vec_st _ _ sid_theoryAt dim).
      Notation mat_eqA := (@mat_eqA_trop dim dim).
      Notation mat_eqA_st := (@mat_eqA_st_trop dim dim).
      Notation matrixInt := (matrixInt_trop matrix_trop).
      Notation mint := (matrixInt dim).
      Notation mat := (matrix_trop dim dim).
      Notation eq_vec_st' := (@eq_vec_st _ _ sid_theoryAt dim).
      Notation eq_vec_mat_eqA_st' := (@VecEq.eq_vec_st _ _ mat_eqA_st).
      Notation eq_vec := (@eq_vec_trop dim).
      Notation "x =v y" := (eq_vec x y)(at level 70).
      Notation "x >>= y" := (get x y) (at level 70).

      Infix "[+]" := vector_plus_trop (at level 50).
      Infix "<*>" := mat_mult_trop (at level 40).

      Add Parametric Relation k : (vector vec k) (@VecEq.eq_vec _
        eq_vec k) reflexivity proved by (@eq_vec_refl _ _ eq_vec_st
          k) symmetry proved by (@eq_vec_sym _ _ eq_vec_st k)
        transitivity proved by (@eq_vec_trans _ _ eq_vec_st k) as
          eq_vec_eq_vec_rel_trop.

      Add Parametric Relation k : (vector (matrix_trop dim dim) k)
        (@VecEq.eq_vec _ mat_eqA k) reflexivity proved by
        (@eq_vec_refl _ _ mat_eqA_st k) symmetry proved by
          (@eq_vec_sym _ _ mat_eqA_st k) transitivity proved by
            (@eq_vec_trans _ _ mat_eqA_st k) as eq_vec_mat_eqA_rel_trop.

      Definition eq_mint_trop k (mi1 mi2 : mint k) := let (c1,
        args1) := mi1 in let (c2, args2) := mi2 in c1 =v c2 /\
      VecEq.eq_vec mat_eqA args1 args2.

      Notation "x =i y" := (eq_mint_trop x y) (at level 70).

      Lemma eq_mint_refl_trop : forall k (x : mint k), x =i x.

      Proof.
        unfold eq_mint_trop. destruct x. intuition.
      Qed.

      Lemma eq_mint_sym_trop : forall k (x y : mint k), x =i y -> y
        =i x.

      Proof.
        unfold eq_mint_trop. destruct x. destruct y. intuition.
      Qed.

      Lemma eq_mint_trans_trop : forall k (x y z : mint k), x =i y
        -> y =i z -> x =i z.

      Proof.
        unfold eq_mint_trop. destruct x. destruct y. destruct z. intuition.
        trans const_trop1; hyp. trans args_trop1; hyp.
      Qed.

      Add Parametric Relation k : (@mint k) (@eq_mint_trop k)
        reflexivity proved by (@eq_mint_refl_trop k) symmetry proved
          by (@eq_mint_sym_trop k) transitivity proved by
            (@eq_mint_trans_trop k) as eq_mint_rel_trop.

      Add Parametric Morphism k : (@mkMatrixInt_trop matrix_trop dim
        k) with signature eq_vec ==> (@VecEq.eq_vec _ mat_eqA k) ==>
      (@eq_mint_trop k) as mkMatrixInt_mor_trop.

      Proof.
        unfold eq_mint_trop. auto.
      Qed.

      Add Parametric Morphism k : (@const_trop matrix_trop dim k)
        with signature (@eq_mint_trop k) ==> eq_vec as
          const_mor_trop.

      Proof.
        destruct x. destruct y. simpl. intuition.
      Qed.

      Add Parametric Morphism k : (@args_trop matrix_trop dim k)
        with signature (@eq_mint_trop k) ==> (@VecEq.eq_vec _
          mat_eqA k) as args_mor_trop.

      Proof.
        destruct x. destruct y. simpl. intuition.
      Qed.

      Section MBI.

        Definition dom_trop := { v : vec | vec_invariant_trop v }.

        Definition dom2vec_trop (d : dom_trop) : vec := proj1_sig d.

        Definition add_matrices_trop i m n (v : vector (matrix_trop
          m n) i) := Vfold_left (@mat_plus_trop m n)
        (zero_matrix_trop m n) v.

        Definition mi_eval_aux_trop n (mi : mint n) (v : vector vec n) : vec :=
          add_vectors_trop (n:=dim) (k:=n)(Vmap2 (@mat_vec_prod_trop dim dim)
            (args_trop mi) v) [+] const_trop mi.

        Add Parametric Morphism n : (@mi_eval_aux_trop n) with
          signature (@eq_mint_trop n) ==> (@VecEq.eq_vec _ eq_vec n)
          ==> eq_vec as mi_eval_aux_mor_trop.

        Proof.
          unfold mi_eval_aux_trop.
          intuition. apply vector_plus_mor_trop.
          apply add_vectors_mor_trop.
          apply Vforall2n_intro. intros. repeat rewrite Vnth_map2.
          apply mat_vec_prod_mor_trop.
          apply (Vnth_mor mat_eqA). rewrite H. refl.
          apply (Vnth_mor eq_vec). hyp.
          rewrite H. refl.
        Qed.

        Variable ma : MatrixMethodConf_trop.

        Variable mi_eval_ok : forall f v, vec_invariant_trop
          (mi_eval_aux_trop (trsInt_trop ma f) (Vmap dom2vec_trop
            v)).

        Definition mi_eval_trop f (v : vector dom_trop
          (ASignature.arity f)) : dom_trop := exist (fun v =>
            vec_invariant_trop v) (mi_eval_aux_trop (trsInt_trop ma f)
              (Vmap dom2vec_trop v)) (mi_eval_ok f v).

        Lemma mi_eval_cons_trop : forall n (mi : mint (S n)) v vs,
          mi_eval_aux_trop mi (Vcons v vs) =v mat_vec_prod_trop
          (Vhead (args_trop mi)) v [+] mi_eval_aux_trop
          (mkMatrixInt_trop (const_trop mi) (Vtail (args_trop mi)))
          vs.

        Proof.
          intros. unfold mi_eval_aux_trop.
          simpl. rewrite vector_plus_assoc_trop.
          apply vector_plus_mor_trop.
          apply vector_plus_comm_trop. refl.
        Qed.

        Notation "x >> y" := (gtt x y) (at level 70).

        Definition dom_zero_trop: dom_trop.

        Proof.
          exists (Vreplace (Vconst A0t dim) dim_pos A1t).
          apply inv_id_matrix_trop.
        Defined.

        Definition I_trop := @mkInterpretation Sig dom_trop
          dom_zero_trop mi_eval_trop.

          (*REMOVE: unusued
             Variable succ : relation dom.
             Notation "x >v y" := (succ x y) (at level 70).*)

        Infix ">=v" := vec_ge_trop (at level 70).

        Definition succeq_trop (x y : dom_trop) := (dom2vec_trop x)
          >=v (dom2vec_trop y).

        Lemma refl_succeq_trop : reflexive succeq_trop.

        Proof.
          intro x. apply vec_ge_refl_trop.
        Qed.

        Lemma trans_succeq_trop : transitive succeq_trop.

        Proof.
          unfold succeq_trop. apply Rof_trans with
          (f:=dom2vec_trop). apply vec_ge_trans_trop.
        Qed.

      (** Monotonicity *)

        Section VecMonotonicity_trop.

          Variable f : matrix_trop dim dim -> vec -> vec.
          Variable f_mon : forall M v1 v2, v1 >=v v2 -> f M v1 >=v f M v2.
          Variables (a b : vec).

          Lemma vec_add_weak_monotone_map2_trop : forall n1 (v1 :
            vector vec n1) n2 (v2 : vector vec n2) n (M : vector
              (matrix_trop dim dim) n) i_j, a >=v b ->
            add_vectors_trop (Vmap2 f M (Vcast (Vapp v1 (Vcons a
              v2)) i_j)) >=v add_vectors_trop (Vmap2 f M (Vcast (Vapp
                v1 (Vcons b v2)) i_j)).

          Proof.
            induction v1; intros; simpl.
            destruct n; try solve [NatUtil.absurd_arith].
            unfold add_vectors_trop, succeq_trop,
              vec_ge_trop. simpl. apply Vforall2n_intro.
            intros. unfold vector_plus_trop. do 2 rewrite Vnth_map2.
            assert (Vnth (f (Vhead M) a) ip >>= Vnth (f (Vhead M) b) ip).
            apply Vforall2n_nth. apply f_mon. hyp.
            apply plus_ge_compat_trop. apply ge_reflt. hyp.
            destruct n0; try solve [NatUtil.absurd_arith].
            unfold add_vectors_trop, succeq_trop, vec_ge_trop.
            simpl. apply Vforall2n_intro.
            intros. unfold vector_plus_trop. do 2 rewrite Vnth_map2.
            apply plus_ge_compat_trop.
            apply Vforall2n_nth.
            unfold add_vectors_trop in IHv1. apply IHv1.
            hyp. apply ge_reflt.
          Qed.

        End VecMonotonicity_trop.

        Lemma monotone_succeq_trop : monotone I_trop succeq_trop.

        Proof.
          intros f i j i_j vi vj a b ab.
          simpl. unfold mi_eval_trop, mi_eval_aux_trop,
          succeq_trop. simpl.
          apply (@vec_plus_ge_compat_r_trop dim).
          do 2 rewrite Vmap_cast. do 2 rewrite Vmap_app. simpl.
          apply vec_add_weak_monotone_map2_trop; trivial.
          intros. unfold succeq_trop, vec_ge_trop.
          apply Vforall2n_intro. intros.
          unfold mat_vec_prod_trop.
          do 2 rewrite Vnth_col_mat_trop. apply mat_mult_mon_trop.
          apply mat_ge_refl_trop. intros x y xp yp.
          do 2 rewrite vec_to_col_mat_spec_trop.
          apply Vforall2n_nth. hyp.
        Qed.

        Lemma succeq_dec_trop : rel_dec succeq_trop.

        Proof.
          intros x y. unfold succeq_trop, vec_ge_trop.
          apply Vforall2n_dec.
          intros m1 n. apply ge_dect.
        Defined.

          (** Decidability of order on terms induced by matrix
          interpretations. *)

        Section OrderDecidability_trop.

          Require Import ABterm.

          Notation bterm := (bterm Sig).

            (** Symbolic computation of term interpretation. *)

          Definition mat_matrixInt_prod_trop n M (mi : mint n) :
            mint n := mkMatrixInt_trop (mat_vec_prod_trop M
              (const_trop mi)) (Vmap (mat_mult_trop M) (args_trop
                mi)).

          Definition combine_matrices_trop n k (v : vector (vector
            mat k) n) := Vbuild (fun i ip => add_matrices_trop (Vmap
              (fun v => Vnth v ip) v)).

          Lemma combine_matrices_nil_trop : forall i,
            combine_matrices_trop Vnil = Vconst (@zero_matrix_trop
              dim dim) i.

          Proof.
            intros. apply Veq_nth. intros. unfold combine_matrices_trop.
            rewrite Vnth_const. rewrite Vbuild_nth. trivial.
          Qed.

          Lemma combine_matrices_cons_trop : forall k n v (vs :
            vector (vector mat k) n), combine_matrices_trop (Vcons v
              vs) = Vmap2 (@mat_plus_trop _ _) (combine_matrices_trop
                vs) v.

          Proof.
            intros. apply Veq_nth. intros.
            unfold combine_matrices_trop, add_matrices_trop. simpl.
            rewrite Vnth_map2. do 2 rewrite Vbuild_nth. refl.
          Qed.

          Fixpoint mi_of_term_trop k (t : bterm k) : mint (S k) :=
            match t with
              | BVar i ip =>
                let zero_int := Vconst (zero_matrix_trop dim dim) (S k) in
                  let args_int := Vreplace zero_int (le_lt_S ip) (id_matrix_trop dim) in
                    mkMatrixInt_trop (@zero_vec_trop dim) args_int
              | BFun f v =>
                let f_int := trsInt_trop ma f in
                  let args_int := Vmap (@mi_of_term_trop k) v in
                    let args_int' := Vmap2 (@mat_matrixInt_prod_trop (S k))
                      (args_trop f_int) args_int in
                      let res_const := add_vectors_trop (Vcons (const_trop f_int)
                        (Vmap (@const_trop matrix_trop dim (S k)) args_int')) in
                      let res_args := combine_matrices_trop
                        (Vmap (@args_trop matrix_trop dim (S k))
                          args_int') in
                        mkMatrixInt_trop res_const res_args
            end.

          Require Import ATrs.

          Definition rule_mi_trop r :=
            let mvl := maxvar (lhs r) in
              let mvr := maxvar (rhs r) in
                let m := max mvl mvr in
                  let lt := inject_term (le_max_l mvl mvr) in
                    let rt := inject_term (le_max_r mvl mvr) in
                      (mi_of_term_trop lt, mi_of_term_trop rt).

            (** Order characteristic for symbolically computed interpretation and
               its decidability. *)

          Notation mat_ge := (@mat_ge_trop dim dim).

          Definition mint_ge_trop n (l r : mint n) := Vforall2n
            mat_ge (args_trop l) (args_trop r) /\ (@vec_ge_trop dim)
            (const_trop l) (const_trop r).

          Definition term_ord_trop (ord : forall n, relation (mint
            n)) l r := let (li, ri) := rule_mi_trop (mkRule l r) in
          ord _ li ri.

          Variable mint_gt_trop : forall n (l r : mint n), Prop.
          Variable mint_gt_dec_trop : forall n, rel_dec (@mint_gt_trop n).

          Definition term_ge_trop := term_ord_trop mint_ge_trop.
          Definition term_gt_trop := term_ord_trop mint_gt_trop.

          Lemma mint_ge_dec_trop : forall n, rel_dec (@mint_ge_trop n).

          Proof.
            intros n x y. unfold mint_ge_trop.
            destruct (Vforall2n_dec
              (@mat_ge_dec_trop dim dim) (args_trop x) (args_trop y));
            intuition.
            destruct (vec_ge_dec_trop (const_trop x) (const_trop y)); intuition.
          Defined.

          Lemma term_ge_dec_trop : rel_dec term_ge_trop.

          Proof.
            intros l r. unfold term_ge_trop, term_ord_trop. simpl.
            match goal with |- {mint_ge_trop ?l ?r} + {~mint_ge_trop ?l ?r} =>
              destruct (mint_ge_dec_trop l r); auto
            end.
          Defined.

          Lemma term_gt_dec_trop : rel_dec term_gt_trop.

          Proof.
            intros l r. unfold term_gt_trop, term_ord_trop. simpl.
            match goal with |- {mint_gt_trop ?l ?r} + {~mint_gt_trop ?l ?r} =>
              destruct (mint_gt_dec_trop l r); auto
            end.
          Defined.

          Notation IR_succeq := (IR I_trop succeq_trop).

          Definition mint_eval_trop (val : valuation I_trop) k (mi :
            mint k) : vec := let coefs := Vbuild (fun i (ip : i < k)
              => dom2vec_trop (val i)) in add_vectors_trop (Vcons
                (const_trop mi) (Vmap2 (@mat_vec_prod_trop dim dim)
                  (args_trop mi) coefs)).

          Add Parametric Morphism val k : (@mint_eval_trop val k)
            with signature (@eq_mint_trop k) ==> eq_vec as
              mint_eval_mor_trop.

          Proof.
            unfold eq_mint_trop. intros [c1 args1] [c2 args2]. intuition.
            unfold mint_eval_trop. simpl. apply add_vectors_mor_trop.
            rewrite (eq_vec_cons eq_vec). intuition.
            apply Vmap2_mor with (eqA := @mat_eqA_trop dim dim) (eqB := eq_vec).
            apply eq_vec_st. apply mat_vec_prod_mor_trop. hyp.
            apply eq_vec_refl. apply eq_vec_st.
          Qed.

          Lemma mint_eval_split_trop : forall val k (mi : mint k),
            let coefs := Vbuild (fun i (ip : i < k) => dom2vec_trop
              (val i)) in mint_eval_trop val mi =v const_trop mi [+]
            add_vectors_trop (Vmap2 (@mat_vec_prod_trop dim dim)
              (args_trop mi) coefs).

          Proof.
            intros. unfold mint_eval_trop, add_vectors_trop. simpl.
            rewrite vector_plus_comm_trop. refl.
          Qed.

          Hint Rewrite mat_mult_id_l_trop zero_matrix_mult_l_trop
            using simpl : arith.

          Lemma mint_eval_var_aux_trop : forall M i k (v : vector
            vec k) (ip : i < k), add_vectors_trop (Vmap2
              (@mat_vec_prod_trop dim dim) (Vreplace (Vconst
                (zero_matrix_trop dim dim) k) ip M) v) =v
            col_mat_to_vec_trop (M <*> (vec_to_col_mat_trop (Vnth v
              ip))).

          Proof.
            induction i; intros.
            destruct k. NatUtil.absurd_arith.
            unfold add_vectors_trop. simpl.
            fold (add_vectors_trop
              (Vmap2 (@mat_vec_prod_trop dim dim)
                (Vconst (zero_matrix_trop dim dim) k) (Vtail v))).
            assert (add_vectors_trop
              (Vmap2 (@mat_vec_prod_trop dim dim) (Vconst
                (zero_matrix_trop dim dim) k) (Vtail v))
              =v @zero_vec_trop dim).
            Focus 2. rewrite H.
            rewrite vector_plus_zero_l_trop.
            unfold mat_vec_prod_trop.
            replace (Vhead v) with (Vnth v ip).
            refl.
            rewrite Vhead_nth.
            rewrite (NatUtil.lt_unique (Lt.lt_O_Sn k) ip). refl.
            apply add_vectors_zero_trop. apply Vforall_nth_intro. intros.
            rewrite Vnth_map2. rewrite Vnth_const.
            unfold mat_vec_prod_trop.
            rewrite zero_matrix_mult_l_trop.
            apply Vforall2n_intro. intros. rewrite Vnth_col_mat_trop.
            unfold zero_matrix_trop, zero_vec_trop.
            rewrite mat_build_elem_trop. rewrite Vnth_const. refl.
            destruct k. NatUtil.absurd_arith.
            rewrite Vreplace_tail. simpl.
            rewrite add_vectors_cons_trop.
            unfold mat_vec_prod_trop at 1.
            rewrite zero_matrix_mult_l_trop.
            assert (col_mat_to_vec_trop
              (zero_matrix_trop dim 1) =v zero_vec_trop dim).
            apply Vforall2n_intro. intros.
            rewrite Vnth_col_mat_trop.
            unfold zero_matrix_trop, zero_vec_trop.
            rewrite mat_build_elem_trop.
            rewrite Vnth_const. refl. rewrite H.
            rewrite vector_plus_zero_l_trop.
            rewrite IHi. rewrite Vnth_tail.
            rewrite (NatUtil.le_unique
              (Lt.lt_n_S (Lt.lt_S_n ip)) ip). refl.
          Qed.

          Lemma mint_eval_eq_term_int_var_trop : forall v (val :
            valuation I_trop) k (t_b : maxvar_le k (Var v)),
          dom2vec_trop (bterm_int val (inject_term t_b)) =v
          mint_eval_trop val (mi_of_term_trop (inject_term t_b)).

          Proof.
            intros. rewrite mint_eval_split_trop.
            change (const_trop (mi_of_term_trop
              (inject_term t_b))) with (zero_vec_trop dim).
            rewrite vector_plus_zero_l_trop.
            change (args_trop (mi_of_term_trop
              (inject_term t_b))) with (Vreplace (Vconst
                (zero_matrix_trop dim dim) (S k)) (NatUtil.le_lt_S (maxvar_var t_b))
              (id_matrix_trop dim)).
            rewrite mint_eval_var_aux_trop.
            rewrite Vbuild_nth. simpl.
            trans (col_mat_to_vec_trop
              (vec_to_col_mat_trop (dom2vec_trop (val v)))).
            rewrite col_mat_to_vec_idem_trop.
            refl. apply get_col_mor_trop.
            rewrite mat_mult_id_l_trop. refl. ded dim_pos. auto.
          Qed.

            (* REMARK: using Hint rewrite to be able to use the
            [autorewrite] *)

          Hint Rewrite vector_plus_zero_l_trop
            vector_plus_zero_r_trop add_vectors_cons_trop : arith.

          Lemma mint_eval_const_trop : forall val k (c : vec),
            mint_eval_trop (k:=k) val (mkMatrixInt_trop c
              (combine_matrices_trop Vnil)) =v c.

          Proof.
            intros. unfold mint_eval_trop. simpl.
            autorewrite with arith.
            trans (c [+] @zero_vec_trop dim).
            apply vector_plus_mor_trop. refl.
            apply add_vectors_zero_trop.
            apply Vforall_nth_intro. intros.
            rewrite Vnth_map2.
            rewrite combine_matrices_nil_trop. rewrite Vnth_const.
            unfold mat_vec_prod_trop. apply Vforall2n_intro. intros.
            rewrite Vnth_col_mat_trop.
            trans (get_elem_trop (zero_matrix_trop dim 1) ip0 access_0).
            apply get_elem_mor_trop. apply zero_matrix_mult_l_trop.
            unfold zero_matrix_trop. rewrite mat_build_elem_trop.
            unfold zero_vec_trop. rewrite Vnth_const. refl.
            apply vector_plus_zero_r_trop.
          Qed.

          Lemma mint_eval_cons_trop : forall n k val c_hd c_tl a_hd
            (a_tl : vector (vector mat k) n), mint_eval_trop val
            (mkMatrixInt_trop (c_hd [+] c_tl) (combine_matrices_trop
              (Vcons a_hd a_tl))) =v mint_eval_trop val
            (mkMatrixInt_trop c_hd a_hd) [+] mint_eval_trop val
            (mkMatrixInt_trop c_tl (combine_matrices_trop a_tl)).

          Proof.
            intros. unfold mint_eval_trop. simpl.
            set (vali := Vbuild (A := vec)
              (fun i (_ : i < k) => dom2vec_trop (val i))).
            rewrite combine_matrices_cons_trop.
            autorewrite with arith.
            repeat rewrite <- vector_plus_assoc_trop.
            apply vector_plus_mor_trop. refl.
            rewrite vector_plus_assoc_trop.
            rewrite (vector_plus_comm_trop _ c_tl).
            rewrite <- vector_plus_assoc_trop.
            apply vector_plus_mor_trop. refl.
            apply add_vectors_split_trop. intros.
            repeat rewrite Vnth_map2. rewrite vector_plus_comm_trop.
            apply mat_vec_prod_distr_mat_trop.
          Qed.

          Lemma mint_eval_mult_factor_trop : forall k val M (mi :
            mint k), mint_eval_trop val (mat_matrixInt_prod_trop M
              mi) =v mat_vec_prod_trop M (mint_eval_trop val mi).

          Proof.
            unfold mint_eval_trop. intros.
            simpl. autorewrite with arith.
            rewrite mat_vec_prod_distr_vec_trop.
            apply vector_plus_mor_trop. refl.
            set (gen := Vbuild (A:=vec)
              (fun i (_ : i < k) => dom2vec_trop (val i))).
            rewrite (mat_vec_prod_distr_add_vectors_trop M
              (Vmap2 (@mat_vec_prod_trop dim dim) (args_trop mi) gen)
              (Vmap2 (@mat_vec_prod_trop dim dim) (Vmap (mat_mult_trop M)
                (args_trop mi)) gen)).
            refl. intros. repeat rewrite Vnth_map2. rewrite Vnth_map.
            unfold mat_vec_prod_trop. rewrite vec_to_col_mat_idem_trop.
            apply get_col_mor_trop. rewrite mat_mult_assoc_trop. refl.
          Qed.

          Lemma mint_eval_eq_bterm_int_fapp_trop : forall k i fi val
            (v : vector (bterm k) i), let arg_eval := Vmap2
              (@mat_matrixInt_prod_trop (S k)) (args_trop fi) (Vmap
                (@mi_of_term_trop k) v) in mi_eval_aux_trop fi (Vmap
                  (fun t : bterm k => mint_eval_trop val (mi_of_term_trop
                    t)) v) =v mint_eval_trop val (mkMatrixInt_trop
                      (add_vectors_trop (Vcons (const_trop fi) (Vmap
                        (@const_trop matrix_trop dim (S k)) arg_eval)))
                      (combine_matrices_trop (Vmap (@args_trop matrix_trop dim
                        (S k)) arg_eval))).

          Proof.
            induction i; intros.
              (* i = 0 *)
            VOtac. simpl.
            unfold mi_eval_aux_trop, add_vectors_trop.
            simpl. autorewrite with arith.
            sym. apply mint_eval_const_trop.
              (* i > 0 *)
            VSntac v. simpl mi_eval_aux_trop.
            rewrite mi_eval_cons_trop.
            rewrite IHi. simpl.
            trans (@mint_eval_trop val (S k)
              (@mkMatrixInt_trop matrix_trop dim (S k)
                (@mat_vec_prod_trop dim dim
                  (@Vhead (matrix_trop dim dim) i
                    (@args_trop matrix_trop dim (S i) fi))
                  (@const_trop matrix_trop dim (S k)
                    (@Vhead (mint (S k)) i
                      (@Vmap (ABterm.bterm Sig k)
                        (mint (S k))
                        (@mi_of_term_trop k) (S i) v)))
                  [+] @add_vectors_trop dim (S i) (@Vcons (vector At dim)
                    (@const_trop matrix_trop dim (S i) fi) i
                    (@Vmap (mint (S k))
                      (vector At dim) (@const_trop matrix_trop dim (S k)) i
                      (@Vmap2 (matrix_trop dim dim)
                        (mint (S k))
                        (mint (S k))
                        (@mat_matrixInt_prod_trop (S k)) i
                        (@Vtail (matrix_trop dim dim) i
                          (@args_trop matrix_trop dim (S i) fi))
                        (@Vtail (mint (S k)) i
                          (@Vmap (ABterm.bterm Sig k)
                            (mint (S k))
                            (@mi_of_term_trop k) (S i) v))))))
                (@combine_matrices_trop (S i) (S k)
                  (@Vcons (vector (matrix_trop dim dim) (S k))
                    (@Vmap (matrix_trop dim dim) (matrix_trop dim dim)
                      (@mat_mult_trop dim dim dim
                        (@Vhead (matrix_trop dim dim) i
                          (@args_trop matrix_trop dim (S i) fi)))
                      (S k)
                      (@args_trop matrix_trop dim (S k)
                        (@Vhead (mint (S k)) i
                          (@Vmap (ABterm.bterm Sig k)
                            (mint (S k))
                            (@mi_of_term_trop k) (S i) v)))) i
                    (@Vmap (mint (S k))
                      (vector (matrix_trop dim dim) (S k))
                      (@args_trop matrix_trop dim (S k)) i
                      (@Vmap2 (matrix_trop dim dim)
                        (mint (S k))
                        (mint (S k))
                        (@mat_matrixInt_prod_trop (S k)) i
                        (@Vtail (matrix_trop dim dim) i
                          (@args_trop matrix_trop dim (S i) fi))
                        (@Vtail (mint (S k)) i
                          (@Vmap (ABterm.bterm Sig k)
                            (mint (S k))
                            (@mi_of_term_trop k) (S i) v)))))))).
            Focus 2. apply mint_eval_mor_trop. split. rewrite add_vectors_perm_trop.
            rewrite (add_vectors_cons_trop (i := S i)
              (mat_vec_prod_trop (Vhead (args_trop fi))
                (const_trop (Vhead (Vmap (mi_of_term_trop (k:=k)) v))))). refl.
            apply eq_vec_refl. apply mat_eqA_st.
            rewrite mint_eval_cons_trop. apply vector_plus_mor_trop.
            Focus 2. rewrite Vmap_tail. refl.
            rewrite H. simpl.
            fold (mat_matrixInt_prod_trop
              (Vhead (args_trop fi)) (mi_of_term_trop (Vhead v))).
            sym. apply mint_eval_mult_factor_trop.
          Qed.

          Lemma mint_eval_eq_bterm_int_trop : forall (val :
            valuation I_trop) t k (t_b : maxvar_le k t),
          dom2vec_trop (bterm_int val (inject_term t_b)) =v
          mint_eval_trop val (mi_of_term_trop (inject_term t_b)).

          Proof.
            intros val t. pattern t. apply term_ind_forall; intros.
            apply mint_eval_eq_term_int_var_trop.
            rewrite inject_term_eq. simpl.
            rewrite Vmap_map.
            rewrite (@Vmap_eqA _ _ eq_vec eq_vec_st
              (fun x => dom2vec_trop (bterm_int val x))
              (fun (t : bterm k) => mint_eval_trop val (mi_of_term_trop t))).
            simpl. apply mint_eval_eq_bterm_int_fapp_trop.
            apply Vforall_nth_intro. intros.
            rewrite inject_terms_nth. apply (Vforall_nth ip H).
          Qed.

          Lemma mint_eval_eq_term_int_trop : forall t (val :
            valuation I_trop) k (t_b : maxvar_le k t), dom2vec_trop
          (term_int val t) =v mint_eval_trop val (mi_of_term_trop
            (inject_term t_b)).

          Proof.
            intros. rewrite <- (term_int_eq_bterm_int val t_b).
            apply mint_eval_eq_bterm_int_trop.
          Qed.

          Lemma mint_eval_equiv_trop : forall l r (val : valuation I_trop),
            let (li, ri) := rule_mi_trop (mkRule l r) in
              let lev := term_int val l in
                let rev := term_int val r in
                  let lv := mint_eval_trop val li in
                    let rv := mint_eval_trop val ri in
                      lv =v dom2vec_trop lev /\ rv =v dom2vec_trop rev.

          Proof.
            intros. simpl. split.
            rewrite (mint_eval_eq_term_int_trop
              val (le_max_l (maxvar l) (maxvar r))).
            refl.
            rewrite (mint_eval_eq_term_int_trop
              val (le_max_r (maxvar l) (maxvar r))).
            refl.
          Qed.

          Lemma mint_eval_mon_succeq_args_trop : forall k (val :
            vector vec k) (mi mi' : mint k), mint_ge_trop mi mi' ->
          add_vectors_trop (Vmap2 (@mat_vec_prod_trop dim dim)
            (args_trop mi) val) >=v add_vectors_trop (Vmap2
              (@mat_vec_prod_trop dim dim) (args_trop mi') val).

          Proof.
            destruct mi. gen val. clear val. induction args_trop0. intros.
            destruct mi'. VOtac.
            unfold mint_eval_trop, add_vectors_trop. simpl.
            apply (vec_ge_refl_trop (@zero_vec_trop dim)).
            intros. destruct mi'. VSntac args_trop1.
            unfold mint_eval_trop, add_vectors_trop. simpl.
            destruct H. apply (@vec_plus_ge_compat_trop dim).
            apply (IHargs_trop0 (Vtail val)
              (mkMatrixInt_trop const_trop1 (Vtail (args_trop1)))).
            split. simpl. change args_trop0 with (Vtail (Vcons h args_trop0)).
            apply Vforall2n_tail. hyp. hyp.
            apply mat_vec_prod_ge_compat_trop.
            change h with (Vhead (Vcons h args_trop0)). do 2 rewrite Vhead_nth.
            apply Vforall2n_nth. hyp.
            apply (vec_ge_refl_trop (Vhead val)).
          Qed.

          Lemma mint_eval_mon_succeq_trop : forall (val : valuation I_trop) k
            (mi mi' : mint k), mint_ge_trop mi mi' ->
            mint_eval_trop val mi >=v mint_eval_trop val mi'.

          Proof.
            intros. unfold mint_eval_trop, add_vectors_trop. simpl.
            apply (@vec_plus_ge_compat_trop dim).
            exact (mint_eval_mon_succeq_args_trop _ H).
            destruct H. hyp.
          Qed.

          Lemma term_ge_incl_succeq_trop : term_ge_trop <<
            IR_succeq.

          Proof.
            intros l r lr v. destruct (mint_eval_equiv_trop l r v). simpl in * .
            unfold succeq_trop.
            rewrite <- (vec_ge_mor_trop H H0).
            apply mint_eval_mon_succeq_trop. hyp.
          Qed.

          Definition succeq_trop' := term_ge_trop.
          Definition succeq'_sub_trop := term_ge_incl_succeq_trop.
          Definition succeq'_dec_trop := term_ge_dec_trop.

        End OrderDecidability_trop.
      End MBI.
    End MatrixBasedInt_trop.
  End Tropical_Dom.
End S.


(**************************************************************)
(*   Copyright                                                *)
(*             Jean-François Monin           [+]              *)
(*             Dominique Larchey-Wendling    [*]              *)
(*                                                            *)
(*            [+] Affiliation VERIMAG - Univ. Grenoble-Alpes  *)
(*            [*] Affiliation LORIA -- CNRS                   *)
(**************************************************************)
(*      This file is distributed under the terms of the       *)
(*         CeCILL v2 FREE SOFTWARE LICENSE AGREEMENT          *)
(**************************************************************)

(* List traversal from right to left *)

Require Import List Utf8.
Import ListNotations.

Require Import mark.

Reserved Notation "x '+:' y" (at level 59, left associativity, format "x +: y").

Fixpoint consr {A} (l : list A) (y : A) { struct l } : list A :=
  match l with
  | [] => [y]
  | x :: l => x :: l +: y
  end
where "x +: y" := (consr x y) : list_scope.

Inductive lr (A: Type) : Type :=
| Nilr : lr A
| Consr : list A → A → lr A
.

Arguments Nilr {A}.
Arguments Consr {A}.

Definition r2l {A} (r: lr A) : list A :=
  match r with
  | Nilr => []
  | Consr u z => u +: z
  end.

(* Simulating destruct from right to left *)
Fixpoint l2r {A} (l : list A) : lr A :=
  match l with
  | [] => Nilr
  | x :: lr =>
     match l2r lr with
     | Nilr => Consr [] x
     | Consr lg z => Consr (x :: lg) z
     end
  end.

(* Reflecting lists "constructed" with +:, using lr *)
Tactic Notation "reflect_lr_term" constr(t) :=
    let changed :=
    match t with
    | context C [@nil ?t] =>  context C [@r2l t Nilr]
    | context C [(?x +: ?y)]  =>  context C [r2l (Consr x y)]
    end in exact changed.
Tactic Notation "reflect_lr" :=
  match goal with |- ?concl => change ltac:(reflect_lr_term concl) end.
Tactic Notation "reflect_lr" "in" hyp(H) :=
  let t := type of H in change ltac:(reflect_lr_term t) in H.

(* The same at marked places *)
Tactic Notation "Mreflect_lr_term" constr(t) :=
    let changed :=
    match t with
    | context C [MARQ (@nil) ?t] =>  context C [@r2l t Nilr]
    | context C [MARQ (@consr) ?t ?x ?y]  =>  context C [@r2l t (Consr x y)]
    end in exact changed.
Tactic Notation "mreflect_lr" :=
  match goal with |- ?concl => change ltac:(Mreflect_lr_term concl) end.
Tactic Notation "mreflect_lr" "in" hyp(H) :=
  let t := type of H in change ltac:(Mreflect_lr_term t) in H.

Section sec_context.

Context {A: Type}.
Implicit Type l u v : list A.
Implicit Type x y z : A.
Implicit Type r : lr A.

(* -------------------------------------------------------------------------- *)
(* Easy key lemmas: r2l et l2r are inverse bijections *)

Lemma l2r_consr : ∀ u z, l2r (u +: z) = Consr u z.
Proof .
  intros u z; induction u as [ | x u Hu]; simpl; [ | rewrite Hu ]; reflexivity.
Qed.

Definition same_by_l2r_consr {P: lr A → Prop} {l u z} (E : l = u+:z) :
  P (l2r l) -> P (Consr u z).
Proof. intros p; rewrite <-l2r_consr, <-E; exact p. Defined.

Lemma rlr_id : ∀ r, l2r (r2l r) = r.
Proof. intros []; simpl; [reflexivity | apply l2r_consr]. Qed.

Corollary r2l_consr : ∀ r u z, r2l r = u +: z → r = Consr u z.
Proof.
  intros r u z e.
  rewrite <- (rlr_id r), e; apply l2r_consr.
Qed.

(*Definition lrl l := r2l (l2r l).*)
Notation lrl := (λ l, r2l (l2r l)).

Lemma lrl_id : ∀ l, lrl l = l.
Proof.
  induction l as [| x v Hv]; simpl.
  - reflexivity.
  - destruct (l2r v) as [| u z]; rewrite <- Hv; reflexivity.
Defined.

Ltac rewrite_lrl := cbv beta; rewrite lrl_id.

Corollary l2r_Nilr : ∀ l, l2r l = Nilr → l = [].
Proof.
  intros l e. reflect_lr. rewrite <- e. symmetry. apply lrl_id.
Qed.

Corollary l2r_Consr : ∀ l u z, l2r l = Consr u z → l = u +: z.
Proof.
  intros l u z e. reflect_lr. rewrite <- e. symmetry. apply lrl_id.
Qed.

(* Cast functions, in Prop and in Type *)
(* Using them constrain the use of eq_ind and eq_rect,
   hence a clearer view of the underlying reasoning *)
Definition up_llP (P: list A → Prop) u : P u → P (lrl u).
Proof. rewrite_lrl; exact (fun p => p). Defined.

Definition up_llT (P: list A → Type) u : P u → P (lrl u).
Proof. rewrite_lrl; exact (fun p => p). Defined.

Definition down_llP (P: list A → Prop) u : P (lrl u) → P u.
Proof. rewrite_lrl; exact (fun p => p). Defined.

Definition down_llT (P: list A → Type) u : P (lrl u) → P u.
Proof. rewrite_lrl; exact (fun p => p). Defined.

End sec_context.

Notation lrl := (λ l, r2l (l2r l)).

(* Adds in the goal a helper ∀ r, R (r2l (l2r l)) r  →  R l r *)
Ltac gen_help l R := generalize (λ y, down_llP (λ x, R x y) l).


(* *****************************************************************)
(*                                                                 *)
(*               Verified polyhedral AST generation                *)
(*                                                                 *)
(*                 Nathanaël Courant, Inria Paris                  *)
(*                                                                 *)
(*  Copyright Inria. All rights reserved. This file is distributed *)
(*  under the terms of the GNU Lesser General Public License as    *)
(*  published by the Free Software Foundation, either version 2.1  *)
(*  of the License, or (at your option) any later version.         *)
(*                                                                 *)
(* *****************************************************************)

Require Import ZArith.
Require Import List.
Require Import Bool.
Require Import Psatz.

Require Import Linalg.
Require Import Misc.
Require Import Semantics.
Require Import PolyLoop.
Require Import PolyOperations.
Require Import ImpureAlarmConfig.

Open Scope Z_scope.

Fixpoint polyloop_simplify stmt n ctx :=
  match stmt with
  | PSkip => pure PSkip
  | PSeq st1 st2 => BIND s1 <- polyloop_simplify st1 n ctx -; BIND s2 <- polyloop_simplify st2 n ctx -; pure (PSeq s1 s2)
  | PGuard pol st =>
    let pol := resize_poly n pol in
    BIND npol <- ctx_simplify pol ctx -;
    BIND nctx <- poly_inter pol ctx -;
    BIND nst <- polyloop_simplify st n nctx -;
    pure (PGuard npol nst)
  | PLoop pol st =>
    let pol := resize_poly (S n) pol in
    BIND npol <- ctx_simplify pol ctx -;
    BIND nctx <- poly_inter pol ctx -;
    BIND nst <- polyloop_simplify st (S n) nctx -;
    pure (PLoop npol nst)
  | PInstr i es => pure (PInstr i es)
  end.

Lemma polyloop_simplify_correct :
  forall stmt n ctx,
    (poly_nrl ctx <= n)%nat ->
    WHEN nst <- polyloop_simplify stmt n ctx THEN
         forall env mem1 mem2, length env = n -> in_poly (rev env) ctx = true ->
                          poly_loop_semantics nst env mem1 mem2 ->
                          poly_loop_semantics stmt env mem1 mem2.
Proof.
  induction stmt; intros n ctx Hctx nst Hnst env mem1 mem2 Henvlen Henvctx Hsem; simpl in *.
  - bind_imp_destruct Hnst npol Hnpol; bind_imp_destruct Hnst nctx Hnctx.
    bind_imp_destruct Hnst nst1 Hnst1; apply mayReturn_pure in Hnst; rewrite <- Hnst in *.
    apply PLLoop_inv_sem in Hsem.
    assert (Hinctx : forall x, in_poly (rev (x :: env)) ctx = true) by
        (intros x; rewrite <- in_poly_nrlength with (n := n); [|auto]; simpl; rewrite resize_app by (rewrite rev_length; auto); auto).
    assert (Heq : forall x, in_poly (rev (x :: env)) npol = in_poly (rev (x :: env)) p) by
        (intros x; erewrite <- (ctx_simplify_correct _ _ _ Hnpol); [rewrite resize_poly_in; [|rewrite rev_length]; simpl; auto|auto]).
    destruct Hsem as [lb [ub [Hlbub Hsem]]].
    apply PLLoop with (lb := lb) (ub := ub); [intros x; rewrite <- Heq; apply Hlbub|].
    eapply iter_semantics_map; [|exact Hsem].
    intros x mem3 mem4 Hx Hsem1. simpl in *.
    rewrite Zrange_in, <- Hlbub, Heq in Hx.
    assert (Hnctxnrl : (poly_nrl nctx <= S n)%nat) by (eapply poly_inter_nrl; [apply resize_poly_nrl| |exact Hnctx]; lia).
    eapply IHstmt; [exact Hnctxnrl|exact Hnst1|simpl; auto| |exact Hsem1].
    erewrite poly_inter_def, poly_inter_pure_def, resize_poly_in; [|rewrite rev_length|exact Hnctx]; [|simpl; auto]; reflect; simpl; auto.
  - apply mayReturn_pure in Hnst; rewrite <- Hnst in *; auto.
  - apply mayReturn_pure in Hnst; rewrite <- Hnst in *; auto.
  - bind_imp_destruct Hnst s1 Hs1; bind_imp_destruct Hnst s2 Hs2; apply mayReturn_pure in Hnst; rewrite <- Hnst in *.
    apply PLSeq_inv_sem in Hsem; destruct Hsem as [mem3 [Hsem1 Hsem2]].
    apply PLSeq with (mem2 := mem3); [eapply IHstmt1 | eapply IHstmt2]; eauto.
  - bind_imp_destruct Hnst npol Hnpol; bind_imp_destruct Hnst nctx Hnctx.
    bind_imp_destruct Hnst nst1 Hnst1; apply mayReturn_pure in Hnst; rewrite <- Hnst in *.
    apply PLGuard_inv_sem in Hsem.
    replace (in_poly (rev env) npol) with (in_poly (rev env) p) in *.
    + destruct (in_poly (rev env) p) eqn:Hin.
      * apply PLGuardTrue; [|auto].
        assert (Henvnctx : in_poly (rev env) nctx = true) by
            (erewrite poly_inter_def, poly_inter_pure_def; [|exact Hnctx]; reflect; rewrite resize_poly_in; auto; rewrite rev_length; auto).
        assert (Hnctxnrl : (poly_nrl nctx <= n)%nat) by (eapply poly_inter_nrl; [apply resize_poly_nrl|exact Hctx|exact Hnctx]).
        eapply IHstmt with (n := n) (ctx := nctx); eauto.
      * rewrite Hsem. apply PLGuardFalse; auto.
    + erewrite <- (ctx_simplify_correct _ _ _ Hnpol); auto.
      rewrite resize_poly_in; [|rewrite rev_length]; auto.
Qed.

Fixpoint polyloop_find_loopseq stmt :=
  match stmt with
  | PSkip => Some nil
  | PSeq (PLoop pol st) stmt => match polyloop_find_loopseq stmt with None => None | Some l => Some ((pol, st) :: l) end
  | _ => None
  end.

Lemma polyloop_find_loopseq_eq :
  forall stmt res, polyloop_find_loopseq stmt = Some res ->
              stmt = make_seq (map (fun z => PLoop (fst z) (snd z)) res).
Proof.
  induction stmt; intros res Hres; simpl in *; try congruence.
  - assert (H : res = nil) by congruence; rewrite H. reflexivity.
  - destruct stmt1; try congruence.
    destruct (polyloop_find_loopseq stmt2) as [l|] eqn:Heq; [|congruence].
    injection Hres as Hres. rewrite <- Hres; simpl.
    f_equal. apply IHstmt2; reflexivity.
Qed.


From isla Require Import opsem.

Definition a2c : isla_trace :=
  Smt (DeclareConst 42%Z (Ty_BitVec 64%N)) Mk_annot :t:
  ReadReg "R20" [] (RegVal_Base (Val_Symbolic 42%Z)) Mk_annot :t:
  Smt (DeclareConst 44%Z (Ty_BitVec 64%N)) Mk_annot :t:
  ReadReg "R23" [] (RegVal_Base (Val_Symbolic 44%Z)) Mk_annot :t:
  Smt (DefineConst 74%Z (Manyop (Bvmanyarith Bvadd) [Manyop (Bvmanyarith Bvadd) [Unop (Extract 63%N 0%N) (Unop (ZeroExtend 64%N) (Val (Val_Symbolic 42%Z) Mk_annot) Mk_annot) Mk_annot; Unop (Extract 63%N 0%N) (Unop (ZeroExtend 64%N) (Unop (Bvnot) (Val (Val_Symbolic 44%Z) Mk_annot) Mk_annot) Mk_annot) Mk_annot] Mk_annot; Val (Val_Bits (BV 64%N 0x1%Z)) Mk_annot] Mk_annot)) Mk_annot :t:
  WriteReg "R8" [] (RegVal_Base (Val_Symbolic 74%Z)) Mk_annot :t:
  Smt (DeclareConst 75%Z (Ty_BitVec 64%N)) Mk_annot :t:
  ReadReg "_PC" [] (RegVal_Base (Val_Symbolic 75%Z)) Mk_annot :t:
  Smt (DefineConst 76%Z (Manyop (Bvmanyarith Bvadd) [Val (Val_Symbolic 75%Z) Mk_annot; Val (Val_Bits (BV 64%N 0x4%Z)) Mk_annot] Mk_annot)) Mk_annot :t:
  WriteReg "_PC" [] (RegVal_Base (Val_Symbolic 76%Z)) Mk_annot :t:
  tnil
.


Require Export DACandMAC.

Section Rmdir.

Variable s : SFSstate.

(*********************************************************************)
(*                   Some Useful Synonymous                          *)
(*********************************************************************)

Definition rmdir_oSC (o : OBJECT) : set (OBJECT * SecClass) :=
  match fOSC (objectSC s) o with
  | None => objectSC s
  | Some y => set_remove OSCeq_dec (o, y) (objectSC s)
  end.

Definition rmdir_acl (o : OBJECT) : set (OBJECT * AccessCtrlListData) :=
  match facl (acl s) o with
  | None => acl s
  | Some y => set_remove ACLeq_dec (o, y) (acl s)
  end.

Let t (o : OBJECT) : SFSstate :=
  mkSFS (groups s) (primaryGrp s) (subjectSC s) (AllGrp s)
    (RootGrp s) (SecAdmGrp s) (rmdir_oSC o) (rmdir_acl o)
    (secmat s) (files s) (rmdir_directories o).

(*********************************************************************)
(*                            rmdir                                  *)
(*********************************************************************)

(*This operation removes a given directory from the filesystem.      *)

Inductive rmdir (u : SUBJECT) (o : OBJECT) : SFSstate -> Prop :=
    RmdirOK :
      ObjType o = Directory ->
      set_In (MyDir (ObjName o)) (domd (directories s)) ->
      match fsecmat (secmat s) (MyDir (ObjName o)) with
      | None => False
      | Some y => set_In u (ActWriters y)
      end -> ~ set_In o (domsecmat (secmat s)) -> rmdir u o (t o).

End Rmdir.

Hint Unfold rmdir_oSC rmdir_acl.


From Test Require Import tactic.

Section FOFProblem.

Variable Universe : Set.
Variable UniverseElement : Universe.

Variable wd_ : Universe -> Universe -> Prop.
Variable col_ : Universe -> Universe -> Universe -> Prop.

Variable col_swap1_1 : (forall A B C : Universe, (col_ A B C -> col_ B A C)).
Variable col_swap2_2 : (forall A B C : Universe, (col_ A B C -> col_ B C A)).
Variable col_triv_3 : (forall A B : Universe, col_ A B B).
Variable wd_swap_4 : (forall A B : Universe, (wd_ A B -> wd_ B A)).
Variable col_trans_5 : (forall P Q A B C : Universe, ((wd_ P Q /\ (col_ P Q A /\ (col_ P Q B /\ col_ P Q C))) -> col_ A B C)).

Theorem pipo_6 : (forall A B C P T : Universe, ((wd_ P B /\ (wd_ A B /\ (wd_ C B /\ (wd_ T B /\ (wd_ T B /\ (col_ T B P /\ (col_ P B A /\ (col_ P B C /\ col_ B A T)))))))) -> col_ A B C)).
Proof.
  time tac.
Qed.

End FOFProblem.


From Test Require Import tactic.

Section FOFProblem.

Variable Universe : Set.
Variable UniverseElement : Universe.

Variable wd_ : Universe -> Universe -> Prop.
Variable col_ : Universe -> Universe -> Universe -> Prop.

Variable col_swap1_1 : (forall A B C : Universe, (col_ A B C -> col_ B A C)).
Variable col_swap2_2 : (forall A B C : Universe, (col_ A B C -> col_ B C A)).
Variable col_triv_3 : (forall A B : Universe, col_ A B B).
Variable wd_swap_4 : (forall A B : Universe, (wd_ A B -> wd_ B A)).
Variable col_trans_5 : (forall P Q A B C : Universe, ((wd_ P Q /\ (col_ P Q A /\ (col_ P Q B /\ col_ P Q C))) -> col_ A B C)).

Theorem pipo_6 : (forall A B C I H1 H2 : Universe, ((wd_ A B /\ (wd_ I H2 /\ (wd_ B C /\ (wd_ I H1 /\ (wd_ I B /\ (col_ B H1 A /\ (col_ B H2 C /\ col_ A B C))))))) -> col_ H2 A B)).
Proof.
  time tac.
Qed.

End FOFProblem.


From Test Require Import tactic.

Section FOFProblem.

Variable Universe : Set.
Variable UniverseElement : Universe.

Variable wd_ : Universe -> Universe -> Prop.
Variable col_ : Universe -> Universe -> Universe -> Prop.

Variable col_swap1_1 : (forall A B C : Universe, (col_ A B C -> col_ B A C)).
Variable col_swap2_2 : (forall A B C : Universe, (col_ A B C -> col_ B C A)).
Variable col_triv_3 : (forall A B : Universe, col_ A B B).
Variable wd_swap_4 : (forall A B : Universe, (wd_ A B -> wd_ B A)).
Variable col_trans_5 : (forall P Q A B C : Universe, ((wd_ P Q /\ (col_ P Q A /\ (col_ P Q B /\ col_ P Q C))) -> col_ A B C)).

Theorem pipo_6 : (forall A B0 C B Bprime : Universe, ((wd_ C A /\ (wd_ A B /\ (wd_ C B /\ (wd_ A B0 /\ (wd_ B0 C /\ (wd_ A Bprime /\ (wd_ B Bprime /\ (col_ A C Bprime /\ col_ B A Bprime)))))))) -> col_ C A B)).
Proof.
  time tac.
Qed.

End FOFProblem.


From Test Require Import tactic.

Section FOFProblem.

Variable Universe : Set.
Variable UniverseElement : Universe.

Variable wd_ : Universe -> Universe -> Prop.
Variable col_ : Universe -> Universe -> Universe -> Prop.

Variable col_swap1_1 : (forall A B C : Universe, (col_ A B C -> col_ B A C)).
Variable col_swap2_2 : (forall A B C : Universe, (col_ A B C -> col_ B C A)).
Variable col_triv_3 : (forall A B : Universe, col_ A B B).
Variable wd_swap_4 : (forall A B : Universe, (wd_ A B -> wd_ B A)).
Variable col_trans_5 : (forall P Q A B C : Universe, ((wd_ P Q /\ (col_ P Q A /\ (col_ P Q B /\ col_ P Q C))) -> col_ A B C)).

Theorem pipo_6 : (forall P A O B Bs : Universe, ((wd_ A O /\ (wd_ O B /\ (wd_ A B /\ (wd_ O P /\ (wd_ A P /\ (wd_ B Bs /\ (wd_ O Bs /\ (wd_ P B /\ (col_ Bs O A /\ col_ B O Bs))))))))) -> col_ A O B)).
Proof.
  time tac.
Qed.

End FOFProblem.


From Undecidability.Shared.Libs.PSL Require Export Prelim EqDec.

Export List.ListNotations.
Notation "x 'el' A" := (In x A) (at level 70).
Notation "A <<= B" := (incl A B) (at level 70).
Notation "| A |" := (length A) (at level 65).

(* ** Lists *)

Create HintDb list.

(* *** Decisions for lists *)

#[global] Instance list_in_dec X (x : X) (A : list X) :
  eq_dec X -> dec (x el A).
Proof.
  intros D. apply in_dec. exact D.
Qed.