/-
Copyright (c) 2023 Aleksandar Milchev, Leo Okawa Ericson, Viggo Laakshoharju. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aleksandar Milchev, Leo Okawa Ericson, Viggo Laakshoharju
-/

import data.real.basic
import data.set.basic
import tactic
import data.finset.basic
import tactic.induction
import algebra.big_operators.order

/-!
# Max flow Min cut theorem

In this file we will prove the max-flow min-cut theorem,
stating that if a maximum flow exists in a flow network,
then its value is equal to the capacity of a minimum cut in the same network.

## Main results

- `weak_duality`         : the value of every flow is less than or equal to the capacity of every cut.

  direct consequences    :
  - the value of a max flow is always less than or equal to the capacity of a min cut.
  - `max_flow_criterion` : if a flow value is equal to a cut capacity in the same flow network, then the flow is maximum.
  - `min_cut_criterion`  : if a capacity of a cut is equal to a flow value in the same network, then the cut is minimum.

- `no_augm_path`         : if the active flow gives a maximum flow, then there is no augmenting path in the residual network.
- `existence_of_a_cut`   : there exists a cut with a capacity equal to the value of the maximum flow.
- `max_flow_min_cut`     : if f is a max flow and c is a min cut in the same network, then their valies are equal (max flow min cut theorem).

## Notation

- Type V is used for the set of all vertices in our graph.

## References

- Some of the structure ideas and lemmas can be seen in https://github.com/Zetagon/maxflow-mincut.

-/

open finset

open_locale big_operators
open_locale classical

notation ` V' ` := univ

/-!
  We now define our flow network. Our goal will be to prove weak_duality.
  As direct consequences, `max_flow_criterion` and `min_cut_criterion` will be proven.
-/

structure digraph (V : Type*) [inst : fintype V] :=
  (is_edge : V → V → Prop)
  (hnonsymmetric : ∀ u v : V, ¬ ((is_edge u v) ∧ (is_edge v u)))

structure capacity (V : Type*) [inst : fintype V]
  extends digraph V :=
  (c : V -> V -> ℝ)
  (non_neg_capacity : ∀ u v : V, c u v ≥ 0)
  (vanishes : ∀ u v : V, ¬ (is_edge u v) → c u v = 0)

structure flow_network (V : Type*) [inst : fintype V]
  extends capacity V :=
  (source : V)
  (sink : V)

noncomputable
def mk_in {V : Type* } [inst : fintype V]
  (f : V -> V -> ℝ) (S : finset V) : ℝ := ∑ x in finset.univ \ S, ∑ y in S, f x y

noncomputable
def mk_out {V : Type* } [inst : fintype V]
  (f : V -> V -> ℝ) (S : finset V) : ℝ := ∑ x in S, ∑ y in finset.univ \ S, f x y

structure active_flow_network (V : Type*)  [fintype V] :=
  (network : flow_network V)
  (f : V -> V -> ℝ)
  (sourceNotSink: network.source ≠ network.sink)
  (non_neg_flow : ∀ u v : V, f u v ≥ 0)
  (no_overflow : ∀ u v : V, f u v ≤ network.c u v)
  (noEdgesInSource : ∀ u : V, ¬ (network.is_edge u network.source))
  (noEdgesOutSink : ∀ u: V, ¬ (network.is_edge network.sink u))
  (conservation : ∀ v : V,
                  v ∈ (V' : finset V) \ {network.source, network.sink} →
                  mk_out f {v} = mk_in f {v})

noncomputable
def F_value {V : Type*}  [fintype V] :
                  active_flow_network V -> ℝ :=
λ N, mk_out N.f {N.network.source} - mk_in N.f {N.network.source}

structure cut (V : Type*)  [fintype V] :=
  (network : flow_network V)
  (S : finset V)
  (T : finset V)
  (sins : network.source ∈ S)
  (tint : network.sink ∈ T)
  (Tcomp : T = univ \ S)

noncomputable
def cut_cap {V : Type*}  [inst' : fintype V] -- stays for capacity of the cut
    (c : cut V) : ℝ := mk_out c.network.c c.S

lemma f_vanishes_outside_edge {V : Type*} [fintype V]
  (afn : active_flow_network V) (u : V) (v : V) (not_edge: ¬afn.network.is_edge u v) :
  afn.f u v = 0 :=
  begin
    have cap_is_zero: afn.network.c u v = 0 :=
      begin
        exact afn.network.vanishes u v not_edge,
      end,
    have bar := afn.no_overflow u v,
    have foo := afn.non_neg_flow u v,
    linarith,
  end

lemma x_not_in_s {V : Type*} [fintype V]
  (c : cut V)  : ∀ x : V, x ∈ c.T -> x ∉ ({c.network.source} : finset V) :=
begin
  intros x xInS,
  cases c,
  simp only [mem_singleton] at *,
  rw c_Tcomp at xInS,
  have h : univ \ c_S ∩ c_S = ∅ := sdiff_inter_self c_S univ,
  have foo : disjoint (univ \ c_S)  c_S  := sdiff_disjoint,
  have bar : c_network.source ∈ c_S := c_sins,
  exact disjoint_iff_ne.mp foo x xInS c_network.source c_sins
end

lemma foobar { a b : ℝ } : a + - b = a - b := rfl

lemma f_zero {V : Type*}  [inst' : fintype V]
  (afn : active_flow_network V) (x : V) : afn.f x x = 0 :=
begin
  have hnonsymm : _ := afn.network.hnonsymmetric x x,
  have hvanish: _ := afn.network.vanishes x x,
  simp only [not_and, imp_not_self] at hnonsymm,
  have hnon_edge := hnonsymm, clear hnonsymm,
  have hcapacity_zero := hvanish hnon_edge,
  have hno_overflow := afn.no_overflow x x,
  rw hcapacity_zero at hno_overflow,
  have hnon_neg_flow := afn.non_neg_flow x x,
  linarith,
end

lemma mk_in_single_node { V : Type* }  [fintype V]
  (p : V) (afn : active_flow_network V) :
  mk_in (afn.f) {p} = ∑ v in finset.univ, (afn.f) v p :=
begin
  rw @sum_eq_sum_diff_singleton_add _ _ _ _ univ p (by simp only [mem_univ]) (λ x, afn.f x p),
  have foo : (λ (x : V), afn.f x p) p = afn.f p p := rfl,
  simp only [congr_fun],
  rw f_zero afn p,
  have bar : ∑ (x : V) in univ \ {p}, afn.f x p + 0 =
  (λ p', ∑ (x : V) in univ \ {p'}, afn.f x p') p := by simp only [add_zero],
  rw bar, clear bar,
  rw ← @finset.sum_singleton _ _ p (λp', ∑ (x : V) in univ \ {p'}, afn.f x p' ) _,
  simp only [mk_in, sum_singleton],
end

@[simp] lemma mk_in_single_node' { V : Type* }  [fintype V]
  (p : V) (afn : active_flow_network V) :
  ∑ v in finset.univ, (afn.f) v p = mk_in (afn.f) {p} := by rw mk_in_single_node

lemma mk_out_single_node { V : Type* }  [fintype V]
  (p : V) (afn : active_flow_network V) :
  mk_out afn.f {p} = ∑ v in finset.univ, (afn.f) p v :=
begin
  rw @sum_eq_sum_diff_singleton_add _ _ _ _ univ p (by simp only [mem_univ]) (λ x, afn.f p x),
  have foo : (λ (x : V), afn.f p x) p = afn.f p p := rfl,
  simp only [congr_fun],
  rw f_zero afn p,
  have bar : ∑ (x : V) in univ \ {p}, afn.f p x + 0 =
  (λ p', ∑ (x : V) in univ \ {p'}, afn.f p' x) p := by simp only [add_zero],
  rw bar, clear bar,
  rw ← @finset.sum_singleton _ _ p (λp', ∑ (x : V) in univ \ {p'}, afn.f p' x) _,
  simp only [mk_out, sum_singleton],
end

@[simp] lemma mk_out_single_node' { V : Type* }  [fintype V]
  (p : V) (afn : active_flow_network V) :
  ∑ v in finset.univ, (afn.f) p v = mk_out afn.f {p} := by rw mk_out_single_node

lemma break_out_neg (a b : ℝ) : (-a) + -(b) = -(a + b) := by ring

noncomputable
def edge_flow {V : Type*}  [inst' : fintype V]
  (afn : active_flow_network V) (x : V) : ℝ := (mk_out afn.f {x} - mk_in afn.f {x})

lemma edge_flow_conservation {V: Type*} [inst' : fintype V]
  (afn : active_flow_network V) (x : V) :
  x ∈ (V' : finset V) \ {afn.network.source, afn.network.sink} -> edge_flow afn x = 0 :=
begin
  intro hx,
  unfold edge_flow,
  rw afn.conservation x,
  {ring},
  {exact hx,}
end

lemma sub_comm_zero (a b : ℝ) : a - b = 0 → b - a = 0 := by {intro eq, linarith}

lemma set_flow_conservation {V : Type*}  [inst' : fintype V]
  (afn : active_flow_network V) (S : finset V) :
S ⊆ finset.univ \ {afn.network.source, afn.network.sink} -> mk_in afn.f S = mk_out afn.f S :=
begin
  intro stNotInS,
  rw ← add_left_inj (- mk_out afn.f S),
  simp only [add_right_neg],
  rw ← add_zero (mk_in afn.f S),
  nth_rewrite 0 ← add_neg_self (∑ u in S, (∑ v in S, afn.f u v)),
  rw ← add_assoc,
  have tmp: mk_in afn.f S + ∑ u in S, ∑ v in S, afn.f u v = ∑ u in S, ∑ v in V', afn.f v u :=
  begin
    unfold mk_in,
    have h: S ⊆ V' := finset.subset_univ S,
    have hyp:
    ∑ (x : V) in V' \ S, ∑ (y : V) in S, afn.f x y + ∑ (u : V) in S, ∑ (v : V) in S, afn.f u v
    = ∑ u in V', ∑ v in S, afn.f u v := finset.sum_sdiff h,
    have swap: ∑ u in V', ∑ v in S, afn.f u v = ∑ u in S, ∑ v in V', afn.f v u := finset.sum_comm,
    rw hyp,
    exact swap,
  end,
  have tmp2: mk_out afn.f S + (∑ u in S, ∑ v in S, afn.f u v) = ∑ u in S, ∑ v in V', afn.f u v :=
  begin
    unfold mk_out,
    rw finset.sum_comm,
    have h: S ⊆ V' := finset.subset_univ S,
    have hyp:
    ∑ (y : V) in V' \ S, ∑ (x : V) in S, afn.f x y + ∑ (u : V) in S, ∑ (v : V) in S, afn.f v u =
    ∑ u in V', ∑ v in S, afn.f v u := finset.sum_sdiff h,
    have obvs: ∑ (u : V) in S, ∑ (v : V) in S, afn.f v u =
    ∑ (u : V) in S, ∑ (v : V) in S, afn.f u v := finset.sum_comm,
    have swap: ∑ u in V', ∑ v in S, afn.f v u = ∑ u in S, ∑ v in V', afn.f u v := finset.sum_comm,
    rw obvs at hyp,
    rw hyp,
    exact swap,
  end,
  rw tmp,
  rw add_assoc,
  rw break_out_neg,
  nth_rewrite 1 add_comm,
  rw tmp2,
  clear tmp tmp2,
  rw foobar,
  rw ← @sum_sub_distrib _ _ S _ _ _,
  simp only [mk_in_single_node', mk_out_single_node'],
  have hseq : S = S := rfl,
  have h : ∀ (x : V), x ∈ S -> - edge_flow afn x = 0 :=
  begin
    intros x hx,
    unfold edge_flow,
    rw afn.conservation x,
    { ring, },
    { exact finset.mem_of_subset stNotInS hx,}
  end,
  have foo := finset.sum_congr hseq h,
  unfold edge_flow at foo,
  simp at foo,
  rw ← foo,
  simp,
end

lemma move_right (a b : ℝ) : b = a → a - b = 0 := by {intro eq, linarith}

lemma set_flow_conservation_eq {V : Type*}  [inst' : fintype V]
  (afn : active_flow_network V) (S : finset V) :
S ⊆ finset.univ \ {afn.network.source, afn.network.sink} -> mk_out afn.f S - mk_in afn.f S = 0 :=
begin
  intro hip,
  have h: mk_in afn.f S = mk_out afn.f S := set_flow_conservation afn S hip,
  linarith
end

lemma add_zero_middle (a b c: ℝ): c = 0 → a + c - b = a - b := by {intro eq, linarith}

lemma group_minus (a b c d : ℝ): a + b - c - d = a + b - (c + d) := by ring

lemma same_source_and_sink {V: Type*} [inst' : fintype V]
  (afn: active_flow_network V) (ct : cut V) (same_net : afn.network = ct.network):
  afn.network.source = ct.network.source ∧ afn.network.sink = ct.network.sink :=
begin
  rw same_net,
  split,
  {simp},
  simp
end

lemma flow_value_source_in_S {V : Type*}  [inst' : fintype V]
  (afn : active_flow_network V) (ct : cut V)
  (same_net : afn.network = ct.network) :
  mk_out afn.f {afn.network.source} - mk_in afn.f {afn.network.source} =
  mk_out afn.f ct.S - mk_in afn.f ct.S :=
begin
  set S := ct.S,
  set T := ct.T,
  set s := afn.network.source,
  set t := afn.network.sink,
  set f := afn.f,
  have same: s = s := rfl,
  have hs : s = afn.network.source := rfl,
  have hT : T = ct.T := rfl,
  have singleton: s ∈ {s} := finset.mem_singleton.2 same,
  have sInS: s ∈ S :=
  begin
    have same_source: s = ct.network.source := (same_source_and_sink afn ct same_net).1,
    rw same_source,
    exact ct.sins,
  end,
  have sSubsetS: {s} ⊆  S := (finset.singleton_subset_iff).2 sInS,
  have disjS: disjoint {s} (S \ {s}) :=
    begin
      have sOut: s ∉ (S \ {s}) := finset.not_mem_sdiff_of_mem_right singleton,
      exact finset.disjoint_singleton_left.2 sOut,
    end,
  have sInCompl: {s} ⊆ V' \ (S \ {s}) :=
  begin
    have sIn: {s} ⊆ V' := finset.subset_univ {s},
    have conj: {s} ⊆ V' ∧ disjoint {s} (S \ {s}) := and.intro sIn disjS,
    exact finset.subset_sdiff.2 conj,
  end,
  have tNots: t ≠ s :=
  begin
    by_contradiction h,
    have contr: s = t := by rw ← h,
    exact absurd contr afn.sourceNotSink,
  end,
  have tNotInS: t ∉ S :=
  begin
    have same_sink: t = ct.network.sink := (same_source_and_sink afn ct same_net).2,
    have tInT: t ∈ T := by {rw same_sink, exact ct.tint},
    have Tcomp : T = univ \ S := ct.Tcomp,
    have foo: S = univ \ (univ \ S) :=
    by {simp only [sdiff_sdiff_right_self, finset.inf_eq_inter, finset.univ_inter]},
    have Scomp : S = univ \ T := by {rw ← Tcomp at foo, exact foo},
    rw Scomp at *,
    exact finset.not_mem_sdiff_of_mem_right tInT,
  end,
  have seteq: V' \ (S \ {s}) \ {s} = V' \ S :=
  begin
    ext x,
    have eq1: V' \ (S \ {s}) \ {s} = V' \ (S \ {s}) ∩ (V' \ {s}) :=
    finset.sdiff_sdiff_left' V' (S \ {s}) {s},
    rw eq1,
    have xIn: x ∈ V' := finset.mem_univ x,
    split,
    {
      intro hyp,
      have xIn1: x ∈ V' \ (S \ {s}) := (finset.mem_inter.1 hyp).1,
      have xIn2: x ∈ V' \ {s} := (finset.mem_inter.1 hyp).2,
      have xOut: x ∉ S :=
      begin
        have xOut1: x ∉ (S \ {s}) := (finset.mem_sdiff.1 xIn1).2,
        have xOut2: x ∉ {s} := (finset.mem_sdiff.1 xIn2).2,
        have xOutAnd: x ∉ (S \ {s}) ∧ x ∉ {s} := and.intro xOut1 xOut2,
        have eq2: S = (S \ {s}) ∪ {s} :=
        begin
          have inter: S ∩ {s} = {s} := finset.inter_singleton_of_mem sInS,
          have eq3: (S \ {s}) ∪ S ∩ {s} = S := by rw finset.sdiff_union_inter S {s},
          calc
            S
                = (S \ {s}) ∪ S ∩ {s} : eq_comm.1 eq3
            ... = (S \ {s}) ∪ {s} : by rw inter,
        end,
        rw eq2,
        exact finset.not_mem_union.2 xOutAnd,
      end,
      have concl: x ∈ V' ∧ x ∉ S := and.intro xIn xOut,
      exact finset.mem_sdiff.2 concl,
    },
    intro hyp,
    have xOutS: x ∉ S := (finset.mem_sdiff.1 hyp).2,
    have xOut: x ∉ S \ {s} :=
    begin
      by_contradiction h,
      have contr: x ∈ S := (finset.mem_sdiff.1 h).1,
      exact absurd contr xOutS,
    end,
    have sdiff: x ∈ V' ∧ x ∉ S \ {s} := and.intro xIn xOut,
    have xIn1: x ∈ V' \ (S \ {s}) := finset.mem_sdiff.2 sdiff,
    have xNotIns: x ∉ {s} :=
    begin
      by_contradiction h,
      have contr: x ∈ S := finset.mem_of_subset sSubsetS h,
      exact absurd contr xOutS,
    end,
    have concl: x ∈ V' ∧ x ∉ {s} := and.intro xIn xNotIns,
    have xIn2: x ∈ V' \ {s} := finset.mem_sdiff.2 concl,
    have member: x ∈ V' \ (S \ {s}) ∧ x ∈ V' \ {s} := and.intro xIn1 xIn2,
    exact finset.mem_inter.2 member,
  end,
  have union: V' \ S ∪ S \ {s} = V' \ {s} :=
  begin
    ext x,
    have xIn: x ∈ V' := finset.mem_univ x,
    split,
    {
      intro hyp,
      have h1: x ∈ V' \ S ∨ x ∈ S \ {s} := finset.mem_union.1 hyp,
      have h2: x ∈ V' \ S → x ∈ V' \ {s} :=
      begin
        intro hypo,
        have xOutS: x ∉ S := (finset.mem_sdiff.1 hypo).2,
        have xNotIns: x ∉ {s} :=
        begin
          by_contradiction h,
          have contr: x ∈ S := finset.mem_of_subset sSubsetS h,
          exact absurd contr xOutS,
        end,
        have concl: x ∈ V' ∧ x ∉ {s} := and.intro xIn xNotIns,
        exact finset.mem_sdiff.2 concl,
      end,
      have h3: x ∈ S \ {s} → x ∈ V' \ {s} :=
      begin
        intro hypo,
        have xNotIns: x ∉ {s} := (finset.mem_sdiff.1 hypo).2,
        have concl: x ∈ V' ∧ x ∉ {s} := and.intro xIn xNotIns,
        exact finset.mem_sdiff.2 concl,
      end,
      exact or.elim h1 h2 h3,
    },
    intro hyp,
    have xNotIns: x ∉ {s} := (finset.mem_sdiff.1 hyp).2,
    by_cases h' : x ∈ S,
    {
      have and: x ∈ S ∧ x ∉ {s} := and.intro h' xNotIns,
      have xInSs: x ∈ S \ {s} := finset.mem_sdiff.2 and,
      have conj: x ∈ V' \ S ∨ x ∈ S \ {s} := or.intro_right (x ∈ V' \ S) xInSs,
      exact finset.mem_union.2 conj,
    },
    {
      have and: x ∈ V' ∧ x ∉ S := and.intro xIn h',
      have xInVS: x ∈ V' \ S := finset.mem_sdiff.2 and,
      have conj: x ∈ V' \ S ∨ x ∈ S \ {s} := or.intro_left (x ∈ S \ {s}) xInVS,
      exact finset.mem_union.2 conj,
    },
  end,
  have disj: disjoint (V' \ S) (S \ {s}) :=
  begin
    have h1: (V' \ S) ∩ (S \ {s}) = ∅ :=
    begin
      have noMembers: ∀ (v : V), v ∉ (V' \ S) ∩ (S \ {s}) :=
      begin
      intro v,
      by_contradiction h,
      have vInVmS: v ∈ (V' \ S) := (finset.mem_inter.1 h).1,
      have vNotInS: v ∉ S := (finset.mem_sdiff.1 vInVmS).2,
      have vInSms: v ∈ (S \ {s}) := (finset.mem_inter.1 h).2,
      have vInS: v ∈ S := (finset.mem_sdiff.1 vInSms).1,
      exact absurd vInS vNotInS,
      end,
      exact finset.eq_empty_of_forall_not_mem noMembers,
    end,
    have h2: ¬ ((V' \ S) ∩ (S \ {s})).nonempty :=
    begin
      by_contradiction h,
      have contr: (V' \ S) ∩ (S \ {s}) ≠ ∅ := finset.nonempty.ne_empty h,
      exact absurd h1 contr,
    end,
    by_contradiction notDisjoint,
    have contr: ((V' \ S) ∩ (S \ {s})).nonempty := finset.not_disjoint_iff_nonempty_inter.1 notDisjoint,
    exact absurd contr h2,
  end,
  have disjTS: disjoint {t} {s} := finset.disjoint_singleton.2 (tNots),
  have expand: mk_out f {s} + (mk_out f (S \ {s}) - mk_in f (S \ {s})) - mk_in f {s}
  =  mk_out f {s} - mk_in f {s} :=
  begin
    have h3: s ∉ S \ {s} := finset.not_mem_sdiff_of_mem_right singleton,
    have eq: mk_out f (S \ {s}) - mk_in f (S \ {s}) = 0 :=
    begin
      have h: (S \ {s}) ⊆ finset.univ \ {s,t} :=
      begin
        intros x xInSms,
        have xIn: x ∈ V' := finset.mem_univ x,
        have xInS: x ∈ S:= ((finset.mem_sdiff).1 xInSms).1,
        have xNotInT: x ∉ {t} :=
        begin
          by_contradiction h,
          have eq: x = t := finset.mem_singleton.1 h,
          rw eq at xInS,
          contradiction,
        end,
        have union: ({s}: finset V) ∪ {t} = {s,t} := by refl,
        have xNotInS: x ∉ {s} := ((finset.mem_sdiff).1 xInSms).2,
        have xOut: x ∉ {s,t} :=
        begin
          by_contradiction h,
          rw ← union at h,
          have inUnion: x ∈ {s} ∨ x ∈ {t} := finset.mem_union.1 h,
          have contr1: x ∈ {s} → false :=
          begin
            intro assumption,
            exact absurd assumption xNotInS,
          end,
          have contr2: x ∈ {t} → false :=
          begin
            intro assumption,
            exact absurd assumption xNotInT,
          end,
          exact or.elim inUnion contr1 contr2,
        end,
        have and: x ∈ V' ∧ x ∉ {s,t} := and.intro xIn xOut,
        exact finset.mem_sdiff.2 and,
      end,
      exact set_flow_conservation_eq afn (S \ {s}) h,
    end,
    exact add_zero_middle (mk_out f {s}) (mk_in f {s}) (mk_out f (S \ {s}) - mk_in f (S \ {s})) eq,
  end,
  have sum1: mk_out f {s} + mk_out f (S \ {s}) =
  mk_out f S + ∑ u in (S \ {s}), f s u + ∑ u in (S \ {s}), f u s :=
  begin
    unfold mk_out,
    have eq1: ∑ (x : V) in S, ∑ (y : V) in V' \ S, f x y =
    ∑ (x : V) in (S \ {s}) , ∑ (y : V) in V' \ S, f x y + ∑ (x : V) in {s}, ∑ (y : V) in V' \ S, f x y :=
    by {rw finset.sum_sdiff sSubsetS},
    have eq2: ∑ (x : V) in {s}, ∑ (y : V) in V' \ S, f x y = ∑ (y : V) in V' \ S, f s y := by simp,
    have eq3: ∑ (x : V) in (S \ {s}), ∑ (y : V) in V' \ (S \ {s}), f x y =
    ∑ (x : V) in (S \ {s}), f x s + ∑ (x : V) in (S \ {s}), ∑ (y : V) in V' \ S, f x y :=
    begin
      have obvs: ∑ (x : V) in (S \ {s}), ∑ (y : V) in V' \ (S \ {s}), f x y =
      ∑ (y : V) in V' \ (S \ {s}), ∑ (x : V) in (S \ {s}), f x y := finset.sum_comm,
      have sdiff: ∑ (y : V) in V' \ (S \ {s}), ∑ (x : V) in (S \ {s}), f x y =
      ∑ (y : V) in V' \ S, ∑ (x : V) in (S \ {s}), f x y + ∑ (y : V) in {s}, ∑ (x : V) in (S \ {s}), f x y :=
      by {rw ← finset.sum_sdiff sInCompl, rw seteq},
      have obs: ∑ (y : V) in {s}, ∑ (x : V) in (S \ {s}), f x y = ∑ (x : V) in (S \ {s}), f x s := by {simp},
      have swap: ∑ (y : V) in V' \ S, ∑ (x : V) in S \ {s}, f x y =
      ∑ (x : V) in S \ {s}, ∑ (y : V) in V' \ S, f x y := finset.sum_comm,
      rw obs at sdiff,
      rw [obvs, sdiff, add_comm, swap],
    end,
    have eq4: ∑ (x : V) in {s}, ∑ (y : V) in V' \ {s}, f x y =
    ∑ (y : V) in V' \ S, f s y + ∑ (u : V) in S \ {s}, f s u :=
    begin
      have obvs: ∑ (x : V) in {s}, ∑ (y : V) in V' \ {s}, f x y =
      ∑ (y : V) in V' \ {s}, f s y := by {simp},
      rw obvs,
      rw ← union,
      exact finset.sum_union disj,
    end,
    linarith
  end,
  have sum2: mk_in f (S \ {s}) + mk_in f {s} =
  mk_in f S + ∑ u in (S \ {s}), f s u + ∑ u in (S \ {s}), f u s :=
  begin
    unfold mk_in,
    have eq1: ∑ (x : V) in V' \ S, ∑ (y : V) in S, f x y =
    ∑ (x : V) in V' \ S, ∑ (y : V) in (S \ {s}), f x y + ∑ (x : V) in V' \ S, ∑ (y : V) in {s}, f x y :=
    begin
      have obvs: ∑ (x : V) in V' \ S, ∑ (y : V) in S, f x y = ∑ (y : V) in S, ∑ (x : V) in V' \ S, f x y := finset.sum_comm,
      have sdiff: ∑ (y : V) in S, ∑ (x : V) in V' \ S, f x y =
      ∑ (y : V) in (S \ {s}), ∑ (x : V) in V' \ S, f x y + ∑ (y : V) in {s}, ∑ (x : V) in V' \ S, f x y :=
      by {rw finset.sum_sdiff sSubsetS},
      have swap: ∑ (y : V) in (S \ {s}), ∑ (x : V) in V' \ S, f x y + ∑ (y : V) in {s}, ∑ (x : V) in V' \ S, f x y =
      ∑ (x : V) in V' \ S, ∑ (y : V) in (S \ {s}), f x y + ∑ (x : V) in V' \ S, ∑ (y : V) in {s}, f x y :=
      begin
        have eq11: ∑ (y : V) in (S \ {s}), ∑ (x : V) in V' \ S, f x y =
        ∑ (x : V) in V' \ S, ∑ (y : V) in (S \ {s}), f x y := finset.sum_comm,
        have eq12: ∑ (y : V) in {s}, ∑ (x : V) in V' \ S, f x y =
        ∑ (x : V) in V' \ S, ∑ (y : V) in {s}, f x y := finset.sum_comm,
        linarith,
      end,
      linarith,
    end,
    have eq2: ∑ (x : V) in V' \ S, ∑ (y : V) in {s}, f x y = ∑ (u : V) in V' \ S, f u s := by {simp},
    have eq3: ∑ (x : V) in V' \ (S \ {s}), ∑ (y : V) in S \ {s}, f x y =
    ∑ (x : V) in V' \ S, ∑ (y : V) in S \ {s}, f x y + ∑ (u : V) in S \ {s}, f s u :=
    begin
      have eq31: ∑ (x : V) in V' \ (S \ {s}), ∑ (y : V) in S \ {s}, f x y =
      ∑ (x : V) in V' \ S, ∑ (y : V) in S \ {s}, f x y + ∑ (x : V) in {s}, ∑ (y : V) in S \ {s}, f x y :=
      by {rw ← finset.sum_sdiff sInCompl, rw seteq},
      have eq32: ∑ (x : V) in {s}, ∑ (y : V) in S \ {s}, f x y = ∑ (u : V) in S \ {s}, f s u := by {simp},
      linarith,
    end,
    have eq4: ∑ (x : V) in V' \ {s}, ∑ (y : V) in {s}, f x y =
    ∑ (u : V) in V' \ S, f u s + ∑ (u : V) in S \ {s}, f u s :=
    begin
      have obvs: ∑ (u : V) in V' \ S, f u s =
      ∑ (x : V) in V' \ S, ∑ (y : V) in {s}, f x y := by {simp},
      have obs: ∑ (u : V) in S \ {s}, f u s =
      ∑ (x : V) in S \ {s}, ∑ (y : V) in {s}, f x y := by {simp},
      rw ← union,
      rw [obvs,obs],
      exact finset.sum_union disj,
    end,
    linarith,
  end,
  rw ← expand,
  rw add_sub,
  rw group_minus (mk_out f {s}) (mk_out f (S \ {s})) (mk_in f (S \ {s})) (mk_in f {s}),
  linarith
end

/-!
  Here is our first big lemma, weak duality.
  Every flow is less than or equal to the capacity of every cut in the same network.
-/

lemma weak_duality {V: Type*} [inst' : fintype V]
  (afn: active_flow_network V) (ct : cut V) (same_net : afn.network = ct.network):
  F_value afn ≤ cut_cap ct :=
begin
  set S := ct.S,
  set T:= ct.T,
  set s := afn.network.source,
  set t := afn.network.sink,
  unfold cut_cap,
  have same: s = s := by {simp},
  have hs : s = afn.network.source := rfl,
  have hT : T = ct.T := rfl,
  have singleton: s ∈ {s} := finset.mem_singleton.2 same,
  have sInS: s ∈ S :=
  begin
    have same_source: s = ct.network.source := (same_source_and_sink afn ct same_net).1,
    rw same_source,
    exact ct.sins,
  end,
  have sInCompl: {s} ⊆ V' \ (S \ {s}) :=
  begin
    have sIn: {s} ⊆ V' := finset.subset_univ {s},
    have disjS: disjoint {s} (S \ {s}) :=
    begin
      have sOut: s ∉ (S \ {s}) := finset.not_mem_sdiff_of_mem_right singleton,
      exact finset.disjoint_singleton_left.2 sOut,
    end,
    have conj: {s} ⊆ V' ∧ disjoint {s} (S \ {s}) := and.intro sIn disjS,
    exact finset.subset_sdiff.2 conj,
  end,
  have tNotInS: t ∉ S :=
  begin
    have same_sink: t = ct.network.sink := (same_source_and_sink afn ct same_net).2,
    have tInT: t ∈ T := by {rw same_sink, exact ct.tint},
    have Tcomp : T = univ \ S := ct.Tcomp,
    have foo: S = univ \ (univ \ S) :=
    by {simp only [sdiff_sdiff_right_self, finset.inf_eq_inter, finset.univ_inter]},
    have Scomp : S = univ \ T := by {rw ← Tcomp at foo, exact foo},
    rw Scomp at *,
    exact finset.not_mem_sdiff_of_mem_right tInT,
  end,
  have lemma1: F_value afn = mk_out afn.f S - mk_in afn.f S :=
  by {unfold F_value, exact flow_value_source_in_S afn ct same_net},
  have lemma2: mk_out afn.f S ≤  mk_out ct.network.to_capacity.c S :=
  begin
    have no_overflow: mk_out afn.f S ≤ mk_out afn.network.to_capacity.c S :=
    begin
      unfold mk_out,
      have flowLEcut: ∀ (x y : V), (x ∈ S ∧ y ∈ V' \ S) →
      (afn.f x y ≤ afn.network.to_capacity.c x y) :=
      by {intros x y hyp, exact afn.no_overflow x y},
      exact finset.sum_le_sum (λ i hi, finset.sum_le_sum $ λ j hj, flowLEcut i j ⟨hi, hj⟩)
    end,
    unfold mk_out at no_overflow,
    rw same_net at no_overflow,
    exact no_overflow,
  end,
  have lemma3: F_value afn ≤ mk_out afn.f S :=
  begin
    rw lemma1,
    have obvs: mk_out afn.f S = mk_out afn.f S + 0 := by rw [add_zero],
    rw obvs,
    simp,
    unfold mk_in,
    have nonneg_flow: ∀ (u v : V), (u ∈ V' \ S ∧ v ∈ S) → afn.f u v ≥ 0 :=
    begin
      intros u v hyp,
      exact afn.non_neg_flow u v,
    end,
    exact finset.sum_nonneg (λ i hi, finset.sum_nonneg $ λ j hj, nonneg_flow i j ⟨hi, hj⟩),
  end,
  apply le_trans lemma3 lemma2,
end

lemma zero_left_move {a b c d : ℝ} : (0 = a + b - c - d) -> (d - b = a - c) :=
by {intro h, linarith}

def is_max_flow  {V : Type*}  [inst' : fintype V]
  (fn: active_flow_network V) : Prop :=
  ∀ fn' : active_flow_network V, fn.network = fn'.network → F_value fn' ≤ F_value fn

def is_min_cut {V : Type*}  [inst' : fintype V]
  (fn: cut V) : Prop := ∀ fn' : cut V, fn.network = fn'.network → cut_cap fn ≤ cut_cap fn'

lemma max_flow_criterion  {V : Type*}  [inst' : fintype V]
  (afn : active_flow_network V) (ct : cut V) (hsame_network: afn.network = ct.network):
  cut_cap ct = F_value afn -> is_max_flow afn :=
begin
  intros eq fn same_net,
  rw ← eq,
  have same_network: fn.network = ct.network := by {rw ← same_net, exact hsame_network},
  exact weak_duality (fn) (ct) (same_network),
end

lemma min_cut_criterion  {V : Type*}  [inst' : fintype V]
  (afn : active_flow_network V) (ct : cut V) (same_net: afn.network = ct.network) :
  cut_cap ct = F_value afn -> is_min_cut ct :=
begin
  intro eq,
  intros cut eq_net,
  rw eq,
  have h: afn.network = cut.network := by {rw same_net, exact eq_net,},
  exact weak_duality (afn) (cut) (h),
end

/-!
  We now define our residual network. Our goal is to prove no_augm_path.
-/

noncomputable
def mk_rsf {V : Type*}  [inst' : fintype V] -- stays for residual flow
  (afn : active_flow_network V)
  (u v : V) : ℝ :=
  if  afn.network.is_edge u v
  then afn.network.c  u v - afn.f u v
  else if afn.network.is_edge v u
        then afn.f v u
        else 0

structure residual_network  (V : Type*)  [inst' : fintype V] :=
  (afn : active_flow_network V)
  (f' : V -> V -> ℝ)
  (f_def : f' = mk_rsf afn)
  (is_edge : V -> V -> Prop)
  (is_edge_def : is_edge = λ u v, f' u v > 0 )

noncomputable
def mk_rsn {V : Type*} [fintype V] -- stays for residual network
  (afn : active_flow_network V) : residual_network V :=
  ⟨afn, mk_rsf afn, rfl, λ u v, mk_rsf afn u v > 0 , rfl ⟩

universe u

/-
  We define a path structure indicating if there is a path between two vertices,
  given the edges in the graph.
-/

inductive path {V : Type u } (is_edge : V -> V -> Prop) (a : V) : V → Type (u + 1)
| nil  : path a
| cons : Π {b c : V}, path b → (is_edge b c) → path c

def no_augumenting_path {V : Type*} [inst' : fintype V]
  (rsn : residual_network V) : Prop :=
  ∀ t : V, ∀ p : path rsn.is_edge rsn.afn.network.source t, ¬ (t = rsn.afn.network.sink)

def path.in {V : Type u }
  {is_edge : V -> V -> Prop}
  (u v : V)
  {s : V} : ∀ {t : V}, path is_edge s t -> Prop
  | t (@path.nil  _ is_edge' a)  := u = v
  | t (@path.cons _ _ _ t' _ p _)  := (u = t' ∧ v = t) ∨ (@path.in t' p)

lemma residual_capacity_non_neg {V : Type*} [inst' : fintype V]
  (rsn : residual_network V) : ∀ u v : V,  0 ≤ rsn.f' u v :=
begin
  intros u v,
  cases rsn,
  simp only,
  rw rsn_f_def,
  unfold mk_rsf,
  have tmp := classical.em (rsn_afn.network.to_capacity.to_digraph.is_edge u v),
  cases tmp,
  {
    simp only [tmp, if_true, sub_nonneg, rsn_afn.no_overflow],
  },
  {
    simp only [tmp, if_false], clear tmp,
    have tmp := classical.em (rsn_afn.network.to_capacity.to_digraph.is_edge v u),
    cases tmp,
    {
      have h := rsn_afn.non_neg_flow v u,
      simp only [tmp, h, if_true],
      linarith,
    },
    {
      simp only [tmp, if_false],
    },
  },
end

/-!
  Here is our second big lemma, if the active flow is maximum,
  then no augmenting path exists in the residual network.
-/

lemma no_augm_path {V : Type*} [inst' : fintype V]
  (rsn : residual_network V) : (is_max_flow rsn.afn) -> no_augumenting_path rsn :=
begin
  intros max_flow v exists_path,
  by_contradiction is_sink,
  set s := rsn.afn.network.source,
  set t := rsn.afn.network.sink,
  set vertices := {s} ∪ { x | (∃ y: V, exists_path.in x y) }, --all vertices in the augmenting path
  set d := 0,
  -- set flows := { rsn.f' x y | exists_path.in x y }, -- set of reals, why it doesn't work?
  -- set d := flows.min, -- the minimum flow in the augmenting path
  have pos: 0 < d := by sorry, -- by definition of is_edge in the residual network
  set better_flow: active_flow_network V :=
  ⟨rsn.afn.network,
  (λ u v : V, if exists_path.in u v then rsn.afn.f u v + d
              else if exists_path.in v u then rsn.afn.f u v - d else rsn.afn.f u v),
  begin -- source ≠ sink
    exact rsn.afn.sourceNotSink,
  end,
  begin -- non_neg_flow
    intros u v,
    by_cases h: exists_path.in u v,
    {
      have h1: rsn.afn.f u v ≥ 0 := rsn.afn.non_neg_flow u v,
      have h2: d ≥ 0 := -- needs to be changed, we can use the definition of rsn and split into cases
      begin
        by_contradiction h',
        have h3: d < 0 := lt_of_not_ge h',
        have h4: ¬ d < 0 := not_lt_of_gt pos,
        exact absurd h3 h4,
      end,
      linarith,
    },
    {
      by_cases h': exists_path.in v u,
        {
          have h1: rsn.f' v u = rsn.afn.f u v :=
          begin
            rw rsn.f_def,
            have edge: rsn.afn.network.is_edge v u := by sorry,-- use h' and definition of path.in
            unfold mk_rsf,
            sorry, -- just use edge to get the wanted result
          end,
          have h2: rsn.f' v u ≥ d := by sorry, -- minimality of d
          have h3: rsn.afn.f u v ≥ d := by {rw ←h1, exact h2},
          linarith,
        },
        {
          -- exact rsn.afn.non_neg_flow u v, -- should be correct, why is not working?
          linarith,
        },
    },
  end,
  begin -- no_overflow
    intros u v,
    by_cases h: exists_path.in u v,
    {
      have h1: rsn.afn.f u v + d ≤ rsn.afn.network.to_capacity.c u v := by sorry,
      -- begin
      --   have h2: rsn.afn.f u v + rsn.f' u v ≤ rsn.afn.network.to_capacity.c u v := by def of rsn
      --   have h3: d ≤ rsn.f' u v := by minimality of d
      --   have h4: rsn.afn.f u v + d ≤ rsn.afn.f u v + rsn.f' u v := by {linarith},
      --   exact le_trans h4 h2
      -- end,
      linarith,
    },
    {
      by_cases h': exists_path.in v u,
        {
          have h1: rsn.afn.f u v ≤ rsn.afn.network.to_capacity.c u v := rsn.afn.no_overflow u v,
          linarith, -- maybe pos will have to be used when d is properly defined
        },
        {
          have h1: rsn.afn.f u v ≤ rsn.afn.network.to_capacity.c u v := rsn.afn.no_overflow u v,
          linarith,
        },
    },
  end,
  begin --noEdgesInSource
    exact rsn.afn.noEdgesInSource,
  end,
  begin --noEdgesOutSink
    exact rsn.afn.noEdgesOutSink,
  end,
  begin -- conservation
    intros v vNotSinkSource,
    by_cases h: v ∈ vertices,
    {
      -- Issues: How are we proving the cardinality of predecessor and ancestor is 1?
      -- How exactly do we use that within the code to prove h2 and h3?
      set predecessor := {u | exists_path.in u v},
      set ancestor := {w | exists_path.in v w},
      have h1: mk_out rsn.afn.f {v} = mk_in rsn.afn.f {v} := rsn.afn.conservation v vNotSinkSource,
      -- have h2: mk_in f {v} = rsn.afn.mk_in {v} + d := by sorry, -- use the predecessor
      -- have h3: mk_out f {v} = rsn.afn.mk_out {v} + d := by sorry, -- use the ancestor
      -- rw [h2,h3,h1],
      -- rfl,
      sorry,
    },
    {
      sorry,
      -- have h1: ∀ u : V, ¬exists_path.in u v :=
      -- begin
      --   by_contradiction h',
      --   have ancestor: ∃w: exists_path.in v w := by v ≠ t,
      --   have contr: v ∈ vertives := by def of vertices and ancestor,
      --   contradiction -- with ¬v ∈ vertices,
      -- end,
      -- have h2: ∀ w : V, ¬exists_path.in u w :=
      -- begin
      --   by_contradiction h',
      --   have contr: v ∈ vertives := by def of vertices,
      --   contradiction -- with ¬v ∈ vertices
      -- end,
      -- have h3: ∀ u : V, better_flow.f u v = rsn.afn.f u v := by h1 and h2
      -- have h4: ∀ w : V, better_flow.f v w = rsn.afn.f v w := by h1 and h2
      -- rw [h3,h4],
      -- exact rsn.afn.conservation v vNotSinkSource,
    },
  end
  ⟩,
  have flow_value: F_value better_flow = F_value rsn.afn + d :=
  begin
    unfold F_value,
    have h1: mk_out better_flow.f {better_flow.network.source} =
    mk_out rsn.afn.f {rsn.afn.network.source} + d :=
    by sorry,
    -- take the edge with the added flow
    -- Issue: How do we prove that there is exactly one edge? How do we use it to prove h1?
    have h2: mk_in better_flow.f {better_flow.network.source} =
    mk_in rsn.afn.f {rsn.afn.network.source} := by {linarith},
    rw [h1,h2],
    linarith
  end,
  have le: F_value rsn.afn ≥ F_value better_flow :=
  begin
    have same_net: better_flow.network = rsn.afn.network := by {simp},
    unfold is_max_flow at max_flow,
    exact max_flow better_flow same_net,
  end,
  have lt: F_value rsn.afn < F_value better_flow :=
  begin
    rw flow_value,
    have h1: F_value rsn.afn - F_value rsn.afn < d :=
    begin
      have eq: F_value rsn.afn - F_value rsn.afn = 0 := by ring,
      rw eq,
      linarith
    end,
    have h2: F_value rsn.afn < F_value rsn.afn + d := lt_add_of_sub_left_lt h1,
    exact gt_iff_lt.2 h2,
  end,
  have nlt: ¬F_value rsn.afn < F_value better_flow := not_lt_of_ge le,
  exact absurd lt nlt,
end

/-!
  Now, we will prove that there exists a cut with value equal to the max flow in the same network.
  We will use a constructive proof, so we will construct our minimum cut.
-/

noncomputable
def mk_cut_set {V : Type u} [inst' : fintype V] -- The source set for the minimum cut
  (rsn : residual_network V) : finset V :=
  {x | (∃ p : path rsn.is_edge rsn.afn.network.source x, true)}.to_finset

noncomputable
def mk_cut_from_S {V : Type*} [inst' : fintype V]
  (rsn : residual_network V)
  (hno_augumenting_path : no_augumenting_path rsn)
  (S : finset V) (hS : S = mk_cut_set rsn) : cut V :=
⟨rsn.afn.network, S, V' \ S,
  begin
    rw hS,
    unfold mk_cut_set,
    simp only [set.mem_to_finset, set.mem_set_of_eq],
    exact exists.intro path.nil trivial,
  end,
  begin
    rw hS,
    unfold mk_cut_set,
    simp only [mem_sdiff, mem_univ, set.mem_to_finset, set.mem_set_of_eq, true_and],
    intro p,
    unfold no_augumenting_path at hno_augumenting_path,
    specialize hno_augumenting_path rsn.afn.network.sink ,
    simp only [eq_self_iff_true, not_true] at hno_augumenting_path,
    apply exists.elim p,
    intros p h,
    specialize hno_augumenting_path p,
    exact hno_augumenting_path,
  end,
rfl⟩

lemma s_t_not_connected {V : Type*} [inst' : fintype V]
  (rsn : residual_network V)
  (S : finset V) (hS : S = mk_cut_set rsn) :
  ∀ u ∈ S, ∀ v ∈ (V' \ S), ¬ rsn.is_edge u v :=
begin
  intros u h_u_in_S v h_v_in_T is_edge_u_v,
  rw hS at *,
  unfold mk_cut_set at *,
  simp only [set.mem_to_finset, set.mem_set_of_eq, mem_sdiff, mem_univ, true_and] at *,
  apply exists.elim h_u_in_S,
  intros p _,
  have tmp := path.cons p is_edge_u_v,
  apply h_v_in_T,
  exact exists.intro tmp trivial,
end

lemma residual_capacity_zero {V : Type*} [inst' : fintype V]
  (rsn : residual_network V)
  (ct : cut V)
  (h_eq_network : rsn.afn.network = ct.network)
  (h: ∀ u ∈ ct.S, ∀ v ∈ ct.T, ¬ rsn.is_edge u v) :
  ∀ u ∈ ct.S, ∀ v ∈ ct.T, rsn.f' u v = 0 :=
begin
  intros u h_u_in_S v h_v_in_T,
  specialize h u h_u_in_S v h_v_in_T,
  rw rsn.is_edge_def at h,
  simp only [not_lt] at h,
  have hge := residual_capacity_non_neg rsn u v,
  exact ge_antisymm hge h,
end

lemma min_max_cap_flow {V : Type*} [inst' : fintype V]
  (rsn : residual_network V)
  (ct : cut V)
  (h_eq_network : rsn.afn.network = ct.network)
  (h: ∀ u ∈ ct.S, ∀ v ∈ ct.T, rsn.f' u v = 0 ) :
  (∀ u ∈ ct.S, ∀ v ∈ ct.T, rsn.afn.f u v = rsn.afn.network.c u v) ∧
  (∀ u ∈ ct.T, ∀ v ∈ ct.S, rsn.afn.f u v = 0) :=
begin
  split,
  {
    intros u uInS v vInT,
    specialize h u uInS v vInT,
    rw rsn.f_def at h,
    unfold mk_rsf at h,
    have tmp := classical.em (rsn.afn.network.to_capacity.to_digraph.is_edge u v),
    cases tmp,
    {
      simp only [tmp, if_true] at h,
      linarith,
    },
    {
      simp only [tmp, if_false, ite_eq_right_iff] at h,
      have foo := rsn.afn.network.vanishes u v tmp,
      rw foo,
      clear tmp h,
      have foo := rsn.afn.non_neg_flow u v,
      have bar := rsn.afn.no_overflow u v,
      linarith,
    }
  },
  {
    intros v h_v_in_T u h_u_in_S,
    specialize h u h_u_in_S v h_v_in_T,
    rw rsn.f_def at h,
    unfold mk_rsf at h,
    have tmp := classical.em (rsn.afn.network.to_capacity.to_digraph.is_edge u v),
    cases tmp,
    {
      have foo := rsn.afn.network.hnonsymmetric u v,
      simp only [not_and] at foo,
      specialize foo tmp,
      have bar := rsn.afn.non_neg_flow v u,
      have baz := rsn.afn.no_overflow v u,
      have blurg := rsn.afn.network.vanishes v u foo,
      linarith,
    },
    {
      simp only [tmp, if_false, ite_eq_right_iff] at h,
      clear tmp,
      have tmp := classical.em (rsn.afn.network.to_capacity.to_digraph.is_edge v u),
      cases tmp,
      {
        exact h tmp,
      },
      {
        have foo := rsn.afn.non_neg_flow v u,
        have bar := rsn.afn.no_overflow v u,
        have baz := rsn.afn.network.vanishes v u tmp,
        linarith,
      },
    },
  }
end

lemma f_value_eq_out {V : Type*} [inst' : fintype V]
    (ct : cut V)
    (afn : active_flow_network V)
    (h_eq_network : afn.network = ct.network)
    (h : (∀ u ∈ ct.T, ∀ v ∈ ct.S, afn.f u v = 0)) :
    F_value afn = mk_out afn.f ct.S :=
begin
  dsimp [F_value],
  rw flow_value_source_in_S afn ct h_eq_network,
  dsimp [mk_in],
  simp_rw [← ct.Tcomp],
  simp only [sub_eq_self],
  have sum_eq_sum_zero : ∑ (x : V) in ct.T, ∑ y in ct.S, (afn.f x y) =
  ∑ x in ct.T, ∑ y in ct.S, 0 :=
  begin
    apply finset.sum_congr rfl,
    intros x xInT,
    apply finset.sum_congr rfl,
    intros y yInS,
    exact h x xInT y yInS,
  end,
  rw sum_eq_sum_zero,
  simp only [sum_const_zero],
end

lemma cut_cap_eq_out {V : Type*} [inst' : fintype V]
  (ct : cut V)
  (afn : active_flow_network V)
  (h_eq_network : afn.network = ct.network)
  (h : (∀ u ∈ ct.S, ∀ v ∈ V' \ ct.S, afn.f u v = afn.network.c u v) ∧
       (∀ u ∈ V' \ ct.S, ∀ v ∈ ct.S, afn.f u v = 0)) :
      mk_out afn.f ct.S = cut_cap ct :=
begin
  cases h with h_flow_eq_cap h_flow_zero,
  dsimp [cut_cap, mk_out],
  apply finset.sum_congr rfl,
  intros x x_in_S,
  rw ← ct.Tcomp at *,
  apply finset.sum_congr rfl,
  intros y y_in_T,
  simp [h_eq_network, h_flow_eq_cap x x_in_S y y_in_T],
end

lemma eq_on_res_then_on_sum {V : Type*} [inst' : fintype V]
  (A : finset V) (B : finset V) (f : V → V → ℝ) (g : V → V → ℝ)
  (eq_on_res : ∀ u ∈ A, ∀ v ∈ B, f u v = g u v) :
  ∑ (u : V) in A, ∑ (v : V) in B, f u v = ∑ (u : V) in A, ∑ (v : V) in B, g u v :=
begin
  apply finset.sum_congr rfl,
  intros a a_in_A,
  apply finset.sum_congr rfl,
  intros b b_in_B,
  exact eq_on_res a a_in_A b b_in_B,
end

/-!
  Here is our last big lemma, if there is no augmenting path in the resiual network,
  then there exists a cut with a capacity equal to the value of the active flow in the same network.
-/

lemma existence_of_a_cut {V : Type*} [inst' : fintype V]
  (rsn : residual_network V)
  (hno_augumenting_path : no_augumenting_path rsn) :
  (∃c : cut V, rsn.afn.network = c.network ∧ cut_cap c = F_value rsn.afn) :=
begin
  let S : finset V := mk_cut_set rsn,
  let T := V' \ S,
  have SCutSet: S = mk_cut_set rsn := by refl,
  let min_cut := mk_cut_from_S (rsn) (hno_augumenting_path) (S) (SCutSet),
  have eq_net : rsn.afn.network = min_cut.network := by refl,
  have subtract: ∀ x y : ℝ, (x=y) ↔ y-x=0 :=
  by {intros x y, split, intro heq, linarith, intro heq, linarith},
  have cf_vanishes_on_pipes: ∀ u ∈ min_cut.S, ∀ v ∈ V' \ min_cut.S, rsn.f' u v = 0 :=
  begin
    intros u uInS v vInNS,
    by_contradiction h,
    have edge: rsn.is_edge u v :=
    begin
      by_contradiction h',
      have contr: rsn.f' u v = 0 :=
      begin
        rw rsn.is_edge_def at h',
        simp only [not_lt] at h',
        have hge := residual_capacity_non_neg rsn u v,
        exact ge_antisymm hge h',
      end,
      contradiction
    end,
    have notEdge: ¬ rsn.is_edge u v := by {exact s_t_not_connected rsn S SCutSet u uInS v vInNS},
    contradiction
  end,
  have cf_vanishes_on_pipes_spec: ∀ u ∈ min_cut.S, ∀ v ∈ V' \ min_cut.S,
    (rsn.afn.network.is_edge u v) → (rsn.afn.network.c u v - rsn.afn.f u v = 0) :=
  begin
    intros u uInS v vInT is_edge,
    have h1: mk_rsf rsn.afn u v = rsn.afn.network.c u v - rsn.afn.f u v :=
    by {unfold mk_rsf, simp only [is_edge, if_true]},
    rw ← h1,
    have h2: mk_rsf rsn.afn u v = rsn.f' u v := by {rw rsn.f_def},
    rw h2,
    exact cf_vanishes_on_pipes u uInS v vInT,
  end,
  have eq_on_pipes: ∀ u ∈ min_cut.S, ∀ v ∈ V' \ min_cut.S, rsn.afn.f u v = rsn.afn.network.c u v :=
  begin
    intros u uInS v vInT,
    cases classical.em (rsn.afn.network.is_edge u v),
    {
      rw subtract (rsn.afn.f u v) (rsn.afn.network.to_capacity.c u v),
      have mk_cf_spec: (rsn.f' u v = rsn.afn.network.c u v - rsn.afn.f u v) :=
      begin
        rw rsn.f_def,
        unfold mk_rsf,
        simp only [h, if_true],
      end,
      rw ← mk_cf_spec,
      exact cf_vanishes_on_pipes u uInS v vInT,
    },
    {
      rw rsn.afn.network.vanishes u v h,
      exact f_vanishes_outside_edge (rsn.afn) (u) (v) (h),
    },
  end,
  have no_backflow: ∀ (u v : V), (u ∈ V' \ min_cut.S ∧ v ∈ min_cut.S) → rsn.afn.f u v = 0 :=
  begin
    intros u v hyp,
    exact (min_max_cap_flow rsn min_cut eq_net cf_vanishes_on_pipes).2 u hyp.1 v hyp.2,
  end,
  have cut_eq_flow: cut_cap min_cut = F_value rsn.afn :=
  begin
    rw F_value,
    simp only,
    rw flow_value_source_in_S rsn.afn min_cut eq_net,
    have no_input : mk_in rsn.afn.f min_cut.S = 0 :=
    begin
      rw mk_in,
      exact finset.sum_eq_zero (λ i hi, finset.sum_eq_zero $ λ j hj, no_backflow i j ⟨hi, hj⟩),
    end,
    rw no_input,
    simp only [sub_zero],
    have flow_eq_cap_on_cut : mk_out rsn.afn.f min_cut.S = mk_out rsn.afn.network.c min_cut.S :=
    begin
      unfold mk_out,
      rw eq_on_res_then_on_sum (min_cut.S) (V' \ min_cut.S) (rsn.afn.f) (rsn.afn.network.to_capacity.c) (eq_on_pipes),
    end,
    rw flow_eq_cap_on_cut,
    refl,
  end,
  use min_cut,
  split,
  {exact eq_net},
  exact cut_eq_flow
end

/-!
  Finally, our biggest result, the max-flow min-cut theorem!
  If a maximum flow exists, its value is equal to the capacity of the min cut in the same network.
-/

theorem max_flow_min_cut {V : Type*} [inst' : fintype V]
  (rsn : residual_network V) (c: cut V) (same_network: rsn.afn.network = c.network) :
  (is_max_flow rsn.afn ∧ is_min_cut c) → (F_value rsn.afn = cut_cap c) :=
begin
  rintros ⟨max_flow, min_cut⟩ ,
  have noAugPath: no_augumenting_path rsn := by {exact no_augm_path rsn max_flow},
  have existsCut: ∃cut:cut V, rsn.afn.network = cut.network ∧
  cut_cap cut = F_value rsn.afn := existence_of_a_cut rsn noAugPath,
  have max_flow_min_cut: ∀ cut : cut V,
  (rsn.afn.network = cut.network ∧ cut_cap cut = F_value rsn.afn) → (F_value rsn.afn = cut_cap c) :=
  begin
    rintros cut ⟨same_net, eq⟩ ,
    have h1: is_min_cut cut := min_cut_criterion rsn.afn cut same_net eq,
    have h2: is_min_cut c := min_cut,
    have same_net1: cut.network = c.network := by {rw ← same_network, rw ← same_net},
    have same_net2: c.network = cut.network := by rw ← same_net1,
    have same_val: cut_cap cut = cut_cap c :=
    begin
      have le1: cut_cap cut ≤ cut_cap c :=
      by {unfold is_min_cut at h1, exact h1 c same_net1},
      have le2: cut_cap c ≤ cut_cap cut :=
      by {unfold is_min_cut at h2, exact h2 cut same_net2},
      exact le_antisymm le1 le2,
    end,
    rw ← eq,
    exact same_val,
  end,
  exact exists.elim existsCut max_flow_min_cut,
end


/-
Copyright (c) 2020 Aaron Anderson, Jalex Stark. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson, Jalex Stark

! This file was ported from Lean 3 source module linear_algebra.matrix.charpoly.minpoly
! leanprover-community/mathlib commit d1d69e99ed34c95266668af4e288fc1c598b9a7f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.Matrix.Charpoly.Coeff
import Mathbin.LinearAlgebra.Matrix.ToLin
import Mathbin.RingTheory.PowerBasis

/-!
# The minimal polynomial divides the characteristic polynomial of a matrix.
-/

noncomputable section

universe u v

open Polynomial Matrix

variable {R : Type u} [CommRing R]

variable {n : Type v} [DecidableEq n] [Fintype n]

open Finset

variable {M : Matrix n n R}

namespace Matrix

theorem isIntegral : IsIntegral R M :=
  ⟨M.charpoly, ⟨charpoly_monic M, aeval_self_charpoly M⟩⟩
#align matrix.is_integral Matrix.isIntegral

theorem minpoly_dvd_charpoly {K : Type _} [Field K] (M : Matrix n n K) : minpoly K M ∣ M.charpoly :=
  minpoly.dvd _ _ (aeval_self_charpoly M)
#align matrix.minpoly_dvd_charpoly Matrix.minpoly_dvd_charpoly

end Matrix

section PowerBasis

open Algebra

/-- The characteristic polynomial of the map `λ x, a * x` is the minimal polynomial of `a`.

In combination with `det_eq_sign_charpoly_coeff` or `trace_eq_neg_charpoly_coeff`
and a bit of rewriting, this will allow us to conclude the
field norm resp. trace of `x` is the product resp. sum of `x`'s conjugates.
-/
theorem charpoly_leftMulMatrix {S : Type _} [Ring S] [Algebra R S] (h : PowerBasis R S) :
    (leftMulMatrix h.Basis h.gen).charpoly = minpoly R h.gen :=
  by
  cases subsingleton_or_nontrivial R; · apply Subsingleton.elim
  apply minpoly.unique' R h.gen (charpoly_monic _)
  · apply (injective_iff_map_eq_zero (left_mul_matrix _)).mp (left_mul_matrix_injective h.basis)
    rw [← Polynomial.aeval_algHom_apply, aeval_self_charpoly]
  refine' fun q hq => or_iff_not_imp_left.2 fun h0 => _
  rw [Matrix.charpoly_degree_eq_dim, Fintype.card_fin] at hq
  contrapose! hq; exact h.dim_le_degree_of_root h0 hq
#align charpoly_left_mul_matrix charpoly_leftMulMatrix

end PowerBasis


-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que en los anillos
--    a * 0 = 0
-- ----------------------------------------------------------------------

import algebra.ring

namespace my_ring

variables {R : Type*} [ring R]

variable (a : R)

-- 1ª demostración
-- ===============

example : a * 0 = 0 :=
begin
  have h : a * 0 + a * 0 = a * 0 + 0,
    calc a * 0 + a * 0
         = a * (0 + 0) : (mul_add a 0 0).symm
     ... = a * 0       : congr_arg (λ x, a * x) (add_zero 0)
     ... = a * 0 + 0   : (add_zero (a * 0)).symm,
  rw add_left_cancel h
end

-- 2ª demostración
-- ===============

example : a * 0 = 0 :=
begin
  have h : a * 0 + a * 0 = a * 0 + 0,
    calc a * 0 + a * 0
         = a * (0 + 0) : by rw ← mul_add
     ... = a * 0       : by rw add_zero
     ... = a * 0 + 0   : by rw add_zero,
  rw add_left_cancel h
end

-- 3ª demostración
-- ===============

example : a * 0 = 0 :=
begin
  have h : a * 0 + a * 0 = a * 0 + 0,
  { rw [←mul_add, add_zero, add_zero] },
  rw add_left_cancel h
end

-- 4ª demostración
-- ===============

example : a * 0 = 0 :=
begin
  have h : a * 0 + a * 0 = a * 0 + 0,
    calc a * 0 + a * 0
         = a * (0 + 0) : by simp
     ... = a * 0       : by simp
     ... = a * 0 + 0   : by simp,
  simp,
end

end my_ring


/-
Copyright (c) 2022 Kexing Ying. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kexing Ying

! This file was ported from Lean 3 source module measure_theory.function.egorov
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Function.StronglyMeasurable.Basic

/-!
# Egorov theorem

This file contains the Egorov theorem which states that an almost everywhere convergent
sequence on a finite measure space converges uniformly except on an arbitrarily small set.
This theorem is useful for the Vitali convergence theorem as well as theorems regarding
convergence in measure.

## Main results

* `measure_theory.egorov`: Egorov's theorem which shows that a sequence of almost everywhere
  convergent functions converges uniformly except on an arbitrarily small set.

-/

noncomputable section

open Classical MeasureTheory NNReal ENNReal Topology

namespace MeasureTheory

open Set Filter TopologicalSpace

variable {α β ι : Type _} {m : MeasurableSpace α} [MetricSpace β] {μ : Measure α}

namespace Egorov

/-- Given a sequence of functions `f` and a function `g`, `not_convergent_seq f g n j` is the
set of elements such that `f k x` and `g x` are separated by at least `1 / (n + 1)` for some
`k ≥ j`.

This definition is useful for Egorov's theorem. -/
def notConvergentSeq [Preorder ι] (f : ι → α → β) (g : α → β) (n : ℕ) (j : ι) : Set α :=
  ⋃ (k) (hk : j ≤ k), { x | 1 / (n + 1 : ℝ) < dist (f k x) (g x) }
#align measure_theory.egorov.not_convergent_seq MeasureTheory.Egorov.notConvergentSeq

variable {n : ℕ} {i j : ι} {s : Set α} {ε : ℝ} {f : ι → α → β} {g : α → β}

theorem mem_notConvergentSeq_iff [Preorder ι] {x : α} :
    x ∈ notConvergentSeq f g n j ↔ ∃ (k : _)(hk : j ≤ k), 1 / (n + 1 : ℝ) < dist (f k x) (g x) :=
  by
  simp_rw [not_convergent_seq, mem_Union]
  rfl
#align measure_theory.egorov.mem_not_convergent_seq_iff MeasureTheory.Egorov.mem_notConvergentSeq_iff

theorem notConvergentSeq_antitone [Preorder ι] : Antitone (notConvergentSeq f g n) := fun j k hjk =>
  unionᵢ₂_mono' fun l hl => ⟨l, le_trans hjk hl, Subset.rfl⟩
#align measure_theory.egorov.not_convergent_seq_antitone MeasureTheory.Egorov.notConvergentSeq_antitone

theorem measure_inter_notConvergentSeq_eq_zero [SemilatticeSup ι] [Nonempty ι]
    (hfg : ∀ᵐ x ∂μ, x ∈ s → Tendsto (fun n => f n x) atTop (𝓝 (g x))) (n : ℕ) :
    μ (s ∩ ⋂ j, notConvergentSeq f g n j) = 0 :=
  by
  simp_rw [Metric.tendsto_atTop, ae_iff] at hfg
  rw [← nonpos_iff_eq_zero, ← hfg]
  refine' measure_mono fun x => _
  simp only [mem_inter_iff, mem_Inter, ge_iff_le, mem_not_convergent_seq_iff]
  push_neg
  rintro ⟨hmem, hx⟩
  refine' ⟨hmem, 1 / (n + 1 : ℝ), Nat.one_div_pos_of_nat, fun N => _⟩
  obtain ⟨n, hn₁, hn₂⟩ := hx N
  exact ⟨n, hn₁, hn₂.le⟩
#align measure_theory.egorov.measure_inter_not_convergent_seq_eq_zero MeasureTheory.Egorov.measure_inter_notConvergentSeq_eq_zero

theorem notConvergentSeq_measurableSet [Preorder ι] [Countable ι]
    (hf : ∀ n, strongly_measurable[m] (f n)) (hg : StronglyMeasurable g) :
    MeasurableSet (notConvergentSeq f g n j) :=
  MeasurableSet.unionᵢ fun k =>
    MeasurableSet.unionᵢ fun hk =>
      StronglyMeasurable.measurableSet_lt stronglyMeasurable_const <| (hf k).dist hg
#align measure_theory.egorov.not_convergent_seq_measurable_set MeasureTheory.Egorov.notConvergentSeq_measurableSet

theorem measure_notConvergentSeq_tendsto_zero [SemilatticeSup ι] [Countable ι]
    (hf : ∀ n, StronglyMeasurable (f n)) (hg : StronglyMeasurable g) (hsm : MeasurableSet s)
    (hs : μ s ≠ ∞) (hfg : ∀ᵐ x ∂μ, x ∈ s → Tendsto (fun n => f n x) atTop (𝓝 (g x))) (n : ℕ) :
    Tendsto (fun j => μ (s ∩ notConvergentSeq f g n j)) atTop (𝓝 0) :=
  by
  cases isEmpty_or_nonempty ι
  · have : (fun j => μ (s ∩ not_convergent_seq f g n j)) = fun j => 0 := by
      simp only [eq_iff_true_of_subsingleton]
    rw [this]
    exact tendsto_const_nhds
  rw [← measure_inter_not_convergent_seq_eq_zero hfg n, inter_Inter]
  refine'
    tendsto_measure_Inter (fun n => hsm.inter <| not_convergent_seq_measurable_set hf hg)
      (fun k l hkl => inter_subset_inter_right _ <| not_convergent_seq_antitone hkl)
      ⟨h.some, (lt_of_le_of_lt (measure_mono <| inter_subset_left _ _) (lt_top_iff_ne_top.2 hs)).Ne⟩
#align measure_theory.egorov.measure_not_convergent_seq_tendsto_zero MeasureTheory.Egorov.measure_notConvergentSeq_tendsto_zero

variable [SemilatticeSup ι] [Nonempty ι] [Countable ι]

theorem exists_notConvergentSeq_lt (hε : 0 < ε) (hf : ∀ n, StronglyMeasurable (f n))
    (hg : StronglyMeasurable g) (hsm : MeasurableSet s) (hs : μ s ≠ ∞)
    (hfg : ∀ᵐ x ∂μ, x ∈ s → Tendsto (fun n => f n x) atTop (𝓝 (g x))) (n : ℕ) :
    ∃ j : ι, μ (s ∩ notConvergentSeq f g n j) ≤ ENNReal.ofReal (ε * 2⁻¹ ^ n) :=
  by
  obtain ⟨N, hN⟩ :=
    (ENNReal.tendsto_atTop ENNReal.zero_ne_top).1
      (measure_not_convergent_seq_tendsto_zero hf hg hsm hs hfg n) (ENNReal.ofReal (ε * 2⁻¹ ^ n)) _
  · rw [zero_add] at hN
    exact ⟨N, (hN N le_rfl).2⟩
  · rw [gt_iff_lt, ENNReal.ofReal_pos]
    exact mul_pos hε (pow_pos (by norm_num) n)
#align measure_theory.egorov.exists_not_convergent_seq_lt MeasureTheory.Egorov.exists_notConvergentSeq_lt

/-- Given some `ε > 0`, `not_convergent_seq_lt_index` provides the index such that
`not_convergent_seq` (intersected with a set of finite measure) has measure less than
`ε * 2⁻¹ ^ n`.

This definition is useful for Egorov's theorem. -/
def notConvergentSeqLtIndex (hε : 0 < ε) (hf : ∀ n, StronglyMeasurable (f n))
    (hg : StronglyMeasurable g) (hsm : MeasurableSet s) (hs : μ s ≠ ∞)
    (hfg : ∀ᵐ x ∂μ, x ∈ s → Tendsto (fun n => f n x) atTop (𝓝 (g x))) (n : ℕ) : ι :=
  Classical.choose <| exists_notConvergentSeq_lt hε hf hg hsm hs hfg n
#align measure_theory.egorov.not_convergent_seq_lt_index MeasureTheory.Egorov.notConvergentSeqLtIndex

theorem notConvergentSeqLtIndex_spec (hε : 0 < ε) (hf : ∀ n, StronglyMeasurable (f n))
    (hg : StronglyMeasurable g) (hsm : MeasurableSet s) (hs : μ s ≠ ∞)
    (hfg : ∀ᵐ x ∂μ, x ∈ s → Tendsto (fun n => f n x) atTop (𝓝 (g x))) (n : ℕ) :
    μ (s ∩ notConvergentSeq f g n (notConvergentSeqLtIndex hε hf hg hsm hs hfg n)) ≤
      ENNReal.ofReal (ε * 2⁻¹ ^ n) :=
  Classical.choose_spec <| exists_notConvergentSeq_lt hε hf hg hsm hs hfg n
#align measure_theory.egorov.not_convergent_seq_lt_index_spec MeasureTheory.Egorov.notConvergentSeqLtIndex_spec

/-- Given some `ε > 0`, `Union_not_convergent_seq` is the union of `not_convergent_seq` with
specific indicies such that `Union_not_convergent_seq` has measure less equal than `ε`.

This definition is useful for Egorov's theorem. -/
def unionNotConvergentSeq (hε : 0 < ε) (hf : ∀ n, StronglyMeasurable (f n))
    (hg : StronglyMeasurable g) (hsm : MeasurableSet s) (hs : μ s ≠ ∞)
    (hfg : ∀ᵐ x ∂μ, x ∈ s → Tendsto (fun n => f n x) atTop (𝓝 (g x))) : Set α :=
  ⋃ n, s ∩ notConvergentSeq f g n (notConvergentSeqLtIndex (half_pos hε) hf hg hsm hs hfg n)
#align measure_theory.egorov.Union_not_convergent_seq MeasureTheory.Egorov.unionNotConvergentSeq

theorem unionNotConvergentSeq_measurableSet (hε : 0 < ε) (hf : ∀ n, StronglyMeasurable (f n))
    (hg : StronglyMeasurable g) (hsm : MeasurableSet s) (hs : μ s ≠ ∞)
    (hfg : ∀ᵐ x ∂μ, x ∈ s → Tendsto (fun n => f n x) atTop (𝓝 (g x))) :
    MeasurableSet <| unionNotConvergentSeq hε hf hg hsm hs hfg :=
  MeasurableSet.unionᵢ fun n => hsm.inter <| notConvergentSeq_measurableSet hf hg
#align measure_theory.egorov.Union_not_convergent_seq_measurable_set MeasureTheory.Egorov.unionNotConvergentSeq_measurableSet

theorem measure_unionNotConvergentSeq (hε : 0 < ε) (hf : ∀ n, StronglyMeasurable (f n))
    (hg : StronglyMeasurable g) (hsm : MeasurableSet s) (hs : μ s ≠ ∞)
    (hfg : ∀ᵐ x ∂μ, x ∈ s → Tendsto (fun n => f n x) atTop (𝓝 (g x))) :
    μ (unionNotConvergentSeq hε hf hg hsm hs hfg) ≤ ENNReal.ofReal ε :=
  by
  refine'
    le_trans (measure_Union_le _)
      (le_trans
        (ENNReal.tsum_le_tsum <| not_convergent_seq_lt_index_spec (half_pos hε) hf hg hsm hs hfg) _)
  simp_rw [ENNReal.ofReal_mul (half_pos hε).le]
  rw [ENNReal.tsum_mul_left, ← ENNReal.ofReal_tsum_of_nonneg, inv_eq_one_div, tsum_geometric_two, ←
    ENNReal.ofReal_mul (half_pos hε).le, div_mul_cancel ε two_ne_zero]
  · exact le_rfl
  · exact fun n => pow_nonneg (by norm_num) _
  · rw [inv_eq_one_div]
    exact summable_geometric_two
#align measure_theory.egorov.measure_Union_not_convergent_seq MeasureTheory.Egorov.measure_unionNotConvergentSeq

theorem unionNotConvergentSeq_subset (hε : 0 < ε) (hf : ∀ n, StronglyMeasurable (f n))
    (hg : StronglyMeasurable g) (hsm : MeasurableSet s) (hs : μ s ≠ ∞)
    (hfg : ∀ᵐ x ∂μ, x ∈ s → Tendsto (fun n => f n x) atTop (𝓝 (g x))) :
    unionNotConvergentSeq hε hf hg hsm hs hfg ⊆ s :=
  by
  rw [Union_not_convergent_seq, ← inter_Union]
  exact inter_subset_left _ _
#align measure_theory.egorov.Union_not_convergent_seq_subset MeasureTheory.Egorov.unionNotConvergentSeq_subset

theorem tendstoUniformlyOn_diff_unionNotConvergentSeq (hε : 0 < ε)
    (hf : ∀ n, StronglyMeasurable (f n)) (hg : StronglyMeasurable g) (hsm : MeasurableSet s)
    (hs : μ s ≠ ∞) (hfg : ∀ᵐ x ∂μ, x ∈ s → Tendsto (fun n => f n x) atTop (𝓝 (g x))) :
    TendstoUniformlyOn f g atTop (s \ Egorov.unionNotConvergentSeq hε hf hg hsm hs hfg) :=
  by
  rw [Metric.tendstoUniformlyOn_iff]
  intro δ hδ
  obtain ⟨N, hN⟩ := exists_nat_one_div_lt hδ
  rw [eventually_at_top]
  refine' ⟨egorov.not_convergent_seq_lt_index (half_pos hε) hf hg hsm hs hfg N, fun n hn x hx => _⟩
  simp only [mem_diff, egorov.Union_not_convergent_seq, not_exists, mem_Union, mem_inter_iff,
    not_and, exists_and_left] at hx
  obtain ⟨hxs, hx⟩ := hx
  specialize hx hxs N
  rw [egorov.mem_not_convergent_seq_iff] at hx
  push_neg  at hx
  rw [dist_comm]
  exact lt_of_le_of_lt (hx n hn) hN
#align measure_theory.egorov.tendsto_uniformly_on_diff_Union_not_convergent_seq MeasureTheory.Egorov.tendstoUniformlyOn_diff_unionNotConvergentSeq

end Egorov

variable [SemilatticeSup ι] [Nonempty ι] [Countable ι] {γ : Type _} [TopologicalSpace γ]
  {f : ι → α → β} {g : α → β} {s : Set α}

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (t «expr ⊆ » s) -/
/-- **Egorov's theorem**: If `f : ι → α → β` is a sequence of strongly measurable functions that
converges to `g : α → β` almost everywhere on a measurable set `s` of finite measure,
then for all `ε > 0`, there exists a subset `t ⊆ s` such that `μ t ≤ ε` and `f` converges to `g`
uniformly on `s \ t`. We require the index type `ι` to be countable, and usually `ι = ℕ`.

In other words, a sequence of almost everywhere convergent functions converges uniformly except on
an arbitrarily small set. -/
theorem tendstoUniformlyOn_of_ae_tendsto (hf : ∀ n, StronglyMeasurable (f n))
    (hg : StronglyMeasurable g) (hsm : MeasurableSet s) (hs : μ s ≠ ∞)
    (hfg : ∀ᵐ x ∂μ, x ∈ s → Tendsto (fun n => f n x) atTop (𝓝 (g x))) {ε : ℝ} (hε : 0 < ε) :
    ∃ (t : _)(_ : t ⊆ s),
      MeasurableSet t ∧ μ t ≤ ENNReal.ofReal ε ∧ TendstoUniformlyOn f g atTop (s \ t) :=
  ⟨Egorov.unionNotConvergentSeq hε hf hg hsm hs hfg,
    Egorov.unionNotConvergentSeq_subset hε hf hg hsm hs hfg,
    Egorov.unionNotConvergentSeq_measurableSet hε hf hg hsm hs hfg,
    Egorov.measure_unionNotConvergentSeq hε hf hg hsm hs hfg,
    Egorov.tendstoUniformlyOn_diff_unionNotConvergentSeq hε hf hg hsm hs hfg⟩
#align measure_theory.tendsto_uniformly_on_of_ae_tendsto MeasureTheory.tendstoUniformlyOn_of_ae_tendsto

/-- Egorov's theorem for finite measure spaces. -/
theorem tendstoUniformlyOn_of_ae_tendsto' [IsFiniteMeasure μ] (hf : ∀ n, StronglyMeasurable (f n))
    (hg : StronglyMeasurable g) (hfg : ∀ᵐ x ∂μ, Tendsto (fun n => f n x) atTop (𝓝 (g x))) {ε : ℝ}
    (hε : 0 < ε) :
    ∃ t, MeasurableSet t ∧ μ t ≤ ENNReal.ofReal ε ∧ TendstoUniformlyOn f g atTop (tᶜ) :=
  by
  obtain ⟨t, _, ht, htendsto⟩ :=
    tendsto_uniformly_on_of_ae_tendsto hf hg MeasurableSet.univ (measure_ne_top μ univ) _ hε
  · refine' ⟨_, ht, _⟩
    rwa [compl_eq_univ_diff]
  · filter_upwards [hfg]with _ htendsto _ using htendsto
#align measure_theory.tendsto_uniformly_on_of_ae_tendsto' MeasureTheory.tendstoUniformlyOn_of_ae_tendsto'

end MeasureTheory


import data.nat.digits
import .list

lemma of_digits_eq_sum_map_with_index_aux (b : ℕ) (l : list ℕ) :
  (list.zip_with ((λ (i a : ℕ), a * b ^ i) ∘ nat.succ) (list.range l.length) l).sum =
  b * (list.zip_with (λ i a, a * b ^ i) (list.range l.length) l).sum :=
begin
  suffices : list.zip_with (((λ (i a : ℕ), a * b ^ i) ∘ nat.succ)) (list.range l.length) l =
      list.zip_with (λ i a, b * (a * b ^ i)) (list.range l.length) l,
    { simp [this] },
  congr,
  ext,
  simp [pow_succ],
  ring
end

lemma of_digits_eq_sum_map_with_index (b: ℕ) (L: list ℕ):
  nat.of_digits b L = list.sum (L.map_with_index (λ (i: ℕ) (a: ℕ), a * b ^ i)) :=
begin
  rw [list.map_with_index_eq_enum_map, list.enum_eq_zip_range,
    list.map_uncurry_zip_eq_zip_with, nat.of_digits_eq_foldr b],
  induction L with hd tl hl,
    { simp },
    {
      norm_cast at hl,
      simp [list.range_succ_eq_map, list.zip_with_map_left, of_digits_eq_sum_map_with_index_aux, hl],
    }
end

lemma fun_of_digits_eq_fun_of_sum_map_with_index
  {α β} [has_lift_t ℕ α]
  [semiring α]
  (f: α → β) (b: ℕ) (l: list ℕ):
  f ((nat.of_digits b l): α) = f (list.sum (l.map_with_index (λ i a, a * (b: α) ^ i))) :=
begin
  congr,
  rw_mod_cast of_digits_eq_sum_map_with_index,
  have := list.sum_hom _ (nat.cast_add_monoid_hom α),
  simp at this,
  rw [← this, list.map_map_with_index],
end

lemma one_le_of_nonzero_digits_length
  (n b: ℕ) (hn: n ≠ 0):
  1 ≤ (b.digits n).length :=
begin
  induction n with d hd,
  exact absurd rfl hn,
  cases b,
  { simp },
  {
    cases b,
    { simp },
    { dsimp [nat.digits],
      rw nat.digits_aux,
      simp only [list.length, zero_le, le_add_iff_nonneg_left],
    }
  },
end


-- Introducing Auxiliary Subgoals

variables p q : Prop

example (h : p ∧ q) : q ∧ p :=
have hp : p, from and.left h,
have hq : q, from and.right h,
show q ∧ p, from and.intro hq hp

example (h : p ∧ q) : q ∧ p :=
have hp : p, from h.left,
suffices hq : q, from and.intro hq hp,
show q, from h.right


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Kenny Lau, Robert Y. Lewis

! This file was ported from Lean 3 source module group_theory.eckmann_hilton
! leanprover-community/mathlib commit 448144f7ae193a8990cb7473c9e9a01990f64ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Group.Defs

/-!
# Eckmann-Hilton argument

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

The Eckmann-Hilton argument says that if a type carries two monoid structures that distribute
over one another, then they are equal, and in addition commutative.
The main application lies in proving that higher homotopy groups (`πₙ` for `n ≥ 2`) are commutative.

## Main declarations

* `eckmann_hilton.comm_monoid`: If a type carries a unital magma structure that distributes
  over a unital binary operation, then the magma is a commutative monoid.
* `eckmann_hilton.comm_group`: If a type carries a group structure that distributes
  over a unital binary operation, then the group is commutative.

-/

universe u

namespace EckmannHilton

variable {X : Type u}

-- mathport name: «expr < > »
local notation a " <" m "> " b => m a b

#print EckmannHilton.IsUnital /-
/-- `is_unital m e` expresses that `e : X` is a left and right unit
for the binary operation `m : X → X → X`. -/
structure IsUnital (m : X → X → X) (e : X) extends IsLeftId _ m e, IsRightId _ m e : Prop
#align eckmann_hilton.is_unital EckmannHilton.IsUnital
-/

/- warning: eckmann_hilton.mul_one_class.is_unital -> EckmannHilton.MulOneClass.isUnital is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} [G : MulOneClass.{u1} X], EckmannHilton.IsUnital.{u1} X (HMul.hMul.{u1, u1, u1} X X X (instHMul.{u1} X (MulOneClass.toHasMul.{u1} X G))) (OfNat.ofNat.{u1} X 1 (OfNat.mk.{u1} X 1 (One.one.{u1} X (MulOneClass.toHasOne.{u1} X G))))
but is expected to have type
  forall {X : Type.{u1}} [G : MulOneClass.{u1} X], EckmannHilton.IsUnital.{u1} X (fun (x._@.Mathlib.GroupTheory.EckmannHilton._hyg.284 : X) (x._@.Mathlib.GroupTheory.EckmannHilton._hyg.286 : X) => HMul.hMul.{u1, u1, u1} X X X (instHMul.{u1} X (MulOneClass.toMul.{u1} X G)) x._@.Mathlib.GroupTheory.EckmannHilton._hyg.284 x._@.Mathlib.GroupTheory.EckmannHilton._hyg.286) (OfNat.ofNat.{u1} X 1 (One.toOfNat1.{u1} X (MulOneClass.toOne.{u1} X G)))
Case conversion may be inaccurate. Consider using '#align eckmann_hilton.mul_one_class.is_unital EckmannHilton.MulOneClass.isUnitalₓ'. -/
@[to_additive EckmannHilton.AddZeroClass.IsUnital]
theorem MulOneClass.isUnital [G : MulOneClass X] : IsUnital (· * ·) (1 : X) :=
  IsUnital.mk (by infer_instance) (by infer_instance)
#align eckmann_hilton.mul_one_class.is_unital EckmannHilton.MulOneClass.isUnital
#align eckmann_hilton.add_zero_class.is_unital EckmannHilton.AddZeroClass.IsUnital

variable {m₁ m₂ : X → X → X} {e₁ e₂ : X}

variable (h₁ : IsUnital m₁ e₁) (h₂ : IsUnital m₂ e₂)

variable (distrib : ∀ a b c d, ((a <m₂> b) <m₁> c <m₂> d) = (a <m₁> c) <m₂> b <m₁> d)

include h₁ h₂ distrib

#print EckmannHilton.one /-
/-- If a type carries two unital binary operations that distribute over each other,
then they have the same unit elements.

In fact, the two operations are the same, and give a commutative monoid structure,
see `eckmann_hilton.comm_monoid`. -/
theorem one : e₁ = e₂ := by
  simpa only [h₁.left_id, h₁.right_id, h₂.left_id, h₂.right_id] using Distrib e₂ e₁ e₁ e₂
#align eckmann_hilton.one EckmannHilton.one
-/

#print EckmannHilton.mul /-
/-- If a type carries two unital binary operations that distribute over each other,
then these operations are equal.

In fact, they give a commutative monoid structure, see `eckmann_hilton.comm_monoid`. -/
theorem mul : m₁ = m₂ := by
  funext a b
  calc
    m₁ a b = m₁ (m₂ a e₁) (m₂ e₁ b) := by
      simp only [one h₁ h₂ Distrib, h₁.left_id, h₁.right_id, h₂.left_id, h₂.right_id]
    _ = m₂ a b := by simp only [Distrib, h₁.left_id, h₁.right_id, h₂.left_id, h₂.right_id]

#align eckmann_hilton.mul EckmannHilton.mul
-/

#print EckmannHilton.mul_comm /-
/-- If a type carries two unital binary operations that distribute over each other,
then these operations are commutative.

In fact, they give a commutative monoid structure, see `eckmann_hilton.comm_monoid`. -/
theorem mul_comm : IsCommutative _ m₂ :=
  ⟨fun a b => by simpa [mul h₁ h₂ Distrib, h₂.left_id, h₂.right_id] using Distrib e₂ a b e₂⟩
#align eckmann_hilton.mul_comm EckmannHilton.mul_comm
-/

#print EckmannHilton.mul_assoc /-
/-- If a type carries two unital binary operations that distribute over each other,
then these operations are associative.

In fact, they give a commutative monoid structure, see `eckmann_hilton.comm_monoid`. -/
theorem mul_assoc : IsAssociative _ m₂ :=
  ⟨fun a b c => by simpa [mul h₁ h₂ Distrib, h₂.left_id, h₂.right_id] using Distrib a b e₂ c⟩
#align eckmann_hilton.mul_assoc EckmannHilton.mul_assoc
-/

omit h₁ h₂ distrib

/- warning: eckmann_hilton.comm_monoid -> EckmannHilton.commMonoid is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} {m₁ : X -> X -> X} {e₁ : X}, (EckmannHilton.IsUnital.{u1} X m₁ e₁) -> (forall [h : MulOneClass.{u1} X], (forall (a : X) (b : X) (c : X) (d : X), Eq.{succ u1} X (m₁ (HMul.hMul.{u1, u1, u1} X X X (instHMul.{u1} X (MulOneClass.toHasMul.{u1} X h)) a b) (HMul.hMul.{u1, u1, u1} X X X (instHMul.{u1} X (MulOneClass.toHasMul.{u1} X h)) c d)) (HMul.hMul.{u1, u1, u1} X X X (instHMul.{u1} X (MulOneClass.toHasMul.{u1} X h)) (m₁ a c) (m₁ b d))) -> (CommMonoid.{u1} X))
but is expected to have type
  forall {X : Type.{u1}} {m₁ : X -> X -> X} {e₁ : X}, (EckmannHilton.IsUnital.{u1} X m₁ e₁) -> (forall [h : MulOneClass.{u1} X], (forall (a : X) (b : X) (c : X) (d : X), Eq.{succ u1} X (m₁ (HMul.hMul.{u1, u1, u1} X X X (instHMul.{u1} X (MulOneClass.toMul.{u1} X h)) a b) (HMul.hMul.{u1, u1, u1} X X X (instHMul.{u1} X (MulOneClass.toMul.{u1} X h)) c d)) (HMul.hMul.{u1, u1, u1} X X X (instHMul.{u1} X (MulOneClass.toMul.{u1} X h)) (m₁ a c) (m₁ b d))) -> (CommMonoid.{u1} X))
Case conversion may be inaccurate. Consider using '#align eckmann_hilton.comm_monoid EckmannHilton.commMonoidₓ'. -/
/-- If a type carries a unital magma structure that distributes over a unital binary
operations, then the magma structure is a commutative monoid. -/
@[reducible,
  to_additive
      "If a type carries a unital additive magma structure that distributes over\na unital binary operations, then the additive magma structure is a commutative additive monoid."]
def commMonoid [h : MulOneClass X]
    (distrib : ∀ a b c d, ((a * b) <m₁> c * d) = (a <m₁> c) * b <m₁> d) : CommMonoid X :=
  { h with
    mul := (· * ·)
    one := 1
    mul_comm := (mul_comm h₁ MulOneClass.isUnital Distrib).comm
    mul_assoc := (mul_assoc h₁ MulOneClass.isUnital Distrib).and_assoc }
#align eckmann_hilton.comm_monoid EckmannHilton.commMonoid
#align eckmann_hilton.add_comm_monoid EckmannHilton.addCommMonoid

/- warning: eckmann_hilton.comm_group -> EckmannHilton.commGroup is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} {m₁ : X -> X -> X} {e₁ : X}, (EckmannHilton.IsUnital.{u1} X m₁ e₁) -> (forall [G : Group.{u1} X], (forall (a : X) (b : X) (c : X) (d : X), Eq.{succ u1} X (m₁ (HMul.hMul.{u1, u1, u1} X X X (instHMul.{u1} X (MulOneClass.toHasMul.{u1} X (Monoid.toMulOneClass.{u1} X (DivInvMonoid.toMonoid.{u1} X (Group.toDivInvMonoid.{u1} X G))))) a b) (HMul.hMul.{u1, u1, u1} X X X (instHMul.{u1} X (MulOneClass.toHasMul.{u1} X (Monoid.toMulOneClass.{u1} X (DivInvMonoid.toMonoid.{u1} X (Group.toDivInvMonoid.{u1} X G))))) c d)) (HMul.hMul.{u1, u1, u1} X X X (instHMul.{u1} X (MulOneClass.toHasMul.{u1} X (Monoid.toMulOneClass.{u1} X (DivInvMonoid.toMonoid.{u1} X (Group.toDivInvMonoid.{u1} X G))))) (m₁ a c) (m₁ b d))) -> (CommGroup.{u1} X))
but is expected to have type
  forall {X : Type.{u1}} {m₁ : X -> X -> X} {e₁ : X}, (EckmannHilton.IsUnital.{u1} X m₁ e₁) -> (forall [G : Group.{u1} X], (forall (a : X) (b : X) (c : X) (d : X), Eq.{succ u1} X (m₁ (HMul.hMul.{u1, u1, u1} X X X (instHMul.{u1} X (MulOneClass.toMul.{u1} X (Monoid.toMulOneClass.{u1} X (DivInvMonoid.toMonoid.{u1} X (Group.toDivInvMonoid.{u1} X G))))) a b) (HMul.hMul.{u1, u1, u1} X X X (instHMul.{u1} X (MulOneClass.toMul.{u1} X (Monoid.toMulOneClass.{u1} X (DivInvMonoid.toMonoid.{u1} X (Group.toDivInvMonoid.{u1} X G))))) c d)) (HMul.hMul.{u1, u1, u1} X X X (instHMul.{u1} X (MulOneClass.toMul.{u1} X (Monoid.toMulOneClass.{u1} X (DivInvMonoid.toMonoid.{u1} X (Group.toDivInvMonoid.{u1} X G))))) (m₁ a c) (m₁ b d))) -> (CommGroup.{u1} X))
Case conversion may be inaccurate. Consider using '#align eckmann_hilton.comm_group EckmannHilton.commGroupₓ'. -/
/-- If a type carries a group structure that distributes over a unital binary operation,
then the group is commutative. -/
@[reducible,
  to_additive
      "If a type carries an additive group structure that\ndistributes over a unital binary operation, then the additive group is commutative."]
def commGroup [G : Group X] (distrib : ∀ a b c d, ((a * b) <m₁> c * d) = (a <m₁> c) * b <m₁> d) :
    CommGroup X :=
  { EckmannHilton.commMonoid h₁ Distrib, G with }
#align eckmann_hilton.comm_group EckmannHilton.commGroup
#align eckmann_hilton.add_comm_group EckmannHilton.addCommGroup

end EckmannHilton


/-
Copyright (c) 2021 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen

! This file was ported from Lean 3 source module ring_theory.integrally_closed
! leanprover-community/mathlib commit 7a030ab8eb5d99f05a891dccc49c5b5b90c947d3
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.FieldTheory.SplittingField
import Mathbin.RingTheory.IntegralClosure
import Mathbin.RingTheory.Localization.Integral

/-!
# Integrally closed rings

An integrally closed domain `R` contains all the elements of `Frac(R)` that are
integral over `R`. A special case of integrally closed domains are the Dedekind domains.

## Main definitions

* `is_integrally_closed R` states `R` contains all integral elements of `Frac(R)`

## Main results

* `is_integrally_closed_iff K`, where `K` is a fraction field of `R`, states `R`
  is integrally closed iff it is the integral closure of `R` in `K`
* `eq_map_mul_C_of_dvd`: if `K = Frac(R)` and `g : K[X]` divides a monic polynomial with
  coefficients in `R`, then `g * (C g.leading_coeff⁻¹)` has coefficients in `R`
-/

open nonZeroDivisors Polynomial

open Polynomial

/-- `R` is integrally closed if all integral elements of `Frac(R)` are also elements of `R`.

This definition uses `fraction_ring R` to denote `Frac(R)`. See `is_integrally_closed_iff`
if you want to choose another field of fractions for `R`.
-/
class IsIntegrallyClosed (R : Type _) [CommRing R] [IsDomain R] : Prop where
  algebraMap_eq_of_integral :
    ∀ {x : FractionRing R}, IsIntegral R x → ∃ y, algebraMap R (FractionRing R) y = x
#align is_integrally_closed IsIntegrallyClosed

section Iff

variable {R : Type _} [CommRing R] [IsDomain R]

variable (K : Type _) [Field K] [Algebra R K] [IsFractionRing R K]

/-- `R` is integrally closed iff all integral elements of its fraction field `K`
are also elements of `R`. -/
theorem isIntegrallyClosed_iff :
    IsIntegrallyClosed R ↔ ∀ {x : K}, IsIntegral R x → ∃ y, algebraMap R K y = x :=
  by
  let e : K ≃ₐ[R] FractionRing R := IsLocalization.algEquiv R⁰ _ _
  constructor
  · rintro ⟨cl⟩
    refine' fun x hx => _
    obtain ⟨y, hy⟩ := cl ((isIntegral_algEquiv e).mpr hx)
    exact ⟨y, e.algebra_map_eq_apply.mp hy⟩
  · rintro cl
    refine' ⟨fun x hx => _⟩
    obtain ⟨y, hy⟩ := cl ((isIntegral_algEquiv e.symm).mpr hx)
    exact ⟨y, e.symm.algebra_map_eq_apply.mp hy⟩
#align is_integrally_closed_iff isIntegrallyClosed_iff

/-- `R` is integrally closed iff it is the integral closure of itself in its field of fractions. -/
theorem isIntegrallyClosed_iff_isIntegralClosure : IsIntegrallyClosed R ↔ IsIntegralClosure R R K :=
  (isIntegrallyClosed_iff K).trans <|
    by
    let e : K ≃ₐ[R] FractionRing R := IsLocalization.algEquiv R⁰ _ _
    constructor
    · intro cl
      refine' ⟨IsFractionRing.injective _ _, fun x => ⟨cl, _⟩⟩
      rintro ⟨y, y_eq⟩
      rw [← y_eq]
      exact isIntegral_algebraMap
    · rintro ⟨-, cl⟩ x hx
      exact cl.mp hx
#align is_integrally_closed_iff_is_integral_closure isIntegrallyClosed_iff_isIntegralClosure

end Iff

namespace IsIntegrallyClosed

variable {R : Type _} [CommRing R] [id : IsDomain R] [iic : IsIntegrallyClosed R]

variable {K : Type _} [Field K] [Algebra R K] [ifr : IsFractionRing R K]

include iic ifr

instance : IsIntegralClosure R R K :=
  (isIntegrallyClosed_iff_isIntegralClosure K).mp iic

theorem isIntegral_iff {x : K} : IsIntegral R x ↔ ∃ y : R, algebraMap R K y = x :=
  IsIntegralClosure.isIntegral_iff
#align is_integrally_closed.is_integral_iff IsIntegrallyClosed.isIntegral_iff

theorem exists_algebraMap_eq_of_isIntegral_pow {x : K} {n : ℕ} (hn : 0 < n)
    (hx : IsIntegral R <| x ^ n) : ∃ y : R, algebraMap R K y = x :=
  isIntegral_iff.mp <| isIntegral_of_pow hn hx
#align is_integrally_closed.exists_algebra_map_eq_of_is_integral_pow IsIntegrallyClosed.exists_algebraMap_eq_of_isIntegral_pow

omit iic ifr

theorem exists_algebraMap_eq_of_pow_mem_subalgebra {K : Type _} [Field K] [Algebra R K]
    {S : Subalgebra R K} [IsIntegrallyClosed S] [IsFractionRing S K] {x : K} {n : ℕ} (hn : 0 < n)
    (hx : x ^ n ∈ S) : ∃ y : S, algebraMap S K y = x :=
  exists_algebraMap_eq_of_isIntegral_pow hn <| isIntegral_iff.mpr ⟨⟨x ^ n, hx⟩, rfl⟩
#align is_integrally_closed.exists_algebra_map_eq_of_pow_mem_subalgebra IsIntegrallyClosed.exists_algebraMap_eq_of_pow_mem_subalgebra

include id ifr

variable {R} (K)

theorem integralClosure_eq_bot_iff : integralClosure R K = ⊥ ↔ IsIntegrallyClosed R :=
  by
  refine' eq_bot_iff.trans _
  constructor
  · rw [isIntegrallyClosed_iff K]
    intro h x hx
    exact set.mem_range.mp (algebra.mem_bot.mp (h hx))
    assumption
  · intro h x hx
    rw [Algebra.mem_bot, Set.mem_range]
    exact is_integral_iff.mp hx
#align is_integrally_closed.integral_closure_eq_bot_iff IsIntegrallyClosed.integralClosure_eq_bot_iff

include iic

variable (R K)

@[simp]
theorem integralClosure_eq_bot : integralClosure R K = ⊥ :=
  (integralClosure_eq_bot_iff K).mpr ‹_›
#align is_integrally_closed.integral_closure_eq_bot IsIntegrallyClosed.integralClosure_eq_bot

end IsIntegrallyClosed

namespace integralClosure

open IsIntegrallyClosed

variable {R : Type _} [CommRing R]

variable (K : Type _) [Field K] [Algebra R K]

theorem mem_lifts_of_monic_of_dvd_map {f : R[X]} (hf : f.Monic) {g : K[X]} (hg : g.Monic)
    (hd : g ∣ f.map (algebraMap R K)) : g ∈ lifts (algebraMap (integralClosure R K) K) :=
  by
  haveI : IsScalarTower R K g.splitting_field := splitting_field_aux.is_scalar_tower _ _ _
  have :=
    mem_lift_of_splits_of_roots_mem_range (integralClosure R g.splitting_field)
      ((splits_id_iff_splits _).2 <| splitting_field.splits g) (hg.map _) fun a ha =>
      (set_like.ext_iff.mp (integralClosure R g.splitting_field).range_algebraMap _).mpr <|
        roots_mem_integralClosure hf _
  · rw [lifts_iff_coeff_lifts, ← RingHom.coe_range, Subalgebra.range_algebraMap] at this
    refine' (lifts_iff_coeff_lifts _).2 fun n => _
    rw [← RingHom.coe_range, Subalgebra.range_algebraMap]
    obtain ⟨p, hp, he⟩ := set_like.mem_coe.mp (this n)
    use p, hp
    rw [IsScalarTower.algebraMap_eq R K, coeff_map, ← eval₂_map, eval₂_at_apply] at he
    rw [eval₂_eq_eval_map]
    apply (injective_iff_map_eq_zero _).1 _ _ he
    · apply RingHom.injective
  rw [IsScalarTower.algebraMap_eq R K _, ← map_map]
  refine' Multiset.mem_of_le (roots.le_of_dvd ((hf.map _).map _).NeZero _) ha
  · infer_instance
  · exact map_dvd (algebraMap K g.splitting_field) hd
  · apply splitting_field_aux.is_scalar_tower
#align integral_closure.mem_lifts_of_monic_of_dvd_map integralClosure.mem_lifts_of_monic_of_dvd_map

variable [IsDomain R] [IsFractionRing R K]

variable {L : Type _} [Field L] [Algebra K L] [Algebra R L] [IsScalarTower R K L]

-- Can't be an instance because you need to supply `K`.
theorem isIntegrallyClosedOfFiniteExtension [FiniteDimensional K L] :
    IsIntegrallyClosed (integralClosure R L) :=
  letI : IsFractionRing (integralClosure R L) L := is_fraction_ring_of_finite_extension K L
  (integral_closure_eq_bot_iff L).mp integralClosure_idem
#align integral_closure.is_integrally_closed_of_finite_extension integralClosure.isIntegrallyClosedOfFiniteExtension

end integralClosure

namespace IsIntegrallyClosed

open integralClosure

variable {R : Type _} [CommRing R] [IsDomain R]

variable (K : Type _) [Field K] [Algebra R K] [IsFractionRing R K]

/-- If `K = Frac(R)` and `g : K[X]` divides a monic polynomial with coefficients in `R`, then
    `g * (C g.leading_coeff⁻¹)` has coefficients in `R` -/
theorem eq_map_mul_c_of_dvd [IsIntegrallyClosed R] {f : R[X]} (hf : f.Monic) {g : K[X]}
    (hg : g ∣ f.map (algebraMap R K)) :
    ∃ g' : R[X], g'.map (algebraMap R K) * (C <| leadingCoeff g) = g :=
  by
  have g_ne_0 : g ≠ 0 := ne_zero_of_dvd_ne_zero (monic.ne_zero <| hf.map (algebraMap R K)) hg
  suffices lem : ∃ g' : R[X], g'.map (algebraMap R K) = g * C g.leading_coeff⁻¹
  · obtain ⟨g', hg'⟩ := lem
    use g'
    rw [hg', mul_assoc, ← C_mul, inv_mul_cancel (leading_coeff_ne_zero.mpr g_ne_0), C_1, mul_one]
  have g_mul_dvd : g * C g.leading_coeff⁻¹ ∣ f.map (algebraMap R K) :=
    by
    rwa [Associated.dvd_iff_dvd_left (show Associated (g * C g.leading_coeff⁻¹) g from _)]
    rw [associated_mul_isUnit_left_iff]
    exact is_unit_C.mpr (inv_ne_zero <| leading_coeff_ne_zero.mpr g_ne_0).IsUnit
  let algeq :=
    (Subalgebra.equivOfEq _ _ <| integral_closure_eq_bot R _).trans
      (Algebra.botEquivOfInjective <| IsFractionRing.injective R <| K)
  have :
    (algebraMap R _).comp algeq.to_alg_hom.to_ring_hom = (integralClosure R _).toSubring.Subtype :=
    by
    ext
    conv_rhs => rw [← algeq.symm_apply_apply x]
    rfl
  have H :=
    (mem_lifts _).1
      (mem_lifts_of_monic_of_dvd_map K hf (monic_mul_leading_coeff_inv g_ne_0) g_mul_dvd)
  refine' ⟨map algeq.to_alg_hom.to_ring_hom _, _⟩
  use Classical.choose H
  rw [map_map, this]
  exact Classical.choose_spec H
#align is_integrally_closed.eq_map_mul_C_of_dvd IsIntegrallyClosed.eq_map_mul_c_of_dvd

end IsIntegrallyClosed


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.nat.choose.basic
import data.nat.factorial.cast

/-!
# Cast of binomial coefficients

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

This file allows calculating the binomial coefficient `a.choose b` as an element of a division ring
of characteristic `0`.
-/

open_locale nat

variables (K : Type*) [division_ring K] [char_zero K]

namespace nat

lemma cast_choose {a b : ℕ} (h : a ≤ b) :
  (b.choose a : K) = b! / (a! * (b - a)!) :=
begin
  have : ∀ {n : ℕ}, (n! : K) ≠ 0 := λ n, nat.cast_ne_zero.2 (factorial_ne_zero _),
  rw eq_div_iff_mul_eq (mul_ne_zero this this),
  rw_mod_cast [← mul_assoc, choose_mul_factorial_mul_factorial h],
end

lemma cast_add_choose {a b : ℕ} :
  ((a + b).choose a : K) = (a + b)! / (a! * b!) :=
by rw [cast_choose K (le_add_right le_rfl), add_tsub_cancel_left]

lemma cast_choose_eq_pochhammer_div (a b : ℕ) :
  (a.choose b : K) = (pochhammer K b).eval (a - (b - 1) : ℕ) / b! :=
by rw [eq_div_iff_mul_eq (nat.cast_ne_zero.2 b.factorial_ne_zero : (b! : K) ≠ 0),
  ←nat.cast_mul, mul_comm, ←nat.desc_factorial_eq_factorial_mul_choose, ←cast_desc_factorial]

lemma cast_choose_two (a : ℕ) :
  (a.choose 2 : K) = a * (a - 1) / 2 :=
by rw [←cast_desc_factorial_two, desc_factorial_eq_factorial_mul_choose, factorial_two, mul_comm,
    cast_mul, cast_two, eq_div_iff_mul_eq (two_ne_zero : (2 : K) ≠ 0)]

end nat


/-
Copyright (c) 2021 Jannis Limperg. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jannis Limperg
-/

import Aesop

set_option aesop.check.all true

inductive Even : Nat → Type
| zero : Even 0
| plusTwo : Even n → Even (n + 2)

attribute [aesop safe] Even

example : Even 6 := by
  aesop