Require Import equiv.

(* "after" is an equivalence relation *)

Lemma after_is_reflexive :
  forall gamma b i,
    is_equiv_rel gamma ->
    is_reflexive (after gamma b i).
Proof.
  intros gamma b i gamma_equiv.
  unfold is_reflexive.
  intros x.
  case x; intros i0.
  - (* x = (X i0) *)
    unfold after.
    case_eq (i0 =? i); intros Hi0.
    + (* Hi: (i0 =? i) = true *)
      right. apply beq_nat_true. assumption.
    + (* Hi: (i0 =? i) = false *)
      destruct gamma_equiv as [gref _].
      apply gref.
  - (* x = (X' i0) *)
    unfold after. reflexivity.
Qed.

Lemma after_is_symmetric :
  forall gamma b i,
    is_equiv_rel gamma ->
    is_symmetric (after gamma b i).
Proof.
  intros gamma b i gamma_equiv.
  unfold is_symmetric.
  intros x y Ha.
  case x, y.
  - (* x = (X i0), y = (X i1) *)
    unfold after.
    case_eq (i1 =? i); intros Hi1.
    + (* Hi1: (i1 =? i) = true *)
      case_eq (i0 =? i); intros Hi0.
      * (* Hi0: (i0 =? i) = true *)
        right. apply beq_nat_true. assumption.
      * (* Hi0: (i0 =? i) = false *)
        unfold after in Ha.
        rewrite Hi0 in Ha.
        rewrite Hi1 in Ha.
        auto.
    + (* Hi1: (i1 =? i) = false *)
      unfold after in Ha.
      case_eq (i0 =? i); intros Hi0.
      * (* Hi0: (i0 =? i) = true *)
        rewrite Hi0 in Ha.
        destruct Ha as [Ha | Ha].
          assumption.
        apply beq_nat_false in Hi1.
        contradiction.
      * (* Hi0: (i0 =? i) = false *)
        rewrite Hi0 in Ha.
        rewrite Hi1 in Ha.
        destruct gamma_equiv as [_ [gsym _]].
        apply gsym. assumption.
  - (* x = (X i0), y = (X' i1) *)
    unfold after. auto.
  - (* x = (X' i0), y = (X i1) *)
    unfold after. auto.
  - (* x = (X' i0), y = (X' i1) *)
    unfold after.
    case_eq (i0 =? i1); intros Hi.
    + (* Hi: (i0 =? i1) = true *)
      apply beq_nat_true in Hi. rewrite Hi. reflexivity.
    + (* Hi: (i0 =? i1) = false *)
      apply beq_nat_false in Hi. auto.
Qed.

Lemma after_is_transitive :
  forall gamma b i,
    is_equiv_rel gamma ->
    gamma |= b ->
    is_transitive (after gamma b i).
Proof.
  intros gamma b i gamma_equiv gamma_b.
  unfold is_transitive.
  intros x y z [Haxy Hayz].
  case x, y, z.
  - (* x = (X i0), y = (X i1), z = (X i2) *)
    unfold after.
    case_eq (i0 =? i); intros Hi0.
    + (* Hi0: (i0 =? i) = true *)
      case_eq (i2 =? i); intros Hi2.
      * (* Hi2: (i2 =? i) = true *)
        right. apply beq_nat_true. assumption.
      * (* Hi2: (i2 =? i) = false *)
        case_eq (i1 =? i); intros Hi1.
          unfold after in Hayz.
          rewrite Hi1 in Hayz.
          assumption.
        (* Hi1: (i1 =? i) = false *)
        unfold after in Haxy.
        rewrite Hi0 in Haxy.
        destruct Haxy as [bi1 | Hi1'].
          unfold after in Hayz.
          rewrite Hi1 in Hayz.
          rewrite Hi2 in Hayz.
          apply gamma_b in Hayz.
            left. assumption.
          assumption.
        apply beq_nat_false in Hi1.
        contradiction.
    + (* Hi0: (i0 =? i) = false *)
      case_eq (i2 =? i); intros Hi2.
      * (* Hi2: (i2 =? i) = true *)
        unfold after in Haxy.
        rewrite Hi0 in Haxy.
        case_eq (i1 =? i); intros Hi1.
          rewrite Hi1 in Haxy. assumption.
        unfold after in Hayz.
        rewrite Hi1 in Haxy.
        rewrite Hi1 in Hayz.
        rewrite Hi2 in Hayz.
        apply gamma_b in Hayz.
        apply Hayz.
        destruct gamma_equiv as [_ [gsym _]].
        apply gsym in Haxy.
        assumption.
      * (* Hi2: (i2 =? i) = false *)
        unfold after in Haxy.
        rewrite Hi0 in Haxy.
        case_eq (i1 =? i); intros Hi1.
          rewrite Hi1 in Haxy.
          apply gamma_b.
            assumption.
          unfold after in Hayz.
          rewrite Hi1 in Hayz.
          destruct Hayz as [bi2 | Hi2'].
            assumption.
          apply beq_nat_false in Hi2.
          contradiction.
        rewrite Hi1 in Haxy.
        unfold after in Hayz.
        rewrite Hi1 in Hayz.
        rewrite Hi2 in Hayz.
        destruct gamma_equiv as [_ [_ gtran]].
        apply (gtran _ (X i1) _).
        auto.
  - (* x = (X i0), y = (X i1), z = (X' i2) *)
    unfold after in Hayz. discriminate.
  - (* x = (X i0), y = (X' i1), z = (X i2) *)
    unfold after in Hayz. discriminate.
  - (* x = (X i0), y = (X' i1), z = (X' i2) *)
    unfold after in Haxy. discriminate.
  - (* x = (X' i0), y = (X i1), z = (X i2) *)
    unfold after in Haxy. discriminate.
  - (* x = (X' i0), y = (X i1), z = (X' i2) *)
    unfold after in Haxy. discriminate.
  - (* x = (X' i0), y = (X' i1), z = (X i2) *)
    unfold after in Hayz. discriminate.
  - (* x = (X' i0), y = (X' i1), z = (X' i2) *)
    unfold after.
    unfold after in Haxy.
    unfold after in Hayz.
    rewrite Haxy.
    assumption.
Qed.

Lemma after_is_equiv_rel :
  forall gamma b i,
    is_equiv_rel gamma ->
    gamma |= b ->
    is_equiv_rel (after gamma b i).
Proof.
  intros gamma b i gamma_equiv gamma_b.
  unfold is_equiv_rel.
  split.
    apply after_is_reflexive; apply gamma_equiv.
  split.
    apply after_is_symmetric; apply gamma_equiv.
    apply after_is_transitive. apply gamma_equiv.
    assumption.
Qed.

(* others *)

Lemma after_is_simpl_rel : (* a relation over (X i) *)
  forall gamma b i,
  is_simpl_rel (after gamma b i).
Proof.
  intros gamma b i.
  unfold is_simpl_rel.
  intros xi xj.
  case xi, xj.
  - auto.
  - unfold after. reflexivity.
  - unfold after. reflexivity.
  - unfold after. reflexivity.
Qed.

Lemma updated_assignment_models_after :
  forall theta gamma b i d,
    theta |= gamma /\ (theta, d) |= b -> update theta i d |= after gamma b i.
Proof.
  intros theta gamma b i d [theta_gamma theta_d_b].
  unfold models. unfold assignment_models_rel.
  split.
    apply after_is_simpl_rel.
  intros i0 j.
  split; intros H.
  - (* H: update theta i d i0 = update theta i d j *)
    unfold after.
    case_eq (i0 =? i); intros Hi0.
    + (* Hi0: (i0 =? i) = true *)
      unfold update in H.
      rewrite Hi0 in H.
      case_eq (j =? i); intros Hj.
      * (* Hj: (j =? i) = true *)
        apply beq_nat_true in Hj. auto.
      * (* Hj: (j =? i) = false *)
        left. apply theta_d_b.
        rewrite Hj in H.
        auto.
    + (* Hi0: (i0 =? i) = false *)
      unfold update in H.
      rewrite Hi0 in H.
      case_eq (j =? i); intros Hj.
      * (* Hj: (j =? i) = true *)
        rewrite Hj in H.
        apply theta_d_b. assumption.
      * (* Hj: (j =? i) = false *)
        rewrite Hj in H.
        apply theta_gamma. assumption.
  - (* H: after gamma b i (X i0) (X j) *)
    unfold update.
    case_eq (i0 =? i); intros Hi0.
    + (* Hi0: (i0 =? i) = true *)
      unfold after in H.
      rewrite Hi0 in H.
      destruct H as [bj | ji].
        apply theta_d_b in bj.
        rewrite bj.
        case (j =? i). trivial. trivial.
      rewrite ji.
      rewrite <- beq_nat_refl.
      reflexivity.
    + (* Hi0: (i0 =? i) = false *)
      unfold after in H.
      rewrite Hi0 in H.
      case_eq (j =? i); intros Hj.
      * (* Hj: (j =? i) = true *)
        rewrite Hj in H.
        apply theta_d_b. assumption.
      * (* Hj: (j =? i) = false *)
        rewrite Hj in H.
        apply theta_gamma. assumption.
Qed.


(* This file is generated by Why3's Coq 8.4 driver *)
(* Beware! Only edit allowed sections below    *)
Require Import BuiltIn.
Require BuiltIn.
Require int.Int.
Require int.Abs.
Require int.ComputerDivision.

Axiom mod_div_unique : forall (x:Z) (y:Z) (q:Z) (r:Z), ((0%Z <= x)%Z /\
  ((0%Z < y)%Z /\ ((x = ((q * y)%Z + r)%Z) /\ ((0%Z <= r)%Z /\
  (r < y)%Z)))) -> ((q = (ZArith.BinInt.Z.quot x y)) /\
  (r = (ZArith.BinInt.Z.rem x y))).

Axiom mod_succ_1 : forall (x:Z) (y:Z), ((0%Z <= x)%Z /\ (0%Z < y)%Z) ->
  ((~ ((ZArith.BinInt.Z.rem (x + 1%Z)%Z y) = 0%Z)) ->
  ((ZArith.BinInt.Z.rem (x + 1%Z)%Z y) = ((ZArith.BinInt.Z.rem x y) + 1%Z)%Z)).

Import Zquot.

(* Why3 goal *)
Theorem mod_succ_2 : forall (x:Z) (y:Z), ((0%Z <= x)%Z /\ (0%Z < y)%Z) ->
  (((ZArith.BinInt.Z.rem (x + 1%Z)%Z y) = 0%Z) ->
  ((ZArith.BinInt.Z.rem x y) = (y - 1%Z)%Z)).
(* Why3 intros x y (h1,h2) h3. *)
intros x y (Hx,Hy) H.
generalize (Z_quot_rem_eq x y); intro h1.
generalize (Z_quot_rem_eq (x+1) y); intro h2.
assert (h3: (x = y * (Z.quot (x + 1) y - 1) + (Z.rem (x + 1) y + y - 1))%Z).
  ring_simplify; omega.
rewrite H in h3.
generalize (mod_div_unique x y (Z.quot (x + 1) y - 1) (0 + y - 1)).
intuition.
destruct H1; auto with zarith.
rewrite h3 at 1.
ring.
Qed.


(************************************************************************)
(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010     *)
(*   \VV/  **************************************************************)
(*    //   *      This file is distributed under the terms of the       *)
(*         *       GNU Lesser General Public License Version 2.1        *)
(************************************************************************)

Require Import Rbase.
Require Import Rfunctions.
Require Import Rseries.
Require Import Max.
Open Local Scope R_scope.

(*****************************************************************)
(**           Convergence properties of sequences                *)
(*****************************************************************)

Definition Un_decreasing (Un:nat -> R) : Prop :=
  forall n:nat, Un (S n) <= Un n.
Definition opp_seq (Un:nat -> R) (n:nat) : R := - Un n.
Definition has_ub (Un:nat -> R) : Prop := bound (EUn Un).
Definition has_lb (Un:nat -> R) : Prop := bound (EUn (opp_seq Un)).

(**********)
Lemma growing_cv :
  forall Un:nat -> R, Un_growing Un -> has_ub Un -> { l:R | Un_cv Un l }.
Proof.
  intros Un Hug Heub.
  exists (projT1 (completeness (EUn Un) Heub (EUn_noempty Un))).
  destruct (completeness _ Heub (EUn_noempty Un)) as (l, H).
  now apply Un_cv_crit_lub.
Qed.

Lemma decreasing_growing :
  forall Un:nat -> R, Un_decreasing Un -> Un_growing (opp_seq Un).
Proof.
  intro.
  unfold Un_growing, opp_seq, Un_decreasing in |- *.
  intros.
  apply Ropp_le_contravar.
  apply H.
Qed.

Lemma decreasing_cv :
  forall Un:nat -> R, Un_decreasing Un -> has_lb Un -> { l:R | Un_cv Un l }.
Proof.
  intros.
  cut ({ l:R | Un_cv (opp_seq Un) l } -> { l:R | Un_cv Un l }).
  intro X.
  apply X.
  apply growing_cv.
  apply decreasing_growing; assumption.
  exact H0.
  intro X.
  elim X; intros.
  exists (- x).
  unfold Un_cv in p.
  unfold R_dist in p.
  unfold opp_seq in p.
  unfold Un_cv in |- *.
  unfold R_dist in |- *.
  intros.
  elim (p eps H1); intros.
  exists x0; intros.
  assert (H4 := H2 n H3).
  rewrite <- Rabs_Ropp.
  replace (- (Un n - - x)) with (- Un n - x); [ assumption | ring ].
Qed.

(***********)
Lemma ub_to_lub :
  forall Un:nat -> R, has_ub Un -> { l:R | is_lub (EUn Un) l }.
Proof.
  intros.
  unfold has_ub in H.
  apply completeness.
  assumption.
  exists (Un 0%nat).
  unfold EUn in |- *.
  exists 0%nat; reflexivity.
Qed.

(**********)
Lemma lb_to_glb :
  forall Un:nat -> R, has_lb Un -> { l:R | is_lub (EUn (opp_seq Un)) l }.
Proof.
  intros; unfold has_lb in H.
  apply completeness.
  assumption.
  exists (- Un 0%nat).
  exists 0%nat.
  reflexivity.
Qed.

Definition lub (Un:nat -> R) (pr:has_ub Un) : R :=
  let (a,_) := ub_to_lub Un pr in a.

Definition glb (Un:nat -> R) (pr:has_lb Un) : R :=
  let (a,_) := lb_to_glb Un pr in - a.

(* Compatibility with previous unappropriate terminology *)
Notation maj_sup := ub_to_lub (only parsing).
Notation min_inf := lb_to_glb (only parsing).
Notation majorant := lub (only parsing).
Notation minorant := glb (only parsing).

Lemma maj_ss :
  forall (Un:nat -> R) (k:nat),
    has_ub Un -> has_ub (fun i:nat => Un (k + i)%nat).
Proof.
  intros.
  unfold has_ub in H.
  unfold bound in H.
  elim H; intros.
  unfold is_upper_bound in H0.
  unfold has_ub in |- *.
  exists x.
  unfold is_upper_bound in |- *.
  intros.
  apply H0.
  elim H1; intros.
  exists (k + x1)%nat; assumption.
Qed.

Lemma min_ss :
  forall (Un:nat -> R) (k:nat),
    has_lb Un -> has_lb (fun i:nat => Un (k + i)%nat).
Proof.
  intros.
  unfold has_lb in H.
  unfold bound in H.
  elim H; intros.
  unfold is_upper_bound in H0.
  unfold has_lb in |- *.
  exists x.
  unfold is_upper_bound in |- *.
  intros.
  apply H0.
  elim H1; intros.
  exists (k + x1)%nat; assumption.
Qed.

Definition sequence_ub (Un:nat -> R) (pr:has_ub Un)
  (i:nat) : R := lub (fun k:nat => Un (i + k)%nat) (maj_ss Un i pr).

Definition sequence_lb (Un:nat -> R) (pr:has_lb Un)
  (i:nat) : R := glb (fun k:nat => Un (i + k)%nat) (min_ss Un i pr).

(* Compatibility *)
Notation sequence_majorant := sequence_ub (only parsing).
Notation sequence_minorant := sequence_lb (only parsing).

Lemma Wn_decreasing :
  forall (Un:nat -> R) (pr:has_ub Un), Un_decreasing (sequence_ub Un pr).
Proof.
  intros.
  unfold Un_decreasing in |- *.
  intro.
  unfold sequence_ub in |- *.
  assert (H := ub_to_lub (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)).
  assert (H0 := ub_to_lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)).
  elim H; intros.
  elim H0; intros.
  cut (lub (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr) = x);
    [ intro Maj1; rewrite Maj1 | idtac ].
  cut (lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr) = x0);
    [ intro Maj2; rewrite Maj2 | idtac ].
  unfold is_lub in p.
  unfold is_lub in p0.
  elim p; intros.
  apply H2.
  elim p0; intros.
  unfold is_upper_bound in |- *.
  intros.
  unfold is_upper_bound in H3.
  apply H3.
  elim H5; intros.
  exists (1 + x2)%nat.
  replace (n + (1 + x2))%nat with (S n + x2)%nat.
  assumption.
  replace (S n) with (1 + n)%nat; [ ring | ring ].
  cut
    (is_lub (EUn (fun k:nat => Un (n + k)%nat))
      (lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr))).
  intro.
  unfold is_lub in p0; unfold is_lub in H1.
  elim p0; intros; elim H1; intros.
  assert (H6 := H5 x0 H2).
  assert
    (H7 := H3 (lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)) H4).
  apply Rle_antisym; assumption.
  unfold lub in |- *.
  case (ub_to_lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)).
  trivial.
  cut
    (is_lub (EUn (fun k:nat => Un (S n + k)%nat))
      (lub (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr))).
  intro.
  unfold is_lub in p; unfold is_lub in H1.
  elim p; intros; elim H1; intros.
  assert (H6 := H5 x H2).
  assert
    (H7 :=
      H3 (lub (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)) H4).
  apply Rle_antisym; assumption.
  unfold lub in |- *.
  case (ub_to_lub (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)).
  trivial.
Qed.

Lemma Vn_growing :
  forall (Un:nat -> R) (pr:has_lb Un), Un_growing (sequence_lb Un pr).
Proof.
  intros.
  unfold Un_growing in |- *.
  intro.
  unfold sequence_lb in |- *.
  assert (H := lb_to_glb (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)).
  assert (H0 := lb_to_glb (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)).
  elim H; intros.
  elim H0; intros.
  cut (glb (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr) = - x);
    [ intro Maj1; rewrite Maj1 | idtac ].
  cut (glb (fun k:nat => Un (n + k)%nat) (min_ss Un n pr) = - x0);
    [ intro Maj2; rewrite Maj2 | idtac ].
  unfold is_lub in p.
  unfold is_lub in p0.
  elim p; intros.
  apply Ropp_le_contravar.
  apply H2.
  elim p0; intros.
  unfold is_upper_bound in |- *.
  intros.
  unfold is_upper_bound in H3.
  apply H3.
  elim H5; intros.
  exists (1 + x2)%nat.
  unfold opp_seq in H6.
  unfold opp_seq in |- *.
  replace (n + (1 + x2))%nat with (S n + x2)%nat.
  assumption.
  replace (S n) with (1 + n)%nat; [ ring | ring ].
  cut
    (is_lub (EUn (opp_seq (fun k:nat => Un (n + k)%nat)))
      (- glb (fun k:nat => Un (n + k)%nat) (min_ss Un n pr))).
  intro.
  unfold is_lub in p0; unfold is_lub in H1.
  elim p0; intros; elim H1; intros.
  assert (H6 := H5 x0 H2).
  assert
    (H7 := H3 (- glb (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)) H4).
  rewrite <-
    (Ropp_involutive (glb (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)))
    .
  apply Ropp_eq_compat; apply Rle_antisym; assumption.
  unfold glb in |- *.
  case (lb_to_glb (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)); simpl.
  intro; rewrite Ropp_involutive.
  trivial.
  cut
    (is_lub (EUn (opp_seq (fun k:nat => Un (S n + k)%nat)))
      (- glb (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr))).
  intro.
  unfold is_lub in p; unfold is_lub in H1.
  elim p; intros; elim H1; intros.
  assert (H6 := H5 x H2).
  assert
    (H7 :=
      H3 (- glb (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)) H4).
  rewrite <-
    (Ropp_involutive
      (glb (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)))
    .
  apply Ropp_eq_compat; apply Rle_antisym; assumption.
  unfold glb in |- *.
  case (lb_to_glb (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)); simpl.
  intro; rewrite Ropp_involutive.
  trivial.
Qed.

(**********)
Lemma Vn_Un_Wn_order :
  forall (Un:nat -> R) (pr1:has_ub Un) (pr2:has_lb Un)
    (n:nat), sequence_lb Un pr2 n <= Un n <= sequence_ub Un pr1 n.
Proof.
  intros.
  split.
  unfold sequence_lb in |- *.
  cut { l:R | is_lub (EUn (opp_seq (fun i:nat => Un (n + i)%nat))) l }.
  intro X.
  elim X; intros.
  replace (glb (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)) with (- x).
  unfold is_lub in p.
  elim p; intros.
  unfold is_upper_bound in H.
  rewrite <- (Ropp_involutive (Un n)).
  apply Ropp_le_contravar.
  apply H.
  exists 0%nat.
  unfold opp_seq in |- *.
  replace (n + 0)%nat with n; [ reflexivity | ring ].
  cut
    (is_lub (EUn (opp_seq (fun k:nat => Un (n + k)%nat)))
      (- glb (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2))).
  intro.
  unfold is_lub in p; unfold is_lub in H.
  elim p; intros; elim H; intros.
  assert (H4 := H3 x H0).
  assert
    (H5 := H1 (- glb (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)) H2).
  rewrite <-
    (Ropp_involutive (glb (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)))
    .
  apply Ropp_eq_compat; apply Rle_antisym; assumption.
  unfold glb in |- *.
  case (lb_to_glb (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)); simpl.
  intro; rewrite Ropp_involutive.
  trivial.
  apply lb_to_glb.
  apply min_ss; assumption.
  unfold sequence_ub in |- *.
  cut { l:R | is_lub (EUn (fun i:nat => Un (n + i)%nat)) l }.
  intro X.
  elim X; intros.
  replace (lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1)) with x.
  unfold is_lub in p.
  elim p; intros.
  unfold is_upper_bound in H.
  apply H.
  exists 0%nat.
  replace (n + 0)%nat with n; [ reflexivity | ring ].
  cut
    (is_lub (EUn (fun k:nat => Un (n + k)%nat))
      (lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1))).
  intro.
  unfold is_lub in p; unfold is_lub in H.
  elim p; intros; elim H; intros.
  assert (H4 := H3 x H0).
  assert
    (H5 := H1 (lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1)) H2).
  apply Rle_antisym; assumption.
  unfold lub in |- *.
  case (ub_to_lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1)).
  intro; trivial.
  apply ub_to_lub.
  apply maj_ss; assumption.
Qed.

Lemma min_maj :
  forall (Un:nat -> R) (pr1:has_ub Un) (pr2:has_lb Un),
    has_ub (sequence_lb Un pr2).
Proof.
  intros.
  assert (H := Vn_Un_Wn_order Un pr1 pr2).
  unfold has_ub in |- *.
  unfold bound in |- *.
  unfold has_ub in pr1.
  unfold bound in pr1.
  elim pr1; intros.
  exists x.
  unfold is_upper_bound in |- *.
  intros.
  unfold is_upper_bound in H0.
  elim H1; intros.
  rewrite H2.
  apply Rle_trans with (Un x1).
  assert (H3 := H x1); elim H3; intros; assumption.
  apply H0.
  exists x1; reflexivity.
Qed.

Lemma maj_min :
  forall (Un:nat -> R) (pr1:has_ub Un) (pr2:has_lb Un),
    has_lb (sequence_ub Un pr1).
Proof.
  intros.
  assert (H := Vn_Un_Wn_order Un pr1 pr2).
  unfold has_lb in |- *.
  unfold bound in |- *.
  unfold has_lb in pr2.
  unfold bound in pr2.
  elim pr2; intros.
  exists x.
  unfold is_upper_bound in |- *.
  intros.
  unfold is_upper_bound in H0.
  elim H1; intros.
  rewrite H2.
  apply Rle_trans with (opp_seq Un x1).
  assert (H3 := H x1); elim H3; intros.
  unfold opp_seq in |- *; apply Ropp_le_contravar.
  assumption.
  apply H0.
  exists x1; reflexivity.
Qed.

(**********)
Lemma cauchy_maj : forall Un:nat -> R, Cauchy_crit Un -> has_ub Un.
Proof.
  intros.
  unfold has_ub in |- *.
  apply cauchy_bound.
  assumption.
Qed.

(**********)
Lemma cauchy_opp :
  forall Un:nat -> R, Cauchy_crit Un -> Cauchy_crit (opp_seq Un).
Proof.
  intro.
  unfold Cauchy_crit in |- *.
  unfold R_dist in |- *.
  intros.
  elim (H eps H0); intros.
  exists x; intros.
  unfold opp_seq in |- *.
  rewrite <- Rabs_Ropp.
  replace (- (- Un n - - Un m)) with (Un n - Un m);
  [ apply H1; assumption | ring ].
Qed.

(**********)
Lemma cauchy_min : forall Un:nat -> R, Cauchy_crit Un -> has_lb Un.
Proof.
  intros.
  unfold has_lb in |- *.
  assert (H0 := cauchy_opp _ H).
  apply cauchy_bound.
  assumption.
Qed.

(**********)
Lemma maj_cv :
  forall (Un:nat -> R) (pr:Cauchy_crit Un),
    { l:R | Un_cv (sequence_ub Un (cauchy_maj Un pr)) l }.
Proof.
  intros.
  apply decreasing_cv.
  apply Wn_decreasing.
  apply maj_min.
  apply cauchy_min.
  assumption.
Qed.

(**********)
Lemma min_cv :
  forall (Un:nat -> R) (pr:Cauchy_crit Un),
    { l:R | Un_cv (sequence_lb Un (cauchy_min Un pr)) l }.
Proof.
  intros.
  apply growing_cv.
  apply Vn_growing.
  apply min_maj.
  apply cauchy_maj.
  assumption.
Qed.

Lemma cond_eq :
  forall x y:R, (forall eps:R, 0 < eps -> Rabs (x - y) < eps) -> x = y.
Proof.
  intros.
  case (total_order_T x y); intro.
  elim s; intro.
  cut (0 < y - x).
  intro.
  assert (H1 := H (y - x) H0).
  rewrite <- Rabs_Ropp in H1.
  cut (- (x - y) = y - x); [ intro; rewrite H2 in H1 | ring ].
  rewrite Rabs_right in H1.
  elim (Rlt_irrefl _ H1).
  left; assumption.
  apply Rplus_lt_reg_r with x.
  rewrite Rplus_0_r; replace (x + (y - x)) with y; [ assumption | ring ].
  assumption.
  cut (0 < x - y).
  intro.
  assert (H1 := H (x - y) H0).
  rewrite Rabs_right in H1.
  elim (Rlt_irrefl _ H1).
  left; assumption.
  apply Rplus_lt_reg_r with y.
  rewrite Rplus_0_r; replace (y + (x - y)) with x; [ assumption | ring ].
Qed.

Lemma not_Rlt : forall r1 r2:R, ~ r1 < r2 -> r1 >= r2.
Proof.
  intros r1 r2; generalize (Rtotal_order r1 r2); unfold Rge in |- *.
  tauto.
Qed.

(**********)
Lemma approx_maj :
  forall (Un:nat -> R) (pr:has_ub Un) (eps:R),
    0 < eps ->  exists k : nat, Rabs (lub Un pr - Un k) < eps.
Proof.
  intros Un pr.
  pose (Vn := fix aux n := match n with S n' => if Rle_lt_dec (aux n') (Un n) then Un n else aux n' | O => Un O end).
  pose (In := fix aux n := match n with S n' => if Rle_lt_dec (Vn n) (Un n) then n else aux n' | O => O end).

  assert (VUI: forall n, Vn n = Un (In n)).
  induction n.
  easy.
  simpl.
  destruct (Rle_lt_dec (Vn n) (Un (S n))) as [H1|H1].
  destruct (Rle_lt_dec (Un (S n)) (Un (S n))) as [H2|H2].
  easy.
  elim (Rlt_irrefl _ H2).
  destruct (Rle_lt_dec (Vn n) (Un (S n))) as [H2|H2].
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 H1)).
  exact IHn.

  assert (HubV : has_ub Vn).
  destruct pr as (ub, Hub).
  exists ub.
  intros x (n, Hn).
  rewrite Hn, VUI.
  apply Hub.
  now exists (In n).

  assert (HgrV : Un_growing Vn).
  intros n.
  induction n.
  simpl.
  destruct (Rle_lt_dec (Un O) (Un 1%nat)) as [H|_].
  exact H.
  apply Rle_refl.
  simpl.
  destruct (Rle_lt_dec (Vn n) (Un (S n))) as [H1|H1].
  destruct (Rle_lt_dec (Un (S n)) (Un (S (S n)))) as [H2|H2].
  exact H2.
  apply Rle_refl.
  destruct (Rle_lt_dec (Vn n) (Un (S (S n)))) as [H2|H2].
  exact H2.
  apply Rle_refl.

  destruct (ub_to_lub Vn HubV) as (l, Hl).
  unfold lub.
  destruct (ub_to_lub Un pr) as (l', Hl').
  replace l' with l.
  intros eps Heps.
  destruct (Un_cv_crit_lub Vn HgrV l Hl eps Heps) as (n, Hn).
  exists (In n).
  rewrite <- VUI.
  rewrite Rabs_minus_sym.
  apply Hn.
  apply le_refl.

  apply Rle_antisym.
  apply Hl.
  intros n (k, Hk).
  rewrite Hk, VUI.
  apply Hl'.
  now exists (In k).
  apply Hl'.
  intros n (k, Hk).
  rewrite Hk.
  apply Rle_trans with (Vn k).
  clear.
  induction k.
  apply Rle_refl.
  simpl.
  destruct (Rle_lt_dec (Vn k) (Un (S k))) as [H|H].
  apply Rle_refl.
  now apply Rlt_le.
  apply Hl.
  now exists k.
Qed.

(**********)
Lemma approx_min :
  forall (Un:nat -> R) (pr:has_lb Un) (eps:R),
    0 < eps ->  exists k : nat, Rabs (glb Un pr - Un k) < eps.
Proof.
  intros Un pr.
  unfold glb.
  destruct lb_to_glb as (lb, Hlb).
  intros eps Heps.
  destruct (approx_maj _ pr eps Heps) as (n, Hn).
  exists n.
  unfold Rminus.
  rewrite <- Ropp_plus_distr, Rabs_Ropp.
  replace lb with (lub (opp_seq Un) pr).
  now rewrite <- (Ropp_involutive (Un n)).
  unfold lub.
  destruct ub_to_lub as (ub, Hub).
  apply Rle_antisym.
  apply Hub.
  apply Hlb.
  apply Hlb.
  apply Hub.
Qed.

(** Unicity of limit for convergent sequences *)
Lemma UL_sequence :
  forall (Un:nat -> R) (l1 l2:R), Un_cv Un l1 -> Un_cv Un l2 -> l1 = l2.
Proof.
  intros Un l1 l2; unfold Un_cv in |- *; unfold R_dist in |- *; intros.
  apply cond_eq.
  intros; cut (0 < eps / 2);
    [ intro
      | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
        [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
  elim (H (eps / 2) H2); intros.
  elim (H0 (eps / 2) H2); intros.
  set (N := max x x0).
  apply Rle_lt_trans with (Rabs (l1 - Un N) + Rabs (Un N - l2)).
  replace (l1 - l2) with (l1 - Un N + (Un N - l2));
  [ apply Rabs_triang | ring ].
  rewrite (double_var eps); apply Rplus_lt_compat.
  rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H3;
    unfold ge, N in |- *; apply le_max_l.
  apply H4; unfold ge, N in |- *; apply le_max_r.
Qed.

(**********)
Lemma CV_plus :
  forall (An Bn:nat -> R) (l1 l2:R),
    Un_cv An l1 -> Un_cv Bn l2 -> Un_cv (fun i:nat => An i + Bn i) (l1 + l2).
Proof.
  unfold Un_cv in |- *; unfold R_dist in |- *; intros.
  cut (0 < eps / 2);
    [ intro
      | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
        [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
  elim (H (eps / 2) H2); intros.
  elim (H0 (eps / 2) H2); intros.
  set (N := max x x0).
  exists N; intros.
  replace (An n + Bn n - (l1 + l2)) with (An n - l1 + (Bn n - l2));
  [ idtac | ring ].
  apply Rle_lt_trans with (Rabs (An n - l1) + Rabs (Bn n - l2)).
  apply Rabs_triang.
  rewrite (double_var eps); apply Rplus_lt_compat.
  apply H3; unfold ge in |- *; apply le_trans with N;
    [ unfold N in |- *; apply le_max_l | assumption ].
  apply H4; unfold ge in |- *; apply le_trans with N;
    [ unfold N in |- *; apply le_max_r | assumption ].
Qed.

(**********)
Lemma cv_cvabs :
  forall (Un:nat -> R) (l:R),
    Un_cv Un l -> Un_cv (fun i:nat => Rabs (Un i)) (Rabs l).
Proof.
  unfold Un_cv in |- *; unfold R_dist in |- *; intros.
  elim (H eps H0); intros.
  exists x; intros.
  apply Rle_lt_trans with (Rabs (Un n - l)).
  apply Rabs_triang_inv2.
  apply H1; assumption.
Qed.

(**********)
Lemma CV_Cauchy :
  forall Un:nat -> R, { l:R | Un_cv Un l } -> Cauchy_crit Un.
Proof.
  intros Un X; elim X; intros.
  unfold Cauchy_crit in |- *; intros.
  unfold Un_cv in p; unfold R_dist in p.
  cut (0 < eps / 2);
    [ intro
      | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
        [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
  elim (p (eps / 2) H0); intros.
  exists x0; intros.
  unfold R_dist in |- *;
    apply Rle_lt_trans with (Rabs (Un n - x) + Rabs (x - Un m)).
  replace (Un n - Un m) with (Un n - x + (x - Un m));
  [ apply Rabs_triang | ring ].
  rewrite (double_var eps); apply Rplus_lt_compat.
  apply H1; assumption.
  rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H1; assumption.
Qed.

(**********)
Lemma maj_by_pos :
  forall Un:nat -> R,
    { l:R | Un_cv Un l } ->
    exists l : R, 0 < l /\ (forall n:nat, Rabs (Un n) <= l).
Proof.
  intros Un X; elim X; intros.
  cut { l:R | Un_cv (fun k:nat => Rabs (Un k)) l }.
  intro X0.
  assert (H := CV_Cauchy (fun k:nat => Rabs (Un k)) X0).
  assert (H0 := cauchy_bound (fun k:nat => Rabs (Un k)) H).
  elim H0; intros.
  exists (x0 + 1).
  cut (0 <= x0).
  intro.
  split.
  apply Rplus_le_lt_0_compat; [ assumption | apply Rlt_0_1 ].
  intros.
  apply Rle_trans with x0.
  unfold is_upper_bound in H1.
  apply H1.
  exists n; reflexivity.
  pattern x0 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
    apply Rlt_0_1.
  apply Rle_trans with (Rabs (Un 0%nat)).
  apply Rabs_pos.
  unfold is_upper_bound in H1.
  apply H1.
  exists 0%nat; reflexivity.
  exists (Rabs x).
  apply cv_cvabs; assumption.
Qed.

(**********)
Lemma CV_mult :
  forall (An Bn:nat -> R) (l1 l2:R),
    Un_cv An l1 -> Un_cv Bn l2 -> Un_cv (fun i:nat => An i * Bn i) (l1 * l2).
Proof.
  intros.
  cut { l:R | Un_cv An l }.
  intro X.
  assert (H1 := maj_by_pos An X).
  elim H1; intros M H2.
  elim H2; intros.
  unfold Un_cv in |- *; unfold R_dist in |- *; intros.
  cut (0 < eps / (2 * M)).
  intro.
  case (Req_dec l2 0); intro.
  unfold Un_cv in H0; unfold R_dist in H0.
  elim (H0 (eps / (2 * M)) H6); intros.
  exists x; intros.
  apply Rle_lt_trans with
    (Rabs (An n * Bn n - An n * l2) + Rabs (An n * l2 - l1 * l2)).
  replace (An n * Bn n - l1 * l2) with
  (An n * Bn n - An n * l2 + (An n * l2 - l1 * l2));
  [ apply Rabs_triang | ring ].
  replace (Rabs (An n * Bn n - An n * l2)) with
  (Rabs (An n) * Rabs (Bn n - l2)).
  replace (Rabs (An n * l2 - l1 * l2)) with 0.
  rewrite Rplus_0_r.
  apply Rle_lt_trans with (M * Rabs (Bn n - l2)).
  do 2 rewrite <- (Rmult_comm (Rabs (Bn n - l2))).
  apply Rmult_le_compat_l.
  apply Rabs_pos.
  apply H4.
  apply Rmult_lt_reg_l with (/ M).
  apply Rinv_0_lt_compat; apply H3.
  rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
  rewrite Rmult_1_l; rewrite (Rmult_comm (/ M)).
  apply Rlt_trans with (eps / (2 * M)).
  apply H8; assumption.
  unfold Rdiv in |- *; rewrite Rinv_mult_distr.
  apply Rmult_lt_reg_l with 2.
  prove_sup0.
  replace (2 * (eps * (/ 2 * / M))) with (2 * / 2 * (eps * / M));
  [ idtac | ring ].
  rewrite <- Rinv_r_sym.
  rewrite Rmult_1_l; rewrite double.
  pattern (eps * / M) at 1 in |- *; rewrite <- Rplus_0_r.
  apply Rplus_lt_compat_l; apply Rmult_lt_0_compat;
    [ assumption | apply Rinv_0_lt_compat; assumption ].
  discrR.
  discrR.
  red in |- *; intro; rewrite H10 in H3; elim (Rlt_irrefl _ H3).
  red in |- *; intro; rewrite H10 in H3; elim (Rlt_irrefl _ H3).
  rewrite H7; do 2 rewrite Rmult_0_r; unfold Rminus in |- *;
    rewrite Rplus_opp_r; rewrite Rabs_R0; reflexivity.
  replace (An n * Bn n - An n * l2) with (An n * (Bn n - l2)); [ idtac | ring ].
  symmetry  in |- *; apply Rabs_mult.
  cut (0 < eps / (2 * Rabs l2)).
  intro.
  unfold Un_cv in H; unfold R_dist in H; unfold Un_cv in H0;
    unfold R_dist in H0.
  elim (H (eps / (2 * Rabs l2)) H8); intros N1 H9.
  elim (H0 (eps / (2 * M)) H6); intros N2 H10.
  set (N := max N1 N2).
  exists N; intros.
  apply Rle_lt_trans with
    (Rabs (An n * Bn n - An n * l2) + Rabs (An n * l2 - l1 * l2)).
  replace (An n * Bn n - l1 * l2) with
  (An n * Bn n - An n * l2 + (An n * l2 - l1 * l2));
  [ apply Rabs_triang | ring ].
  replace (Rabs (An n * Bn n - An n * l2)) with
  (Rabs (An n) * Rabs (Bn n - l2)).
  replace (Rabs (An n * l2 - l1 * l2)) with (Rabs l2 * Rabs (An n - l1)).
  rewrite (double_var eps); apply Rplus_lt_compat.
  apply Rle_lt_trans with (M * Rabs (Bn n - l2)).
  do 2 rewrite <- (Rmult_comm (Rabs (Bn n - l2))).
  apply Rmult_le_compat_l.
  apply Rabs_pos.
  apply H4.
  apply Rmult_lt_reg_l with (/ M).
  apply Rinv_0_lt_compat; apply H3.
  rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
  rewrite Rmult_1_l; rewrite (Rmult_comm (/ M)).
  apply Rlt_le_trans with (eps / (2 * M)).
  apply H10.
  unfold ge in |- *; apply le_trans with N.
  unfold N in |- *; apply le_max_r.
  assumption.
  unfold Rdiv in |- *; rewrite Rinv_mult_distr.
  right; ring.
  discrR.
  red in |- *; intro; rewrite H12 in H3; elim (Rlt_irrefl _ H3).
  red in |- *; intro; rewrite H12 in H3; elim (Rlt_irrefl _ H3).
  apply Rmult_lt_reg_l with (/ Rabs l2).
  apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
  rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
  rewrite Rmult_1_l; apply Rlt_le_trans with (eps / (2 * Rabs l2)).
  apply H9.
  unfold ge in |- *; apply le_trans with N.
  unfold N in |- *; apply le_max_l.
  assumption.
  unfold Rdiv in |- *; right; rewrite Rinv_mult_distr.
  ring.
  discrR.
  apply Rabs_no_R0; assumption.
  apply Rabs_no_R0; assumption.
  replace (An n * l2 - l1 * l2) with (l2 * (An n - l1));
  [ symmetry  in |- *; apply Rabs_mult | ring ].
  replace (An n * Bn n - An n * l2) with (An n * (Bn n - l2));
  [ symmetry  in |- *; apply Rabs_mult | ring ].
  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
  assumption.
  apply Rinv_0_lt_compat; apply Rmult_lt_0_compat;
    [ prove_sup0 | apply Rabs_pos_lt; assumption ].
  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
    [ assumption
      | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat;
        [ prove_sup0 | assumption ] ].
  exists l1; assumption.
Qed.

Lemma tech9 :
  forall Un:nat -> R,
    Un_growing Un -> forall m n:nat, (m <= n)%nat -> Un m <= Un n.
Proof.
  intros; unfold Un_growing in H.
  induction  n as [| n Hrecn].
  induction  m as [| m Hrecm].
  right; reflexivity.
  elim (le_Sn_O _ H0).
  cut ((m <= n)%nat \/ m = S n).
  intro; elim H1; intro.
  apply Rle_trans with (Un n).
  apply Hrecn; assumption.
  apply H.
  rewrite H2; right; reflexivity.
  inversion H0.
  right; reflexivity.
  left; assumption.
Qed.

Lemma tech13 :
  forall (An:nat -> R) (k:R),
    0 <= k < 1 ->
    Un_cv (fun n:nat => Rabs (An (S n) / An n)) k ->
    exists k0 : R,
      k < k0 < 1 /\
      (exists N : nat,
        (forall n:nat, (N <= n)%nat -> Rabs (An (S n) / An n) < k0)).
Proof.
  intros; exists (k + (1 - k) / 2).
  split.
  split.
  pattern k at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l.
  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
  apply Rplus_lt_reg_r with k; rewrite Rplus_0_r; replace (k + (1 - k)) with 1;
    [ elim H; intros; assumption | ring ].
  apply Rinv_0_lt_compat; prove_sup0.
  apply Rmult_lt_reg_l with 2.
  prove_sup0.
  unfold Rdiv in |- *; rewrite Rmult_1_r; rewrite Rmult_plus_distr_l;
    pattern 2 at 1 in |- *; rewrite Rmult_comm; rewrite Rmult_assoc;
      rewrite <- Rinv_l_sym; [ idtac | discrR ]; rewrite Rmult_1_r;
        replace (2 * k + (1 - k)) with (1 + k); [ idtac | ring ].
  elim H; intros.
  apply Rplus_lt_compat_l; assumption.
  unfold Un_cv in H0; cut (0 < (1 - k) / 2).
  intro; elim (H0 ((1 - k) / 2) H1); intros.
  exists x; intros.
  assert (H4 := H2 n H3).
  unfold R_dist in H4; rewrite <- Rabs_Rabsolu;
    replace (Rabs (An (S n) / An n)) with (Rabs (An (S n) / An n) - k + k);
    [ idtac | ring ];
    apply Rle_lt_trans with (Rabs (Rabs (An (S n) / An n) - k) + Rabs k).
  apply Rabs_triang.
  rewrite (Rabs_right k).
  apply Rplus_lt_reg_r with (- k); rewrite <- (Rplus_comm k);
    repeat rewrite <- Rplus_assoc; rewrite Rplus_opp_l;
      repeat rewrite Rplus_0_l; apply H4.
  apply Rle_ge; elim H; intros; assumption.
  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
  apply Rplus_lt_reg_r with k; rewrite Rplus_0_r; elim H; intros;
    replace (k + (1 - k)) with 1; [ assumption | ring ].
  apply Rinv_0_lt_compat; prove_sup0.
Qed.

(**********)
Lemma growing_ineq :
  forall (Un:nat -> R) (l:R),
    Un_growing Un -> Un_cv Un l -> forall n:nat, Un n <= l.
Proof.
  intros; case (total_order_T (Un n) l); intro.
  elim s; intro.
  left; assumption.
  right; assumption.
  cut (0 < Un n - l).
  intro; unfold Un_cv in H0; unfold R_dist in H0.
  elim (H0 (Un n - l) H1); intros N1 H2.
  set (N := max n N1).
  cut (Un n - l <= Un N - l).
  intro; cut (Un N - l < Un n - l).
  intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H3 H4)).
  apply Rle_lt_trans with (Rabs (Un N - l)).
  apply RRle_abs.
  apply H2.
  unfold ge, N in |- *; apply le_max_r.
  unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- l));
    apply Rplus_le_compat_l.
  apply tech9.
  assumption.
  unfold N in |- *; apply le_max_l.
  apply Rplus_lt_reg_r with l.
  rewrite Rplus_0_r.
  replace (l + (Un n - l)) with (Un n); [ assumption | ring ].
Qed.

(** Un->l => (-Un) -> (-l) *)
Lemma CV_opp :
  forall (An:nat -> R) (l:R), Un_cv An l -> Un_cv (opp_seq An) (- l).
Proof.
  intros An l.
  unfold Un_cv in |- *; unfold R_dist in |- *; intros.
  elim (H eps H0); intros.
  exists x; intros.
  unfold opp_seq in |- *; replace (- An n - - l) with (- (An n - l));
    [ rewrite Rabs_Ropp | ring ].
  apply H1; assumption.
Qed.

(**********)
Lemma decreasing_ineq :
  forall (Un:nat -> R) (l:R),
    Un_decreasing Un -> Un_cv Un l -> forall n:nat, l <= Un n.
Proof.
  intros.
  assert (H1 := decreasing_growing _ H).
  assert (H2 := CV_opp _ _ H0).
  assert (H3 := growing_ineq _ _ H1 H2).
  apply Ropp_le_cancel.
  unfold opp_seq in H3; apply H3.
Qed.

(**********)
Lemma CV_minus :
  forall (An Bn:nat -> R) (l1 l2:R),
    Un_cv An l1 -> Un_cv Bn l2 -> Un_cv (fun i:nat => An i - Bn i) (l1 - l2).
Proof.
  intros.
  replace (fun i:nat => An i - Bn i) with (fun i:nat => An i + opp_seq Bn i).
  unfold Rminus in |- *; apply CV_plus.
  assumption.
  apply CV_opp; assumption.
  unfold Rminus, opp_seq in |- *; reflexivity.
Qed.

(** Un -> +oo *)
Definition cv_infty (Un:nat -> R) : Prop :=
  forall M:R,  exists N : nat, (forall n:nat, (N <= n)%nat -> M < Un n).

(** Un -> +oo => /Un -> O *)
Lemma cv_infty_cv_R0 :
  forall Un:nat -> R,
    (forall n:nat, Un n <> 0) -> cv_infty Un -> Un_cv (fun n:nat => / Un n) 0.
Proof.
  unfold cv_infty, Un_cv in |- *; unfold R_dist in |- *; intros.
  elim (H0 (/ eps)); intros N0 H2.
  exists N0; intros.
  unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r;
    rewrite (Rabs_Rinv _ (H n)).
  apply Rmult_lt_reg_l with (Rabs (Un n)).
  apply Rabs_pos_lt; apply H.
  rewrite <- Rinv_r_sym.
  apply Rmult_lt_reg_l with (/ eps).
  apply Rinv_0_lt_compat; assumption.
  rewrite Rmult_1_r; rewrite (Rmult_comm (/ eps)); rewrite Rmult_assoc;
    rewrite <- Rinv_r_sym.
  rewrite Rmult_1_r; apply Rlt_le_trans with (Un n).
  apply H2; assumption.
  apply RRle_abs.
  red in |- *; intro; rewrite H4 in H1; elim (Rlt_irrefl _ H1).
  apply Rabs_no_R0; apply H.
Qed.

(**********)
Lemma decreasing_prop :
  forall (Un:nat -> R) (m n:nat),
    Un_decreasing Un -> (m <= n)%nat -> Un n <= Un m.
Proof.
  unfold Un_decreasing in |- *; intros.
  induction  n as [| n Hrecn].
  induction  m as [| m Hrecm].
  right; reflexivity.
  elim (le_Sn_O _ H0).
  cut ((m <= n)%nat \/ m = S n).
  intro; elim H1; intro.
  apply Rle_trans with (Un n).
  apply H.
  apply Hrecn; assumption.
  rewrite H2; right; reflexivity.
  inversion H0; [ right; reflexivity | left; assumption ].
Qed.

(** |x|^n/n! -> 0 *)
Lemma cv_speed_pow_fact :
  forall x:R, Un_cv (fun n:nat => x ^ n / INR (fact n)) 0.
Proof.
  intro;
    cut
      (Un_cv (fun n:nat => Rabs x ^ n / INR (fact n)) 0 ->
        Un_cv (fun n:nat => x ^ n / INR (fact n)) 0).
  intro; apply H.
  unfold Un_cv in |- *; unfold R_dist in |- *; intros; case (Req_dec x 0);
    intro.
  exists 1%nat; intros.
  rewrite H1; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r;
    rewrite Rabs_R0; rewrite pow_ne_zero;
      [ unfold Rdiv in |- *; rewrite Rmult_0_l; rewrite Rabs_R0; assumption
        | red in |- *; intro; rewrite H3 in H2; elim (le_Sn_n _ H2) ].
  assert (H2 := Rabs_pos_lt x H1); set (M := up (Rabs x)); cut (0 <= M)%Z.
  intro; elim (IZN M H3); intros M_nat H4.
  set (Un := fun n:nat => Rabs x ^ (M_nat + n) / INR (fact (M_nat + n))).
  cut (Un_cv Un 0); unfold Un_cv in |- *; unfold R_dist in |- *; intros.
  elim (H5 eps H0); intros N H6.
  exists (M_nat + N)%nat; intros;
    cut (exists p : nat, (p >= N)%nat /\ n = (M_nat + p)%nat).
  intro; elim H8; intros p H9.
  elim H9; intros; rewrite H11; unfold Un in H6; apply H6; assumption.
  exists (n - M_nat)%nat.
  split.
  unfold ge in |- *; apply (fun p n m:nat => plus_le_reg_l n m p) with M_nat;
    rewrite <- le_plus_minus.
  assumption.
  apply le_trans with (M_nat + N)%nat.
  apply le_plus_l.
  assumption.
  apply le_plus_minus; apply le_trans with (M_nat + N)%nat;
    [ apply le_plus_l | assumption ].
  set (Vn := fun n:nat => Rabs x * (Un 0%nat / INR (S n))).
  cut (1 <= M_nat)%nat.
  intro; cut (forall n:nat, 0 < Un n).
  intro; cut (Un_decreasing Un).
  intro; cut (forall n:nat, Un (S n) <= Vn n).
  intro; cut (Un_cv Vn 0).
  unfold Un_cv in |- *; unfold R_dist in |- *; intros.
  elim (H10 eps0 H5); intros N1 H11.
  exists (S N1); intros.
  cut (forall n:nat, 0 < Vn n).
  intro; apply Rle_lt_trans with (Rabs (Vn (pred n) - 0)).
  repeat rewrite Rabs_right.
  unfold Rminus in |- *; rewrite Ropp_0; do 2 rewrite Rplus_0_r;
    replace n with (S (pred n)).
  apply H9.
  inversion H12; simpl in |- *; reflexivity.
  apply Rle_ge; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; left;
    apply H13.
  apply Rle_ge; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; left;
    apply H7.
  apply H11; unfold ge in |- *; apply le_S_n; replace (S (pred n)) with n;
    [ unfold ge in H12; exact H12 | inversion H12; simpl in |- *; reflexivity ].
  intro; apply Rlt_le_trans with (Un (S n0)); [ apply H7 | apply H9 ].
  cut (cv_infty (fun n:nat => INR (S n))).
  intro; cut (Un_cv (fun n:nat => / INR (S n)) 0).
  unfold Un_cv, R_dist in |- *; intros; unfold Vn in |- *.
  cut (0 < eps1 / (Rabs x * Un 0%nat)).
  intro; elim (H11 _ H13); intros N H14.
  exists N; intros;
    replace (Rabs x * (Un 0%nat / INR (S n)) - 0) with
    (Rabs x * Un 0%nat * (/ INR (S n) - 0));
    [ idtac | unfold Rdiv in |- *; ring ].
  rewrite Rabs_mult; apply Rmult_lt_reg_l with (/ Rabs (Rabs x * Un 0%nat)).
  apply Rinv_0_lt_compat; apply Rabs_pos_lt.
  apply prod_neq_R0.
  apply Rabs_no_R0; assumption.
  assert (H16 := H7 0%nat); red in |- *; intro; rewrite H17 in H16;
    elim (Rlt_irrefl _ H16).
  rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
  rewrite Rmult_1_l.
  replace (/ Rabs (Rabs x * Un 0%nat) * eps1) with (eps1 / (Rabs x * Un 0%nat)).
  apply H14; assumption.
  unfold Rdiv in |- *; rewrite (Rabs_right (Rabs x * Un 0%nat)).
  apply Rmult_comm.
  apply Rle_ge; apply Rmult_le_pos.
  apply Rabs_pos.
  left; apply H7.
  apply Rabs_no_R0.
  apply prod_neq_R0;
    [ apply Rabs_no_R0; assumption
      | assert (H16 := H7 0%nat); red in |- *; intro; rewrite H17 in H16;
        elim (Rlt_irrefl _ H16) ].
  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
  assumption.
  apply Rinv_0_lt_compat; apply Rmult_lt_0_compat.
  apply Rabs_pos_lt; assumption.
  apply H7.
  apply (cv_infty_cv_R0 (fun n:nat => INR (S n))).
  intro; apply not_O_INR; discriminate.
  assumption.
  unfold cv_infty in |- *; intro; case (total_order_T M0 0); intro.
  elim s; intro.
  exists 0%nat; intros.
  apply Rlt_trans with 0; [ assumption | apply lt_INR_0; apply lt_O_Sn ].
  exists 0%nat; intros; rewrite b; apply lt_INR_0; apply lt_O_Sn.
  set (M0_z := up M0).
  assert (H10 := archimed M0).
  cut (0 <= M0_z)%Z.
  intro; elim (IZN _ H11); intros M0_nat H12.
  exists M0_nat; intros.
  apply Rlt_le_trans with (IZR M0_z).
  elim H10; intros; assumption.
  rewrite H12; rewrite <- INR_IZR_INZ; apply le_INR.
  apply le_trans with n; [ assumption | apply le_n_Sn ].
  apply le_IZR; left; simpl in |- *; unfold M0_z in |- *;
    apply Rlt_trans with M0; [ assumption | elim H10; intros; assumption ].
  intro; apply Rle_trans with (Rabs x * Un n * / INR (S n)).
  unfold Un in |- *; replace (M_nat + S n)%nat with (M_nat + n + 1)%nat.
  rewrite pow_add; replace (Rabs x ^ 1) with (Rabs x);
    [ idtac | simpl in |- *; ring ].
  unfold Rdiv in |- *; rewrite <- (Rmult_comm (Rabs x));
    repeat rewrite Rmult_assoc; repeat apply Rmult_le_compat_l.
  apply Rabs_pos.
  left; apply pow_lt; assumption.
  replace (M_nat + n + 1)%nat with (S (M_nat + n)).
  rewrite fact_simpl; rewrite mult_comm; rewrite mult_INR;
    rewrite Rinv_mult_distr.
  apply Rmult_le_compat_l.
  left; apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red in |- *;
    intro; assert (H10 := sym_eq H9); elim (fact_neq_0 _ H10).
  left; apply Rinv_lt_contravar.
  apply Rmult_lt_0_compat; apply lt_INR_0; apply lt_O_Sn.
  apply lt_INR; apply lt_n_S.
  pattern n at 1 in |- *; replace n with (0 + n)%nat; [ idtac | reflexivity ].
  apply plus_lt_compat_r.
  apply lt_le_trans with 1%nat; [ apply lt_O_Sn | assumption ].
  apply INR_fact_neq_0.
  apply not_O_INR; discriminate.
  ring.
  ring.
  unfold Vn in |- *; rewrite Rmult_assoc; unfold Rdiv in |- *;
    rewrite (Rmult_comm (Un 0%nat)); rewrite (Rmult_comm (Un n)).
  repeat apply Rmult_le_compat_l.
  apply Rabs_pos.
  left; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn.
  apply decreasing_prop; [ assumption | apply le_O_n ].
  unfold Un_decreasing in |- *; intro; unfold Un in |- *.
  replace (M_nat + S n)%nat with (M_nat + n + 1)%nat.
  rewrite pow_add; unfold Rdiv in |- *; rewrite Rmult_assoc;
    apply Rmult_le_compat_l.
  left; apply pow_lt; assumption.
  replace (Rabs x ^ 1) with (Rabs x); [ idtac | simpl in |- *; ring ].
  replace (M_nat + n + 1)%nat with (S (M_nat + n)).
  apply Rmult_le_reg_l with (INR (fact (S (M_nat + n)))).
  apply lt_INR_0; apply neq_O_lt; red in |- *; intro; assert (H9 := sym_eq H8);
    elim (fact_neq_0 _ H9).
  rewrite (Rmult_comm (Rabs x)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym.
  rewrite Rmult_1_l.
  rewrite fact_simpl; rewrite mult_INR; rewrite Rmult_assoc;
    rewrite <- Rinv_r_sym.
  rewrite Rmult_1_r; apply Rle_trans with (INR M_nat).
  left; rewrite INR_IZR_INZ.
  rewrite <- H4; assert (H8 := archimed (Rabs x)); elim H8; intros; assumption.
  apply le_INR; omega.
  apply INR_fact_neq_0.
  apply INR_fact_neq_0.
  ring.
  ring.
  intro; unfold Un in |- *; unfold Rdiv in |- *; apply Rmult_lt_0_compat.
  apply pow_lt; assumption.
  apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red in |- *; intro;
    assert (H8 := sym_eq H7); elim (fact_neq_0 _ H8).
  clear Un Vn; apply INR_le; simpl in |- *.
  induction  M_nat as [| M_nat HrecM_nat].
  assert (H6 := archimed (Rabs x)); fold M in H6; elim H6; intros.
  rewrite H4 in H7; rewrite <- INR_IZR_INZ in H7.
  simpl in H7; elim (Rlt_irrefl _ (Rlt_trans _ _ _ H2 H7)).
  replace 1 with (INR 1); [ apply le_INR | reflexivity ]; apply le_n_S;
    apply le_O_n.
  apply le_IZR; simpl in |- *; left; apply Rlt_trans with (Rabs x).
  assumption.
  elim (archimed (Rabs x)); intros; assumption.
  unfold Un_cv in |- *; unfold R_dist in |- *; intros; elim (H eps H0); intros.
  exists x0; intros;
    apply Rle_lt_trans with (Rabs (Rabs x ^ n / INR (fact n) - 0)).
  unfold Rminus in |- *; rewrite Ropp_0; do 2 rewrite Rplus_0_r;
    rewrite (Rabs_right (Rabs x ^ n / INR (fact n))).
  unfold Rdiv in |- *; rewrite Rabs_mult; rewrite (Rabs_right (/ INR (fact n))).
  rewrite RPow_abs; right; reflexivity.
  apply Rle_ge; left; apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt;
    red in |- *; intro; assert (H4 := sym_eq H3); elim (fact_neq_0 _ H4).
  apply Rle_ge; unfold Rdiv in |- *; apply Rmult_le_pos.
  case (Req_dec x 0); intro.
  rewrite H3; rewrite Rabs_R0.
  induction  n as [| n Hrecn];
    [ simpl in |- *; left; apply Rlt_0_1
      | simpl in |- *; rewrite Rmult_0_l; right; reflexivity ].
  left; apply pow_lt; apply Rabs_pos_lt; assumption.
  left; apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red in |- *;
    intro; assert (H4 := sym_eq H3); elim (fact_neq_0 _ H4).
  apply H1; assumption.
Qed.


(* A few tests of the syntax of clauses and of the interpretation of change *)

Goal let a := 0+0 in a=a.
intro.
change 0 in (value of a).
change ((fun A:Type => A) nat) in (type of a).
Abort.

Goal forall x, 2 + S x = 1 + S x.
intro.
change (?u + S x) with (S (u + x)).
Abort.

(* Check the combination of at, with and in (see bug #2146) *)

Goal 3=3 -> 3=3. intro H.
change 3 at 2 with (1+2) in |- *.
change 3 at 2 with (1+2) in H |-.
change 3 with (1+2) in H at 1 |- * at 1.
(* Now check that there are no more 3's *)
change 3 with (1+2) in * || reflexivity.
Qed.

(* Note: the following is invalid and must fail
change 3 at 1 with (1+2) at 3.
change 3 at 1 with (1+2) in *.
change 3 at 1 with (1+2) in H at 2 |-.
change 3 at 1 with (1+2) in |- * at 3.
change 3 at 1 with (1+2) in H |- *.
change 3 at 1 with (1+2) in H, H|-.
change 3 in |- * at 1.
 *)


(** * Module [extralibrary]: library functions, theorems, and tactics *)

Require Import Arith.
Require Import ZArith.
Require Import List.
Require Export decidable_In.

(** ** Tactics *)

Ltac decEq :=
  match goal with
  | [ |- (_, _) = (_, _) ] =>
      apply injective_projections; unfold fst,snd; try reflexivity
  | [ |- (@Some ?T _ = @Some ?T _) ] =>
      apply (f_equal (@Some T)); try reflexivity
  | [ |- (@cons ?T _ _ = @cons ?T _ _) ] =>
      apply (f_equal2 (@cons T)); try reflexivity
  | [ |- (?X _ _ _ _ _ = ?X _ _ _ _ _) ] =>
      apply (f_equal5 X); try reflexivity
  | [ |- (?X _ _ _ _ = ?X _ _ _ _) ] =>
      apply (f_equal4 X); try reflexivity
  | [ |- (?X _ _ _ = ?X _ _ _) ] =>
      apply (f_equal3 X); try reflexivity
  | [ |- (?X _ _ = ?X _ _) ] =>
      apply (f_equal2 X); try reflexivity
  | [ |- (?X _ = ?X _) ] =>
      apply (f_equal X); try reflexivity
  | [ |- (?X ?A <> ?X ?B) ] =>
      cut (A <> B); [intro; congruence | try discriminate]
  end.

Ltac omegaContradiction :=
  cut False; [contradiction|omega].

Ltac caseEq name :=
  generalize (refl_equal name); pattern name at -1 in |- *; case name.

(** ** Arithmetic *)

Inductive comparison_nat (x y: nat) : Set :=
  | Nat_less:    x < y -> comparison_nat x y
  | Nat_equal:   x = y -> comparison_nat x y
  | Nat_greater: x > y -> comparison_nat x y.

Lemma compare_nat: forall x y, comparison_nat x y.
Proof.
  intros. case (lt_eq_lt_dec x y); intro.
  destruct s. apply Nat_less; auto. apply Nat_equal; auto.
  apply Nat_greater; auto.
Defined.

Lemma map_append {A} {B} (f: A -> B) (l1 l2: list A) :
  map f (l1 ++ l2) = (map f l1) ++ (map f l2).
Proof.
  induction l1; simpl; intros. auto. decEq; auto.
Qed.

(** ** Peano induction. *)

(** This is a variant of the induction principle over natural
  numbers.  It will be used later to do induction over
  the size of a type. *)

Lemma Peano_induction:
  forall (P: nat -> Prop),
  (forall x, (forall y, y < x -> P y) -> P x) ->
  forall x, P x.
Proof.
  intros P H.
  assert (forall x, forall y, y < x -> P y).
  induction x; intros.
  omegaContradiction.
  apply H. intros. apply IHx. omega.
  intro. apply H0 with (S x). omega.
Qed.

Ltac destruct_notIn :=
  match goal with
    | H : (?x # (?l ++ ?m)) |- _  =>
      destruct (notIn_app_1 x l m H); clear H; destruct_notIn
    | x := ?l |- _ =>
      assert (x = l); auto; clearbody x; destruct_notIn
    | _ => idtac
  end.

Ltac solve_notIn :=
  intros;
  destruct_notIn;
  repeat first [ apply notIn_app_2
               | apply notIn_cons_3
               | apply notIn_singleton_1
               | apply notIn_empty_1

               ];
  auto;
  try tauto;
  fail "Not solvable by [solve_notIn]; try [destruct_notIn]".


(* -------------------------------------------------------------------- *)
From mathcomp Require Import all_ssreflect all_algebra.
(* ------- *) Require Import xbigops misc lp.

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

Import GRing.Theory Num.Theory Order.Theory.

Local Open Scope ring_scope.

Delimit Scope syntax_scope with T.

(* -------------------------------------------------------------------- *)
Section Vertex.
Context {T : Type}.

Inductive vertex := Vertex of (bool + T).

Coercion vertex_val (v : vertex) : bool + T :=
  let: Vertex v := v in v.

Canonical vertex_subType := [newType for vertex_val].
End Vertex.

Arguments vertex T : clear implicits.

Definition vertex_eqMixin (T : eqType) :=
  [eqMixin of vertex T by <:].
Canonical vertex_eqType (T : eqType) :=
  Eval hnf in EqType (vertex T) (vertex_eqMixin T).

Definition vertex_choiceMixin (T : choiceType) :=
  [choiceMixin of vertex T by <:].
Canonical vertex_choiceType (T : choiceType) :=
  Eval hnf in ChoiceType (vertex T) (vertex_choiceMixin T).

Definition vertex_countMixin (T : countType) :=
  [countMixin of vertex T by <:].
Canonical vertex_countType (T : countType) :=
  Eval hnf in CountType (vertex T) (vertex_countMixin T).
Canonical vertex_subCountType (T : countType) :=
  Eval hnf in [subCountType of vertex T].

Definition vertex_finMixin (T : finType) :=
  [finMixin of vertex T by <:].
Canonical vertex_finType (T : finType) :=
  Eval hnf in FinType (vertex T) (vertex_finMixin T).

(* -------------------------------------------------------------------- *)
Notation "↓ x" := (Vertex (inr x)) (at level 2).
Notation "⊤"   := (Vertex (inl true )) (at level 0).
Notation "⊥"   := (Vertex (inl false)) (at level 0).

Local Notation edge T := (vertex T * vertex T)%type.

(* -------------------------------------------------------------------- *)
Section MaxFlow.
Context {R : realFieldType}.

(* -------------------------------------------------------------------- *)
Reserved Notation "{ 'network' T }"
  (at level 0, format "{ 'network'  T }").

Reserved Notation "{ 'flow' g }"
  (at level 0, format "{ 'flow'  g }").

Reserved Notation "g .-flow"
  (at level 2, format "g .-flow").

(* -------------------------------------------------------------------- *)
Section VertexW.
Context (T : Type) (P : vertex T -> Prop).

Hypothesis Psrc : P ⊤.
Hypothesis Pdst : P ⊥.
Hypothesis Pgrd : forall u, P ↓u.

Lemma vertexW : forall u, P u.
Proof. by case=> -[[]|]. Qed.
End VertexW.

(* -------------------------------------------------------------------- *)
Section Network.
Context {T : finType}.

Definition isnetwork (f : edge T -> R) := [forall e, 0 <= f e].

Lemma networkP (f : edge T -> R) :
  reflect (forall e, 0 <= f e) (isnetwork f).
Proof. by apply/forallP. Qed.

Record network : predArgType := Network
  { capacity :> {ffun edge T -> R}; _ : isnetwork capacity; }.

Canonical network_subType := Eval hnf in [subType for capacity].

Definition network_eqMixin := Eval hnf in [eqMixin of network by <:].
Canonical  network_eqType  := Eval hnf in EqType network network_eqMixin.

Definition network_of of phant T := network.
Identity Coercion type_network_of : network_of >-> network.
End Network.

Notation "{ 'network' T }" := (network_of (Phant T)).

Lemma network_ge0 {T : finType} (g : {network T}) e : 0 <= g e.
Proof. by case: g => /= g /networkP /(_ e). Qed.

Hint Immediate network_ge0 : core.

(* -------------------------------------------------------------------- *)
Section Flow.
Context {T : finType}.

Definition isflow (g : {network T}) : pred (edge T -> R) :=
  [pred f : edge T -> R |
     [&& [forall e : edge T, f e <= g.(capacity) e]
       , [forall u, forall v, f (u, v) == - f (v, u)]
       & [forall u, (\sum_v f (↓u, v) == 0)]]].

Definition IsFlow (g : {network T}) : qualifier 1 _ :=
  Qualifier 1 (fun f => isflow g f).

Fact IsFlow_key g : pred_key (IsFlow g). Proof. by []. Qed.
Definition IsFlow_keyed g := KeyedQualifier (IsFlow_key g).

Notation "g .-flow" := (IsFlow g).

(* -------------------------------------------------------------------- *)
Definition fmass (f : edge T -> R) := \sum_v f(⊤, v).

Lemma fmassE f : fmass f = \sum_v f(⊤, v).
Proof. by []. Qed.

(* -------------------------------------------------------------------- *)
Section IsFlowTh.
Context (g : {network T}) (f : edge T -> R).

Hypothesis fl_f : f \is a g.-flow.

Lemma isflow_lecp (e : edge T) : f e <= g e.
Proof. by have /and3P[h _ _] := fl_f; move/forallP: h. Qed.

Lemma isflow_antisym u v : f (u, v) = - f (v, u).
Proof. by have /and3P[_ h _] := fl_f; move/'forall_'forall_eqP: h. Qed.

Lemma isflow_kirchnoff u : \sum_v f (↓ u, v) = 0.
Proof. by have /and3P[_ _] := fl_f => /'forall_eqP. Qed.
End IsFlowTh.

Record flow (g : {network T}) : predArgType := Flow
  { fun_of_flow :> edge T -> R; _ : fun_of_flow \is a g.-flow }.

Canonical flow_subType g := Eval hnf in [subType for @fun_of_flow g].
End Flow.

(* -------------------------------------------------------------------- *)
Notation "g .-flow" := (IsFlow g).

(* -------------------------------------------------------------------- *)
Lemma isflowP {T : finType} (g : {network T}) (f : edge T -> R) :
     (forall e, f e <= g e)
  -> (forall u v, f (u, v) = - f (v, u))
  -> (forall u, \sum_v f (↓u, v) = 0)
  -> f \is a g.-flow.
Proof.
move=> lecp asym eq0; apply/and3P; split.
+ by apply/forallP. + by apply/'forall_'forall_eqP.
by apply/forallP=> x; rewrite eq0 eqxx.
Qed.

(* -------------------------------------------------------------------- *)
Section CoreFlowTheory.
Context {T : finType} (g : {network T}) (f : flow g).

Lemma isflow_0 : (fun _ => 0) \is a g.-flow.
Proof. apply/isflowP => [e|_ _| _].
+ by apply/network_ge0. + by rewrite oppr0. + by rewrite big1.
Qed.

Lemma eq_isflow f1 f2 :
  (f1 =1 f2) -> f1 \is a g.-flow -> f2 \is a g.-flow.
Proof.
move=> eqf hf1; apply/isflowP=> [e|u v|u].
+ by rewrite -eqf; apply/(isflow_lecp hf1).
+ by rewrite -!eqf; apply/(isflow_antisym hf1).
+ rewrite -[RHS](isflow_kirchnoff hf1 u).
  by apply/eq_bigr=> v _; rewrite eqf.
Qed.

Lemma isflow_flow : (fun_of_flow f) \is a g.-flow.
Proof. by apply/valP. Qed.

Hint Resolve isflow_flow : core.

Lemma flow_lecp e : f e <= g e.
Proof. by apply/isflow_lecp. Qed.

Lemma flow_antisym u v : f (u, v) = - f (v, u).
Proof. by apply/(isflow_antisym isflow_flow). Qed.

Lemma flow_kirchnoff u : \sum_v f (↓u, v) = 0.
Proof. by apply/(isflow_kirchnoff isflow_flow). Qed.

Lemma flow_self u : f (u, u) = 0.
Proof.
have /eqP := flow_antisym u u; rewrite -addr_eq0 -mulr2n.
by rewrite -mulr_natl mulf_eq0 pnatr_eq0 => /eqP.
Qed.

Lemma flow_ge0 u v: g (u, v) = 0 -> 0 <= f (v, u).
Proof.
move=> zg; rewrite flow_antisym oppr_ge0.
by rewrite -zg; apply/flow_lecp.
Qed.

Lemma flow_eq0 u v: g (u, v) = 0 -> g(v, u) = 0 -> f (u, v) = 0.
Proof.
move=> zg1 zg2; apply/eqP; rewrite eq_le.
by rewrite flow_ge0 // andbT flow_antisym oppr_le0 flow_ge0.
Qed.
End CoreFlowTheory.

(* -------------------------------------------------------------------- *)
Section Residual.
Context {T : finType} (g : {network T}) (f : flow g).

Definition preresidual (e : edge T) : R := g e - f e.

Lemma network_residual : isnetwork (finfun preresidual).
Proof. by apply/networkP=> e; rewrite ffunE subr_ge0 flow_lecp. Qed.

Definition residual : {network T} := Network network_residual.

Lemma residualE e : residual e = g e - f e.
Proof. by rewrite ffunE. Qed.
End Residual.

(* -------------------------------------------------------------------- *)
Section AddFlow.
Context {T : finType} {g : {network T}}.
Context (f : flow g) (fp : flow (residual f)).

Lemma isflow_addflow : (f \+ fp) \is a g.-flow.
Proof. apply/isflowP => [e|u v|u] /=.
+ by have := flow_lecp fp e; rewrite residualE ler_subr_addl.
+ by rewrite opprD [f _]flow_antisym [fp _]flow_antisym.
+ by rewrite big_split /= !flow_kirchnoff addr0.
Qed.

Definition addflow := Flow isflow_addflow.

Lemma addflowE e : addflow e = f e + fp e.
Proof. by []. Qed.

Lemma fmassD : fmass addflow = fmass f + fmass fp.
Proof. by rewrite !fmassE big_split. Qed.
End AddFlow.

Local Notation "`| f |" := (fmass f).
Local Notation "f \+ g" := (addflow f g).

(* -------------------------------------------------------------------- *)
Section AugmentingPath.
Context {T : finType} (g : {network T}) (f : flow g).

Definition spath (s : seq T) :=
  let s : seq (vertex T) := [seq ↓u | u <- s] in
  path [rel x y | 0 < residual f (x, y)] ⊤ (rcons s ⊥).

Inductive apath := APath (s : seq T) of uniq s && spath s.

Definition apath_proj (p : apath) :=
  let: APath p _ := p in p.

Canonical apth_subType := Eval hnf in [subType for apath_proj].
Definition apath_eqMixin := Eval hnf in [eqMixin of apath by <:].
Canonical apath_eqType := Eval hnf in EqType apath apath_eqMixin.
Definition apath_choiceMixin := Eval hnf in [choiceMixin of apath by <:].
Canonical apath_choiceType := Eval hnf in ChoiceType apath apath_choiceMixin.
Definition apath_countMixin := Eval hnf in [countMixin of apath by <:].
Canonical apath_countType := Eval hnf in CountType apath apath_countMixin.

Definition aenum : seq apath :=
  pmap insub (flatten
    [seq [seq val s | s <- enum {: n.-tuple T}] | n <- iota 0 #|T|.+1]).

Lemma uniq_aenum : uniq aenum.
Proof.
rewrite /aenum -(map_inj_uniq (@Some_inj _)) pmapS_filter.
rewrite map_inj_in_uniq.
+ move=> x y; rewrite !mem_filter => /andP[hx _] /andP[hy _].
  rewrite !insubT //=; try by rewrite !isSome_insub in hx, hy.
  by move=> py px; case.
apply/filter_uniq; elim: #|T|.+1 0%N => //= n ih k; rewrite cat_uniq.
rewrite (map_inj_uniq val_inj) enum_uniq /= ih andbT; apply/hasPn=> /=.
move=> s /flatten_mapP /= [j]; rewrite mem_iota ltn_neqAle.
case/andP=> /andP[] ne_kj _ _ /mapP /= [t _ ->]; apply/negP.
case/mapP=> /= t' _ /(congr1 size); rewrite !size_tuple.
by move=> eq; move: ne_kj; rewrite eq eqxx.
Qed.

Lemma aenum_finAxiom : Finite.axiom aenum.
Proof.
move=> s; rewrite count_uniq_mem ?uniq_aenum // (rwP eqP) eqb1.
case: s=> s Ps; rewrite -(mem_map (@Some_inj _)) pmapS_filter.
apply/mapP; exists s; rewrite ?insubT //.
rewrite mem_filter insubT; apply/flattenP.
pose t := map val (enum {: (size s).-tuple T}); exists t.
+ apply/mapP; exists (size s) => //; rewrite mem_iota /= add0n.
  by case/andP: Ps => /card_uniqP <- _; rewrite ltnS max_card.
by apply/mapP=> /=; exists (in_tuple s) => //; rewrite mem_enum.
Qed.

Definition apath_finMixin := FinMixin aenum_finAxiom.
Canonical apath_finType := Eval hnf in FinType apath apath_finMixin.

Coercion path_of_apath (p : apath) :=
  let: APath p _ := p in ⊤ :: (rcons [seq ↓u | u <- p] ⊥).

Lemma size_apath (p : apath) : (size p <= #|T|.+2)%N.
Proof.
case: p => p /= /andP[uqP _]; rewrite size_rcons !ltnS size_map.
by move/card_uniqP: uqP => <-; apply/max_card.
Qed.

Lemma uniq_apath (a : apath) : uniq a.
Proof.
case: a => /= a /andP[uq _]; rewrite !(mem_rcons, rcons_uniq).
rewrite map_inj_uniq ?uq ?andbT => [u1 u2 [//]|].
by apply/andP; split; apply/negP => /mapP[].
Qed.

(* -------------------------------------------------------------------- *)
Definition asegment (a : seq (vertex T)) (e : edge T) :=
  [&& ((e.1 != ⊥) && (e.2 != ⊤)), e.1 != e.2 & next a e.1 == e.2].

Lemma asegmentP (a : apath) (e : edge T) :
  asegment a e -> f e < g e.
Proof.
pose ep := [rel x y | ((x, y) == (⊥, ⊤)) || (0 < residual f (x, y))].
move=> h; have hc: cycle ep (a : seq _); first rewrite (cycle_path ⊤).
+ case: {h} a => a /=; rewrite last_rcons /= => /andP[_].
  by apply/sub_path => /= u v /= h; rewrite /ep /= h orbT.
case/and3P: h => nz_e neq_e hnx; have: e.1 \in (a : seq _).
+ by move: hnx; rewrite next_nth; case: ifP => // _; apply/contraLR.
move/next_cycle => -/(_ _ hc); rewrite (eqP hnx) /eq /=.
case: {neq_e hnx} e nz_e => u v /=; rewrite [_ (u, v)]eqE /=.
case/andP=> [/negbTE->] _; rewrite ffunE /=.
by rewrite /preresidual subr_gt0.
Qed.

Lemma nz_apath (a : apath) : exists e, asegment a e.
Proof.
exists (nth ⊤ a 0, nth ⊤ a 1) => /=; case: a => /= a _.
by rewrite /asegment; case: a => /=.
Qed.

Lemma next_snk (a : apath) : next a ⊥ = ⊤.
Proof.
rewrite next_nth; case: a => /= a _.
rewrite mem_behead /= ?mem_rcons // -cats1.
rewrite index_cat; case: ifPn => [/mapP[//]|_].
rewrite size_map /= addn0; set s := _ ++ _.
case E: s => [|x s'] //; rewrite nth_default //.
move/(congr1 size): E; rewrite {}/s size_cat /= addn1.
by case=> <-; rewrite size_map.
Qed.

Lemma prev_src (a : apath) : prev a ⊤ = ⊥.
Proof.
rewrite (rwP eqP) -(inj_eq (can_inj (prev_next (uniq_apath a)))).
by rewrite next_prev ?uniq_apath // next_snk.
Qed.

Definition aweight (a : apath) : R :=
  residual f (arg_minr (residual f) (nz_apath a)).

Lemma aweight_gt0 (a : apath) : 0 < aweight a.
Proof.
rewrite /aweight; case: arg_minrP => /= e he _.
by rewrite ffunE /preresidual subr_gt0 (asegmentP he).
Qed.

Lemma aweight_ge0 (a : apath) : 0 <= aweight a.
Proof. by apply/ltW/aweight_gt0. Qed.

Lemma aweight_flow_le (a : apath) (e : edge T) :
  asegment a e -> aweight a <= residual f e.
Proof.
by move=> he; rewrite /aweight; case: arg_minrP => e' _ /(_ _ he).
Qed.

Lemma asegment_meml a e : asegment a e -> e.1 \in a.
Proof.
case: e => u v /= /and3P[/= _ /eqP ne_uv].
by rewrite next_nth; case: (_ \in _) => // /eqP.
Qed.

Lemma asegment_memr a e : asegment a e -> e.2 \in a.
Proof.
move=> h; have := asegment_meml h; case: e h => u v /=.
by case/and3P=> /= _ _ /eqP <-; rewrite mem_next.
Qed.

Lemma asegment_injr (a : apath) u v1 v2 :
  asegment a (u, v1) -> asegment a (u, v2) -> v1 = v2.
Proof. by move=> /and3P[/= _ _ /eqP <-] /and3P[/= _ _ /eqP <-]. Qed.

Lemma asegment_injl (a : apath) u1 u2 v :
  asegment a (u1, v) -> asegment a (u2, v) -> u1 = u2.
Proof.
move=> /and3P[/= _ ne1 /eqP h1] /and3P[/= _ ne2 /eqP h2].
by apply/(can_inj (prev_next (uniq_apath a))); rewrite h1 h2.
Qed.

Lemma asegment0 (a : apath) u v :
  val a = [::] -> asegment a (u, v) -> (u, v) = (⊤, ⊥).
Proof.
case: a => /= a _ -> /and3P[/= ne1 ne2].
case: ifPn => [/eqP->/eqP<-//|] ne3 /eqP vE.
by case: ifPn vE ne1 ne2 => [/eqP-><-//|_ ->]; rewrite eqxx.
Qed.

Lemma asegment_src (a : apath) : asegment a (⊤, next a ⊤).
Proof.
by apply/and3P; split=> //; case: a => /= a _; case: a.
Qed.

Lemma asegmentN_src_snk (a : apath) : ~~ asegment a (⊥, ⊤).
Proof. by apply/negP; case/and3P. Qed.

Lemma apath_neq_next (a : apath) u :
  ↓ u \in (a : seq _) -> ↓ u != next a (↓ u).
Proof.
have: (2 <= size a)%N by case: a => /= a; rewrite size_rcons !ltnS.
move=> sz ua; rewrite head_rot_index ?uniq_apath //.
move/path.splitP: ua sz (uniq_apath a) => [p1 p2]; rewrite rotS.
+ by rewrite index_mem mem_cat mem_rcons mem_head.
rewrite size_cat size_rcons addSn ltnS addnC -size_cat => sz.
rewrite -cats1 -catA uniq_catCA => /= /andP[h _].
move: h; rewrite mem_cat negb_or => /andP[h1 h2].
rewrite index_cat (negbTE h1) /= eqxx addn0 rot_size_cat.
have h: ↓ u \notin (p2 ++ p1) by rewrite mem_cat (negbTE h2).
move: sz; rewrite /= rot1_cons; case: (p2 ++ p1) h => //.
by move=> x s; rewrite in_cons negb_or => /andP[].
Qed.

Lemma apath_neq_prev (a : apath) u :
  ↓ u \in (a : seq _) -> ↓ u != prev a (↓ u).
Proof.
rewrite -(inj_eq (can_inj (prev_next (uniq_apath a)))).
by rewrite next_prev ?uniq_apath // eq_sym; apply/apath_neq_next.
Qed.

Lemma asegment_next (a : apath) v :
  ↓ v \in (a : seq _) -> asegment a (↓ v, next a (↓ v)).
Proof.
move=> va; apply/and3P; split=> //=; last by apply/apath_neq_next.
rewrite -(inj_eq (can_inj (next_prev (uniq_apath a)))).
by rewrite prev_next ?uniq_apath // prev_src.
Qed.

Lemma asegment_prev (a : apath) v :
  ↓ v \in (a : seq _) -> asegment a (prev a (↓ v), ↓ v).
Proof.
move=> va; apply/and3P; split=> //=; rewrite ?andbT.
+ rewrite -(inj_eq (can_inj (prev_next (uniq_apath a)))).
  by rewrite next_prev ?uniq_apath // next_snk.
+ by rewrite eq_sym apath_neq_prev.
+ by rewrite next_prev ?uniq_apath.
Qed.

Lemma asegment_asym (a : apath) u v :
  asegment a (u, v) -> ~~ asegment a (v, u).
Proof.
move=> ae; case: (val a =P [::]) => [|nz_a].
+ by move/asegment0/(_ ae)=> [-> ->]; apply/asegmentN_src_snk.
case/and3P: ae => /= _ _ /eqP<-; apply/negP; case/and3P=> /= ne.
rewrite {1}next_nth; case/boolP: (u \in (_ a)) => //; last first.
+ by move=> _; rewrite eqxx.
move=> ua _; suff: exists v1 v2, exists s, [/\ u <> v1, u <> v2 &
  rot (index u a) a = u :: v1 :: v2 :: s].
+ case=> [v1] [v2] [s] [/eqP ne1 /eqP ne2 eq] /=.
  rewrite -[next a u](next_rot (index u a)) ?uniq_apath // eq.
  rewrite /= eqxx -[next a v1](next_rot (index u a)) ?uniq_apath //.
  by rewrite eq /= ![_==u]eq_sym (negbTE ne1) eqxx (negbTE ne2).
have: (3 <= size a)%N.
+ case: {ne ua} a nz_a => /= a _; case: a => //.
  by move=> x a _; rewrite size_rcons !ltnS.
case: (path.splitP ua) (uniq_apath a) => p1 p2.
rewrite size_cat size_rcons addSn ltnS -size_cat.
rewrite -{1}cats1 -catA -(rot_uniq (size p1)) rot_size_cat /=.
rewrite mem_cat negb_or => /andP[/andP[hm2 hm1] _].
rewrite index_cat mem_rcons mem_head -{1}cats1.
rewrite index_cat (negbTE hm1) /= eqxx addn0.
rewrite -cats1 -catA rot_size_cat /= size_cat addnC -size_cat.
have: u \notin (p2 ++ p1) by rewrite mem_cat negb_or hm2.
case: (p2 ++ p1) => // v1 [] // v2 s h _; exists v1, v2, s.
move: h; rewrite !in_cons !negb_or => /and3P.
by case=> /eqP h1 /eqP h2 _; split.
Qed.

(* -------------------------------------------------------------------- *)
Definition preflow_of_apath (a : apath) := fun (e : edge T) =>
  if asegment a (e.1, e.2) then   aweight a else
  if asegment a (e.2, e.1) then - aweight a else 0.

Lemma preflow_of_apath_is_flow (a : apath) :
  preflow_of_apath a \is a (residual f).-flow.
Proof. apply/isflowP => [e|u v|v].
- rewrite /preflow_of_apath; case: ifPn => [|_].
  + by move=> /aweight_flow_le; case: e.
  case: ifPn => _; last by rewrite network_ge0.
  apply/(@le_trans _ _ 0)/network_ge0.
  by rewrite oppr_le0 aweight_ge0.
- rewrite /preflow_of_apath /=; case: ifPn.
  + by move/asegment_asym/negbTE=> ->; rewrite opprK.
  by move=> _; case: ifPn => // _; rewrite oppr0.
- case/boolP: (↓ v \in (a : seq _)) => va; last first.
  + rewrite big1 //= => u _; rewrite /preflow_of_apath /=.
    case: ifP; last case: ifP => //.
    * by move/asegment_meml=> /=; rewrite (negbTE va).
    * by move/asegment_memr=> /=; rewrite (negbTE va).
  rewrite (bigD1 (next a (↓ v))) 1?(bigD1 (prev a (↓ v))) //=.
  + have := asegment_asym (asegment_next va); apply/contra.
    by move=> /eqP <-; apply/asegment_prev.
  rewrite big1 ?addr0 => [u /andP [hu1 hu2]|].
  + rewrite /preflow_of_apath /=; do! case: ifPn=> //.
    * by case/and3P=> /= _ _; rewrite eq_sym (negbTE hu1).
    * case/and3P=> /= _ _ => /eqP /(congr1 (prev a)).
      by rewrite prev_next ?uniq_apath // (rwP eqP) (negbTE hu2).
    rewrite /preflow_of_apath /= asegment_next //=.
    by rewrite -if_neg asegment_asym ?asegment_prev // subrr.
Qed.

(* -------------------------------------------------------------------- *)
Definition flow_of_apath (a : apath) :=
  Flow (preflow_of_apath_is_flow a).

Lemma flow_of_apath_neq0 a : 0 < `|flow_of_apath a|.
Proof.
rewrite fmassE (bigD1 (next a ⊤)) //= big1 ?addr0.
+ move=> v Nva; rewrite /preflow_of_apath /=.
  case: ifPn => [/(asegment_injr (asegment_src a))|].
  * by move/eqP; rewrite eq_sym (negbTE Nva).
  by move=> _; rewrite -if_neg /asegment /= andbF.
by rewrite /preflow_of_apath /= asegment_src aweight_gt0.
Qed.
End AugmentingPath.

(* -------------------------------------------------------------------- *)
Notation cut T := (pred T) (only parsing).

Section CutDef.
Context {T : finType} (C : cut T).

Definition cleft : pred (vertex T) :=
  [pred x | if x is ↓x then C x else x == ⊤].

Definition cright : pred (vertex T) :=
  [pred x | if x is ↓x then ~~ C x else x == ⊥].

(* -------------------------------------------------------------------- *)
Definition cweight (g : {network T}) :=
  \sum_(u in cleft ) \sum_(v in cright) g (u, v).

Definition cflow (f : edge T -> R) :=
  \sum_(u in cleft) \sum_(v in cright) f (u, v).

(* -------------------------------------------------------------------- *)
Lemma cleft_grdE u : ↓u \in cleft = C u.
Proof. by []. Qed.

Lemma cright_grdE u : ↓u \in cright = ~~ C u.
Proof. by []. Qed.

Definition cut_grdE := (cleft_grdE, cright_grdE).

(* -------------------------------------------------------------------- *)
Lemma cut_span u : (u \in cleft) || (u \in cright).
Proof. by elim/vertexW: u => //= u; rewrite !cut_grdE orbN. Qed.

(* -------------------------------------------------------------------- *)
Lemma cut_disjoint : [disjoint cleft & cright].
Proof.
rewrite disjoint_subset; apply/subsetP; elim/vertexW => //=.
by move=> u; rewrite !(cut_grdE) inE negbK.
Qed.

(* -------------------------------------------------------------------- *)
Lemma cright_cleft : cright =1 predC cleft.
Proof. by elim/vertexW. Qed.

(* -------------------------------------------------------------------- *)
Lemma cflowE f : cflow f =
  \sum_(u | u \in cleft) \sum_(v | v \notin cleft) f (u, v).
Proof.
apply/eq_bigr=> /= u _; apply/eq_bigl=> v /=.
by rewrite -!topredE /= cright_cleft.
Qed.

(* -------------------------------------------------------------------- *)
Lemma cweightE (g : {network T}) : cweight g =
  \sum_(u | u \in cleft) \sum_(v | v \notin cleft) g (u, v).
Proof.
apply/eq_bigr=> /= u _; apply/eq_bigl=> v /=.
by rewrite -!topredE /= cright_cleft.
Qed.
End CutDef.

(* -------------------------------------------------------------------- *)
Section FlowMeasure.
Context {T : finType} {g : {network T}} (C : cut T) (f : flow g).

Lemma flow_cflow : `|f| = cflow C f.
Proof.
have eq0: \sum_(u in cleft C | u != ⊤) \sum_v f (u, v) = 0.
  by rewrite big1 //=; elim/vertexW => // u _; rewrite flow_kirchnoff.
rewrite fmassE cflowE -[LHS]addr0 -{}[X in _+X]eq0.
rewrite -bigD1 //= (eq_bigr _ (fun _ _ => bigID (cleft C) _ _)) /=.
rewrite big_split /= [X in X+_](_ : _ = 0) ?add0r //.
apply/(@mulfI _ 2%:R); first by rewrite pnatr_eq0.
rewrite mulr0 mulr_natl mulr2n {1}exchange_big /= -big_split /=.
rewrite big1 // => u _; rewrite -big_split big1 //= => v _.
by rewrite [X in _+X]flow_antisym subrr.
Qed.
End FlowMeasure.

(* -------------------------------------------------------------------- *)
Section FMass.
Context {T : finType} (g : {network T}) (f : flow g).

Lemma fmass_snkE : `|f| = \sum_v f (v, ⊥).
Proof.
rewrite (flow_cflow predT) /cflow exchange_big /=.
rewrite (bigD1 ⊥) //= addrC big1 ?add0r; first by case=> -[[]|].
apply/esym; rewrite (bigD1 ⊥) //= flow_self add0r.
by apply/eq_bigl; case=> -[[|]|].
Qed.
End FMass.

(* -------------------------------------------------------------------- *)
Section WeakMaxFlowMinCut.
Context {T : finType} (g : {network T}) (C : cut T) (f : flow g).

Lemma weak_maxflow_mincut : `|f| <= cweight C g.
Proof.
rewrite (flow_cflow C) cflowE cweightE !pair_big /=.
by apply/ler_sum=> e _; apply/flow_lecp.
Qed.
End WeakMaxFlowMinCut.

(* -------------------------------------------------------------------- *)
Section MaxFlowMinCut.
Context {T : finType} (g : {network T}).

Local Notation nv := #|{: vertex T}|.
Local Notation ne := #|{: edge T}|.

(* -------------------------------------------------------------------- *)
Let eswap (e : edge T) : edge T := (e.2, e.1).

Let evar (e : edge T) : 'cV[R]_ne :=
  delta_mx (enum_rank e) 0.

Definition flow_eqs : (ne + ne + #|T|).-tuple (lpeq ne) :=
    [tuple of
      (  [seq (evar e <= g e)%T | e <- enum {: edge T}]
      ++ [seq (evar e + evar (eswap e) == 0)%T | e <- enum {: edge T}])
      ++ [seq (\sum_v evar (↓u, v) == 0)%T | u <- enum T]].

Definition flow_of_vector (x : 'rV[R]_ne) :=
  fun e : edge T => x 0 (enum_rank e).

(* -------------------------------------------------------------------- *)
Definition flow_cost (x : 'rV[R]_ne) :=
  fmass (flow_of_vector x).

Lemma flow_cost_is_linear : scalar flow_cost.
Proof.
move=> c u v; rewrite /flow_cost /fmass mulr_sumr -big_split /=.
by apply/eq_bigr=> x _; rewrite /flow_of_vector !mxE.
Qed.

(* -------------------------------------------------------------------- *)
Definition flow_pb :=
  {| lppb_eqs  := flow_eqs;
     lppb_bnd  := \sum_e g e;
     lppb_cost := Linear flow_cost_is_linear |}.

(* -------------------------------------------------------------------- *)
Lemma flow_pbP (x : 'rV[R]_ne) (f : edge T -> R) :
     (forall e, f e = x 0 (enum_rank e))
  -> (x \in flow_pb) = (f \is a g.-flow).
Proof.
move=> eq_fx; have xE e: (x *m evar e) 0 0 = f e.
+ rewrite mulmx_sum_rowE (bigD1 (enum_rank e)) //= !mxE !eqxx mulr1.
  rewrite big1 ?addr0 ?eq_fx // => i ne.
  by rewrite !mxE (negbTE ne) mulr0.
apply/idP/idP => [/lppbP[h _]|].
+ apply/isflowP => [e|u v|u].
  * move/(_ (lshift _ (lshift _ (enum_rank e)))): h => /=.
    rewrite /flow_eqs !tnth_catlr tnth_map mem_lpeqE /=.
    by rewrite (tnth_nth e) /= nth_enum_rank xE.
  * move/(_ (lshift _ (rshift _ (enum_rank (u, v))))): h.
    rewrite /flow_eqs !tnth_catlr tnth_map mem_lpeqE /=.
    rewrite !(tnth_nth (u, v)) !nth_enum_rank /eswap /=.
    by rewrite mulmxDr !(xE, mxE) addr_eq0 => /eqP.
  * move/(_ (rshift _ (enum_rank u))): h; rewrite /flow_eqs.
    rewrite !tnth_catlr tnth_map mem_lpeqE /= mulmx_sumr summxE.
    move/eqP=> h; rewrite -{}[RHS]h; apply/eq_bigr=> v _.
    by rewrite xE; rewrite (tnth_nth u) nth_enum_rank.
+ move=> hf; apply/lppbP; split; last first.
  * move=> e; rewrite -[e]enum_valK -eq_fx /flow_pb /=.
    case: (enum_val e) => {e} u v; rewrite ler_norml.
    rewrite {1}(bigD1 (v, u)) //= (bigD1 (P := predT) (u, v)) //=.
    rewrite ler_oppl -(isflow_antisym hf) !ler_paddr //; solve
      [ by rewrite sumr_ge0 // => i _; rewrite network_ge0
      | by apply/(isflow_lecp hf)].
  (do! elim/splitW) => i; rewrite !tnth_catlr tnth_map mem_lpeqE /=.
  * by rewrite xE; apply/(isflow_lecp hf).
  * rewrite mulmxDr !(xE, mxE); case: (tnth _ _) => u v.
    by rewrite /eswap /= addr_eq0; apply/eqP/(isflow_antisym hf).
  * rewrite mulmx_sumr summxE -(rwP eqP); set u := tnth _ _.
    rewrite -[RHS](isflow_kirchnoff hf u).
    by apply/eq_bigr=> v _; rewrite xE.
Qed.

(* -------------------------------------------------------------------- *)
Lemma flow_pb_of_vector (x : 'rV[R]_ne) :
  (x \in flow_pb) = (flow_of_vector x \is a g.-flow).
Proof. by apply/flow_pbP => e. Qed.

(* -------------------------------------------------------------------- *)
Lemma maxflow_mincut :
  {f : flow g |
        (forall C : cut T, `|f| <= cweight C g)
     /\ (exists C : cut T, `|f|  = cweight C g)}.
Proof.
case: (lppbsolve (pb := flow_pb)).
+ exists 0; rewrite flow_pb_of_vector (eq_isflow _ (isflow_0 g)) //.
  by move=> e; rewrite /flow_of_vector mxE.
move=> x; rewrite flow_pb_of_vector => -[solx maxx].
exists (Flow solx); split => [C|]; first by apply/weak_maxflow_mincut.
pose r := residual (Flow solx).
pose P u := [exists i : 'I_#|T|, [exists s : i.-tuple T,
  uniq (rcons s u) && path
    [rel x y | 0 < r (x, y)] ⊤ [seq ↓ x | x <- rcons s u]]].
exists P; rewrite cweightE (flow_cflow P) cflowE.
apply/eq_bigr=> /= u uP; apply/eq_bigr=> /= v vNP.
have /(_ (u, v)) := isflow_lecp solx; rewrite le_eqVlt.
case/orP=> [/eqP->//|]; elim/vertexW: v vNP => // [|v] vNP h.
+ have: exists _ : apath (Flow solx), true.
  * case: u uP h => -[[_|_]|u uP] h //.
    - have: uniq ([::] : seq T) && spath (Flow solx) [::].
      + by rewrite /spath /= andbT ffunE /preresidual subr_gt0.
      by move=> ha; exists (APath ha).
    move: uP; rewrite cut_grdE => /existsP[/= i].
    move/existsP=> [/= s] /andP[uqs hp].
    have: uniq (rcons s u) && spath (Flow solx) (rcons s u).
    - rewrite uqs /= /spath rcons_path hp /= ffunE.
      by rewrite map_rcons last_rcons /preresidual subr_gt0.
    by move=> ha; exists (APath ha).
  case=> ap _; pose fa := addflow (flow_of_apath ap).
  have ltf: `|Flow solx| < `|fa|.
  * by rewrite fmassD /= ltr_addl flow_of_apath_neq0.
  pose z : 'rV[R]_#|{: edge T}| := \row_i fa (enum_val i).
  have /(maxx z): z \in flow_pb.
  * rewrite flow_pb_of_vector; set fb := (X in X \is a _).
    apply/(@eq_isflow _ _ fa fb); last by apply/isflow_flow.
    by move=> y; rewrite /fb /flow_of_vector mxE enum_rankK.
  suff ->: flow_pb.(lppb_cost) z = `|fa| by rewrite leNgt ltf.
  rewrite {}/z /flow_pb /flow_cost /= !fmassE.
  apply/eq_bigr=> /= v _; rewrite /flow_of_vector.
  by rewrite !mxE !(enum_valK, enum_rankK).
+ suff {vNP} Pv: P v by move: vNP; rewrite inE Pv.
  elim/vertexW: u uP h => // => [_ |u uP] h.
  * have := leq0n #|T|; rewrite leq_eqVlt => /orP[/eqP /esym T0|].
    - have: v \in enum T by rewrite mem_enum.
      by move/eqP: T0; rewrite cardT size_eq0 => /eqP->.
    move=> gt0_T; apply/existsP; exists (Ordinal gt0_T).
    apply/existsP; exists [tuple] => /=; rewrite andbT.
    by rewrite ffunE /preresidual subr_gt0.
  case: (u =P v) uP => [->|]; rewrite cut_grdE //.
  move=> ne_uv /existsP[/= i] /existsP[/= s].
  case/andP=> uqs hp; case/boolP: (v \in s) => vs.
  * pose j := index v s; have lt_ji: (j < i)%N.
    - by rewrite -[X in (_ < X)%N](size_tuple s) index_mem.
    apply/existsP; exists (Ordinal (ltn_trans lt_ji (ltn_ord i))).
    have hs: size (take j s) == j by rewrite size_take index_mem vs.
    apply/existsP; exists (Tuple hs) => /=; apply/andP; split.
    - rewrite rcons_uniq /=; apply/andP; split; last first.
      + move: uqs; rewrite rcons_uniq => /andP[_].
        by rewrite -{1}[_ s](cat_take_drop j) cat_uniq => /and3P[].
      apply/negP=> vjs; move: hs; rewrite {2}/j.
      rewrite -{2}[_ s](cat_take_drop j) index_cat vjs /=.
      by rewrite gtn_eqF // index_mem.
    move: hp; rewrite -cats1 -{1}[_ s](cat_take_drop j) -catA.
    rewrite map_cat cat_path => /andP[hv1 hv2].
    rewrite map_rcons rcons_path {}hv1 andTb /= ffunE.
    move: hv2; rewrite cats1 headI /= => /andP[hv _].
    by move: hv; rewrite -nth0 nth_drop addn0 nth_index // ffunE.
  * have: (size (rcons s u) <= #|T|)%N by rewrite size_rcons size_tuple.
    rewrite leq_eqVlt => /orP[hz|hz]; last first.
    - apply/existsP; exists (Ordinal hz); apply/existsP => /=.
      exists (in_tuple (rcons s u)) => /=; apply/andP; split.
      + rewrite rcons_uniq uqs andbT mem_rcons in_cons.
        by rewrite negb_or vs andbT; apply/eqP=> /esym.
      rewrite map_rcons rcons_path hp /= ffunE.
      by rewrite map_rcons last_rcons /= /preresidual subr_gt0.
    case: (@uniq_min_size _ (rcons s u) (enum T)) => //.
    - by move=> y _; rewrite mem_enum.
    - by rewrite (eqP hz) cardT.
    move=> _ /(_ v); rewrite mem_rcons in_cons (negbTE vs) orbF.
    by rewrite mem_enum => /eqP /= /esym.
Qed.
End MaxFlowMinCut.
End MaxFlow.

(* -------------------------------------------------------------------- *)
Notation "{ 'network' T }" := (network_of (Phant T)).


Require Export prosa.behavior.all.

(** To reason about classes of schedule types / processor models, we define the
    following properties that group processor models into classes of similar
    models. *)
Section ProcessorModels.
  (** Consider any job type and any processor state.

      Note: we make the processor state an explicit variable (rather than
      implicit context) because it is the primary subject of the following
      definitions. *)
  Context {Job : JobType}.
  Variable PState : Type.
  Context `{ProcessorState Job PState}.

  (** We say that a processor model provides unit service if no job ever
      receives more than one unit of service at any time. *)
  Definition unit_service_proc_model :=
    forall (j : Job) (s : PState), service_in j s <= 1.

  (** We say that a processor model offers ideal progress if a scheduled job
      always receives non-zero service. *)
  Definition ideal_progress_proc_model :=
    forall j s, scheduled_in j s -> service_in j s > 0.

  (** In a uniprocessor model, the scheduled job is always unique. *)
  Definition uniprocessor_model :=
    forall j1 j2 s t,
      scheduled_at s j1 t ->
      scheduled_at s j2 t ->
      j1 = j2.

End ProcessorModels.


Require Import List.
Require Import Arith.
Require Import Bool.
From Coq Require Import ssreflect ssrfun ssrbool.
(*From mathcomp Require Import eqtype ssrnat div prime.
From Coq Require Import Reals.Reals.*)

Notation "x | y" := (y mod x = 0)(at level 40, left associativity).

Goal forall n:nat, exists x, x=n.
Proof.
  intros.
  refine(ex_intro _ (n) _).
  reflexivity.
Qed.

Goal forall n:nat, exists x, x>n.
Proof.
  intros.
  refine(ex_intro _ (S n) _).
  intuition.
Qed.

Goal forall (n:nat), exists x:nat, n>1 -> x <S n.
Proof.
  intros.
  refine(ex_intro _ n _).
  intros.
  intuition.
Qed.

Goal forall n, n + 0 = n.
Proof.
induction n.
  reflexivity.
  simpl.
  rewrite IHn.
  reflexivity.
Qed.

Goal forall n m, n + m = m + n.
Proof.
  intros.
  induction n.
    elim m.
      intros.
      reflexivity.
      intros.
      simpl.
      rewrite <- H.
      simpl.
      reflexivity.
    simpl.
    rewrite IHn.
    elim m.
    simpl.
    reflexivity.
    intros.
    simpl.
    rewrite H.
    reflexivity.
Qed.

Goal forall x y z,  (x + y) + z = x + (y + z).
Proof.
  intros.
  elim x.
  simpl.
  reflexivity.
  intros.
  simpl.
  rewrite <- H.
  reflexivity.
Qed.

Goal forall x y z, (x + y) * z = x * z + y * z.
Proof.
  intros.
  elim x.
  simpl.
  reflexivity.
  intros.
  simpl.
  rewrite H.

  assert(forall a b c,  (a + b) + c = a + (b + c)).
  intros.
  elim a.
  simpl.
  reflexivity.
  intros.
  simpl.
  rewrite <- H0.
  reflexivity.

  case H0.
  reflexivity.
Qed.

Goal forall m n, m * n = n * m.
Proof.
  intros m n.
  elim m.
    simpl.
    elim n.
      simpl.
      reflexivity.
      intros m' H1.
      simpl.
      case H1.
      reflexivity.
    intros m' H2.
    simpl.
    rewrite H2.
    elim n.
      simpl.
      reflexivity.
    intros n' H3.
    simpl.

    assert(forall n m, n = m -> S n = S m).
    auto.
    apply H.

    rewrite <- H3.

    assert(forall x y, x + (y + x*y) = y + (x + x*y)).
    intros x y.
    elim x.
        simpl.
        reflexivity.
    intros n0 H5.
    simpl.
    rewrite H5.
    elim y.
      simpl.
      reflexivity.
      intros n1 H6.
      simpl.
      apply H.

      assert(forall a b c d, a + b = c + d -> a + S b = c + S d).
      intros.
      apply eq_add_S.
      assert(forall a b, a + S b = S(a+b)). auto.
      rewrite H1.
      rewrite H1.
      apply H.
      apply H.
      exact H0.

      apply H0.

      (*
      assert(forall a b c d, a+(b+S(c)) = b+S d -> a+S(c) = S d).
      intros a b c d.
      intros H7.
      assert(forall a , a + S c = S(a+c)). auto.
      rewrite H1.
      apply H.*)

      admit.

    case H0.
    reflexivity.
Admitted.


Welcome to Coq ciosx:/builds/workspace/coq-8.5pl3-macos,(detached from 2290dbb) (2290dbb9c95b63e693ced647731623e64297f5c8)

Coq < Module Playground1.
Interactive Module Playground1 started

Coq < Require Import Arith Classical.
[Loading ML file z_syntax_plugin.cmxs ... done]
[Loading ML file quote_plugin.cmxs ... done]
[Loading ML file newring_plugin.cmxs ... done]
<W> Grammar extension: in [tactic:simple_tactic], some rule has been masked
<W> Grammar extension: in [tactic:simple_tactic], some rule has been masked
<W> Grammar extension: in [tactic:simple_tactic], some rule has been masked
<W> Grammar extension: in [tactic:simple_tactic], some rule has been masked
<W> Grammar extension: in [tactic:simple_tactic], some rule has been masked

Coq < Fixpoint evenb (n:nat) : bool := match n with | O => true | S O => false | S (S n') => evenb n' end.
evenb is defined
evenb is recursively defined (decreasing on 1st argument)

Coq < Definition oddb (n:nat) : bool := negb (evenb n).
oddb is defined

Coq < Example test_oddb2: oddb 4 = false.
1 subgoal

  ============================
  oddb 4 = false

test_oddb2 < Proof.
1 subgoal

  ============================
  oddb 4 = false

test_oddb2 < simpl.
1 subgoal

  ============================
  oddb 4 = false

test_oddb2 < reflexivity.
No more subgoals.

test_oddb2 < Qed.
Proof.
simpl.
reflexivity.

Qed.
test_oddb2 is defined


(***************************************************************************
* Calculus of Constructions - Properties of Conversion                     *
* Arthur Charguéraud, April 2007                                           *
***************************************************************************)

Set Implicit Arguments.
Require Import LibLN CoC_Definitions CoC_Infrastructure
 CoC_BetaStar CoC_ChurchRosser.

(* ********************************************************************** *)
(** ** Some Properties of Conversion *)

Lemma conv_red_out : red_out conv.
Proof.
  intros_all. lets: beta_red_out. induction* H0.
Qed.

Lemma conv_from_beta_star :
  (beta star) simulated_by (conv).
Proof.
  intros_all. induction* H.
Qed.

Lemma conv_from_beta_star_trans : forall T U1 U2,
  (beta star) U1 T -> (beta star) U2 T -> conv U1 U2.
Proof.
 introv R1 R2. apply (@equiv_trans beta T).
   apply* conv_from_beta_star.
   apply equiv_sym. apply* conv_from_beta_star.
Qed.

Lemma conv_from_open_beta : forall u u' t,
  body t -> beta u u' -> conv (t ^^ u') (t ^^ u).
Proof.
  introv B R. destruct B as [L Fr].
  pick_fresh x.
  rewrite* (@subst_intro x t u).
  rewrite* (@subst_intro x t u').
  unfold conv. apply equiv_sym.
  apply conv_from_beta_star.
  apply* beta_star_red_in.
Qed.

(* ********************************************************************** *)
(** ** Inversion Lemmas for Conversion *)

Section ProdInv.

Tactic Notation "helper" :=
 match goal with |- ex (fun _ => ex (fun _ =>
  trm_prod ?A ?B = trm_prod _ _ /\ _)) =>
  exists A B; splits 3; [auto | | exists_fresh ] end.

Tactic Notation "helper" "*" := helper; eauto.

Lemma beta_star_prod_any_inv : forall P U1 T1,
  (beta star) (trm_prod U1 T1) P ->
  exists U2, exists T2, P = trm_prod U2 T2 /\
  (beta star) U1 U2 /\
  exists L, forall x, x \notin L ->
   (beta star) (T1 ^ x) (T2 ^ x).
Proof.
  introv H. gen_eq Q: (trm_prod U1 T1). gen U1 T1.
  induction H; intros; subst.
  inversions H. helper*.
  destruct~ (IHstar_1 U1 T1) as [U3 [T3 [EQ3 [H3 [L3 R3]]]]]. subst.
   destruct~ (IHstar_2 U3 T3) as [U2 [T2 [EQ2 [H2 [L2 R2]]]]]. subst.
   helper*.
   inversions H; helper*.
Qed.

End ProdInv.

Lemma beta_star_type_any_inv : forall P i,
  (beta star) (trm_type i) P -> P = trm_type i.
Proof.
  introv R.
  gen_eq T: (trm_type i).
  induction R; intros EQ; subst.
  auto.
  forwards*: IHR1. subst. auto.
  inversion H.
Qed.

Lemma conv_prod_prod_inv : forall U1 T1 U2 T2,
  conv (trm_prod U1 T1) (trm_prod U2 T2) ->
     conv U1 U2
  /\ exists L, forall x, x \notin L -> conv (T1 ^ x) (T2 ^ x).
Proof.
  unfold conv. introv C.
  destruct (church_rosser_beta C) as [P3 [Red1 Red2]].
  destruct (beta_star_prod_any_inv Red1)
   as [P3_11 [P3_12 [EQ1 [R1 [L1 S1]]]]].
  destruct (beta_star_prod_any_inv Red2)
   as [P3_21 [P3_22 [EQ2 [R2 [L2 S2]]]]].
  subst. inversions EQ2.
  split. applys conv_from_beta_star_trans R1 R2.
  exists_fresh. intros x Fr.
   forwards~ K1: (S1 x). forwards~ K2: (S2 x).
   apply* conv_from_beta_star_trans.
Qed.

Lemma conv_type_type_inv : forall i j,
  conv (trm_type i) (trm_type j) -> i = j.
Proof.
  unfold conv. introv C.
  destruct (church_rosser_beta C) as [T [Red1 Red2]].
  rewrite (beta_star_type_any_inv Red1) in Red2.
  lets K: (beta_star_type_any_inv Red2). inversions* K.
Qed.

Lemma conv_type_prod_inv : forall U1 U2 i,
  conv (trm_type i) (trm_prod U1 U2) -> False.
Proof.
  unfold conv. introv C.
  destruct (church_rosser_beta C) as [P3 [Red1 Red2]].
  destruct (beta_star_prod_any_inv Red2)
     as [P3_11 [P3_12 [EQ1 [R1 [L1 S1]]]]].
  rewrite (beta_star_type_any_inv Red1) in *.
  false.
Qed.


(* Copyright 2021 Pierre Courtieu
  This file is part of LibHyps. It is distributed under the MIT
  "expat license". You should have recieved a LICENSE file with it. *)
(* Adding variables, thus an environment. *)

Require Import FSets.FMapList FSets.FMapFacts Arith ZArith
        LibHyps.LibHyps List.
Require Import Structures.OrderedTypeEx FSets.FSetList.

(* Env is a map from nat to values (Z) *)
Module Env := FMapList.Make(Nat_as_OT).
Module EnvFact := FMapFacts.Facts(Env).

Inductive binop := Plus | Minus | Mult.

(* We add variabes *)
Inductive exp : Type :=
| Val : Z -> exp
| Var : nat -> exp
| BinOp: binop -> exp -> exp -> exp.

Definition eval_op op :=
  match op with
     Plus => Z.add| Minus => Z.sub| Mult => Z.mul
  end.

(* We add an environment Γ in the rules. *)
Inductive Eval_exp Γ : exp -> Z -> Prop:=
  EE_val: forall v, Eval_exp Γ (Val v) v
| EE_var: forall x v, Env.MapsTo x v Γ -> Eval_exp Γ (Var x) v
| EE_binop: forall e1 e2 v1 v2 op f,
    Eval_exp Γ e1 v1
    -> Eval_exp Γ e2 v2
    -> eval_op op = f
    -> Eval_exp Γ (BinOp op e1 e2) (f v1 v2).

(* optional customization. NEEDS UPDATE (Γ + Var). *)
Ltac rename_depth ::= constr:(3).
Local Open Scope autonaming_scope.
Import ListNotations.
Ltac rename_hyp_eval n th :=
  match th with
    Eval_exp ?e ?v => name(`_EE` ++ e#n ++ v#n)
  | Val ?v => name(v#(S n))
  | BinOp ?o ?e1 ?e2 => name(o#(S 0) ++ e1#n ++ e2#n)
  | eval_op ?o ?v1 ?v2 => name(o#(S 0) ++ v1#n ++ v2#n)
  end.
Close Scope autonaming_scope.
Ltac rename_hyp ::= rename_hyp_eval.

(* NEEDS UPDATE: add gamma *)
Lemma determ_nolibhyp: forall e v v',
    Eval_exp e v ->
    Eval_exp e v' ->
    v = v'.
Proof.
  intros * h_EE_e_v.
  revert v'.
  induction h_EE_e_v as
      [v | e1 e2 v1 v2 op f h_e_v1 IH_v1 h_e_v2 IH_v2 hop];
    intros v' h_EE_e_v'.
  - inversion h_EE_e_v'.
    auto.
  - inversion h_EE_e_v'.
    subst.
    erewrite IH_v1;eauto.
    erewrite IH_v2;eauto.
Qed.

(* Same proof as above, no naming effort. *)
Lemma determ: forall e v v',
    Eval_exp e v ->
    Eval_exp e v' ->
    v = v'.
Proof.
  intros until 1 /ng.
  revert v'.
  induction h_EE_e_v_; intros /sng.
  - inversion h_EE_v_v'_.
    auto.
  - inversion h_EE_op_e1_e2_v'_ /sng.
    erewrite h_all_eq_v1_v'_;eauto.
    erewrite h_all_eq_v2_v'_;eauto.
Qed.

(*** Local Variables: ***)
(*** eval: (company-coq-mode 1) ***)
(*** End: ***)


Definition jk (k:nat) (a b:nat) : Prop :=
  (a <= k /\ a = b)
  \/
  (k < a /\ b <= a).

Definition rk (k:nat) (a b:nat) : Prop :=
  (a <= k /\ a = b)
  \/
  (a = (S k) /\ S b <= a)
  \/
  (S k < a /\ S b = a).

Definition sd_coface (k:nat) (a b:nat) : Prop :=
  (a < k /\ a = b)
  \/
  (k <= a /\ S a = b).

Definition sd_codegen (k:nat) (a b:nat) : Prop :=
  (a <= k /\ a = b)
  \/
  (k < a /\ a = (S b)).

Definition comp (g f:nat->nat->Prop) (a b:nat) : Prop :=
  exists (x:nat), (f a x) /\ (g x b).