(* (c) Copyright Microsoft Corporation and Inria. All rights reserved. *)
Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq.

(******************************************************************************)
(* This file deals with divisibility for natural numbers.                     *)
(* It contains the definitions of:                                            *)
(*      edivn m d   == the pair composed of the quotient and remainder        *)
(*                     of the Euclidean division of m by d.                   *)
(*          m %/ d  == quotient of m by d.                                    *)
(*          m %% d  == remainder of m by d.                                   *)
(*  m = n %[mod d]  <-> m equals n modulo d.                                  *)
(*  m == n %[mod d] <=> m equals n modulo d (boolean version).                *)
(*  m <> n %[mod d] <-> m differs from n modulo d.                            *)
(*  m != n %[mod d] <=> m differs from n modulo d (boolean version).          *)
(*           d %| m <=> d divides m.                                          *)
(*         gcdn m n == the GCD of m and n.                                    *)
(*        egcdn m n == the extended GCD of m and n.                           *)
(*         lcmn m n == the LCM of m and n.                                    *)
(*      coprime m n <=> m and n are coprime (:= gcdn m n == 1).               *)
(*  chinese m n r s == witness of the chinese remainder theorem.              *)
(* We adjoin an m to operator suffixes to indicate a nested %% (modn), as in  *)
(*   modnDml : m %% d + n = m + n %[mod d].                                   *)
(******************************************************************************)

Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

(** Euclidean division *)

Definition edivn_rec d :=
  fix loop m q := if m - d is m'.+1 then loop m' q.+1 else (q, m).

Definition edivn m d := if d > 0 then edivn_rec d.-1 m 0 else (0, m).

CoInductive edivn_spec m d : nat * nat -> Type :=
  EdivnSpec q r of m = q * d + r & (d > 0) ==> (r < d) : edivn_spec m d (q, r).

Lemma edivnP m d : edivn_spec m d (edivn m d).
Proof.
rewrite -{1}[m]/(0 * d + m) /edivn; case: d => //= d.
elim: m {-2}m 0 (leqnn m) => [|n IHn] [|m] q //= le_mn.
have le_m'n: m - d <= n by rewrite (leq_trans (leq_subr d m)).
rewrite subn_if_gt; case: ltnP => [// | le_dm].
by rewrite -{1}(subnKC le_dm) -addSn addnA -mulSnr; exact: IHn.
Qed.

Lemma edivn_eq d q r : r < d -> edivn (q * d + r) d = (q, r).
Proof.
move=> lt_rd; have d_gt0: 0 < d by exact: leq_trans lt_rd.
case: edivnP lt_rd => q' r'; rewrite d_gt0 /=.
wlog: q q' r r' / q <= q' by case/orP: (leq_total q q'); last symmetry; eauto.
rewrite leq_eqVlt; case/predU1P => [-> /addnI-> |] //=.
rewrite -(leq_pmul2r d_gt0) => /leq_add lt_qr eq_qr _ /lt_qr {lt_qr}.
by rewrite addnS ltnNge mulSn -addnA eq_qr addnCA addnA leq_addr.
Qed.

Definition divn m d := (edivn m d).1.

Notation "m %/ d" := (divn m d) : nat_scope.

(* We redefine modn so that it is structurally decreasing. *)

Definition modn_rec d := fix loop m := if m - d is m'.+1 then loop m' else m.

Definition modn m d := if d > 0 then modn_rec d.-1 m else m.

Notation "m %% d" := (modn m d) : nat_scope.
Notation "m = n %[mod d ]" := (m %% d = n %% d) : nat_scope.
Notation "m == n %[mod d ]" := (m %% d == n %% d) : nat_scope.
Notation "m <> n %[mod d ]" := (m %% d <> n %% d) : nat_scope.
Notation "m != n %[mod d ]" := (m %% d != n %% d) : nat_scope.

Lemma modn_def m d : m %% d = (edivn m d).2.
Proof.
case: d => //= d; rewrite /modn /edivn /=.
elim: m {-2}m 0 (leqnn m) => [|n IHn] [|m] q //=.
rewrite ltnS !subn_if_gt; case: (d <= m) => // le_mn.
by apply: IHn; apply: leq_trans le_mn; exact: leq_subr.
Qed.

Lemma edivn_def m d : edivn m d = (m %/ d, m %% d).
Proof. by rewrite /divn modn_def; case: (edivn m d). Qed.

Lemma divn_eq m d : m = m %/ d * d + m %% d.
Proof. by rewrite /divn modn_def; case: edivnP. Qed.

Lemma div0n d : 0 %/ d = 0. Proof. by case: d. Qed.
Lemma divn0 m : m %/ 0 = 0. Proof. by []. Qed.
Lemma mod0n d : 0 %% d = 0. Proof. by case: d. Qed.
Lemma modn0 m : m %% 0 = m. Proof. by []. Qed.

Lemma divn_small m d : m < d -> m %/ d = 0.
Proof. by move=> lt_md; rewrite /divn (edivn_eq 0). Qed.

Lemma divnMDl q m d : 0 < d -> (q * d + m) %/ d = q + m %/ d.
Proof.
move=> d_gt0; rewrite {1}(divn_eq m d) addnA -mulnDl.
by rewrite /divn edivn_eq // modn_def; case: edivnP; rewrite d_gt0.
Qed.

Lemma mulnK m d : 0 < d -> m * d %/ d = m.
Proof. by move=> d_gt0; rewrite -[m * d]addn0 divnMDl // div0n addn0. Qed.

Lemma mulKn m d : 0 < d -> d * m %/ d = m.
Proof. by move=> d_gt0; rewrite mulnC mulnK. Qed.

Lemma expnB p m n : p > 0 -> m >= n -> p ^ (m - n) = p ^ m %/ p ^ n.
Proof.
by move=> p_gt0 /subnK{2}<-; rewrite expnD mulnK // expn_gt0 p_gt0.
Qed.

Lemma modn1 m : m %% 1 = 0.
Proof. by rewrite modn_def; case: edivnP => ? []. Qed.

Lemma divn1 m : m %/ 1 = m.
Proof. by rewrite {2}(@divn_eq m 1) // modn1 addn0 muln1. Qed.

Lemma divnn d : d %/ d = (0 < d).
Proof. by case: d => // d; rewrite -{1}[d.+1]muln1 mulKn. Qed.

Lemma divnMl p m d : p > 0 -> p * m %/ (p * d) = m %/ d.
Proof.
move=> p_gt0; case: (posnP d) => [-> | d_gt0]; first by rewrite muln0.
rewrite {2}/divn; case: edivnP; rewrite d_gt0 /= => q r ->{m} lt_rd.
rewrite mulnDr mulnCA divnMDl; last by rewrite muln_gt0 p_gt0.
by rewrite addnC divn_small // ltn_pmul2l.
Qed.
Implicit Arguments divnMl [p m d].

Lemma divnMr p m d : p > 0 -> m * p %/ (d * p) = m %/ d.
Proof. by move=> p_gt0; rewrite -!(mulnC p) divnMl. Qed.
Implicit Arguments divnMr [p m d].

Lemma ltn_mod m d : (m %% d < d) = (0 < d).
Proof. by case: d => // d; rewrite modn_def; case: edivnP. Qed.

Lemma ltn_pmod m d : 0 < d -> m %% d < d.
Proof. by rewrite ltn_mod. Qed.

Lemma leq_trunc_div m d : m %/ d * d <= m.
Proof. by rewrite {2}(divn_eq m d) leq_addr. Qed.

Lemma leq_mod m d : m %% d  <= m.
Proof. by rewrite {2}(divn_eq m d) leq_addl. Qed.

Lemma leq_div m d : m %/ d <= m.
Proof.
by case: d => // d; apply: leq_trans (leq_pmulr _ _) (leq_trunc_div _ _).
Qed.

Lemma ltn_ceil m d : 0 < d -> m < (m %/ d).+1 * d.
Proof.
by move=> d_gt0; rewrite {1}(divn_eq m d) -addnS mulSnr leq_add2l ltn_mod.
Qed.

Lemma ltn_divLR m n d : d > 0 -> (m %/ d < n) = (m < n * d).
Proof.
move=> d_gt0; apply/idP/idP.
  by rewrite -(leq_pmul2r d_gt0); apply: leq_trans (ltn_ceil _ _).
rewrite !ltnNge -(@leq_pmul2r d n) //; apply: contra => le_nd_floor.
exact: leq_trans le_nd_floor (leq_trunc_div _ _).
Qed.

Lemma leq_divRL m n d : d > 0 -> (m <= n %/ d) = (m * d <= n).
Proof. by move=> d_gt0; rewrite leqNgt ltn_divLR // -leqNgt. Qed.

Lemma ltn_Pdiv m d : 1 < d -> 0 < m -> m %/ d < m.
Proof. by move=> d_gt1 m_gt0; rewrite ltn_divLR ?ltn_Pmulr // ltnW. Qed.

Lemma divn_gt0 d m : 0 < d -> (0 < m %/ d) = (d <= m).
Proof. by move=> d_gt0; rewrite leq_divRL ?mul1n. Qed.

Lemma leq_div2r d m n : m <= n -> m %/ d <= n %/ d.
Proof.
have [-> //| d_gt0 le_mn] := posnP d.
by rewrite leq_divRL // (leq_trans _ le_mn) -?leq_divRL.
Qed.

Lemma leq_div2l m d e : 0 < d -> d <= e -> m %/ e <= m %/ d.
Proof.
move/leq_divRL=> -> le_de.
by apply: leq_trans (leq_trunc_div m e); apply: leq_mul.
Qed.

Lemma leq_divDl p m n : (m + n) %/ p <= m %/ p + n %/ p + 1.
Proof.
have [-> //| p_gt0] := posnP p; rewrite -ltnS -addnS ltn_divLR // ltnW //.
rewrite {1}(divn_eq n p) {1}(divn_eq m p) addnACA !mulnDl -3!addnS leq_add2l.
by rewrite mul2n -addnn -addSn leq_add // ltn_mod.
Qed.

Lemma geq_divBl k m p : k %/ p - m %/ p <= (k - m) %/ p + 1.
Proof.
rewrite leq_subLR addnA; apply: leq_trans (leq_divDl _ _ _).
by rewrite -maxnE leq_div2r ?leq_maxr.
Qed.

Lemma divnMA m n p : m %/ (n * p) = m %/ n %/ p.
Proof.
case: n p => [|n] [|p]; rewrite ?muln0 ?div0n //.
rewrite {2}(divn_eq m (n.+1 * p.+1)) mulnA mulnAC !divnMDl //.
by rewrite [_ %/ p.+1]divn_small ?addn0 // ltn_divLR // mulnC ltn_mod.
Qed.

Lemma divnAC m n p : m %/ n %/ p =  m %/ p %/ n.
Proof. by rewrite -!divnMA mulnC. Qed.

Lemma modn_small m d : m < d -> m %% d = m.
Proof. by move=> lt_md; rewrite {2}(divn_eq m d) divn_small. Qed.

Lemma modn_mod m d : m %% d = m %[mod d].
Proof. by case: d => // d; apply: modn_small; rewrite ltn_mod. Qed.

Lemma modnMDl p m d : p * d + m = m %[mod d].
Proof.
case: (posnP d) => [-> | d_gt0]; first by rewrite muln0.
by rewrite {1}(divn_eq m d) addnA -mulnDl modn_def edivn_eq // ltn_mod.
Qed.

Lemma muln_modr {p m d} : 0 < p -> p * (m %% d) = (p * m) %% (p * d).
Proof.
move=> p_gt0; apply: (@addnI (p * (m %/ d * d))).
by rewrite -mulnDr -divn_eq mulnCA -(divnMl p_gt0) -divn_eq.
Qed.

Lemma muln_modl {p m d} : 0 < p -> (m %% d) * p = (m * p) %% (d * p).
Proof. by rewrite -!(mulnC p); apply: muln_modr. Qed.

Lemma modnDl m d : d + m = m %[mod d].
Proof. by rewrite -{1}[d]mul1n modnMDl. Qed.

Lemma modnDr m d : m + d = m %[mod d].
Proof. by rewrite addnC modnDl. Qed.

Lemma modnn d : d %% d = 0.
Proof. by rewrite -{1}[d]addn0 modnDl mod0n. Qed.

Lemma modnMl p d : p * d %% d = 0.
Proof. by rewrite -[p * d]addn0 modnMDl mod0n. Qed.

Lemma modnMr p d : d * p %% d = 0.
Proof. by rewrite mulnC modnMl. Qed.

Lemma modnDml m n d : m %% d + n = m + n %[mod d].
Proof. by rewrite {2}(divn_eq m d) -addnA modnMDl. Qed.

Lemma modnDmr m n d : m + n %% d = m + n %[mod d].
Proof. by rewrite !(addnC m) modnDml. Qed.

Lemma modnDm m n d : m %% d  + n %% d = m + n %[mod d].
Proof. by rewrite modnDml modnDmr. Qed.

Lemma eqn_modDl p m n d : (p + m == p + n %[mod d]) = (m == n %[mod d]).
Proof.
case: d => [|d]; first by rewrite !modn0 eqn_add2l.
apply/eqP/eqP=> eq_mn; last by rewrite -modnDmr eq_mn modnDmr.
rewrite -(modnMDl p m) -(modnMDl p n) !mulnSr -!addnA.
by rewrite -modnDmr eq_mn modnDmr.
Qed.

Lemma eqn_modDr p m n d : (m + p == n + p %[mod d]) = (m == n %[mod d]).
Proof. by rewrite -!(addnC p) eqn_modDl. Qed.

Lemma modnMml m n d : m %% d * n = m * n %[mod d].
Proof. by rewrite {2}(divn_eq m d) mulnDl mulnAC modnMDl. Qed.

Lemma modnMmr m n d : m * (n %% d) = m * n %[mod d].
Proof. by rewrite !(mulnC m) modnMml. Qed.

Lemma modnMm m n d : m %% d * (n %% d) = m * n %[mod d].
Proof. by rewrite modnMml modnMmr. Qed.

Lemma modn2 m : m %% 2 = odd m.
Proof. by elim: m => //= m IHm; rewrite -addn1 -modnDml IHm; case odd. Qed.

Lemma divn2 m : m %/ 2 = m./2.
Proof. by rewrite {2}(divn_eq m 2) modn2 muln2 addnC half_bit_double. Qed.

Lemma odd_mod m d : odd d = false -> odd (m %% d) = odd m.
Proof.
by move=> d_even; rewrite {2}(divn_eq m d) odd_add odd_mul d_even andbF.
Qed.

Lemma modnXm m n a : (a %% n) ^ m = a ^ m %[mod n].
Proof.
by elim: m => // m IHm; rewrite !expnS -modnMmr IHm modnMml modnMmr.
Qed.

(** Divisibility **)

Definition dvdn d m := m %% d == 0.

Notation "m %| d" := (dvdn m d) : nat_scope.

Lemma dvdnP d m : reflect (exists k, m = k * d) (d %| m).
Proof.
apply: (iffP eqP) => [md0 | [k ->]]; last by rewrite modnMl.
by exists (m %/ d); rewrite {1}(divn_eq m d) md0 addn0.
Qed.
Implicit Arguments dvdnP [d m].
Prenex Implicits dvdnP.

Lemma dvdn0 d : d %| 0.
Proof. by case: d. Qed.

Lemma dvd0n n : (0 %| n) = (n == 0).
Proof. by case: n. Qed.

Lemma dvdn1 d : (d %| 1) = (d == 1).
Proof. by case: d => [|[|d]] //; rewrite /dvdn modn_small. Qed.

Lemma dvd1n m : 1 %| m.
Proof. by rewrite /dvdn modn1. Qed.

Lemma dvdn_gt0 d m : m > 0 -> d %| m -> d > 0.
Proof. by case: d => // /prednK <-. Qed.

Lemma dvdnn m : m %| m.
Proof. by rewrite /dvdn modnn. Qed.

Lemma dvdn_mull d m n : d %| n -> d %| m * n.
Proof. by case/dvdnP=> n' ->; rewrite /dvdn mulnA modnMl. Qed.

Lemma dvdn_mulr d m n : d %| m -> d %| m * n.
Proof. by move=> d_m; rewrite mulnC dvdn_mull. Qed.
Hint Resolve dvdn0 dvd1n dvdnn dvdn_mull dvdn_mulr.

Lemma dvdn_mul d1 d2 m1 m2 : d1 %| m1 -> d2 %| m2 -> d1 * d2 %| m1 * m2.
Proof.
by move=> /dvdnP[q1 ->] /dvdnP[q2 ->]; rewrite mulnCA -mulnA 2?dvdn_mull.
Qed.

Lemma dvdn_trans n d m : d %| n -> n %| m -> d %| m.
Proof. by move=> d_dv_n /dvdnP[n1 ->]; exact: dvdn_mull. Qed.

Lemma dvdn_eq d m : (d %| m) = (m %/ d * d == m).
Proof.
apply/eqP/eqP=> [modm0 | <-]; last exact: modnMl.
by rewrite {2}(divn_eq m d) modm0 addn0.
Qed.

Lemma dvdn2 n : (2 %| n) = ~~ odd n.
Proof. by rewrite /dvdn modn2; case (odd n). Qed.

Lemma dvdn_odd m n : m %| n -> odd n -> odd m.
Proof.
by move=> m_dv_n; apply: contraTT; rewrite -!dvdn2 => /dvdn_trans->.
Qed.

Lemma divnK d m : d %| m -> m %/ d * d = m.
Proof. by rewrite dvdn_eq; move/eqP. Qed.

Lemma leq_divLR d m n : d %| m -> (m %/ d <= n) = (m <= n * d).
Proof. by case: d m => [|d] [|m] ///divnK=> {2}<-; rewrite leq_pmul2r. Qed.

Lemma ltn_divRL d m n : d %| m -> (n < m %/ d) = (n * d < m).
Proof. by move=> dv_d_m; rewrite !ltnNge leq_divLR. Qed.

Lemma eqn_div d m n : d > 0 -> d %| m -> (n == m %/ d) = (n * d == m).
Proof. by move=> d_gt0 dv_d_m; rewrite -(eqn_pmul2r d_gt0) divnK. Qed.

Lemma eqn_mul d m n : d > 0 -> d %| m -> (m == n * d) = (m %/ d == n).
Proof. by move=> d_gt0 dv_d_m; rewrite eq_sym -eqn_div // eq_sym. Qed.

Lemma divn_mulAC d m n : d %| m -> m %/ d * n = m * n %/ d.
Proof.
case: d m => [[] //| d m] dv_d_m; apply/eqP.
by rewrite eqn_div ?dvdn_mulr // mulnAC divnK.
Qed.

Lemma muln_divA d m n : d %| n -> m * (n %/ d) = m * n %/ d.
Proof. by move=> dv_d_m; rewrite !(mulnC m) divn_mulAC. Qed.

Lemma muln_divCA d m n : d %| m -> d %| n -> m * (n %/ d) = n * (m %/ d).
Proof. by move=> dv_d_m dv_d_n; rewrite mulnC divn_mulAC ?muln_divA. Qed.

Lemma divnA m n p : p %| n -> m %/ (n %/ p) = m * p %/ n.
Proof. by case: p => [|p] dv_n; rewrite -{2}(divnK dv_n) // divnMr. Qed.

Lemma modn_dvdm m n d : d %| m -> n %% m = n %[mod d].
Proof.
by case/dvdnP=> q def_m; rewrite {2}(divn_eq n m) {3}def_m mulnA modnMDl.
Qed.

Lemma dvdn_leq d m : 0 < m -> d %| m -> d <= m.
Proof. by move=> m_gt0 /dvdnP[[|k] Dm]; rewrite Dm // leq_addr in m_gt0 *. Qed.

Lemma gtnNdvd n d : 0 < n -> n < d -> (d %| n) = false.
Proof. by move=> n_gt0 lt_nd; rewrite /dvdn eqn0Ngt modn_small ?n_gt0. Qed.

Lemma eqn_dvd m n : (m == n) = (m %| n) && (n %| m).
Proof.
case: m n => [|m] [|n] //; apply/idP/andP; first by move/eqP->; auto.
rewrite eqn_leq => [[Hmn Hnm]]; apply/andP; have:= dvdn_leq; auto.
Qed.

Lemma dvdn_pmul2l p d m : 0 < p -> (p * d %| p * m) = (d %| m).
Proof. by case: p => // p _; rewrite /dvdn -muln_modr // muln_eq0. Qed.
Implicit Arguments dvdn_pmul2l [p m d].

Lemma dvdn_pmul2r p d m : 0 < p -> (d * p %| m * p) = (d %| m).
Proof. by move=> p_gt0; rewrite -!(mulnC p) dvdn_pmul2l. Qed.
Implicit Arguments dvdn_pmul2r [p m d].

Lemma dvdn_divLR p d m : 0 < p -> p %| d -> (d %/ p %| m) = (d %| m * p).
Proof. by move=> /(@dvdn_pmul2r p _ m) <- /divnK->. Qed.

Lemma dvdn_divRL p d m : p %| m -> (d %| m %/ p) = (d * p %| m).
Proof.
have [-> | /(@dvdn_pmul2r p d) <- /divnK-> //] := posnP p.
by rewrite divn0 muln0 dvdn0.
Qed.

Lemma dvdn_div d m : d %| m -> m %/ d %| m.
Proof. by move/divnK=> {2}<-; apply: dvdn_mulr. Qed.

Lemma dvdn_exp2l p m n : m <= n -> p ^ m %| p ^ n.
Proof. by move/subnK <-; rewrite expnD dvdn_mull. Qed.

Lemma dvdn_Pexp2l p m n : p > 1 -> (p ^ m %| p ^ n) = (m <= n).
Proof.
move=> p_gt1; case: leqP => [|gt_n_m]; first exact: dvdn_exp2l.
by rewrite gtnNdvd ?ltn_exp2l ?expn_gt0 // ltnW.
Qed.

Lemma dvdn_exp2r m n k : m %| n -> m ^ k %| n ^ k.
Proof. by case/dvdnP=> q ->; rewrite expnMn dvdn_mull. Qed.

Lemma dvdn_addr m d n : d %| m -> (d %| m + n) = (d %| n).
Proof. by case/dvdnP=> q ->; rewrite /dvdn modnMDl. Qed.

Lemma dvdn_addl n d m : d %| n -> (d %| m + n) = (d %| m).
Proof. by rewrite addnC; exact: dvdn_addr. Qed.

Lemma dvdn_add d m n : d %| m -> d %| n -> d %| m + n.
Proof. by move/dvdn_addr->. Qed.

Lemma dvdn_add_eq d m n : d %| m + n -> (d %| m) = (d %| n).
Proof. by move=> dv_d_mn; apply/idP/idP => [/dvdn_addr | /dvdn_addl] <-. Qed.

Lemma dvdn_subr d m n : n <= m -> d %| m -> (d %| m - n) = (d %| n).
Proof. by move=> le_n_m dv_d_m; apply: dvdn_add_eq; rewrite subnK. Qed.

Lemma dvdn_subl d m n : n <= m -> d %| n -> (d %| m - n) = (d %| m).
Proof. by move=> le_n_m dv_d_m; rewrite -(dvdn_addl _ dv_d_m) subnK. Qed.

Lemma dvdn_sub d m n : d %| m -> d %| n -> d %| m - n.
Proof.
by case: (leqP n m) => [le_nm /dvdn_subr <- // | /ltnW/eqnP ->]; rewrite dvdn0.
Qed.

Lemma dvdn_exp k d m : 0 < k -> d %| m -> d %| (m ^ k).
Proof. by case: k => // k _ d_dv_m; rewrite expnS dvdn_mulr. Qed.

Hint Resolve dvdn_add dvdn_sub dvdn_exp.

Lemma eqn_mod_dvd d m n : n <= m -> (m == n %[mod d]) = (d %| m - n).
Proof.
by move=> le_mn; rewrite -{1}[n]add0n -{1}(subnK le_mn) eqn_modDr mod0n.
Qed.

Lemma divnDl m n d : d %| m -> (m + n) %/ d = m %/ d + n %/ d.
Proof. by case: d => // d /divnK{1}<-; rewrite divnMDl. Qed.

Lemma divnDr m n d : d %| n -> (m + n) %/ d = m %/ d + n %/ d.
Proof. by move=> dv_n; rewrite addnC divnDl // addnC. Qed.

(***********************************************************************)
(*   A function that computes the gcd of 2 numbers                     *)
(***********************************************************************)

Fixpoint gcdn_rec m n :=
  let n' := n %% m in if n' is 0 then m else
  if m - n'.-1 is m'.+1 then gcdn_rec (m' %% n') n' else n'.

Definition gcdn := nosimpl gcdn_rec.

Lemma gcdnE m n : gcdn m n = if m == 0 then n else gcdn (n %% m) m.
Proof.
rewrite /gcdn; elim: m {-2}m (leqnn m) n => [|s IHs] [|m] le_ms [|n] //=.
case def_n': (_ %% _) => // [n'].
have{def_n'} lt_n'm: n' < m by rewrite -def_n' -ltnS ltn_pmod.
rewrite {}IHs ?(leq_trans lt_n'm) // subn_if_gt ltnW //=; congr gcdn_rec.
by rewrite -{2}(subnK (ltnW lt_n'm)) -addnS modnDr.
Qed.

Lemma gcdnn : idempotent gcdn.
Proof. by case=> // n; rewrite gcdnE modnn. Qed.

Lemma gcdnC : commutative gcdn.
Proof.
move=> m n; wlog lt_nm: m n / n < m.
  by case: (ltngtP n m) => [||-> //]; last symmetry; auto.
by rewrite gcdnE -{1}(ltn_predK lt_nm) modn_small.
Qed.

Lemma gcd0n : left_id 0 gcdn. Proof. by case. Qed.
Lemma gcdn0 : right_id 0 gcdn. Proof. by case. Qed.

Lemma gcd1n : left_zero 1 gcdn.
Proof. by move=> n; rewrite gcdnE modn1. Qed.

Lemma gcdn1 : right_zero 1 gcdn.
Proof. by move=> n; rewrite gcdnC gcd1n. Qed.

Lemma dvdn_gcdr m n : gcdn m n %| n.
Proof.
elim: m {-2}m (leqnn m) n => [|s IHs] [|m] le_ms [|n] //.
rewrite gcdnE; case def_n': (_ %% _) => [|n']; first by rewrite /dvdn def_n'.
have lt_n's: n' < s by rewrite -ltnS (leq_trans _ le_ms) // -def_n' ltn_pmod.
rewrite /= (divn_eq n.+1 m.+1) def_n' dvdn_addr ?dvdn_mull //; last exact: IHs.
by rewrite gcdnE /= IHs // (leq_trans _ lt_n's) // ltnW // ltn_pmod.
Qed.

Lemma dvdn_gcdl m n : gcdn m n %| m.
Proof. by rewrite gcdnC dvdn_gcdr. Qed.

Lemma gcdn_gt0 m n : (0 < gcdn m n) = (0 < m) || (0 < n).
Proof.
by case: m n => [|m] [|n] //; apply: (@dvdn_gt0 _ m.+1) => //; exact: dvdn_gcdl.
Qed.

Lemma gcdnMDl k m n : gcdn m (k * m + n) = gcdn m n.
Proof. by rewrite !(gcdnE m) modnMDl mulnC; case: m. Qed.

Lemma gcdnDl m n : gcdn m (m + n) = gcdn m n.
Proof. by rewrite -{2}(mul1n m) gcdnMDl. Qed.

Lemma gcdnDr m n : gcdn m (n + m) = gcdn m n.
Proof. by rewrite addnC gcdnDl. Qed.

Lemma gcdnMl n m : gcdn n (m * n) = n.
Proof. by case: n => [|n]; rewrite gcdnE modnMl gcd0n. Qed.

Lemma gcdnMr n m : gcdn n (n * m) = n.
Proof. by rewrite mulnC gcdnMl. Qed.

Lemma gcdn_idPl {m n} : reflect (gcdn m n = m) (m %| n).
Proof.
by apply: (iffP idP) => [/dvdnP[q ->] | <-]; rewrite (gcdnMl, dvdn_gcdr).
Qed.

Lemma gcdn_idPr {m n} : reflect (gcdn m n = n) (n %| m).
Proof. by rewrite gcdnC; apply: gcdn_idPl. Qed.

Lemma expn_min e m n : e ^ minn m n = gcdn (e ^ m) (e ^ n).
Proof.
rewrite /minn; case: leqP; [rewrite gcdnC | move/ltnW];
  by move/(dvdn_exp2l e)/gcdn_idPl.
Qed.

Lemma gcdn_modr m n : gcdn m (n %% m) = gcdn m n.
Proof. by rewrite {2}(divn_eq n m) gcdnMDl. Qed.

Lemma gcdn_modl m n : gcdn (m %% n) n = gcdn m n.
Proof. by rewrite !(gcdnC _ n) gcdn_modr. Qed.

(* Extended gcd, which computes Bezout coefficients. *)

Fixpoint Bezout_rec km kn qs :=
  if qs is q :: qs' then Bezout_rec kn (NatTrec.add_mul q kn km) qs'
  else (km, kn).

Fixpoint egcdn_rec m n s qs :=
  if s is s'.+1 then
    let: (q, r) := edivn m n in
    if r > 0 then egcdn_rec n r s' (q :: qs) else
    if odd (size qs) then qs else q.-1 :: qs
  else [::0].

Definition egcdn m n := Bezout_rec 0 1 (egcdn_rec m n n [::]).

CoInductive egcdn_spec m n : nat * nat -> Type :=
  EgcdnSpec km kn of km * m = kn * n + gcdn m n & kn * gcdn m n < m :
    egcdn_spec m n (km, kn).

Lemma egcd0n n : egcdn 0 n = (1, 0).
Proof. by case: n. Qed.

Lemma egcdnP m n : m > 0 -> egcdn_spec m n (egcdn m n).
Proof.
rewrite /egcdn; have: (n, m) = Bezout_rec n m [::] by [].
case: (posnP n) => [-> /=|]; first by split; rewrite // mul1n gcdn0.
move: {2 6}n {4 6}n {1 4}m [::] (ltnSn n) => s n0 m0.
elim: s n m => [[]//|s IHs] n m qs /= le_ns n_gt0 def_mn0 m_gt0.
case: edivnP => q r def_m; rewrite n_gt0 /= => lt_rn.
case: posnP => [r0 {s le_ns IHs lt_rn}|r_gt0]; last first.
  by apply: IHs => //=; [rewrite (leq_trans lt_rn) | rewrite natTrecE -def_m].
rewrite {r}r0 addn0 in def_m; set b := odd _; pose d := gcdn m n.
pose km := ~~ b : nat; pose kn := if b then 1 else q.-1.
rewrite (_ : Bezout_rec _ _ _ = Bezout_rec km kn qs); last first.
  by rewrite /kn /km; case: (b) => //=; rewrite natTrecE addn0 muln1.
have def_d: d = n by rewrite /d def_m gcdnC gcdnE modnMl gcd0n -[n]prednK.
have: km * m + 2 * b * d = kn * n + d.
  rewrite {}/kn {}/km def_m def_d -mulSnr; case: b; rewrite //= addn0 mul1n.
  by rewrite prednK //; apply: dvdn_gt0 m_gt0 _; rewrite def_m dvdn_mulr.
have{def_m}: kn * d <= m.
  have q_gt0 : 0 < q by rewrite def_m muln_gt0 n_gt0 ?andbT in m_gt0.
  by rewrite /kn; case b; rewrite def_d def_m leq_pmul2r // leq_pred.
have{def_d}: km * d <= n by rewrite -[n]mul1n def_d leq_pmul2r // leq_b1.
move: km {q}kn m_gt0 n_gt0 def_mn0; rewrite {}/d {}/b.
elim: qs m n => [|q qs IHq] n r kn kr n_gt0 r_gt0 /=.
  case=> -> -> {m0 n0}; rewrite !addn0 => le_kn_r _ def_d; split=> //.
  have d_gt0: 0 < gcdn n r by rewrite gcdn_gt0 n_gt0.
  have: 0 < kn * n by rewrite def_d addn_gt0 d_gt0 orbT.
  rewrite muln_gt0 n_gt0 andbT; move/ltn_pmul2l <-.
  by rewrite def_d -addn1 leq_add // mulnCA leq_mul2l le_kn_r orbT.
rewrite !natTrecE; set m:= _ + r; set km := _ * _ + kn; pose d := gcdn m n.
have ->: gcdn n r = d by rewrite [d]gcdnC gcdnMDl.
have m_gt0: 0 < m by rewrite addn_gt0 r_gt0 orbT.
have d_gt0: 0 < d by rewrite gcdn_gt0 m_gt0.
move/IHq=> {IHq} IHq le_kn_r le_kr_n def_d; apply: IHq => //; rewrite -/d.
  by rewrite mulnDl leq_add // -mulnA leq_mul2l le_kr_n orbT.
apply: (@addIn d); rewrite -!addnA addnn addnCA mulnDr -addnA addnCA.
rewrite /km mulnDl mulnCA mulnA -addnA; congr (_ + _).
by rewrite -def_d addnC -addnA -mulnDl -mulnDr addn_negb -mul2n.
Qed.

Lemma Bezoutl m n : m > 0 -> {a | a < m & m %| gcdn m n + a * n}.
Proof.
move=> m_gt0; case: (egcdnP n m_gt0) => km kn def_d lt_kn_m.
exists kn; last by rewrite addnC -def_d dvdn_mull.
apply: leq_ltn_trans lt_kn_m.
by rewrite -{1}[kn]muln1 leq_mul2l gcdn_gt0 m_gt0 orbT.
Qed.

Lemma Bezoutr m n : n > 0 -> {a | a < n & n %| gcdn m n + a * m}.
Proof. by rewrite gcdnC; exact: Bezoutl. Qed.

(* Back to the gcd. *)

Lemma dvdn_gcd p m n : p %| gcdn m n = (p %| m) && (p %| n).
Proof.
apply/idP/andP=> [dv_pmn | [dv_pm dv_pn]].
  by rewrite !(dvdn_trans dv_pmn) ?dvdn_gcdl ?dvdn_gcdr.
case (posnP n) => [->|n_gt0]; first by rewrite gcdn0.
case: (Bezoutr m n_gt0) => // km _ /(dvdn_trans dv_pn).
by rewrite dvdn_addl // dvdn_mull.
Qed.

Lemma gcdnAC : right_commutative gcdn.
Proof.
suffices dvd m n p: gcdn (gcdn m n) p %| gcdn (gcdn m p) n.
  by move=> m n p; apply/eqP; rewrite eqn_dvd !dvd.
rewrite !dvdn_gcd dvdn_gcdr.
by rewrite !(dvdn_trans (dvdn_gcdl _ p)) ?dvdn_gcdl ?dvdn_gcdr.
Qed.

Lemma gcdnA : associative gcdn.
Proof. by move=> m n p; rewrite !(gcdnC m) gcdnAC. Qed.

Lemma gcdnCA : left_commutative gcdn.
Proof. by move=> m n p; rewrite !gcdnA (gcdnC m). Qed.

Lemma gcdnACA : interchange gcdn gcdn.
Proof. by move=> m n p q; rewrite -!gcdnA (gcdnCA n). Qed.

Lemma muln_gcdr : right_distributive muln gcdn.
Proof.
move=> p m n; case: (posnP p) => [-> //| p_gt0].
elim: {m}m.+1 {-2}m n (ltnSn m) => // s IHs m n; rewrite ltnS => le_ms.
rewrite gcdnE [rhs in _ = rhs]gcdnE muln_eq0 (gtn_eqF p_gt0) -muln_modr //=.
by case: posnP => // m_gt0; apply: IHs; apply: leq_trans le_ms; apply: ltn_pmod.
Qed.

Lemma muln_gcdl : left_distributive muln gcdn.
Proof. by move=> m n p; rewrite -!(mulnC p) muln_gcdr. Qed.

Lemma gcdn_def d m n :
    d %| m -> d %| n -> (forall d', d' %| m -> d' %| n -> d' %| d) ->
  gcdn m n = d.
Proof.
move=> dv_dm dv_dn gdv_d; apply/eqP.
by rewrite eqn_dvd dvdn_gcd dv_dm dv_dn gdv_d ?dvdn_gcdl ?dvdn_gcdr.
Qed.

Lemma muln_divCA_gcd n m : n * (m %/ gcdn n m)  = m * (n %/ gcdn n m).
Proof. by rewrite muln_divCA ?dvdn_gcdl ?dvdn_gcdr. Qed.

(* We derive the lcm directly. *)

Definition lcmn m n := m * n %/ gcdn m n.

Lemma lcmnC : commutative lcmn.
Proof. by move=> m n; rewrite /lcmn mulnC gcdnC. Qed.

Lemma lcm0n : left_zero 0 lcmn.  Proof. by move=> n; exact: div0n. Qed.
Lemma lcmn0 : right_zero 0 lcmn. Proof. by move=> n; rewrite lcmnC lcm0n. Qed.

Lemma lcm1n : left_id 1 lcmn.
Proof. by move=> n; rewrite /lcmn gcd1n mul1n divn1. Qed.

Lemma lcmn1 : right_id 1 lcmn.
Proof. by move=> n; rewrite lcmnC lcm1n. Qed.

Lemma muln_lcm_gcd m n : lcmn m n * gcdn m n = m * n.
Proof. by apply/eqP; rewrite divnK ?dvdn_mull ?dvdn_gcdr. Qed.

Lemma lcmn_gt0 m n : (0 < lcmn m n) = (0 < m) && (0 < n).
Proof. by rewrite -muln_gt0 ltn_divRL ?dvdn_mull ?dvdn_gcdr. Qed.

Lemma muln_lcmr : right_distributive muln lcmn.
Proof.
case=> // m n p; rewrite /lcmn -muln_gcdr -!mulnA divnMl // mulnCA.
by rewrite muln_divA ?dvdn_mull ?dvdn_gcdr.
Qed.

Lemma muln_lcml : left_distributive muln lcmn.
Proof. by move=> m n p; rewrite -!(mulnC p) muln_lcmr. Qed.

Lemma lcmnA : associative lcmn.
Proof.
move=> m n p; rewrite {1 3}/lcmn mulnC !divn_mulAC ?dvdn_mull ?dvdn_gcdr //.
rewrite -!divnMA ?dvdn_mulr ?dvdn_gcdl // mulnC mulnA !muln_gcdr.
by rewrite ![_ * lcmn _ _]mulnC !muln_lcm_gcd !muln_gcdl -!(mulnC m) gcdnA.
Qed.

Lemma lcmnCA : left_commutative lcmn.
Proof. by move=> m n p; rewrite !lcmnA (lcmnC m). Qed.

Lemma lcmnAC : right_commutative lcmn.
Proof. by move=> m n p; rewrite -!lcmnA (lcmnC n). Qed.

Lemma lcmnACA : interchange lcmn lcmn.
Proof. by move=> m n p q; rewrite -!lcmnA (lcmnCA n). Qed.

Lemma dvdn_lcml d1 d2 : d1 %| lcmn d1 d2.
Proof. by rewrite /lcmn -muln_divA ?dvdn_gcdr ?dvdn_mulr. Qed.

Lemma dvdn_lcmr d1 d2 : d2 %| lcmn d1 d2.
Proof. by rewrite lcmnC dvdn_lcml. Qed.

Lemma dvdn_lcm d1 d2 m : lcmn d1 d2 %| m = (d1 %| m) && (d2 %| m).
Proof.
case: d1 d2 => [|d1] [|d2]; try by case: m => [|m]; rewrite ?lcmn0 ?andbF.
rewrite -(@dvdn_pmul2r (gcdn d1.+1 d2.+1)) ?gcdn_gt0 // muln_lcm_gcd.
by rewrite muln_gcdr dvdn_gcd {1}mulnC andbC !dvdn_pmul2r.
Qed.

Lemma lcmnMl m n : lcmn m (m * n) = m * n.
Proof. by case: m => // m; rewrite /lcmn gcdnMr mulKn. Qed.

Lemma lcmnMr m n : lcmn n (m * n) = m * n.
Proof. by rewrite mulnC lcmnMl. Qed.

Lemma lcmn_idPr {m n} : reflect (lcmn m n = n) (m %| n).
Proof.
by apply: (iffP idP) => [/dvdnP[q ->] | <-]; rewrite (lcmnMr, dvdn_lcml).
Qed.

Lemma lcmn_idPl {m n} : reflect (lcmn m n = m) (n %| m).
Proof. by rewrite lcmnC; apply: lcmn_idPr. Qed.

Lemma expn_max e m n : e ^ maxn m n = lcmn (e ^ m) (e ^ n).
Proof.
rewrite /maxn; case: leqP; [rewrite lcmnC | move/ltnW];
 by move/(dvdn_exp2l e)/lcmn_idPr.
Qed.

(* Coprime factors *)

Definition coprime m n := gcdn m n == 1.

Lemma coprime1n n : coprime 1 n.
Proof. by rewrite /coprime gcd1n. Qed.

Lemma coprimen1 n : coprime n 1.
Proof. by rewrite /coprime gcdn1. Qed.

Lemma coprime_sym m n : coprime m n = coprime n m.
Proof. by rewrite /coprime gcdnC. Qed.

Lemma coprime_modl m n : coprime (m %% n) n = coprime m n.
Proof. by rewrite /coprime gcdn_modl. Qed.

Lemma coprime_modr m n : coprime m (n %% m) = coprime m n.
Proof. by rewrite /coprime gcdn_modr. Qed.

Lemma coprime2n n : coprime 2 n = odd n.
Proof. by rewrite -coprime_modr modn2; case: (odd n). Qed.

Lemma coprimen2 n : coprime n 2 = odd n.
Proof. by rewrite coprime_sym coprime2n. Qed.

Lemma coprimeSn n : coprime n.+1 n.
Proof. by rewrite -coprime_modl (modnDr 1) coprime_modl coprime1n. Qed.

Lemma coprimenS n : coprime n n.+1.
Proof. by rewrite coprime_sym coprimeSn. Qed.

Lemma coprimePn n : n > 0 -> coprime n.-1 n.
Proof. by case: n => // n _; rewrite coprimenS. Qed.

Lemma coprimenP n : n > 0 -> coprime n n.-1.
Proof. by case: n => // n _; rewrite coprimeSn. Qed.

Lemma coprimeP n m :
  n > 0 -> reflect (exists u, u.1 * n - u.2 * m = 1) (coprime n m).
Proof.
move=> n_gt0; apply: (iffP eqP) => [<-| [[kn km] /= kn_km_1]].
  by have [kn km kg _] := egcdnP m n_gt0; exists (kn, km); rewrite kg addKn.
apply gcdn_def; rewrite ?dvd1n // => d dv_d_n dv_d_m.
by rewrite -kn_km_1 dvdn_subr ?dvdn_mull // ltnW // -subn_gt0 kn_km_1.
Qed.

Lemma modn_coprime k n : 0 < k -> (exists u, (k * u) %% n = 1) -> coprime k n.
Proof.
move=> k_gt0 [u Hu]; apply/coprimeP=> //.
by exists (u, k * u %/ n); rewrite /= mulnC {1}(divn_eq (k * u) n) addKn.
Qed.

Lemma Gauss_dvd m n p : coprime m n -> (m * n %| p) = (m %| p) && (n %| p).
Proof. by move=> co_mn; rewrite -muln_lcm_gcd (eqnP co_mn) muln1 dvdn_lcm. Qed.

Lemma Gauss_dvdr m n p : coprime m n -> (m %| n * p) = (m %| p).
Proof.
case: n => [|n] co_mn; first by case: m co_mn => [|[]] // _; rewrite !dvd1n.
by symmetry; rewrite mulnC -(@dvdn_pmul2r n.+1) ?Gauss_dvd // andbC dvdn_mull.
Qed.

Lemma Gauss_dvdl m n p : coprime m p -> (m %| n * p) = (m %| n).
Proof. by rewrite mulnC; apply: Gauss_dvdr. Qed.

Lemma Gauss_gcdr p m n : coprime p m -> gcdn p (m * n) = gcdn p n.
Proof.
move=> co_pm; apply/eqP; rewrite eqn_dvd !dvdn_gcd !dvdn_gcdl /=.
rewrite andbC dvdn_mull ?dvdn_gcdr //= -(@Gauss_dvdr _ m) ?dvdn_gcdr //.
by rewrite /coprime gcdnAC (eqnP co_pm) gcd1n.
Qed.

Lemma Gauss_gcdl p m n : coprime p n -> gcdn p (m * n) = gcdn p m.
Proof. by move=> co_pn; rewrite mulnC Gauss_gcdr. Qed.

Lemma coprime_mulr p m n : coprime p (m * n) = coprime p m && coprime p n.
Proof.
case co_pm: (coprime p m) => /=; first by rewrite /coprime Gauss_gcdr.
apply/eqP=> co_p_mn; case/eqnP: co_pm; apply gcdn_def => // d dv_dp dv_dm.
by rewrite -co_p_mn dvdn_gcd dv_dp dvdn_mulr.
Qed.

Lemma coprime_mull p m n : coprime (m * n) p = coprime m p && coprime n p.
Proof. by rewrite -!(coprime_sym p) coprime_mulr. Qed.

Lemma coprime_pexpl k m n : 0 < k -> coprime (m ^ k) n = coprime m n.
Proof.
case: k => // k _; elim: k => [|k IHk]; first by rewrite expn1.
by rewrite expnS coprime_mull -IHk; case coprime.
Qed.

Lemma coprime_pexpr k m n : 0 < k -> coprime m (n ^ k) = coprime m n.
Proof. by move=> k_gt0; rewrite !(coprime_sym m) coprime_pexpl. Qed.

Lemma coprime_expl k m n : coprime m n -> coprime (m ^ k) n.
Proof. by case: k => [|k] co_pm; rewrite ?coprime1n // coprime_pexpl. Qed.

Lemma coprime_expr k m n : coprime m n -> coprime m (n ^ k).
Proof. by rewrite !(coprime_sym m); exact: coprime_expl. Qed.

Lemma coprime_dvdl m n p : m %| n -> coprime n p -> coprime m p.
Proof. by case/dvdnP=> d ->; rewrite coprime_mull => /andP[]. Qed.

Lemma coprime_dvdr m n p : m %| n -> coprime p n -> coprime p m.
Proof. by rewrite !(coprime_sym p); exact: coprime_dvdl. Qed.

Lemma coprime_egcdn n m : n > 0 -> coprime (egcdn n m).1 (egcdn n m).2.
Proof.
move=> n_gt0; case: (egcdnP m n_gt0) => kn km /= /eqP.
have [/dvdnP[u defn] /dvdnP[v defm]] := (dvdn_gcdl n m, dvdn_gcdr n m).
rewrite -[gcdn n m]mul1n {1}defm {1}defn !mulnA -mulnDl addnC.
rewrite eqn_pmul2r ?gcdn_gt0 ?n_gt0 //; case: kn => // kn /eqP def_knu _.
by apply/coprimeP=> //; exists (u, v); rewrite mulnC def_knu mulnC addnK.
Qed.

Lemma dvdn_pexp2r m n k : k > 0 -> (m ^ k %| n ^ k) = (m %| n).
Proof.
move=> k_gt0; apply/idP/idP=> [dv_mn_k|]; last exact: dvdn_exp2r.
case: (posnP n) => [-> | n_gt0]; first by rewrite dvdn0.
have [n' def_n] := dvdnP (dvdn_gcdr m n); set d := gcdn m n in def_n.
have [m' def_m] := dvdnP (dvdn_gcdl m n); rewrite -/d in def_m.
have d_gt0: d > 0 by rewrite gcdn_gt0 n_gt0 orbT.
rewrite def_m def_n !expnMn dvdn_pmul2r ?expn_gt0 ?d_gt0 // in dv_mn_k.
have: coprime (m' ^ k) (n' ^ k).
  rewrite coprime_pexpl // coprime_pexpr // /coprime -(eqn_pmul2r d_gt0) mul1n.
  by rewrite muln_gcdl -def_m -def_n.
rewrite /coprime -gcdn_modr (eqnP dv_mn_k) gcdn0 -(exp1n k).
by rewrite (inj_eq (expIn k_gt0)) def_m; move/eqP->; rewrite mul1n dvdn_gcdr.
Qed.

Section Chinese.

(***********************************************************************)
(*   The chinese remainder theorem                                     *)
(***********************************************************************)

Variables m1 m2 : nat.
Hypothesis co_m12 : coprime m1 m2.

Lemma chinese_remainder x y :
  (x == y %[mod m1 * m2]) = (x == y %[mod m1]) && (x == y %[mod m2]).
Proof.
wlog le_yx : x y / y <= x; last by rewrite !eqn_mod_dvd // Gauss_dvd.
by case/orP: (leq_total y x); last rewrite !(eq_sym (x %% _)); auto.
Qed.

(***********************************************************************)
(*   A function that solves the chinese remainder problem              *)
(***********************************************************************)

Definition chinese r1 r2 :=
  r1 * m2 * (egcdn m2 m1).1 + r2 * m1 * (egcdn m1 m2).1.

Lemma chinese_modl r1 r2 : chinese r1 r2 = r1 %[mod m1].
Proof.
rewrite /chinese; case: (posnP m2) co_m12 => [-> /eqnP | m2_gt0 _].
  by rewrite gcdn0 => ->; rewrite !modn1.
case: egcdnP => // k2 k1 def_m1 _.
rewrite mulnAC -mulnA def_m1 gcdnC (eqnP co_m12) mulnDr mulnA muln1.
by rewrite addnAC (mulnAC _ m1) -mulnDl modnMDl.
Qed.

Lemma chinese_modr r1 r2 : chinese r1 r2 = r2 %[mod m2].
Proof.
rewrite /chinese; case: (posnP m1) co_m12 => [-> /eqnP | m1_gt0 _].
  by rewrite gcd0n => ->; rewrite !modn1.
case: (egcdnP m2) => // k1 k2 def_m2 _.
rewrite addnC mulnAC -mulnA def_m2 (eqnP co_m12) mulnDr mulnA muln1.
by rewrite addnAC (mulnAC _ m2) -mulnDl modnMDl.
Qed.

Lemma chinese_mod x : x = chinese (x %% m1) (x %% m2) %[mod m1 * m2].
Proof.
apply/eqP; rewrite chinese_remainder //.
by rewrite chinese_modl chinese_modr !modn_mod !eqxx.
Qed.

End Chinese.


Require Import Reals Sums Lra Lia.
(* Require Import Coquelicot.Hierarchy Coquelicot.Series Coquelicot.Lim_seq Coquelicot.Rbar.*)
Require Import Coquelicot.Coquelicot.
Require Import LibUtils.
Require Import sumtest.
Require Import RealAdd.

Set Bullet Behavior "Strict Subproofs".

Section fold_iter.

Lemma fold_right_mult_acc (acc : R) (l : list R) :
  List.fold_right Rmult acc l =
  List.fold_right Rmult 1 l * acc.
Proof.
  revert acc.
  induction l; simpl; intros acc.
  - lra.
  - rewrite IHl.
    lra.
Qed.

Lemma iota_is_an_annoying_seq m n : seq.iota m n = List.seq m n.
Proof.
  revert m.
  induction n; simpl; trivial.
Qed.

Lemma fold_right_mult_pos {A} (a: A -> posreal) (l:list A) :
  0 < List.fold_right (fun (a1 : A) (b : R) => a a1 * b) 1 l.
Proof.
  induction l; simpl.
  - lra.
  - apply Rmult_lt_0_compat.
    + apply cond_pos.
    + trivial.
Qed.

Lemma fold_right_max_upper_list  acc l x :
  List.In x l -> x <= List.fold_right Rmax acc l.
Proof.
  induction l; simpl; intros inn; [intuition | ].
  destruct inn.
  - subst.
    apply Rmax_l.
  - specialize (IHl H).
    eapply Rle_trans.
    + eapply IHl.
    + apply Rmax_r.
Qed.

Lemma fold_right_max_upper_acc acc l :
  acc <= List.fold_right Rmax acc l.
Proof.
  induction l; simpl.
  - lra.
  - eapply Rle_trans.
    + eapply IHl.
    + apply Rmax_r.
Qed.

Lemma fold_right_max_in acc l :
  (List.fold_right Rmax acc l) = acc \/
  List.In (List.fold_right Rmax acc l) l.
Proof.
  induction l; simpl.
  - intuition.
  - destruct IHl.
    + rewrite H.
      apply Rmax_case; eauto.
    + apply Rmax_case; eauto.
Qed.

Lemma fold_right_max_acc (acc1 acc2 : R) (l : list R) :
  Rmax acc2 (List.fold_right Rmax acc1 l) =
  Rmax acc1 (List.fold_right Rmax acc2 l).
Proof.
  revert acc1 acc2.
  induction l; simpl; intros acc1 acc2.
  - apply Rmax_comm.
  - rewrite Rmax_comm, <- Rmax_assoc.
    rewrite (Rmax_comm _ acc2).
    rewrite IHl.
    rewrite Rmax_assoc.
    rewrite (Rmax_comm a _).
    now rewrite <- Rmax_assoc.
Qed.

Lemma fold_right_plus_acc {G: AbelianGroup} (f : nat -> G) (acc : G) (l : list nat) :
  List.fold_right (fun (i : nat) (acc : G) => plus (f i) acc) acc l =
  plus (List.fold_right (fun (i : nat) (acc : G) => plus (f i) acc) zero l) acc.
Proof.
  revert acc.
  induction l; simpl; intros acc.
  - now rewrite plus_zero_l.
  - rewrite IHl.
    now rewrite plus_assoc.
Qed.

Lemma fold_right_rmax_const acc l c:
  0 <= c ->
  List.fold_right Rmax acc l * c = List.fold_right Rmax (acc*c) (List.map (fun x => x * c) l).
Proof.
  induction l; simpl; trivial; intros.
  rewrite <- IHl by trivial.
  repeat rewrite (Rmult_comm _ c).
  now rewrite RmaxRmult by trivial.
Qed.

Lemma iter_plus_times_const {A} F (l:list A)  c :
        Iter.iter Rplus 0 l (fun k  => F k * c) =
        Iter.iter Rplus 0 l (fun k => F k) * c.
Proof.
  induction l; simpl; intros.
  - lra.
  - rewrite IHl.
    lra.
Qed.

Lemma list_seq_init_map init len :
  List.seq init len = List.map (fun x => (init + x)%nat) (List.seq 0 len).
Proof.
  induction init; simpl.
  - now rewrite List.map_id.
  - simpl.
    rewrite <- List.seq_shift.
    rewrite IHinit.
    now rewrite List.map_map.
Qed.

End fold_iter.

Section products.

Definition part_prod_n (a : nat -> posreal) (n m : nat) :R  :=
  List.fold_right Rmult 1 (List.map (fun x => (a x).(pos)) (List.seq n (S m - n)%nat)).

Definition part_prod (a : nat -> posreal) (n : nat) : R :=
  part_prod_n a 0 n.

Lemma pos_part_prod_n  (a : nat -> posreal) (m n : nat) :
  0 < part_prod_n a m n.
Proof.
  unfold part_prod_n.
  generalize (S n - m)%nat; intros.
  revert m.
  induction n0; simpl; intros m.
  - lra.
  - apply Rmult_lt_0_compat; [|trivial].
    apply cond_pos.
Qed.

Lemma pos_part_prod (a : nat -> posreal) (n : nat) :
  0 < part_prod a n.
Proof.
  apply pos_part_prod_n.
Qed.

Definition part_prod_n_pos (a : nat -> posreal) (m n : nat) : posreal :=
  mkposreal (part_prod_n a m n) (pos_part_prod_n a m n).

Definition part_prod_pos (a : nat -> posreal) (n : nat) : posreal :=
  mkposreal (part_prod a n) (pos_part_prod a n).

Lemma part_prod_n_S a m n :
  (m <= S n)%nat ->
  (part_prod_n a m (S n)) = part_prod_n a m n * a (S n).
Proof.
  intros mle.
  unfold part_prod_n.
  replace (S (S n) - m)%nat with ((S n - m) + 1)%nat by lia.
  rewrite seq_plus, List.map_app, List.fold_right_app, fold_right_mult_acc.
  f_equal.
  simpl.
  destruct m; simpl.
  - lra.
  - field_simplify.
    simpl.
    do 3 f_equal.
    lia.
Qed.

Lemma part_prod_n_k_k a k :
  part_prod_n a k k = a k.
Proof.
  unfold part_prod_n.
  replace (S k - k)%nat with (1%nat) by lia.
  simpl; lra.
Qed.

Lemma part_prod_n_1 a m n :
  (m > n)%nat ->
  (part_prod_n a m n) = 1.
Proof.
  intros.
  unfold part_prod_n.
  replace (S n - m)%nat with (0%nat) by lia.
  now simpl.
Qed.

Theorem ln_part_prod (a : nat -> posreal) (n : nat) :
  ln (part_prod_pos a n) = sum_n (fun n1 => ln (a n1)) n.
Proof.
  unfold part_prod_pos, part_prod; simpl.
  unfold sum_n, sum_n_m.
  unfold Iter.iter_nat.
  rewrite Iter.iter_iter'.
  rewrite iota_is_an_annoying_seq.
  unfold Iter.iter', part_prod_n.
  generalize (List.seq 0 (S n - 0)); intros l; simpl.
  rewrite ListAdd.fold_right_map.
  induction l; simpl.
  - apply ln_1.
  - rewrite ln_mult.
    + now rewrite IHl.
    + apply cond_pos.
    + apply fold_right_mult_pos.
Qed.

Lemma initial_seg_prod (a : nat -> posreal) (m k:nat):
  part_prod a (m + S k)%nat = (part_prod a m) * (part_prod_n a (S m) (m + S k)%nat).
Proof.
  induction k; simpl.
  - unfold part_prod.
    replace (m+1)%nat with (S m) by lia.
    rewrite part_prod_n_S; [|lia].
    rewrite part_prod_n_k_k; lra.
  - replace (m + S (S k))%nat with (S (m + S k)%nat) by lia; simpl.
    unfold part_prod in *.
    rewrite part_prod_n_S; [|lia].
    rewrite IHk; simpl.
    rewrite part_prod_n_S; [|lia]; lra.
Qed.

Lemma initial_seg_prod_n (a : nat -> posreal) (k m n:nat):
  (k <= m)%nat ->
  part_prod_n a k (S m + n)%nat = (part_prod_n a k m) * (part_prod_n a (S m) (S m + n)%nat).
Proof.
  intros.
  induction n; simpl.
  - replace (m+0)%nat with (m) by lia.
    rewrite part_prod_n_S.
    now rewrite part_prod_n_k_k.
    lia.
  - rewrite part_prod_n_S; [|lia].
    rewrite part_prod_n_S; [|lia].
    replace (m + S n)%nat with (S m + n)%nat by lia.
    rewrite IHn; lra.
Qed.

Lemma part_prod_n_shift (F : nat -> posreal) (m n:nat) :
  part_prod_n (fun k : nat => F (m + k)%nat) 0 n = part_prod_n F m (n +  m).
Proof.
  unfold part_prod_n.
  f_equal.
  replace (S n - 0)%nat with (S n) by lia.
  replace (S (n + m) - m)%nat with (S n) by lia.
  induction n.
  - simpl.
    now replace (m + 0)%nat with (m) by lia.
  - replace (S (S n)) with (S n+1)%nat by lia.
    rewrite seq_plus, seq_plus, List.map_app.
    rewrite IHn.
    replace (S n) with (n+1)%nat by lia.
    rewrite List.map_app.
    now simpl.
Qed.

Lemma initial_seg_prod2 (a : nat -> posreal) (m k:nat):
  part_prod a (k + S m)%nat =
  (part_prod a m) * (part_prod (fun k0 : nat => a (S m + k0)%nat) k).
Proof.
  generalize (initial_seg_prod a m k).
  unfold part_prod.
  intros.
  replace (k + S m)%nat with (m + S k)%nat by lia.
  rewrite H, part_prod_n_shift.
  now replace (m + S k)%nat with (k + S m)%nat by lia.
Qed.

Program Definition pos_sq (c : posreal) : posreal :=
  mkposreal (c * c) _.
Next Obligation.
  apply Rmult_lt_0_compat; apply (cond_pos c).
Qed.

Definition pos_sq_fun (a : nat -> posreal) : (nat -> posreal) :=
  fun n => pos_sq (a n).

Lemma part_prod_pos_sq_pos (a : nat -> posreal) (n:nat) :
  (part_prod_pos (pos_sq_fun a) n).(pos) = (pos_sq_fun (part_prod_pos a) n).(pos).
Proof.
  unfold pos_sq_fun, pos_sq, part_prod_pos; simpl.
  induction n; simpl; trivial.
  - unfold part_prod, part_prod_n.
    simpl; lra.
  - unfold part_prod in *.
    rewrite part_prod_n_S; [|lia].
    rewrite IHn; simpl.
    rewrite part_prod_n_S; [|lia]; lra.
Qed.

Lemma inf_prod_sq_0 (a : nat -> posreal) :
  is_lim_seq (part_prod_pos a) 0 ->
  is_lim_seq (part_prod_pos (pos_sq_fun a)) 0.
Proof.
  intros.
  apply (is_lim_seq_ext (fun n => pos_sq_fun (part_prod_pos a) n)).
  intros; now rewrite (part_prod_pos_sq_pos a n).
  simpl; replace (0) with (0 * 0) by lra.
  now apply is_lim_seq_mult with (l1 := 0) (l2 := 0).
Qed.

Lemma inf_prod_m_0 (a : nat -> posreal):
  is_lim_seq (part_prod_pos a) 0 ->
  forall (m:nat), is_lim_seq (part_prod_pos (fun n => a (m + n)%nat)) 0.
Proof.
  intros.
  destruct m.
  - apply (is_lim_seq_ext (part_prod a)); trivial.
  - generalize (is_lim_seq_incr_n (part_prod_pos a) (S m) 0).
    intros.
    destruct H0.
    specialize (H0 H).
    apply (is_lim_seq_ext (fun k => (/ (part_prod a m)) *
                                  (part_prod a (k + S m)))).
    + intros.
      rewrite initial_seg_prod2.
      rewrite <- Rmult_assoc.
      rewrite Rmult_comm with (r2 := part_prod a m).
      rewrite  Rinv_r_simpl_r; trivial.
      apply Rgt_not_eq.
      apply Rlt_gt.
      apply pos_part_prod.
    + apply is_lim_seq_mult with (l1 := / (part_prod_pos a m)) (l2 := 0).
      * apply is_lim_seq_const.
      * apply H0.
      * unfold is_Rbar_mult; simpl.
        now rewrite Rmult_0_r.
Qed.

Lemma inf_prod_n_m_0 (a : nat -> posreal):
  is_lim_seq (part_prod_pos a) 0 ->
  forall (m:nat), is_lim_seq (part_prod_n_pos a m) 0.
Proof.
  intros.
  unfold part_prod_n_pos.
  apply is_lim_seq_incr_n with (N := m).
  apply (is_lim_seq_ext (fun n : nat => part_prod_pos (fun k : nat => a (m + k)%nat) n)).
  intros; simpl.
  unfold part_prod.
  now rewrite part_prod_n_shift.
  now apply inf_prod_m_0.
Qed.

End products.

Section series_sequences.

Lemma series_seq (a : nat -> R) (l:R) :
  is_series a l <-> is_lim_seq (sum_n a) l.
Proof.
  now unfold is_series, is_lim_seq.
Qed.

Lemma log_product_iff_sum_logs (a : nat -> posreal) (l:R):
  is_lim_seq (fun n => (ln (part_prod_pos a n))) l <-> is_series (fun n => ln (a n)) l .
Proof.
  rewrite series_seq.
  split.
  - apply is_lim_seq_ext; intros.
    apply ln_part_prod.
  - apply is_lim_seq_ext; intros.
    now rewrite <- ln_part_prod.
Qed.

Lemma derivable_pt_ln (x:R) :
  0 < x -> derivable_pt ln x.
Proof.
  intros.
  unfold derivable_pt, derivable_pt_abs.
  exists (/ x).
  now apply derivable_pt_lim_ln.
Defined.

Lemma log_product_iff_product (a : nat -> posreal) (l:posreal):
  is_lim_seq (fun n => (ln (part_prod_pos a n))) (ln l) <-> is_lim_seq (part_prod_pos a) l .
Proof.
  assert (0 < l) by (apply (cond_pos l)).
  split; intros.
  - apply (is_lim_seq_ext (fun n =>  exp (ln (part_prod_pos a n)))).
    + intros.
      rewrite exp_ln; f_equal.
      apply pos_part_prod.
    + replace (pos l) with (exp (ln (pos l))) by (rewrite exp_ln; trivial).
      apply is_lim_seq_continuous; [|trivial].
      apply derivable_continuous_pt; apply derivable_pt_exp.
  - apply is_lim_seq_continuous; [|trivial].
    apply derivable_continuous_pt; now apply derivable_pt_ln.
Qed.

Lemma is_product_iff_is_log_sum (a : nat -> posreal) (l:posreal) :
  is_lim_seq (part_prod_pos a) l <-> is_series (fun n => ln (a n)) (ln l).
Proof.
  rewrite <- log_product_iff_sum_logs.
  now rewrite log_product_iff_product.
Qed.

Lemma is_lim_seq_pos (a : nat -> posreal) (l:R) (lb:posreal):
  (forall n, lb <= a n) -> is_lim_seq a l -> 0 < l.
Proof.
  generalize (is_lim_seq_const lb); intros.
  generalize (is_lim_seq_le (fun _ => lb) a lb l H0 H H1).
  destruct lb; simpl.
  lra.
Qed.

Lemma ex_product_iff_ex_log_sum (a : nat -> posreal) (lb:posreal):
  (forall n, lb <= part_prod_pos a n) ->
  ex_finite_lim_seq (part_prod_pos a) <-> ex_series (fun n => ln (a n)).
Proof.
  unfold ex_finite_lim_seq, ex_series.
  split; intros; destruct H0.
  - generalize (is_lim_seq_pos (part_prod_pos a) x lb H H0); intros.
    exists (ln x).
    now apply is_product_iff_is_log_sum with (l := mkposreal x H1).
  - exists (exp x).
    replace (x) with (ln (exp x)) in H0 by apply ln_exp.
    assert (0 < exp x) by apply exp_pos.
    now apply is_product_iff_is_log_sum with (l := mkposreal (exp x) H1).
Qed.

Lemma sum_split {G : AbelianGroup} (f : nat -> G) (n1 n2 m : nat) :
  (n1 <= m)%nat -> (m < n2)%nat ->
  sum_n_m f n1 n2 = plus (sum_n_m f n1 m) (sum_n_m f (S m) n2).
Proof.
  intros.
  unfold sum_n_m.
  unfold Iter.iter_nat.
  repeat rewrite Iter.iter_iter'.
  unfold Iter.iter'.
  rewrite iota_is_an_annoying_seq.
  rewrite (iota_is_an_annoying_seq n1  (S m - n1)).
  rewrite (iota_is_an_annoying_seq (S m) (S n2 - S m)).
  replace (S n2 - n1)%nat with ((S m - n1) + (S n2 - S m))%nat by lia.
  rewrite seq_plus.
  rewrite List.fold_right_app.
  rewrite fold_right_plus_acc.
  now replace (n1 + (S m - n1))%nat with (S m) by lia.
Qed.

Lemma sum_split_plus {G : AbelianGroup} (f : nat -> G) (n1 n2 k : nat) :
  (n1 <= n2)%nat -> (0 < k)%nat ->
  sum_n_m f n1 (n2 + k) = plus (sum_n_m f n1 n2) (sum_n_m f (S n2) (n2 + k)).
Proof.
  intros.
  apply sum_split; lia.
Qed.

    Lemma seq_sum_shift (α : nat -> R) (nk:nat):
      is_lim_seq (sum_n α) p_infty ->
      is_lim_seq (sum_n (fun n0 => α (n0 + nk)%nat)) p_infty.
    Proof.
      intros.
      destruct (Nat.eq_dec nk 0).
      - subst.
        eapply (is_lim_seq_ext _ _ _ _ H).
        Unshelve.
        intros.
        apply sum_n_ext.
        intros.
        f_equal; lia.
     -  apply is_lim_seq_incr_n with (N := nk) in H.
        assert (0 < nk)%nat by lia.
        apply is_lim_seq_ext
              with (v := (fun n => ((sum_n α (nk-1)%nat) +
                                    (sum_n (fun n1 : nat => α (n1 + nk)%nat) n))%R ))
                   in H.
        + eapply is_lim_seq_minus with (v := fun _ => sum_n α (nk-1)) in H.
          * eapply is_lim_seq_ext in H.
            -- apply H.
            -- intros; lra.
          * apply is_lim_seq_const.
          * unfold is_Rbar_minus, is_Rbar_plus.
            now simpl.
        + intros.
          unfold sum_n.
          rewrite sum_split with (m := (nk-1)%nat); try lia.
          apply Rplus_eq_compat_l.
          replace (S (nk - 1)) with (nk) by lia.
          apply sum_n_m_shift.
    Qed.

  Lemma ex_seq_sum_shift (α : nat -> R) (nk:nat):
      ex_lim_seq (sum_n α) ->
      ex_lim_seq (sum_n (fun n0 => α (n0 + nk)%nat)).
  Proof.
    destruct nk.
    {
      apply ex_lim_seq_ext; intros.
      apply sum_n_ext; intros.
      f_equal; lia.
    }
    intros.
    eapply ex_lim_seq_ext.
    - intros.
      apply (sum_n_m_shift α (S nk) n).
    - unfold sum_n in H.
      apply (ex_lim_seq_incr_n _ (S nk)) in H.
      simpl in H.

      cut (ex_lim_seq (fun n : nat => sum_n_m α 0 (nk + S n) - sum_n_m α 0 nk)).
      {
        apply ex_lim_seq_ext; intros.
        rewrite (sum_split_plus α 0 nk (S n)); try lia.
        unfold plus; simpl.
        field_simplify.
        f_equal.
        lia.
      }
      apply ex_lim_seq_minus.
      + revert H.
        apply ex_lim_seq_ext; intros.
        f_equal; lia.
      + apply ex_lim_seq_const.
      + rewrite Lim_seq_const.
        unfold ex_Rbar_minus.
        apply CoquelicotAdd.ex_Rbar_plus_Finite_r.
  Qed.

Lemma nneg_sum_n_m_sq  (a : nat -> R) (n m : nat) :
  0 <= sum_n_m (fun k => Rsqr (a k)) n m.
Proof.
  replace (0) with (INR (S m - n) * 0) by lra.
  rewrite <- sum_n_m_const.
  apply sum_n_m_le.
  intros.
  apply Rle_0_sqr.
Qed.

Lemma nneg_series (a : nat -> R) :
  (forall n, 0 <= a n) ->
  ex_series a ->
  0 <= Series a.
Proof.
  intros.
  assert (Series (fun _ => 0) = 0).
  {
    unfold Series.
    rewrite <- (Lim_seq_ext (fun _ => 0)).
    now rewrite Lim_seq_const.
    intros.
    rewrite sum_n_const; lra.
  }
  rewrite <- H1.
  apply Series_le; trivial.
  intros.
  split; try lra; trivial.
Qed.

Lemma nneg_series_sq (a : nat -> R) :
  ex_series (fun n => Rsqr (a n)) ->
  0 <= Series (fun n => Rsqr (a n)).
Proof.
  intros.
  apply nneg_series; trivial.
  intros.
  apply Rle_0_sqr.
Qed.

Lemma sub_sum_limit_nneg (a : nat -> R) (n: nat) :
  (forall n, 0 <= a n) ->
  ex_series a ->
  sum_n a n <= Series a.
Proof.
  intros.
  assert (0 < S n)%nat by lia.
  generalize (Series_incr_n a (S n) H1 H0).
  intros.
  rewrite H2.
  rewrite <- sum_n_Reals.
  replace (Init.Nat.pred (S n)) with (n) by lia.
  replace (sum_n a n) with (sum_n a n + 0) at 1 by lra.
  apply Rplus_le_compat_l.
  apply nneg_series; trivial.
  rewrite <- (ex_series_incr_n a (S n)); trivial.
Qed.

Lemma sub_sum_limit_sq (a : nat -> R) (n: nat) :
  let fnsq := (fun n => Rsqr (a n)) in
  ex_series fnsq ->
  sum_n fnsq n <= Series fnsq.
Proof.
  apply sub_sum_limit_nneg.
  intros.
  apply Rle_0_sqr.
Qed.

Lemma lim_sq_0 (a : nat -> R) :
  is_series (fun k => Rsqr (a k)) 0 ->
  forall n, 0 = a n.
Proof.
  intros.
  assert (H' := H).
  apply is_series_unique in H.
  assert (ex_series (fun k : nat => (a k)²)).
  unfold ex_series.
  exists 0; trivial.
  generalize (sub_sum_limit_sq a n H0); intros.
  rewrite H in H1.
  generalize (nneg_sum_n_m_sq  a 0%nat n); intros.
  unfold sum_n in H1.
  generalize  (Rle_antisym _ _ H2 H1); intros.
  induction n.
  - rewrite sum_n_n in H3; trivial.
    now rewrite Rsqr_eq_0.
  - rewrite sum_n_Sm in H3; unfold plus in H3; simpl in H3; [|lia].
    generalize (Rle_0_sqr (a (S n))); intros.
    generalize (nneg_sum_n_m_sq  a 0%nat n); intros.
    generalize (Rplus_eq_R0 _ _ H4 H5).
    intros.
    destruct H6; [lra|].
    now apply Rsqr_eq_0 in H6.
Qed.

End series_sequences.

Section max_prod.

Definition max_prod_fun (a : nat -> posreal) (m n : nat) : R :=
  List.fold_right Rmax 0 (List.map (fun k => part_prod_n a k n) (List.seq 0 (S m)%nat)).

Lemma max_prod_le (F : nat -> posreal) (k m n:nat) :
  (k <= m)%nat ->
  (m <= n)%nat ->
  part_prod_n F k n <= max_prod_fun F m n.
Proof.
  intros.
  unfold max_prod_fun.
  apply fold_right_max_upper_list.
  apply List.in_map_iff.
  exists k.
  split; trivial.
  apply List.in_seq; lia.
Qed.

Lemma max_bounded1_pre_le (F : nat -> posreal) (m n:nat) :
  (forall (n:nat), F n <= 1) ->
  (S m <= n)%nat ->
  part_prod_n F m n <= part_prod_n F (S m) n.
Proof.
  intros.
  unfold part_prod_n.
  replace (S n - S m)%nat with (n - m)%nat by lia.
  replace (S n - m)%nat with (1 + (n - m))%nat by lia.
  rewrite seq_plus, List.map_app; simpl.
  replace (m + 1)%nat with (S m) by lia.
  specialize (H m).
  rewrite <- Rmult_1_l.
  apply Rmult_le_compat_r; trivial.
  rewrite ListAdd.fold_right_map.
  left; apply fold_right_mult_pos.
Qed.

Lemma max_bounded1 (F : nat -> posreal) (m n:nat) :
  (forall (n:nat), F n <= 1) ->
  (m <= n)%nat -> max_prod_fun F m n = part_prod_n F m n.
Proof.
  intros.
  unfold max_prod_fun.
  induction m.
  - apply Rmax_left.
    left.
    apply pos_part_prod_n.
  - replace (S (S m)) with (S m + 1)%nat by lia.
    rewrite seq_plus, List.map_app, List.fold_right_app.
    replace (List.fold_right Rmax
    (List.fold_right Rmax 0 (List.map (fun k : nat => part_prod_n F k n) (List.seq (0 + S m) 1)))
    (List.map (fun k : nat => part_prod_n F k n) (List.seq 0 (S m))))
      with
        (Rmax 0 (List.fold_right Rmax
    (List.fold_right Rmax 0 (List.map (fun k : nat => part_prod_n F k n) (List.seq (0 + S m) 1)))
    (List.map (fun k : nat => part_prod_n F k n) (List.seq 0 (S m))))).
    + rewrite fold_right_max_acc.
      rewrite IHm by lia.
      simpl.
      rewrite (Rmax_left _ 0).
      * apply Rmax_left.
        now apply max_bounded1_pre_le.
      * left; apply pos_part_prod_n.
    + apply Rmax_right; simpl.
      apply Rle_trans with (r2 := part_prod_n F 0 n); trivial.
      left; apply pos_part_prod_n.
      apply Rmax_l.
Qed.

Lemma lim_max_bounded1 (F : nat -> posreal) (m:nat) :
  (forall (n:nat), F n <= 1) ->
  is_lim_seq (part_prod F) 0 -> is_lim_seq (fun n => max_prod_fun F m (n+m)%nat) 0.
Proof.
  intros.
  apply (is_lim_seq_ext (part_prod (fun k : nat => F (m + k)%nat))).
  - intros.
    rewrite max_bounded1; [|trivial|lia].
    unfold part_prod.
    apply part_prod_n_shift.
  - now apply inf_prod_m_0.
Qed.

Lemma pos_sq_bounded1 (F : nat -> posreal) (n : nat) :
  F n <= 1 -> (pos_sq_fun F) n <= 1.
Proof.
  intros.
  unfold pos_sq_fun, pos_sq; simpl.
  replace (1) with (1 * 1) by lra.
  assert (0 <= F n) by (destruct (F n); simpl; lra).
  apply Rmult_le_compat; trivial.
Qed.

Lemma lim_max_bounded1_sq (F : nat -> posreal) (m:nat) :
  (forall (n:nat), F n <= 1) ->
  is_lim_seq (part_prod F) 0 -> is_lim_seq (fun n => max_prod_fun (pos_sq_fun F) m (n+m)%nat) 0.
Proof.
  intros.
  apply lim_max_bounded1; intros.
  now apply pos_sq_bounded1.
  apply inf_prod_sq_0.
  apply H0.
Qed.

Lemma max_prod_index_n (F : nat -> posreal) (m : nat) (n:nat) (mle:(m <= n)%nat) :
  exists k : nat,
    (k <= m)%nat /\
     part_prod_n F k n = max_prod_fun F m n.
Proof.
  unfold max_prod_fun.
  destruct (fold_right_max_in 0 (List.map (fun k : nat => part_prod_n F k n) (List.seq 0 (S m)))).
  - generalize (pos_part_prod_n F); intros.
    simpl in H.
    generalize (Rmax_l  (part_prod_n F 0 n) (List.fold_right Rmax 0 (List.map (fun k : nat => part_prod_n F k n) (List.seq 1 m)))); intros ineq1.
    rewrite H in ineq1.
    specialize (H0 0%nat n); lra.
  - rewrite List.in_map_iff in H.
    destruct H as [k [keqq ink]].
    apply List.in_seq in ink.
    exists k.
    split; trivial; lia.
Qed.

Lemma max_prod_n_S (a: nat -> posreal) (m n : nat) :
  (m <= n)%nat ->
  (max_prod_fun a m (S n)) = max_prod_fun a m n * a (S n).
Proof.
  intros mle.
  unfold max_prod_fun.
  rewrite fold_right_rmax_const.
  - rewrite List.map_map.
    f_equal.
    + lra.
    + apply List.map_ext_in; intros.
      apply List.in_seq in H.
      apply part_prod_n_S.
      lia.
  - left. apply cond_pos.
Qed.

Lemma initial_max_prod_n (a : nat -> posreal) (k m n:nat):
  (k <= m)%nat ->
  max_prod_fun a k (S m + n)%nat = (max_prod_fun a k m) * (part_prod_n a (S m) (S m + n)%nat).
Proof.
  intros.
  induction n; simpl.
  - replace (m+0)%nat with (m) by lia.
    rewrite part_prod_n_k_k, max_prod_n_S; trivial.
  - rewrite part_prod_n_S; [|lia].
    rewrite max_prod_n_S; [|lia].
    replace (m + S n)%nat with (S m + n)%nat by lia.
    rewrite IHn; lra.
Qed.

Lemma max_prod_index (F : nat -> posreal) (m:nat) :
  exists (k:nat), (k<=m)%nat /\
                  forall (n:nat), (m <= n)%nat ->
                  part_prod_n F k n = max_prod_fun F m n.
Proof.
  intros.
  assert (m <= m)%nat by lia.
  generalize (max_prod_index_n F m m H); intros.
  destruct H0 as [k H0]; destruct H0.
  exists k.
  split; trivial; intros.
  destruct (lt_dec m n).
  + remember (n - S m)%nat as nm.
    replace (n) with (S m + nm)%nat; [|lia].
    rewrite initial_seg_prod_n; trivial.
    rewrite initial_max_prod_n; trivial.
    now rewrite H1.
  + replace (n) with (m) by lia.
    now rewrite H1.
Qed.

Lemma lim_max_prod_m_0 (a : nat -> posreal):
  is_lim_seq (part_prod_pos a) 0 ->
  forall (m:nat), is_lim_seq (max_prod_fun a m) 0.
Proof.
  intros.
  generalize (max_prod_index a m); intros.
  destruct H0 as [k H0]; destruct H0.
  apply is_lim_seq_incr_n with (N:=m).
  apply (is_lim_seq_ext (fun n => part_prod_n a k (n+m)%nat)).
  intros; apply H1; lia.
  generalize (inf_prod_n_m_0 a H k); intros.
  apply is_lim_seq_incr_n.
  now unfold part_prod_n_pos in H2; simpl in H2.
Qed.

End max_prod.

Lemma prod_sq_bounded_1 (F : nat -> posreal) (r s :nat) :
  (forall (n:nat), F n <= 1) -> part_prod_n (pos_sq_fun F) r s <= 1.
Proof.
  intros.
  generalize (pos_sq_bounded1 F); intros.
  unfold part_prod_n.
  induction (S s-r)%nat.
  - simpl.
    lra.
  - replace (S n) with (n+1)%nat by lia.
    rewrite seq_plus, List.map_app, List.fold_right_app; simpl.
    replace (1) with (1*1) at 2 by lra.
    rewrite fold_right_mult_acc.
    apply Rmult_le_compat; trivial.
    + rewrite ListAdd.fold_right_map; left.
      apply (fold_right_mult_pos (pos_sq_fun F)).
    + left; apply Rmult_lt_0_compat; [|lra].
      apply Rmult_lt_0_compat; apply cond_pos.
    + rewrite Rmult_1_r, <- Rmult_1_r.
      apply Rmult_le_compat; trivial.
      left; apply cond_pos.
      left; apply cond_pos.
Qed.

Lemma part_prod_le (F : nat -> posreal) (m k n:nat) :
  (forall (n:nat), F n <= 1) ->
  (m + k <= n)%nat ->
  part_prod_n (pos_sq_fun F) m n <= part_prod_n (pos_sq_fun F) (m + k)%nat n.
Proof.
  intros.
  induction k.
  - replace (m + 0)%nat with (m) by lia; lra.
  - assert (m + k <= n)%nat by lia.
    specialize (IHk H1).
    apply Rle_trans with (r2 := part_prod_n (pos_sq_fun F) (m + k) n); trivial.
    replace (m + S k)%nat with (S (m+k)%nat) by lia.
    destruct (le_gt_dec (S (m+k)) n).
    + apply max_bounded1_pre_le; trivial.
      intros; apply pos_sq_bounded1; trivial.
    + rewrite (part_prod_n_1 (pos_sq_fun F) (S (m + k)%nat)) ; [|lia].
      apply prod_sq_bounded_1; trivial.
Qed.

Section Dvoretsky.

Theorem Dvoretzky4_0 (F: nat -> posreal) (sigma V : nat -> R) :
  (forall (n:nat), V (S n) <= (F n) * (V n) + (sigma n)) ->
  (forall (n:nat),
      V (S n) <= sum_n (fun k => (sigma k)*(part_prod_n F (S k) n)) n +
                 (V 0%nat)*(part_prod_n F 0 n)).
Proof.
  intros.
  induction n.
  - unfold sum_n, part_prod_n; simpl.
    unfold sum_n_m, Iter.iter_nat; simpl.
    specialize (H 0%nat).
    unfold plus, zero; simpl; lra.
  - rewrite sum_Sn.
    unfold sum_n in *.
    unfold sum_n_m, Iter.iter_nat in *; simpl.
    unfold plus, zero in *; simpl in *.
    rewrite (Iter.iter_ext _ _ _ (fun k : nat => sigma k * part_prod_n F (S k) (S n))
                           (fun k : nat => (sigma k * part_prod_n F (S k) n) * F (S n))).
    + rewrite iter_plus_times_const.
      specialize (H (S n)).
      rewrite part_prod_n_S; [|lia].
      rewrite (part_prod_n_1 _ (S (S n)) (S n)); [|lia].
      rewrite part_prod_n_S; [|lia].
      apply Rle_trans with (r2 := F (S n) * V (S n) + sigma (S n)); trivial.
      apply Rmult_le_compat_l with (r:=F (S n)) in IHn.
      apply Rplus_le_compat_r with (r:=sigma (S n))  in IHn.
      lra.
      left; apply cond_pos.
    + intros.
      rewrite part_prod_n_S.
      * lra.
      * generalize (Iter.In_iota 1 x n); intros HH.
        replace (S n - 1)%nat with n in HH by lia.
        apply HH in H0; lia.
Qed.

Lemma sum_bound_prod_A (F : nat -> posreal) (sigma : nat -> R) (A : R) (n m:nat) :
  (forall r s, part_prod_n (pos_sq_fun F) r s <= A) ->
  sum_n_m (fun k => (Rsqr (sigma k))*(part_prod_n (pos_sq_fun F) (S k) n)) (S m) n <=
  (sum_n_m (fun k => Rsqr (sigma k)) (S m) n) * A.
Proof.
  intros.
  rewrite <- sum_n_m_mult_r with (a := A).
  apply sum_n_m_le; intros.
  specialize (H (S k) n).
  apply Rmult_le_compat; trivial.
  apply Rle_0_sqr.
  left; apply pos_part_prod_n.
  lra.
Qed.

Lemma sum_bound3_max (F : nat -> posreal) (sigma : nat -> R) (n m:nat) :
  (S m <= n)%nat ->
  sum_n (fun k => (Rsqr (sigma k))*(part_prod_n (pos_sq_fun F) (S k) n)) m <=
  (sum_n (fun k => (Rsqr (sigma k))) m) * (max_prod_fun (pos_sq_fun F) (S m) n).
Proof.
  intros.
  rewrite <- sum_n_mult_r with (a := (max_prod_fun (pos_sq_fun F) (S m) n)).
  apply sum_n_le_loc; intros.
  apply Rmult_le_compat_l.
  apply Rle_0_sqr.
  apply max_prod_le; lia.
Qed.

Theorem Dvoretzky4_8_5 (F : nat -> posreal) (sigma V: nat -> R) (n m:nat) (A:R):
  (forall r s, part_prod_n (pos_sq_fun F) r s <= A) ->
  (forall (n:nat), Rsqr (V (S n)) <= (pos_sq_fun F) n * Rsqr (V n) + Rsqr (sigma n)) ->
  (m<n)%nat ->
   Rsqr (V (S n)) <=
     ( sum_n_m (fun k => Rsqr (sigma k)) (S m) n) * A +
     (Rsqr (V 0%nat) + sum_n (fun k => (Rsqr (sigma k))) m) *
             (max_prod_fun (pos_sq_fun F) (S m) n).
Proof.
  intros F1 Vsqle mn.
  generalize (Dvoretzky4_0 (pos_sq_fun F) (fun k => Rsqr(sigma k)) (fun k => Rsqr (V k))).
  intros.
  specialize (H Vsqle n).
  unfold sum_n in H.
  rewrite (sum_split _ _ _ m) in H; trivial; [|lia].
  generalize (sum_bound_prod_A F sigma A n m F1); intros.
  generalize (max_prod_le (pos_sq_fun F) 0 (S m) n); intros.
  generalize (sum_bound3_max F sigma n m); intros.
  apply Rmult_le_compat_l with (r := Rsqr (V 0%nat)) in H1; try lia; [|apply Rle_0_sqr].
  unfold sum_n in *.
  assert (S m <= n)%nat by lia.
  specialize (H2 H3).
  generalize (Rplus_le_compat _ _ _ _ H0 H1); intros.
  generalize (Rplus_le_compat _ _ _ _ H2 H4); intros.
  unfold plus, zero in *.
  simpl in *.
  lra.
Qed.

Lemma sum_bound_prod_A_sigma1
      (F : nat -> posreal) (sigma : nat -> R) (A : R) (n m:nat) :
  (forall r s, part_prod_n (pos_sq_fun F) r s <= A) ->
  (forall n, 0 <= sigma n) ->
  sum_n_m (fun k => (sigma k)*(part_prod_n (pos_sq_fun F) (S k) n)) (S m) n <=
  (sum_n_m sigma (S m) n) * A.
Proof.
  intros.
  rewrite <- sum_n_m_mult_r with (a := A).
  apply sum_n_m_le; intros.
  specialize (H (S k) n).
  apply Rmult_le_compat; trivial; try lra.
  left; apply pos_part_prod_n.
Qed.

Lemma sum_bound3_max_sigma1 (F : nat -> posreal) (sigma : nat -> R) (n m:nat) :
  (S m <= n)%nat ->
  (forall n, 0 <= sigma n) ->
  sum_n (fun k => (sigma k)*(part_prod_n (pos_sq_fun F) (S k) n)) m <=
  (sum_n sigma m) * (max_prod_fun (pos_sq_fun F) (S m) n).
Proof.
  intros.
  rewrite <- sum_n_mult_r with (a := (max_prod_fun (pos_sq_fun F) (S m) n)).
  apply sum_n_le_loc; intros.
  apply Rmult_le_compat_l.
  - apply H0.
  - apply max_prod_le; lia.
Qed.

Theorem Dvoretzky4_8_5_V1 (F : nat -> posreal) (sigma V: nat -> R) (n m:nat) (A:R):
  (forall r s, part_prod_n (pos_sq_fun F) r s <= A) ->
  (forall (n:nat), (V (S n)) <= (pos_sq_fun F) n * (V n) + (sigma n)) ->
  (forall (n:nat), 0 <= V n) ->
  (forall (n:nat), 0 <= sigma n) ->
  (m<n)%nat ->
  V (S n) <=
  (sum_n_m sigma (S m) n) * A +
  (V 0%nat + sum_n sigma m) *
             (max_prod_fun (pos_sq_fun F) (S m) n).
Proof.
  intros F1 Vle Vpos sigma_pos mn.
  generalize (Dvoretzky4_0 (pos_sq_fun F) sigma V).
  intros.
  specialize (H Vle n).
  unfold sum_n in H.
  rewrite (sum_split _ _ _ m) in H; trivial; [|lia].
  generalize (sum_bound_prod_A_sigma1 F sigma A n m F1); intros.
  generalize (max_prod_le (pos_sq_fun F) 0 (S m) n); intros.
  generalize (sum_bound3_max_sigma1 F sigma n m); intros.
  apply Rmult_le_compat_l with (r := (V 0%nat)) in H1; try lia; try apply Vpos.
  unfold sum_n in *.
  assert (S m <= n)%nat by lia.
  specialize (H2 H3 sigma_pos).
  specialize (H0 sigma_pos).
  generalize (Rplus_le_compat _ _ _ _ H0 H1); intros.
  generalize (Rplus_le_compat _ _ _ _ H2 H4); intros.
  unfold plus, zero in *.
  simpl in *.
  lra.
Qed.

Theorem Dvoretzky4_8_5_1 (F : nat -> posreal) (sigma V: nat -> R) (n m:nat) (A sigmasum:R) :
  (forall r s, part_prod_n (pos_sq_fun F) r s <= A) ->
  (forall (n:nat), Rsqr (V (S n)) <= (pos_sq_fun F) n * Rsqr (V n) + Rsqr (sigma n)) ->
  is_series (fun n => Rsqr (sigma n)) sigmasum ->
  (m<n)%nat ->
   Rsqr (V (S n)) <=
      (sum_n_m (fun k => Rsqr (sigma k)) (S m) n) * A +
     (Rsqr (V 0%nat) + sigmasum) * (max_prod_fun (pos_sq_fun F) (S m) n).
Proof.
  intros.
  generalize (Dvoretzky4_8_5 F sigma V n m A H H0 H2); intros.
  assert (sum_n (fun k : nat => (sigma k)²) m <= sigmasum).
  - assert (H1' := H1).
    apply is_series_unique in H1.
    assert (ex_series (fun k : nat => (sigma k)²)).
    + unfold ex_series.
      exists sigmasum; trivial.
    + rewrite <- H1.
      apply sub_sum_limit_sq; trivial.
  - apply Rplus_le_compat_l with (r := Rsqr (V 0%nat)) in H4.
    apply Rmult_le_compat_r with
      (r := max_prod_fun (pos_sq_fun F) (S m) n) in H4; try lra.
    assert (part_prod_n (pos_sq_fun F) (S m) n <=  max_prod_fun (pos_sq_fun F) (S m) n).
    + apply max_prod_le; lia.
    + assert (0 <= part_prod_n (pos_sq_fun F) (S m) n).
      * left; apply pos_part_prod_n.
      * apply (Rle_trans  _ _ _ H6 H5).
Qed.

Theorem Dvoretzky4_8_5_1_V1 (F : nat -> posreal) (sigma V: nat -> R) (n m:nat) (A sigmasum:R) :
  (forall r s, part_prod_n (pos_sq_fun F) r s <= A) ->
  (forall (n:nat), V (S n) <= (pos_sq_fun F) n * (V n) + (sigma n)) ->
  (forall n, 0 <= sigma n) ->
  (forall n, 0 <= V n) ->
  is_series sigma sigmasum ->
  (m<n)%nat ->
   V (S n) <=
      (sum_n_m sigma (S m) n) * A +
      (V 0%nat + sigmasum) * (max_prod_fun (pos_sq_fun F) (S m) n).
Proof.
  intros.
  generalize (Dvoretzky4_8_5_V1 F sigma V n m A H H0 H2 H1 H4); intros.
  assert (sum_n sigma m <= sigmasum).
  - assert (H3' := H3).
    apply is_series_unique in H3.
    assert (ex_series sigma).
    + unfold ex_series.
      exists sigmasum; trivial.
    + rewrite <- H3.
      apply sub_sum_limit_nneg; trivial.
  - apply Rplus_le_compat_l with (r := (V 0%nat)) in H6.
    apply Rmult_le_compat_r with
        (r := max_prod_fun (pos_sq_fun F) (S m) n) in H6; try lra.
    assert (part_prod_n (pos_sq_fun F) (S m) n <=  max_prod_fun (pos_sq_fun F) (S m) n).
    + apply max_prod_le; lia.
    + assert (0 <= part_prod_n (pos_sq_fun F) (S m) n).
      * left; apply pos_part_prod_n.
      * apply (Rle_trans  _ _ _ H8 H7).
Qed.

Lemma Dvoretzky4_sigma_v0_2_0 (F : nat -> posreal) (sigma V: nat -> R) :
  (forall (n:nat), Rsqr (V (S n)) <= (pos_sq_fun F) n * Rsqr (V n) + Rsqr (sigma n)) ->
  ex_series (fun n => Rsqr (sigma n)) ->
  Series (fun n => Rsqr (sigma n)) + Rsqr (V 0%nat) = 0 ->
  forall n, V n = 0.
Proof.
  intros.
  remember (Series (fun n => Rsqr (sigma n))) as sigma_sum.
  generalize (nneg_series_sq sigma H0); simpl; intros.
  generalize (Rle_0_sqr (V 0%nat)); intros.
  rewrite <- Heqsigma_sum in H2.
  generalize (Rplus_eq_R0 sigma_sum (Rsqr (V 0%nat)) H2 H3 H1); intros.
  destruct H4.
  generalize (lim_sq_0 sigma).
  rewrite Heqsigma_sum in H4; intros.
  generalize (Series_correct _ H0); intros.
  rewrite H4 in H7.
  specialize (H6 H7).
  induction n.
  - now apply Rsqr_eq_0 in H5.
  - specialize (H n).
    rewrite IHn, <- H6 in H.
    rewrite Rsqr_0, Rplus_0_r, Rmult_0_r in H.
    generalize (Rle_0_sqr (V (S n))); intros.
    generalize (Rle_antisym _ _ H H8).
    apply Rsqr_eq_0.
Qed.

Lemma Dvoretzky4_sigma_v0_2_0_V_pos (F : nat -> posreal) (sigma V: nat -> R) :
  (forall n, 0 <= sigma n) ->
  (forall n, 0 <= V n) ->
  (forall (n:nat), (V (S n)) <= (pos_sq_fun F) n * (V n) + (sigma n)) ->
  ex_series sigma ->
  Series sigma + (V 0%nat) = 0 ->
  forall n, V n = 0.
Proof.
  intros.
  remember (Series sigma) as sigma_sum.
  generalize (nneg_series sigma H H2); simpl; intros.
  rewrite <- Heqsigma_sum in H4.
  generalize (Rplus_eq_R0 sigma_sum (V 0%nat) H4 (H0 0%nat) H3); intros.
  destruct H5.
  generalize (lim_0_nneg sigma).
  rewrite Heqsigma_sum in H5; intros.
  generalize (Series_correct _ H2); intros.
  rewrite H5 in H8.
  specialize (H7 H8).
  induction n.
  - trivial.
  - specialize (H1 n).
    cut_to H7; trivial.
    specialize (H7 n).
    rewrite IHn, H7 in H1.
    rewrite Rplus_0_r, Rmult_0_r in H1.
    now apply Rle_antisym.
Qed.

Theorem Dvoretzky4_A (F : nat -> posreal) (sigma V: nat -> R) (A:posreal) :
  (forall r s, part_prod_n (pos_sq_fun F) r s <= A) ->
  (forall (n:nat), Rsqr (V (S n)) <= (pos_sq_fun F) n * Rsqr (V n) + Rsqr (sigma n)) ->
  is_lim_seq (part_prod F) 0 ->
  ex_series (fun n => Rsqr (sigma n)) ->
  is_lim_seq (fun n => Rsqr (V n)) 0.
Proof.
  intros.
  generalize (Cauchy_ex_series (fun n : nat => (sigma n)²) H2); intros.
  unfold Cauchy_series in H3.
  generalize (inf_prod_sq_0 F H1); intros lim_prod_sq.
  generalize (lim_max_prod_m_0 (pos_sq_fun F) lim_prod_sq); intros.
  rewrite is_lim_seq_Reals; unfold Un_cv; intros.
  assert (0 < eps/(2*A)).
  apply Rdiv_lt_0_compat; trivial.
  apply Rmult_lt_0_compat; [lra|apply cond_pos].
  remember (mkposreal (eps/(2*A)) H6) as half_eps_div_A.
  specialize (H3 half_eps_div_A).
  destruct H3 as [Nsigma H3].
  unfold norm in H3; simpl in H3.
  unfold abs in H3; simpl in H3.
  assert (H2' := H2).
  unfold ex_series in H2.
  destruct H2 as [sigma_sum H2].
  remember (sigma_sum + Rsqr (V 0%nat)) as sigma_V0_2.
  destruct (Req_dec sigma_V0_2 0).
  - exists (0%nat); intros.
    rewrite Heqsigma_V0_2 in H7.
    apply is_series_unique in H2.
    rewrite <- H2 in H7.
    rewrite (Dvoretzky4_sigma_v0_2_0 F sigma); trivial.
    unfold R_dist.
    now rewrite Rsqr_0, Rminus_0_r, Rabs_R0.
  - assert (0 <= sigma_V0_2).
    rewrite Heqsigma_V0_2.
    apply Rplus_le_le_0_compat.
    assert (H2'' := H2).
    apply is_series_unique in H2''.
    rewrite <- H2''.
    apply nneg_series_sq; trivial.
    apply Rle_0_sqr.
    destruct H8; [|congruence].
    remember ((eps / 2) / sigma_V0_2) as part_prod_eps.
    specialize (H4 (S Nsigma)).
    rewrite is_lim_seq_Reals in H4; unfold Un_cv in H4.
    specialize (H4 part_prod_eps).
    assert (part_prod_eps > 0).
    rewrite Heqpart_prod_eps.
    apply  Rdiv_lt_0_compat; trivial; lra.
    specialize (H4 H9).
    destruct H4 as [NH4 H4].
    remember ( NH4 + S Nsigma)%nat as NV.
    exists (S NV).
    unfold R_dist in *; intros.
    rewrite Rminus_0_r, Rabs_pos_eq; [| apply Rle_0_sqr].
    generalize (Dvoretzky4_8_5_1 F sigma V (n-1)%nat Nsigma A sigma_sum H H0 H2).
    replace (S (n-1)%nat) with n by lia; intros.
    cut_to H11; [|lia].
    specialize (H3 (S Nsigma) (n-1)%nat).
    cut_to H3; try lia.
    rewrite Rabs_pos_eq in H3; [|apply nneg_sum_n_m_sq ].
    specialize (H4 (n - 1)%nat).
    rewrite Rminus_0_r in H4.
    assert (0 < max_prod_fun (pos_sq_fun F) (S Nsigma) (n - 1)).

    + generalize (max_prod_index_n (pos_sq_fun F) (S Nsigma) (n-1)%nat); intros.
      destruct H12 as [k H12]; [lia|]; destruct H12.
      rewrite <- H13.
      apply pos_part_prod_n.
    + rewrite Rabs_pos_eq in H4; [|left; apply H12].
      apply Rmult_lt_compat_l with (r := sigma_V0_2) in H4; trivial; try lia.
      rewrite Heqpart_prod_eps in H4.
      replace (sigma_V0_2 * (eps / 2 / sigma_V0_2)) with (eps/2) in H4; [|now field_simplify].
      rewrite Rplus_comm in Heqsigma_V0_2.
      rewrite <- Heqsigma_V0_2 in H11.
      unfold part_prod_pos, pos in H4.
      rewrite Heqhalf_eps_div_A in H3; simpl in H3.
      apply Rmult_lt_compat_r with (r := A) in H3; [|apply cond_pos].
      replace (eps / ( 2 * A) * A) with (eps / 2) in H3;
        [|field_simplify;trivial; apply Rgt_not_eq; apply cond_pos].
      generalize (Rplus_lt_compat _ _ _ _ H3 H4); intros.
      replace (eps/2 + eps/2) with (eps) in H13 by lra.
      apply (Rle_lt_trans  _ _ _ H11 H13).
Qed.

Theorem Dvoretzky4_A_Vpos (F : nat -> posreal) (sigma V: nat -> R) (A:posreal) :
  (forall r s, part_prod_n (pos_sq_fun F) r s <= A) ->
  (forall (n:nat), V (S n) <= (pos_sq_fun F) n * (V n) + (sigma n)) ->
  (forall (n:nat), 0 <= V n) ->
  (forall (n:nat), 0 <= sigma n) ->
  is_lim_seq (part_prod F) 0 ->
  ex_series sigma ->
  is_lim_seq V 0.
Proof.
  intros.
  generalize (Cauchy_ex_series sigma H4); intros.
  unfold Cauchy_series in H5.
  generalize (inf_prod_sq_0 F H3); intros lim_prod_sq.
  generalize (lim_max_prod_m_0 (pos_sq_fun F) lim_prod_sq); intros.
  rewrite is_lim_seq_Reals; unfold Un_cv; intros.
  assert (0 < eps/(2*A)).
  apply Rdiv_lt_0_compat; trivial.
  apply Rmult_lt_0_compat; [lra|apply cond_pos].
  remember (mkposreal (eps/(2*A)) H8) as half_eps_div_A.
  specialize (H5 half_eps_div_A).
  destruct H5 as [Nsigma H5].
  unfold norm in H5; simpl in H5.
  unfold abs in H5; simpl in H5.
  assert (H4' := H4).
  unfold ex_series in H4.
  destruct H4 as [sigma_sum H4].
  remember (sigma_sum + (V 0%nat)) as sigma_V0.
  destruct (Req_dec sigma_V0 0).
  - exists (0%nat); intros.
    rewrite Heqsigma_V0 in H9.
    apply is_series_unique in H4.
    rewrite <- H4 in H9.
    rewrite (Dvoretzky4_sigma_v0_2_0_V_pos F sigma); trivial.
    unfold R_dist.
    now rewrite Rminus_0_r, Rabs_R0.
  - assert (0 <= sigma_V0).
    rewrite Heqsigma_V0.
    apply Rplus_le_le_0_compat; trivial.
    assert (H4'' := H4).
    apply is_series_unique in H4''.
    rewrite <- H4''.
    apply nneg_series; trivial.
    destruct H10; [|congruence].
    remember ((eps / 2) / sigma_V0) as part_prod_eps.
    specialize (H6 (S Nsigma)).
    rewrite is_lim_seq_Reals in H6; unfold Un_cv in H6.
    specialize (H6 part_prod_eps).
    assert (part_prod_eps > 0).
    rewrite Heqpart_prod_eps.
    apply  Rdiv_lt_0_compat; trivial; lra.
    specialize (H6 H11).
    destruct H6 as [NH6 H6].
    remember ( NH6 + S Nsigma)%nat as NV.
    exists (S NV).
    unfold R_dist in *; intros.
    rewrite Rminus_0_r, Rabs_pos_eq; trivial.
    generalize (Dvoretzky4_8_5_1_V1 F sigma V (n-1)%nat Nsigma A sigma_sum H H0 H2 H1 H4).
    replace (S (n-1)%nat) with n by lia; intros.
    cut_to H13; [|lia].
    specialize (H5 (S Nsigma) (n-1)%nat).
    cut_to H5; try lia.
    rewrite Rabs_pos_eq in H5; [|apply sum_n_m_pos; intros; apply H2; try lia].
    specialize (H6 (n - 1)%nat).
    rewrite Rminus_0_r in H6.
    assert (0 < max_prod_fun (pos_sq_fun F) (S Nsigma) (n - 1)).

    + generalize (max_prod_index_n (pos_sq_fun F) (S Nsigma) (n-1)%nat); intros.
      destruct H14 as [k H14]; [lia|]; destruct H14.
      rewrite <- H15.
      apply pos_part_prod_n.
    + rewrite Rabs_pos_eq in H6; [|left; apply H14].
      apply Rmult_lt_compat_l with (r := sigma_V0) in H6; trivial; try lia.
      rewrite Heqpart_prod_eps in H6.
      replace (sigma_V0 * (eps / 2 / sigma_V0)) with (eps/2) in H6; [|now field_simplify].
      rewrite Rplus_comm in Heqsigma_V0.
      rewrite <- Heqsigma_V0 in H13.
      unfold part_prod_pos, pos in H6.
      rewrite Heqhalf_eps_div_A in H5; simpl in H5.
      apply Rmult_lt_compat_r with (r := A) in H5; [|apply cond_pos].
      replace (eps / ( 2 * A) * A) with (eps / 2) in H5;
        [|field_simplify;trivial; apply Rgt_not_eq; apply cond_pos].
      generalize (Rplus_lt_compat _ _ _ _ H5 H6); intros.
      replace (eps/2 + eps/2) with (eps) in H15 by lra.
      apply (Rle_lt_trans  _ _ _ H13 H15).
Qed.

Theorem Dvoretzky4B (F : nat -> posreal) (sigma V: nat -> R) :
  (forall n, F n <= 1) ->
  (forall (n:nat), Rsqr (V (S n)) <= (pos_sq_fun F) n * Rsqr (V n) + Rsqr (sigma n)) ->
  is_lim_seq (part_prod F) 0 ->
  ex_series (fun n => Rsqr (sigma n)) ->
  is_lim_seq (fun n => Rsqr (V n)) 0.
Proof.
  intros.
  apply Dvoretzky4_A with (F := F) (sigma := sigma) (A := mkposreal _ Rlt_0_1); trivial.
  intros; apply prod_sq_bounded_1; trivial.
Qed.

Theorem Dvoretzky4B_Vpos (F : nat -> posreal) (sigma V: nat -> R) :
  (forall n, F n <= 1) ->
  (forall n, 0 <= V n) ->
  (forall n, 0 <= sigma n) ->
  (forall (n:nat), V (S n) <= (pos_sq_fun F) n * (V n) + (sigma n)) ->
  is_lim_seq (part_prod F) 0 ->
  ex_series sigma ->
  is_lim_seq V 0.
Proof.
  intros.
  apply Dvoretzky4_A_Vpos with (F := F) (sigma := sigma) (A := mkposreal _ Rlt_0_1); trivial.
  intros; apply prod_sq_bounded_1; trivial.
Qed.

Section Generalized_Harmonic_Series.

Lemma inv_bound_gt (a b : posreal) :
  / a  > / (a + b).
Proof.
  apply Rinv_lt_contravar.
  - apply Rmult_lt_0_compat.
    + apply cond_pos.
    + apply Rplus_lt_0_compat; apply cond_pos.
  - replace (pos a) with (a + 0) at 1 by lra.
    apply Rplus_lt_compat_l.
    apply cond_pos.
Qed.

Lemma inv_bound_sq_gt (a b : posreal) :
  Rsqr (/ a)  > Rsqr (/ (a + b)).
Proof.
  apply Rsqr_incrst_1.
  + apply inv_bound_gt.
  + left.
    apply Rinv_0_lt_compat.
    apply Rplus_lt_0_compat; apply cond_pos.
  + left.
    apply Rinv_0_lt_compat; apply cond_pos.
Qed.

Lemma inv_bound_exists_lt  (a b : posreal) :
  exists (j : nat), forall (n:nat), / (a * (INR ((S n) + j))) < / (a * INR (S n) + b).
Proof.
  exists (Z.to_nat (up (b/a))).
  intros.
  generalize  (RealAdd.up_pos (b/a)); intros.
  cut_to H.
  apply Z.gt_lt in H.
  apply Rinv_lt_contravar.
  - apply Rmult_lt_0_compat.
    + apply Rplus_lt_0_compat; [| apply cond_pos].
      apply Rmult_lt_0_compat; [apply cond_pos | ].
      apply lt_0_INR; lia.
    + apply Rmult_lt_0_compat; [apply cond_pos | ].
      apply lt_0_INR; lia.
  - rewrite plus_INR.
    rewrite Rmult_plus_distr_l.
    apply Rplus_lt_compat_l.
    assert (b/a < IZR (up (b/a))) by apply archimed.
    rewrite INR_IZR_INZ.
    rewrite Z2Nat.id; trivial; [|lia].
    apply Rmult_lt_compat_l with (r:=a) in H0; [|apply cond_pos].
    replace (a * (b / a)) with (pos b) in H0.
    generalize (cond_pos a); intros.
    lra.
    field.
    apply  Rgt_not_eq, cond_pos.
  - unfold Rdiv.
    apply Rmult_gt_0_compat; [apply cond_pos|].
    apply Rinv_0_lt_compat; apply cond_pos.
Qed.

Lemma genharmonic_series_sq (b c : posreal) :
  ex_series (fun n => Rsqr (/ (b + c * INR (S n)))).
Proof.
  apply (@ex_series_le R_AbsRing) with (b := fun n => Rsqr ( / (c * INR (S n)))).
  - intros.
    assert (0 < c * INR (S n)).
    + apply Rmult_lt_0_compat; [apply cond_pos | ].
      apply lt_0_INR; lia.
    + rewrite Rabs_right.
      * left; apply Rgt_lt.
        rewrite Rplus_comm.
        generalize (inv_bound_sq_gt (mkposreal _ H) b); intros.
        apply H0.
      * apply Rle_ge.
        apply Rle_0_sqr.
  - generalize sum_inv_sqr_bounded; intros.
    unfold ex_finite_lim_seq in H.
    destruct H.
    apply (ex_series_ext (fun n => Rsqr (/ c) * Rsqr (/ INR (S n)))).
    + intros.
      rewrite Rinv_mult_distr.
      * now rewrite Rsqr_mult.
      * apply Rgt_not_eq; apply cond_pos.
      * apply Rgt_not_eq.
        apply RealAdd.INR_zero_lt; lia.
    + apply (@ex_series_scal R_AbsRing).
      unfold ex_series.
      exists x.
      apply is_series_Reals.
      apply infinite_sum_is_lim_seq.
      apply (is_lim_seq_ext (fun n : nat => sum_f_R0 (fun i : nat => 1 / (INR i + 1)²) n)); trivial; intros.
      apply sum_f_R0_ext; intros.
      unfold Rdiv.
      rewrite  Rmult_1_l.
      rewrite Rsqr_inv.
      * now rewrite S_INR.
      * apply not_0_INR; lia.
Qed.

Lemma genharmonic_sq_lim (b c : posreal) :
  is_lim_seq (fun n => Rsqr (/ (b + c * INR (S n)))) 0.
Proof.
  apply ex_series_lim_0.
  apply genharmonic_series_sq.
Qed.

Lemma harmonic_increasing :
  let f := fun i => sum_f_R0' (fun n => 1 / INR (S n)) i in
  forall n m : nat, (n <= m)%nat -> f n <= f m.
Proof.
  intros.
  subst f.
  simpl.
  replace (m) with (n + (m-n))%nat by lia.
  rewrite sum_f_R0'_plus_n.
  rewrite <- Rplus_0_r at 1.
  apply Rplus_le_compat_l.
  induction (m-n)%nat.
  - simpl; lra.
  - simpl.
    apply Rplus_le_le_0_compat; trivial.
    unfold Rdiv.
    rewrite Rmult_1_l.
    left.
    apply Rinv_0_lt_compat.
    destruct (n + n0)%nat.
    + lra.
    + rewrite <- S_INR.
      apply lt_0_INR; lia.
Qed.

Lemma harmonic_series :
  is_lim_seq (fun i => sum_f_R0' (fun n => 1 / INR (S n)) i) p_infty.
Proof.
  apply is_lim_seq_spec.
  intro.
  unfold eventually.
  generalize (sum_f_R0'_bound2 (Z.to_nat (up (2 * (Rabs M))))); intros.
  exists (2 ^ Z.to_nat (up (2 * (Rabs M))))%nat.
  intros.
  assert (IZR (up (2 * Rabs M)) > 2*Rabs M) by apply archimed.
  assert (1 + INR (Z.to_nat (up (2 * (Rabs M)))) / 2 > Rabs M).
  rewrite RealAdd.INR_up_pos.
  lra.
  assert (0 <= Rabs M) by apply Rabs_pos; lra.
  generalize (harmonic_increasing (2 ^ Z.to_nat (up (2 * Rabs M))) n H0).
  intros.
  generalize (Rle_abs M); intros.
  lra.
Qed.

Lemma harmonic_series2 (c:posreal) :
  is_lim_seq (fun i => sum_f_R0' (fun n =>  1 / (c * INR (S n))) i) p_infty.
Proof.
  generalize (cond_pos c); intros cpos.
  generalize harmonic_series; intros.
  apply is_lim_seq_scal_l with (a := /c) in H.
  replace (Rbar_mult (/c) p_infty) with p_infty in H.
  - apply (is_lim_seq_ext (fun n : nat => /c * sum_f_R0' (fun n0 : nat => 1 / INR (S n0)) n)); intros; trivial.
    rewrite <- sum_f_R0'_mult_const.
    apply sum_f_R0'_ext.
    intros.
    unfold Rdiv.
    do 2 rewrite Rmult_1_l.
    rewrite Rinv_mult_distr; trivial.
    lra.
    apply not_0_INR; lia.
  - rewrite Rbar_mult_comm; symmetry.
    apply is_Rbar_mult_unique.
    apply is_Rbar_mult_p_infty_pos.
    apply Rinv_0_lt_compat; apply cond_pos.
Qed.

Lemma harmonic_series3 (j:nat) (f : nat -> R) :
  is_lim_seq (fun i => sum_f_R0' f i) p_infty ->
  is_lim_seq (fun i => sum_f_R0' (fun n => f (n + j)%nat) i) p_infty.
Proof.
  intros.
  apply (is_lim_seq_incr_n _ j) in H.
  apply is_lim_seq_minus with (v := fun _ => sum_f_R0' f j) (l2 := sum_f_R0' f j) (l1 := p_infty) (l := p_infty) in H.
  - apply (is_lim_seq_ext  (fun n : nat => sum_f_R0' f (n + j) - sum_f_R0' f j)); trivial.
    intros.
    rewrite sum_f_R0'_split with (m := j); [|lia].
    replace (n+j-j)%nat with n by lia.
    lra.
  - apply is_lim_seq_const.
  - unfold is_Rbar_minus, is_Rbar_plus.
    now simpl.
Qed.

Lemma genharmon (a b : posreal) :
  forall (n:nat), / ((a+b)*(INR (S n))) <= /(a*(INR (S n)) + b) < /(a * (INR (S n))).
Proof.
  intros.
  split.
  - apply Rinv_le_contravar.
    + apply Rplus_lt_0_compat; [ | apply cond_pos].
      apply Rmult_lt_0_compat; [apply cond_pos | ].
      apply lt_0_INR; lia.
    + rewrite Rmult_plus_distr_r.
      apply Rplus_le_compat_l.
      replace (pos b) with (b * 1) at 1 by lra.
      apply Rmult_le_compat_l; [left;apply cond_pos | ].
      rewrite S_O_plus_INR.
      replace 1 with (1 + 0) by lra.
      apply Rplus_le_compat_l.
      apply pos_INR.
  - assert (0 < a * INR (S n)).
    + apply Rmult_lt_0_compat; [apply cond_pos | ].
      apply lt_0_INR; lia.
    + apply Rinv_lt_contravar.
      * apply Rmult_lt_0_compat; trivial.
        apply Rplus_lt_0_compat; [trivial | apply cond_pos].
      * replace (a * INR (S n)) with (a * INR (S n) + 0) at 1 by lra.
        apply Rplus_lt_compat_l; apply cond_pos.
Qed.

Lemma genharmon_sq (a b : posreal) :
  forall (n:nat),
    Rsqr (/ ((a+b)*(INR (S n)))) <= Rsqr (/ (a*(INR (S n)) + b)) < Rsqr (/ (a * (INR (S n)))).
Proof.
  intros.
  generalize (genharmon a b n); intros.
  destruct H.
  assert (0 < INR (S n)) by (apply lt_0_INR; lia).
  assert (0 < (a + b) * INR (S n)).
  - apply Rmult_lt_0_compat; trivial.
    apply Rplus_lt_0_compat; apply cond_pos.
  - assert (0 < a * INR (S n) + b).
    + apply Rplus_lt_0_compat; [ | apply cond_pos].
      apply Rmult_lt_0_compat; [apply cond_pos| trivial].
    + split.
      * apply Rsqr_incr_1; trivial.
        -- left; apply Rinv_0_lt_compat; trivial.
        -- left; apply Rinv_0_lt_compat; trivial.
      * apply Rsqr_incrst_1; trivial.
        -- left; apply Rinv_0_lt_compat; trivial.
        -- left; apply Rinv_0_lt_compat.
           apply Rmult_lt_0_compat; [apply cond_pos | trivial].
Qed.

Lemma genharmonic_series (b c : posreal) :
  is_lim_seq (fun i => sum_f_R0' (fun n => 1 / (b + c * INR (S n))) i) p_infty.
Proof.
  generalize (cond_pos c); intros cpos.
  generalize (inv_bound_exists_lt c b); intros.
  destruct H as [j H].
  unfold is_lim_seq.
  apply filterlim_ge_p_infty with (f := fun n : nat => sum_f_R0' (fun n0 : nat => 1 / (c *INR (S (n0) + j))) n).
  unfold eventually;  exists (0%nat); intros.
  apply sum_f_R0'_le_f.
  intros.
  unfold Rdiv; do 2 rewrite Rmult_1_l.
  rewrite Rplus_comm; left; apply H.
  generalize (harmonic_series2 c); intros.
  generalize (harmonic_series3 j (fun n => 1 / (c * INR (S n))) H0); trivial.
Qed.

Lemma genharmonic_series2 (b c : posreal) :
  is_lim_seq (fun i => sum_f_R0' (fun n => 1 / (b + c * INR (S n))) i) p_infty.
Proof.
  generalize (genharmon c b); intros.
  assert (0 < c + b).
  apply Rplus_lt_0_compat; apply cond_pos.
  generalize (harmonic_series2 (mkposreal _ H0)); intros.
  unfold is_lim_seq in *.
  apply filterlim_ge_p_infty
    with (f := (fun i : nat =>
          sum_f_R0' (fun n : nat => 1 / ({| pos := c + b; cond_pos := H0 |} * INR (S n))) i)); trivial.
  unfold eventually;  exists (0%nat); intros.
  apply sum_f_R0'_le_f.
  intros.
  specialize (H i); destruct H.
  unfold Rdiv.
  do 2 rewrite Rmult_1_l.
  replace (b + c * INR (S i)) with (c * INR (S i) + b) by lra.
  apply H.
Qed.

End Generalized_Harmonic_Series.

Lemma Robbins_Monro_0 (u : R) (a : nat -> posreal) (g : R -> R) (A B : posreal) :
  (forall (u:R), u <> 0 -> A <= g u <= B) ->
  forall (n:nat),
    (u <> 0) ->
    Rabs (1 - a n * g u) <= Rmax (1-A*(a n)) (B*(a n) - 1).
Proof.
  intros.
  specialize (H u H0).
  destruct H.
  replace (B*(a n) - 1) with (- (1 - B*a n)) by lra.
  apply Rcomplements.Rabs_le_between_Rmax; unfold Rminus.
  split; apply Rplus_le_compat_l, Ropp_le_contravar; rewrite Rmult_comm.
  - apply Rmult_le_compat_r; trivial.
    left; apply cond_pos.
  - apply Rmult_le_compat_l; trivial.
    left; apply cond_pos.
Qed.

Lemma Robbins_Monro_1 (r : nat -> R) (a : nat -> posreal) (f : R -> R) (A B : posreal) :
  (forall (u:R), u <> 0 -> A <= f(u)/u <= B) ->
  forall (n:nat), r n <> 0 -> Rabs (r n - a n * f (r n)) <= Rabs (r n) * Rmax (1-A*(a n)) (B*(a n) - 1).
Proof.
  intros.
  replace (r n - a n * f (r n)) with ((r n)*(1 - a n * (f(r n)/(r n)))).
  - rewrite Rabs_mult.
    apply Rmult_le_compat_l; [apply Rabs_pos | ].
    apply Robbins_Monro_0 with (g := fun u => f u / u); trivial.
  - now field.
Qed.

Lemma Robbins_Monro_1b (a A B : posreal) :
  a < 2/(A + B) -> Rmax (1-A*a) (B*a-1) = 1-A*a.
Proof.
  intros.
  assert (0 < A + B).
  apply Rplus_lt_0_compat; apply cond_pos.
  apply Rmax_left; left.
  unfold Rdiv in H.
  replace (pos a) with (a * (A + B) * / (A + B)) in H.
  - apply Rmult_lt_reg_r in H; [lra | ].
    now apply Rinv_0_lt_compat.
  - field.
    now apply Rgt_not_eq.
Qed.

Lemma is_derive_Rsqr (f : R -> R) (x df : R) :
  is_derive f x df -> is_derive (fun x0 => Rsqr (f x0)) x (2 * (f x) * df).
Proof.
  intros.
  apply (is_derive_ext (fun x0 => (f x0) * (f x0))); [now unfold Rsqr |].
  replace (2 * f x * df) with ((df * f x) + (f x * df)) by lra.
  apply (@is_derive_mult R_AbsRing); trivial.
  apply Rmult_comm.
Qed.

Lemma Robbins_Monro_2a (A sigma : posreal) (a0 V : R) :
  let f := fun a => (Rsqr (1-A*a) * (Rsqr V)) + (Rsqr a * (Rsqr sigma)) in
  is_derive f a0 ((2 * (1-A*a0) * (-A) * (Rsqr V)) + (2 * a0 * (Rsqr sigma))).
Proof.
  intros.
  apply (@is_derive_plus R_AbsRing).
  - apply (@is_derive_scal_l R_AbsRing).
    apply (is_derive_Rsqr (fun x => (1 - A * x))).
    replace (-A) with (0 - A) by lra.
    apply (@is_derive_minus R_AbsRing).
    + apply (@is_derive_const R_AbsRing).
    + replace (pos A) with (A*1) at 2 by lra.
      apply is_derive_scal.
      apply (@is_derive_id R_AbsRing).
  - apply (@is_derive_scal_l R_AbsRing).
    replace (2 * a0) with (2 * a0 * 1) by lra.
    apply is_derive_Rsqr.
    apply (@is_derive_id R_AbsRing).
Qed.

Lemma Robbins_Monro_2b (A sigma : posreal) (V : R) :
  let a0 := (A * V^2) / (sigma^2 + A^2 * V^2) in
  (2 * (1-A*a0) * (-A) * (Rsqr V)) + (2 * a0 * (Rsqr sigma)) = 0.
Proof.
  intros.
  subst a0; unfold Rsqr.
  field.
  apply Rgt_not_eq.
  apply Rlt_gt.
  generalize (cond_pos sigma); intros.
  apply Rplus_lt_le_0_compat.
  - apply Rmult_lt_0_compat; [apply cond_pos | ].
    rewrite Rmult_1_r; apply cond_pos.
  - replace ((A * V)^2) with (Rsqr (A*V)) by (unfold Rsqr; lra).
    apply Rle_0_sqr.
Qed.

Lemma Robbins_Monro_2c (A sigma : posreal) (V x : R) :
  let f := fun a => (Rsqr (1-A*a) * (Rsqr V)) + (Rsqr a * (Rsqr sigma)) in
  let a0 := (A * V^2) / (sigma^2 + A^2 * V^2) in
  is_derive f a0 0.
Proof.
  intros.
  subst f.
  generalize (Robbins_Monro_2a A sigma a0 V); intros.
  simpl in H; subst a0.
  now rewrite (Robbins_Monro_2b A sigma V) in H.
Qed.

Lemma Robbins_Monro_2d (A sigma : posreal) (V x : R) :
  let f := fun a => (Rsqr (1-A*a) * (Rsqr V)) + (Rsqr a * (Rsqr sigma)) in
  let a0 := (A * V^2) / (sigma^2 + A^2 * V^2) in
  f a0 = sigma^2 * V^2 / (sigma^2 + (A*V)^2).
Proof.
  intros.
  subst f; subst a0; simpl.
  unfold Rsqr.
  field.
  apply Rgt_not_eq.
  apply Rlt_gt.
  apply Rplus_lt_le_0_compat.
  - apply Rmult_lt_0_compat; apply cond_pos.
  - replace (A * V * (A * V)) with (Rsqr (A * V)) by (unfold Rsqr; lra).
    apply Rle_0_sqr.
Qed.

End Dvoretsky.


Require Import Omega.
Require Import Wf_nat.

Definition f1_aux :
  forall x, (forall z, z < x ->{y:nat | z=0 \/ y < z})->{y:nat | x=0\/ y< x}.
 intros x; case x.
(* value for 0 *)
 intros rec; exists 0; auto.
 intros x'; case x'.
(* value for 1 *)
 intros rec; exists 0; auto.
(* value for x > 1 *)
 refine
    (fun x'' rec =>
      match rec (S x'') _ with
      | (exist _ v H) =>
        match rec (S v) _ with
        | (exist _ v' H') => (exist _ (S v') _)
        end
      end); omega.
Defined.

Definition f1' : forall x, {y:nat | x=0 \/ y<x} :=
 (well_founded_induction lt_wf
   (fun x:nat => {y:nat | x=0\/ y<x})
   f1_aux).

Definition f1 (x:nat): nat :=
 match f1' x with (exist _ v _) => v end.


From DEZ.Has Require Export
  EquivalenceRelation OrderRelation.
From DEZ.Is Require Export
  Proper Antisymmetric Transitive Connex.
From DEZ.ShouldHave Require Import
  OrderNotations.

Class IsTotalOrder {A : Type} {has_eqv : HasEqv A}
  (has_ord : HasOrd A) : Prop := {
  ord_is_proper :> IsProper (eqv ==> eqv ==> flip impl) ord;
  ord_is_antisymmetric :> IsAntisymmetric ord;
  ord_is_transitive :> IsTransitive ord;
  ord_is_connex :> IsConnex ord;
}.

Section Context.

Context {A : Type} `{is_total_order : IsTotalOrder A}.

Theorem ord_reflexive : forall x : A, x <= x.
Proof.
  intros x. destruct (connex x x) as [H | H].
  - specialize (H : x <= x). apply H.
  - specialize (H : x <= x). apply H. Qed.

Global Instance ord_is_reflexive : IsReflexive ord := {}.
Proof. apply ord_reflexive. Qed.

End Context.


(* From Arthur Chargueraud's TLC
   http://www.chargueraud.org/softs/tlc/

   Source: tlc/LibHeap.v
*)

Require Import ssreflect eqtype choice ssrbool seq.

Set Implicit Arguments.

(** * Heaps: finite maps from keys to values *)

Section HeapDef.

  Variable K: eqType.
  Variable V: eqType.

  Definition heap K V := seq (K*V).
  Canonical heap_eqType := Eval hnf in [eqType of heap K V].

  Definition empty : heap K V := [::].
  Definition dom (l : heap K V) : seq K := [seq fst x | x <- l ].
  Definition binds (l : heap K V) k v := (k,v) \in l.
  Definition to_list (l : heap K V) := l.
  Definition read (l : heap K V)(k : K) := ohead [seq kv <- l | fst kv == k ].
  Definition write (l : heap K V) k v := [:: (k, v) & l].
  Definition rem (l : heap K V) k := [seq p <- l | ~~ (fst p == k) ].
  Definition indom h r := (r \in dom h).

End HeapDef.

Arguments empty [K V].
Arguments dom [K V] h : rename.
Arguments binds [K V] h k v : rename.
Arguments read [K V] h k : rename.
Arguments write [K V] h k v : rename.
Arguments to_list [K V] h : rename.
Arguments indom [K V] h r : rename.


Require Import JMeq.

Lemma plus_assoc_JM : forall n p q:nat,
                       JMeq (n+(p+q)) (n+p+q).
Proof.
 induction n; simpl.
 -  split.
 -  intros p q; pattern (n+p+q).
    eapply JMeq_ind.
    +  apply JMeq_refl.
    +  auto.
Qed.


(* =========== Basic tactics :
-> intro - introduction rule for Pi;
-> apply - elimination rule for Pi;
-> assumption, exact - match conclusion with an hypothesis.
*)

(* =========== Tactics for first-order reasoning:
-> intro - introduction rule for negation, implication and universal quantification
-> split - introduction rule for conjunction
-> left, right - introduction rule for disjuntion
-> exists x - introduction rule for existencial quantification
-> apply H -  elimination rule for negation, implication and universal quantification
-> elim H - elimination rule for conjunction, disjuntion and existencial quantification
-> destruct H as ... - elimination rule for: [H1 H2] conjunction, [H1 | H2] disjuntion, [x H] exists
*)

(* =========== Tactics for EQUALITY and REWRITING :
-> rewrite - rewrites an equality;
-> rewrite <- - reverse rewrite of an equality;
-> reflexivity - reflexivity property for equality;
-> symmetry - symmetry property for equality;
-> transitivity - transitivity property for equality.
*)

(* =========== Tactics for EVALUATION and CONVERTIBILITY :
-> simpl, red, cbv, lazy - performs evaluation;
-> pattern - performs a beta-expansion on the goal;
-> change - replaces the goal by a convertible one.
*)

(* =========== Tactics for INDUCTION :
-> elim - to apply the corresponding induction principle;
-> induction - performs induction on an identifier;
-> destruct - case analysis;
-> discriminate - discriminates objects built from different constructors;
-> injection - constructors of inductive types are injections;
-> inversion - given an inductive type instance, find all the necessary condition
               that must hold on the arguments of its constructors.
*)

(* =========== LIBRARIES
A large base of definitions and facts found in the Coq Standard Library.
Often used libraries:
-> Arith - unary integers;
-> ZArith - binary integers;
-> List - polymorphic lists;

Useful commands for finding theorems acting on a given identifier:
-> Search
-> SearchAbout
-> SearchPattern
*)

(* =========== AUTOMATISATION
For some specific domains, Coq is able to support some degree of automatisation:
-> auto - automatically applies theorems from a database;
-> tauto, intuition - decision procedures for specific classes of goals (e.g. propositional logic);
-> firstorder - useful to prove facts that are tautologies in intuitionistic FOL;
-> omega, ring - specialized tactics for numerical properties.
*)

(* =========== USEFUL tactics and commands...
Tactics:
-> clear - removes an hypothesis from the environment;
-> generalize - re-introduce an hypothesis into the goal;
-> cut, assert - proves the goal through an intermediate result;
-> pattern - performs eta-expansion on the goal.

Commands:
-> Admitted - aborts the current proof (property is assumed);
-> Set Implicit Arguments - makes possible to omit some arguments (when inferable by the system);
-> Open Scope - opens a syntax notation scope (constants, operators, etc.)

See the Reference Manual...
 *)

(* ================================================================== *)

Require Import Arith.

Set Implicit Arguments.

Section Parte1.
(* ****** Prove os lemas desta secção SEM usar táticas automáticas ****** *)

Variables A B : Prop.
Variable X : Set.
Variables P Q R W : X -> Prop.

Lemma questao1 : (A->B) -> ((A/\B) -> A) /\ (A -> (A/\B)).
Proof.
intro H1.
split.
intro H2.
destruct H2 as [H3 H4].
exact H3.
intro H2.
split.
exact H2.
apply H1.
exact H2.
Qed.

Lemma questao2 : ~A \/ ~B -> ~(A /\ B).
Proof.
intro H.
intro H2.
destruct H2 as [H3 H4].
destruct H as [H5 | H6].
apply H5.
exact H3.
apply H6.
exact H4.
Qed.

Lemma questao3 : (forall x y:X, (R y) -> (P x)) -> (exists y:X, (R y)) -> (forall x:X, (P x)).
Proof.
intros H1 H2.
intro x.
destruct H2 as [y H3].
apply H1 with (y := y).
exact H3.
Qed.

Lemma questao4 : (forall z:X, (P z)->(W z)) -> (exists x:X, (P x)/\(Q x)) -> (exists y:X, (W y)/\(Q y)).
Proof.
intros H1 H2.
destruct H2 as [x H3].
destruct H3 as [H4 H5].
exists x.
split.
apply H1.
exact H4.
exact H5.
Qed.

Lemma questao5 : forall (x y:nat), x+2=y -> y>x.
Proof.
intros.
induction H.
rewrite plus_n_O.
SearchPattern (_ + _ > _).
apply plus_gt_compat_l.
SearchPattern (_ > 0).
apply gt_Sn_O.
Qed.

End Parte1.

(* ================================================================== *)

Section Parte2.

Require Import List.
Require Import ZArith.

Open Scope Z_scope.

Fixpoint Elem (A:Type) (a : A) (l : list A) {struct l} : Prop :=
  match l with
  | nil => False
  | b :: m => b = a \/ Elem a m
  end.

Fixpoint count (z:Z) (l:list Z) {struct l} : nat :=
  match l with
  | nil => O
  | (z' :: l') =>
      match Z_eq_dec z z' with
      | left _ => S (count z l')
      | right _ => count z l'
      end
  end.

Inductive Prefix (A:Type) : list A -> list A -> Prop :=
  | PreNil : forall (l:list A), Prefix nil l
  | PreCons : forall (x:A) (l1 l2:list A), Prefix l1 l2 -> Prefix (x::l1) (x::l2).

Inductive SubList (A:Type) : list A -> list A -> Prop :=
  | SLnil : forall (l:list A), SubList nil l
  | SLcons1 : forall (x:A) (l1 l2:list A), SubList l1 l2 -> SubList (x::l1) (x::l2)
  | SLcons2 : forall (x:A) (l1 l2:list A), SubList l1 l2 -> SubList l1 (x::l2).

Inductive Sorted : list Z -> Prop :=
  | sorted0 : Sorted nil
  | sorted1 : forall z:Z, Sorted (z :: nil)
  | sorted2 : forall (z1 z2:Z) (l:list Z),
        z1 <= z2 -> Sorted (z2 :: l) -> Sorted (z1 :: z2 :: l).

Lemma questao6 :  forall (x:Z) (l: list Z), Sorted (x::l) -> Sorted l.
Proof.
intros x l H.
induction l.
(* base *)
apply sorted0.
(* ind1 *)
inversion H.
exact H4.
Qed.

Lemma questao7 : forall (x y:Z) (l: list Z), ~(Elem x (y::l)) -> ~(Elem x l).
Proof.
intros x y l.
intro H.
intro H1.
apply H.
simpl.
right; assumption.
Qed.

Close Scope Z_scope.

Lemma questao8 : forall (x:Z) (l: list Z), (count x l) > O -> Elem x l.
Proof.
induction l.
(* base *)
simpl.
intro H.
inversion H.
(* ind *)
intro H.
simpl.
simpl in H.
destruct Z.eq_dec.
left.
symmetry; assumption.
right.
apply IHl; assumption.
Qed.

Lemma questao9 : forall (A:Type) (x:A) (l1 l2: list A), (Elem x l1) -> SubList l1 l2 -> Elem x l2.
Proof.
intros.
induction H0.
induction l.
exact H.
simpl.
right; assumption.
simpl.
simpl in H.
destruct H as [H1 | H2].
left; assumption.
right.
apply IHSubList; assumption.
simpl.
right.
apply IHSubList; assumption.
Qed.

End Parte2.


(* This code is copyrighted by its authors; it is distributed under  *)
(* the terms of the LGPL license (see LICENSE and description files) *)

Require Import ZArith.

Lemma Zabs_Zle_1 : forall z : Z, {Z.abs z = 0%Z} + {(0 < Z.abs z)%Z}.

Proof.
intros.
destruct z.
auto with arith.
right.
simpl in |- *.
apply Z.gt_lt.
apply Zorder.Zgt_pos_0.
right.
simpl in |- *.
apply Z.gt_lt.
apply Zorder.Zgt_pos_0.
Qed.

Hint Resolve Zabs_Zle_1: real.

Lemma Zabs_Zle_2 :
 forall z z1 : Z, {z = 0%Z /\ z1 = 0%Z} + {(0 < Z.abs z)%Z \/ (0 < Z.abs z1)%Z}.

Proof.
intros.
destruct z.
destruct z1.
left.
auto with arith.
right; right.
simpl in |- *.
apply Z.gt_lt.
apply Zorder.Zgt_pos_0.
do 2 right.
simpl in |- *.
apply Z.gt_lt.
apply Zorder.Zgt_pos_0.
right.
left.
simpl in |- *.
apply Z.gt_lt.
apply Zorder.Zgt_pos_0.
right.
left.
simpl in |- *.
apply Z.gt_lt.
apply Zorder.Zgt_pos_0.

Qed.

Hint Resolve Zabs_Zle_2: real.

Lemma Zlt_le_ind : forall z z1 : Z, (z1 <= z)%Z \/ (z <= z1)%Z.

Proof.
intros.
cut ({(z1 <= z)%Z} + {(z1 > z)%Z}); [ intro | apply Z_le_gt_dec ].
elim H.
intro.
left; auto.
intro; right; apply Zlt_le_weak; apply Z.gt_lt; auto.
Qed.