/-
Copyright (c) 2019 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.ring_theory.algebra_tower
import Mathlib.ring_theory.polynomial.scale_roots
import Mathlib.PostPort

universes u_1 u_3 u_2 u_4 u_5

namespace Mathlib

/-!
# Integral closure of a subring.

If A is an R-algebra then `a : A` is integral over R if it is a root of a monic polynomial
with coefficients in R. Enough theory is developed to prove that integral elements
form a sub-R-algebra of A.

## Main definitions

Let `R` be a `comm_ring` and let `A` be an R-algebra.

* `ring_hom.is_integral_elem (f : R →+* A) (x : A)` : `x` is integral with respect to the map `f`,

* `is_integral (x : A)`  : `x` is integral over `R`, i.e., is a root of a monic polynomial with
                           coefficients in `R`.
* `integral_closure R A` : the integral closure of `R` in `A`, regarded as a sub-`R`-algebra of `A`.
-/

/-- An element `x` of `A` is said to be integral over `R` with respect to `f`
if it is a root of a monic polynomial `p : polynomial R` evaluated under `f` -/
def ring_hom.is_integral_elem {R : Type u_1} {A : Type u_3} [comm_ring R] [ring A] (f : R →+* A) (x : A) :=
  ∃ (p : polynomial R), polynomial.monic p ∧ polynomial.eval₂ f x p = 0

/-- A ring homomorphism `f : R →+* A` is said to be integral
if every element `A` is integral with respect to the map `f` -/
def ring_hom.is_integral {R : Type u_1} {A : Type u_3} [comm_ring R] [ring A] (f : R →+* A) :=
  ∀ (x : A), ring_hom.is_integral_elem f x

/-- An element `x` of an algebra `A` over a commutative ring `R` is said to be *integral*,
if it is a root of some monic polynomial `p : polynomial R`.
Equivalently, the element is integral over `R` with respect to the induced `algebra_map` -/
def is_integral (R : Type u_1) {A : Type u_3} [comm_ring R] [ring A] [algebra R A] (x : A) :=
  ring_hom.is_integral_elem (algebra_map R A) x

/-- An algebra is integral if every element of the extension is integral over the base ring -/
def algebra.is_integral (R : Type u_1) (A : Type u_3) [comm_ring R] [ring A] [algebra R A] :=
  ring_hom.is_integral (algebra_map R A)

theorem ring_hom.is_integral_map {R : Type u_1} {S : Type u_2} [comm_ring R] [ring S] (f : R →+* S) {x : R} : ring_hom.is_integral_elem f (coe_fn f x) := sorry

theorem is_integral_algebra_map {R : Type u_1} {A : Type u_3} [comm_ring R] [ring A] [algebra R A] {x : R} : is_integral R (coe_fn (algebra_map R A) x) :=
  ring_hom.is_integral_map (algebra_map R A)

theorem is_integral_of_noetherian {R : Type u_1} {A : Type u_3} [comm_ring R] [ring A] [algebra R A] (H : is_noetherian R A) (x : A) : is_integral R x := sorry

theorem is_integral_of_submodule_noetherian {R : Type u_1} {A : Type u_3} [comm_ring R] [ring A] [algebra R A] (S : subalgebra R A) (H : is_noetherian R ↥↑S) (x : A) (hx : x ∈ S) : is_integral R x := sorry

theorem is_integral_alg_hom {R : Type u_1} {A : Type u_2} {B : Type u_3} [comm_ring R] [comm_ring A] [comm_ring B] [algebra R A] [algebra R B] (f : alg_hom R A B) {x : A} (hx : is_integral R x) : is_integral R (coe_fn f x) := sorry

theorem is_integral_of_is_scalar_tower {R : Type u_1} {A : Type u_2} {B : Type u_3} [comm_ring R] [comm_ring A] [comm_ring B] [algebra R A] [algebra R B] [algebra A B] [is_scalar_tower R A B] (x : B) (hx : is_integral R x) : is_integral A x := sorry

theorem is_integral_of_subring {R : Type u_1} {A : Type u_2} [comm_ring R] [comm_ring A] [algebra R A] {x : A} (T : set R) [is_subring T] (hx : is_integral (↥T) x) : is_integral R x :=
  is_integral_of_is_scalar_tower x hx

theorem is_integral_algebra_map_iff {R : Type u_1} {A : Type u_2} {B : Type u_3} [comm_ring R] [comm_ring A] [comm_ring B] [algebra R A] [algebra R B] [algebra A B] [is_scalar_tower R A B] {x : A} (hAB : function.injective ⇑(algebra_map A B)) : is_integral R (coe_fn (algebra_map A B) x) ↔ is_integral R x := sorry

theorem is_integral_iff_is_integral_closure_finite {R : Type u_1} {A : Type u_2} [comm_ring R] [comm_ring A] [algebra R A] {r : A} : is_integral R r ↔ ∃ (s : set R), set.finite s ∧ is_integral (↥(ring.closure s)) r := sorry

theorem fg_adjoin_singleton_of_integral {R : Type u_1} {A : Type u_2} [comm_ring R] [comm_ring A] [algebra R A] (x : A) (hx : is_integral R x) : submodule.fg ↑(algebra.adjoin R (singleton x)) := sorry

theorem fg_adjoin_of_finite {R : Type u_1} {A : Type u_2} [comm_ring R] [comm_ring A] [algebra R A] {s : set A} (hfs : set.finite s) (his : ∀ (x : A), x ∈ s → is_integral R x) : submodule.fg ↑(algebra.adjoin R s) := sorry

theorem is_integral_of_mem_of_fg {R : Type u_1} {A : Type u_2} [comm_ring R] [comm_ring A] [algebra R A] (S : subalgebra R A) (HS : submodule.fg ↑S) (x : A) (hx : x ∈ S) : is_integral R x := sorry

theorem ring_hom.is_integral_of_mem_closure {R : Type u_1} {S : Type u_4} [comm_ring R] [comm_ring S] (f : R →+* S) {x : S} {y : S} {z : S} (hx : ring_hom.is_integral_elem f x) (hy : ring_hom.is_integral_elem f y) (hz : z ∈ ring.closure (insert x (singleton y))) : ring_hom.is_integral_elem f z := sorry

theorem is_integral_of_mem_closure {R : Type u_1} {A : Type u_2} [comm_ring R] [comm_ring A] [algebra R A] {x : A} {y : A} {z : A} (hx : is_integral R x) (hy : is_integral R y) (hz : z ∈ ring.closure (insert x (singleton y))) : is_integral R z :=
  ring_hom.is_integral_of_mem_closure (algebra_map R A) hx hy hz

theorem ring_hom.is_integral_zero {R : Type u_1} {S : Type u_4} [comm_ring R] [comm_ring S] (f : R →+* S) : ring_hom.is_integral_elem f 0 :=
  ring_hom.map_zero f ▸ ring_hom.is_integral_map f

theorem is_integral_zero {R : Type u_1} {A : Type u_2} [comm_ring R] [comm_ring A] [algebra R A] : is_integral R 0 :=
  ring_hom.is_integral_zero (algebra_map R A)

theorem ring_hom.is_integral_one {R : Type u_1} {S : Type u_4} [comm_ring R] [comm_ring S] (f : R →+* S) : ring_hom.is_integral_elem f 1 :=
  ring_hom.map_one f ▸ ring_hom.is_integral_map f

theorem is_integral_one {R : Type u_1} {A : Type u_2} [comm_ring R] [comm_ring A] [algebra R A] : is_integral R 1 :=
  ring_hom.is_integral_one (algebra_map R A)

theorem ring_hom.is_integral_add {R : Type u_1} {S : Type u_4} [comm_ring R] [comm_ring S] (f : R →+* S) {x : S} {y : S} (hx : ring_hom.is_integral_elem f x) (hy : ring_hom.is_integral_elem f y) : ring_hom.is_integral_elem f (x + y) :=
  ring_hom.is_integral_of_mem_closure f hx hy
    (is_add_submonoid.add_mem (ring.subset_closure (Or.inl rfl)) (ring.subset_closure (Or.inr rfl)))

theorem is_integral_add {R : Type u_1} {A : Type u_2} [comm_ring R] [comm_ring A] [algebra R A] {x : A} {y : A} (hx : is_integral R x) (hy : is_integral R y) : is_integral R (x + y) :=
  ring_hom.is_integral_add (algebra_map R A) hx hy

theorem ring_hom.is_integral_neg {R : Type u_1} {S : Type u_4} [comm_ring R] [comm_ring S] (f : R →+* S) {x : S} (hx : ring_hom.is_integral_elem f x) : ring_hom.is_integral_elem f (-x) :=
  ring_hom.is_integral_of_mem_closure f hx hx (is_add_subgroup.neg_mem (ring.subset_closure (Or.inl rfl)))

theorem is_integral_neg {R : Type u_1} {A : Type u_2} [comm_ring R] [comm_ring A] [algebra R A] {x : A} (hx : is_integral R x) : is_integral R (-x) :=
  ring_hom.is_integral_neg (algebra_map R A) hx

theorem ring_hom.is_integral_sub {R : Type u_1} {S : Type u_4} [comm_ring R] [comm_ring S] (f : R →+* S) {x : S} {y : S} (hx : ring_hom.is_integral_elem f x) (hy : ring_hom.is_integral_elem f y) : ring_hom.is_integral_elem f (x - y) := sorry

theorem is_integral_sub {R : Type u_1} {A : Type u_2} [comm_ring R] [comm_ring A] [algebra R A] {x : A} {y : A} (hx : is_integral R x) (hy : is_integral R y) : is_integral R (x - y) :=
  ring_hom.is_integral_sub (algebra_map R A) hx hy

theorem ring_hom.is_integral_mul {R : Type u_1} {S : Type u_4} [comm_ring R] [comm_ring S] (f : R →+* S) {x : S} {y : S} (hx : ring_hom.is_integral_elem f x) (hy : ring_hom.is_integral_elem f y) : ring_hom.is_integral_elem f (x * y) :=
  ring_hom.is_integral_of_mem_closure f hx hy
    (is_submonoid.mul_mem (ring.subset_closure (Or.inl rfl)) (ring.subset_closure (Or.inr rfl)))

theorem is_integral_mul {R : Type u_1} {A : Type u_2} [comm_ring R] [comm_ring A] [algebra R A] {x : A} {y : A} (hx : is_integral R x) (hy : is_integral R y) : is_integral R (x * y) :=
  ring_hom.is_integral_mul (algebra_map R A) hx hy

/-- The integral closure of R in an R-algebra A. -/
def integral_closure (R : Type u_1) (A : Type u_2) [comm_ring R] [comm_ring A] [algebra R A] : subalgebra R A :=
  subalgebra.mk (set_of fun (r : A) => is_integral R r) is_integral_one sorry is_integral_zero sorry sorry

theorem mem_integral_closure_iff_mem_fg (R : Type u_1) (A : Type u_2) [comm_ring R] [comm_ring A] [algebra R A] {r : A} : r ∈ integral_closure R A ↔ ∃ (M : subalgebra R A), submodule.fg ↑M ∧ r ∈ M := sorry

/-- Mapping an integral closure along an `alg_equiv` gives the integral closure. -/
theorem integral_closure_map_alg_equiv {R : Type u_1} {A : Type u_2} {B : Type u_3} [comm_ring R] [comm_ring A] [comm_ring B] [algebra R A] [algebra R B] (f : alg_equiv R A B) : subalgebra.map (integral_closure R A) ↑f = integral_closure R B := sorry

theorem integral_closure.is_integral {R : Type u_1} {A : Type u_2} [comm_ring R] [comm_ring A] [algebra R A] (x : ↥(integral_closure R A)) : is_integral R x := sorry

theorem ring_hom.is_integral_of_is_integral_mul_unit {R : Type u_1} {S : Type u_4} [comm_ring R] [comm_ring S] (f : R →+* S) (x : S) (y : S) (r : R) (hr : coe_fn f r * y = 1) (hx : ring_hom.is_integral_elem f (x * y)) : ring_hom.is_integral_elem f x := sorry

theorem is_integral_of_is_integral_mul_unit {R : Type u_1} {A : Type u_2} [comm_ring R] [comm_ring A] [algebra R A] {x : A} {y : A} {r : R} (hr : coe_fn (algebra_map R A) r * y = 1) (hx : is_integral R (x * y)) : is_integral R x :=
  ring_hom.is_integral_of_is_integral_mul_unit (algebra_map R A) x y r hr hx

/-- Generalization of `is_integral_of_mem_closure` bootstrapped up from that lemma -/
theorem is_integral_of_mem_closure' {R : Type u_1} {A : Type u_2} [comm_ring R] [comm_ring A] [algebra R A] (G : set A) (hG : ∀ (x : A), x ∈ G → is_integral R x) (x : A) (H : x ∈ subring.closure G) : is_integral R x :=
  subring.closure_induction hx hG is_integral_zero is_integral_one (fun (_x _x_1 : A) => is_integral_add)
    (fun (_x : A) => is_integral_neg) fun (_x _x_1 : A) => is_integral_mul

theorem is_integral_of_mem_closure'' {R : Type u_1} [comm_ring R] {S : Type u_2} [comm_ring S] {f : R →+* S} (G : set S) (hG : ∀ (x : S), x ∈ G → ring_hom.is_integral_elem f x) (x : S) (H : x ∈ subring.closure G) : ring_hom.is_integral_elem f x :=
  is_integral_of_mem_closure' G hG x hx

theorem is_integral_trans_aux {R : Type u_1} {A : Type u_2} {B : Type u_3} [comm_ring R] [comm_ring A] [comm_ring B] [algebra A B] [algebra R B] (x : B) {p : polynomial A} (pmonic : polynomial.monic p) (hp : coe_fn (polynomial.aeval x) p = 0) : is_integral (↥(algebra.adjoin R ↑(finsupp.frange (polynomial.map (algebra_map A B) p)))) x := sorry

/-- If A is an R-algebra all of whose elements are integral over R,
and x is an element of an A-algebra that is integral over A, then x is integral over R.-/
theorem is_integral_trans {R : Type u_1} {A : Type u_2} {B : Type u_3} [comm_ring R] [comm_ring A] [comm_ring B] [algebra A B] [algebra R B] [algebra R A] [is_scalar_tower R A B] (A_int : algebra.is_integral R A) (x : B) (hx : is_integral A x) : is_integral R x := sorry

/-- If A is an R-algebra all of whose elements are integral over R,
and B is an A-algebra all of whose elements are integral over A,
then all elements of B are integral over R.-/
theorem algebra.is_integral_trans {R : Type u_1} {A : Type u_2} {B : Type u_3} [comm_ring R] [comm_ring A] [comm_ring B] [algebra A B] [algebra R B] [algebra R A] [is_scalar_tower R A B] (hA : algebra.is_integral R A) (hB : algebra.is_integral A B) : algebra.is_integral R B :=
  fun (x : B) => is_integral_trans hA x (hB x)

theorem ring_hom.is_integral_trans {R : Type u_1} {S : Type u_4} {T : Type u_5} [comm_ring R] [comm_ring S] [comm_ring T] (f : R →+* S) (g : S →+* T) (hf : ring_hom.is_integral f) (hg : ring_hom.is_integral g) : ring_hom.is_integral (ring_hom.comp g f) :=
  algebra.is_integral_trans hf hg

theorem ring_hom.is_integral_of_surjective {R : Type u_1} {S : Type u_4} [comm_ring R] [comm_ring S] (f : R →+* S) (hf : function.surjective ⇑f) : ring_hom.is_integral f :=
  fun (x : S) => Exists.rec_on (hf x) fun (y : R) (hy : coe_fn f y = x) => hy ▸ ring_hom.is_integral_map f

theorem is_integral_of_surjective {R : Type u_1} {A : Type u_2} [comm_ring R] [comm_ring A] [algebra R A] (h : function.surjective ⇑(algebra_map R A)) : algebra.is_integral R A :=
  ring_hom.is_integral_of_surjective (algebra_map R A) h

/-- If `R → A → B` is an algebra tower with `A → B` injective,
then if the entire tower is an integral extension so is `R → A` -/
theorem is_integral_tower_bot_of_is_integral {R : Type u_1} {A : Type u_2} {B : Type u_3} [comm_ring R] [comm_ring A] [comm_ring B] [algebra A B] [algebra R B] [algebra R A] [is_scalar_tower R A B] (H : function.injective ⇑(algebra_map A B)) {x : A} (h : is_integral R (coe_fn (algebra_map A B) x)) : is_integral R x := sorry

theorem ring_hom.is_integral_tower_bot_of_is_integral {R : Type u_1} {S : Type u_4} {T : Type u_5} [comm_ring R] [comm_ring S] [comm_ring T] (f : R →+* S) (g : S →+* T) (hg : function.injective ⇑g) (hfg : ring_hom.is_integral (ring_hom.comp g f)) : ring_hom.is_integral f :=
  fun (x : S) => is_integral_tower_bot_of_is_integral hg (hfg (coe_fn g x))

theorem is_integral_tower_bot_of_is_integral_field {R : Type u_1} {A : Type u_2} {B : Type u_3} [comm_ring R] [field A] [comm_ring B] [nontrivial B] [algebra R A] [algebra A B] [algebra R B] [is_scalar_tower R A B] {x : A} (h : is_integral R (coe_fn (algebra_map A B) x)) : is_integral R x :=
  is_integral_tower_bot_of_is_integral (ring_hom.injective (algebra_map A B)) h

theorem ring_hom.is_integral_elem_of_is_integral_elem_comp {R : Type u_1} {S : Type u_4} {T : Type u_5} [comm_ring R] [comm_ring S] [comm_ring T] (f : R →+* S) (g : S →+* T) {x : T} (h : ring_hom.is_integral_elem (ring_hom.comp g f) x) : ring_hom.is_integral_elem g x := sorry

theorem ring_hom.is_integral_tower_top_of_is_integral {R : Type u_1} {S : Type u_4} {T : Type u_5} [comm_ring R] [comm_ring S] [comm_ring T] (f : R →+* S) (g : S →+* T) (h : ring_hom.is_integral (ring_hom.comp g f)) : ring_hom.is_integral g :=
  fun (x : T) => ring_hom.is_integral_elem_of_is_integral_elem_comp f g (h x)

/-- If `R → A → B` is an algebra tower,
then if the entire tower is an integral extension so is `A → B`. -/
theorem is_integral_tower_top_of_is_integral {R : Type u_1} {A : Type u_2} {B : Type u_3} [comm_ring R] [comm_ring A] [comm_ring B] [algebra A B] [algebra R B] [algebra R A] [is_scalar_tower R A B] {x : B} (h : is_integral R x) : is_integral A x := sorry

theorem ring_hom.is_integral_quotient_of_is_integral {R : Type u_1} {S : Type u_4} [comm_ring R] [comm_ring S] (f : R →+* S) {I : ideal S} (hf : ring_hom.is_integral f) : ring_hom.is_integral (ideal.quotient_map I f le_rfl) := sorry

theorem is_integral_quotient_of_is_integral {R : Type u_1} {A : Type u_2} [comm_ring R] [comm_ring A] [algebra R A] {I : ideal A} (hRA : algebra.is_integral R A) : algebra.is_integral (ideal.quotient (ideal.comap (algebra_map R A) I)) (ideal.quotient I) :=
  ring_hom.is_integral_quotient_of_is_integral (algebra_map R A) hRA

theorem is_integral_quotient_map_iff {R : Type u_1} {S : Type u_4} [comm_ring R] [comm_ring S] (f : R →+* S) {I : ideal S} : ring_hom.is_integral (ideal.quotient_map I f le_rfl) ↔ ring_hom.is_integral (ring_hom.comp (ideal.quotient.mk I) f) := sorry

/-- If the integral extension `R → S` is injective, and `S` is a field, then `R` is also a field. -/
theorem is_field_of_is_integral_of_is_field {R : Type u_1} {S : Type u_2} [integral_domain R] [integral_domain S] [algebra R S] (H : algebra.is_integral R S) (hRS : function.injective ⇑(algebra_map R S)) (hS : is_field S) : is_field R := sorry

theorem integral_closure_idem {R : Type u_1} {A : Type u_2} [comm_ring R] [comm_ring A] [algebra R A] : integral_closure (↥↑(integral_closure R A)) A = ⊥ := sorry

protected instance integral_closure.integral_domain {R : Type u_1} {S : Type u_2} [comm_ring R] [integral_domain S] [algebra R S] : integral_domain ↥(integral_closure R S) :=
  integral_domain.mk comm_ring.add sorry comm_ring.zero sorry sorry comm_ring.neg comm_ring.sub sorry sorry comm_ring.mul
    sorry comm_ring.one sorry sorry sorry sorry sorry sorry sorry


/-
Copyright (c) 2022 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Patrick Massot, Sébastien Gouëzel, Zhouhang Zhou, Reid Barton,
Anatole Dedecker
-/
import topology.homeomorph
import topology.uniform_space.uniform_embedding
import topology.uniform_space.pi

/-!
# Uniform isomorphisms

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

This file defines uniform isomorphisms between two uniform spaces. They are bijections with both
directions uniformly continuous. We denote uniform isomorphisms with the notation `≃ᵤ`.

# Main definitions

* `uniform_equiv α β`: The type of uniform isomorphisms from `α` to `β`.
  This type can be denoted using the following notation: `α ≃ᵤ β`.

-/

open set filter
open_locale

universes u v
variables {α : Type u} {β : Type*} {γ : Type*} {δ : Type*}

/-- Uniform isomorphism between `α` and `β` -/
@[nolint has_nonempty_instance] -- not all spaces are homeomorphic to each other
structure uniform_equiv (α : Type*) (β : Type*) [uniform_space α] [uniform_space β]
  extends α ≃ β :=
(uniform_continuous_to_fun  : uniform_continuous to_fun)
(uniform_continuous_inv_fun : uniform_continuous inv_fun)

infix ` ≃ᵤ `:25 := uniform_equiv

namespace uniform_equiv
variables [uniform_space α] [uniform_space β] [uniform_space γ] [uniform_space δ]

instance : has_coe_to_fun (α ≃ᵤ β) (λ _, α → β) := ⟨λe, e.to_equiv⟩

@[simp] lemma uniform_equiv_mk_coe (a : equiv α β) (b c) :
  ((uniform_equiv.mk a b c) : α → β) = a :=
rfl

/-- Inverse of a uniform isomorphism. -/
protected def symm (h : α ≃ᵤ β) : β ≃ᵤ α :=
{ uniform_continuous_to_fun  := h.uniform_continuous_inv_fun,
  uniform_continuous_inv_fun := h.uniform_continuous_to_fun,
  to_equiv := h.to_equiv.symm }

/-- See Note [custom simps projection]. We need to specify this projection explicitly in this case,
  because it is a composition of multiple projections. -/
def simps.apply (h : α ≃ᵤ β) : α → β := h
/-- See Note [custom simps projection] -/
def simps.symm_apply (h : α ≃ᵤ β) : β → α := h.symm

initialize_simps_projections uniform_equiv
  (to_equiv_to_fun → apply, to_equiv_inv_fun → symm_apply, -to_equiv)

@[simp] lemma coe_to_equiv (h : α ≃ᵤ β) : ⇑h.to_equiv = h := rfl
@[simp] lemma coe_symm_to_equiv (h : α ≃ᵤ β) : ⇑h.to_equiv.symm = h.symm := rfl

lemma to_equiv_injective : function.injective (to_equiv : α ≃ᵤ β → α ≃ β)
| ⟨e, h₁, h₂⟩ ⟨e', h₁', h₂'⟩ rfl := rfl

@[ext] lemma ext {h h' : α ≃ᵤ β} (H : ∀ x, h x = h' x) : h = h' :=
to_equiv_injective $ equiv.ext H

/-- Identity map as a uniform isomorphism. -/
@[simps apply {fully_applied := ff}]
protected def refl (α : Type*) [uniform_space α] : α ≃ᵤ α :=
{ uniform_continuous_to_fun := uniform_continuous_id,
  uniform_continuous_inv_fun := uniform_continuous_id,
  to_equiv := equiv.refl α }

/-- Composition of two uniform isomorphisms. -/
protected def trans (h₁ : α ≃ᵤ β) (h₂ : β ≃ᵤ γ) : α ≃ᵤ γ :=
{ uniform_continuous_to_fun  := h₂.uniform_continuous_to_fun.comp h₁.uniform_continuous_to_fun,
  uniform_continuous_inv_fun := h₁.uniform_continuous_inv_fun.comp h₂.uniform_continuous_inv_fun,
  to_equiv := equiv.trans h₁.to_equiv h₂.to_equiv }

@[simp] lemma trans_apply (h₁ : α ≃ᵤ β) (h₂ : β ≃ᵤ γ) (a : α) : h₁.trans h₂ a = h₂ (h₁ a) := rfl

@[simp] lemma uniform_equiv_mk_coe_symm (a : equiv α β) (b c) :
  ((uniform_equiv.mk a b c).symm : β → α) = a.symm :=
rfl

@[simp] lemma refl_symm : (uniform_equiv.refl α).symm = uniform_equiv.refl α := rfl

protected lemma uniform_continuous (h : α ≃ᵤ β) : uniform_continuous h :=
h.uniform_continuous_to_fun

@[continuity]
protected lemma continuous (h : α ≃ᵤ β) : continuous h :=
h.uniform_continuous.continuous

protected lemma uniform_continuous_symm (h : α ≃ᵤ β) : uniform_continuous (h.symm) :=
h.uniform_continuous_inv_fun

@[continuity] -- otherwise `by continuity` can't prove continuity of `h.to_equiv.symm`
protected lemma continuous_symm (h : α ≃ᵤ β) : continuous (h.symm) :=
h.uniform_continuous_symm.continuous

/-- A uniform isomorphism as a homeomorphism. -/
@[simps]
protected def to_homeomorph (e : α ≃ᵤ β) : α ≃ₜ β :=
{ continuous_to_fun := e.continuous,
  continuous_inv_fun := e.continuous_symm,
  .. e.to_equiv }

@[simp] lemma apply_symm_apply (h : α ≃ᵤ β) (x : β) : h (h.symm x) = x :=
h.to_equiv.apply_symm_apply x

@[simp] lemma symm_apply_apply (h : α ≃ᵤ β) (x : α) : h.symm (h x) = x :=
h.to_equiv.symm_apply_apply x

protected lemma bijective (h : α ≃ᵤ β) : function.bijective h := h.to_equiv.bijective
protected lemma injective (h : α ≃ᵤ β) : function.injective h := h.to_equiv.injective
protected lemma surjective (h : α ≃ᵤ β) : function.surjective h := h.to_equiv.surjective

/-- Change the uniform equiv `f` to make the inverse function definitionally equal to `g`. -/
def change_inv (f : α ≃ᵤ β) (g : β → α) (hg : function.right_inverse g f) : α ≃ᵤ β :=
have g = f.symm, from funext (λ x, calc g x = f.symm (f (g x)) : (f.left_inv (g x)).symm
                                        ... = f.symm x : by rw hg x),
{ to_fun := f,
  inv_fun := g,
  left_inv := by convert f.left_inv,
  right_inv := by convert f.right_inv,
  uniform_continuous_to_fun := f.uniform_continuous,
  uniform_continuous_inv_fun := by convert f.symm.uniform_continuous }

@[simp] lemma symm_comp_self (h : α ≃ᵤ β) : ⇑h.symm ∘ ⇑h = id :=
funext h.symm_apply_apply

@[simp] lemma self_comp_symm (h : α ≃ᵤ β) : ⇑h ∘ ⇑h.symm = id :=
funext h.apply_symm_apply

@[simp] lemma range_coe (h : α ≃ᵤ β) : range h = univ :=
h.surjective.range_eq

lemma preimage_symm (h : α ≃ᵤ β) : preimage h.symm = image h :=
(funext h.to_equiv.image_eq_preimage).symm

@[simp] lemma image_preimage (h : α ≃ᵤ β) (s : set β) : h '' (h ⁻¹' s) = s :=
h.to_equiv.image_preimage s

@[simp] lemma preimage_image (h : α ≃ᵤ β) (s : set α) : h ⁻¹' (h '' s) = s :=
h.to_equiv.preimage_image s

protected lemma uniform_inducing (h : α ≃ᵤ β) : uniform_inducing h :=
uniform_inducing_of_compose h.uniform_continuous h.symm.uniform_continuous $
  by simp only [symm_comp_self, uniform_inducing_id]

lemma comap_eq (h : α ≃ᵤ β) : uniform_space.comap h ‹_› = ‹_› :=
by ext : 1; exact h.uniform_inducing.comap_uniformity

protected lemma uniform_embedding (h : α ≃ᵤ β) : uniform_embedding h :=
⟨h.uniform_inducing, h.injective⟩

/-- Uniform equiv given a uniform embedding. -/
noncomputable def of_uniform_embedding (f : α → β) (hf : uniform_embedding f) :
  α ≃ᵤ (set.range f) :=
{ uniform_continuous_to_fun := hf.to_uniform_inducing.uniform_continuous.subtype_mk _,
  uniform_continuous_inv_fun :=
    by simp [hf.to_uniform_inducing.uniform_continuous_iff, uniform_continuous_subtype_coe],
  to_equiv := equiv.of_injective f hf.inj }

/-- If two sets are equal, then they are uniformly equivalent. -/
def set_congr {s t : set α} (h : s = t) : s ≃ᵤ t :=
{ uniform_continuous_to_fun := uniform_continuous_subtype_val.subtype_mk _,
  uniform_continuous_inv_fun := uniform_continuous_subtype_val.subtype_mk _,
  to_equiv := equiv.set_congr h }

/-- Product of two uniform isomorphisms. -/
def prod_congr (h₁ : α ≃ᵤ β) (h₂ : γ ≃ᵤ δ) : α × γ ≃ᵤ β × δ :=
{ uniform_continuous_to_fun  := (h₁.uniform_continuous.comp uniform_continuous_fst).prod_mk
    (h₂.uniform_continuous.comp uniform_continuous_snd),
  uniform_continuous_inv_fun := (h₁.symm.uniform_continuous.comp uniform_continuous_fst).prod_mk
    (h₂.symm.uniform_continuous.comp uniform_continuous_snd),
  to_equiv := h₁.to_equiv.prod_congr h₂.to_equiv }

@[simp] lemma prod_congr_symm (h₁ : α ≃ᵤ β) (h₂ : γ ≃ᵤ δ) :
  (h₁.prod_congr h₂).symm = h₁.symm.prod_congr h₂.symm := rfl

@[simp] lemma coe_prod_congr (h₁ : α ≃ᵤ β) (h₂ : γ ≃ᵤ δ) :
  ⇑(h₁.prod_congr h₂) = prod.map h₁ h₂ := rfl

section
variables (α β γ)

/-- `α × β` is uniformly isomorphic to `β × α`. -/
def prod_comm : α × β ≃ᵤ β × α :=
{ uniform_continuous_to_fun  := uniform_continuous_snd.prod_mk uniform_continuous_fst,
  uniform_continuous_inv_fun := uniform_continuous_snd.prod_mk uniform_continuous_fst,
  to_equiv := equiv.prod_comm α β }

@[simp] lemma prod_comm_symm : (prod_comm α β).symm = prod_comm β α := rfl
@[simp] lemma coe_prod_comm : ⇑(prod_comm α β) = prod.swap := rfl

/-- `(α × β) × γ` is uniformly isomorphic to `α × (β × γ)`. -/
def prod_assoc : (α × β) × γ ≃ᵤ α × (β × γ) :=
{ uniform_continuous_to_fun  := (uniform_continuous_fst.comp uniform_continuous_fst).prod_mk
    ((uniform_continuous_snd.comp uniform_continuous_fst).prod_mk uniform_continuous_snd),
  uniform_continuous_inv_fun := (uniform_continuous_fst.prod_mk
    (uniform_continuous_fst.comp uniform_continuous_snd)).prod_mk
    (uniform_continuous_snd.comp uniform_continuous_snd),
  to_equiv := equiv.prod_assoc α β γ }

/-- `α × {*}` is uniformly isomorphic to `α`. -/
@[simps apply {fully_applied := ff}]
def prod_punit : α × punit ≃ᵤ α :=
{ to_equiv := equiv.prod_punit α,
  uniform_continuous_to_fun := uniform_continuous_fst,
  uniform_continuous_inv_fun := uniform_continuous_id.prod_mk uniform_continuous_const }

/-- `{*} × α` is uniformly isomorphic to `α`. -/
def punit_prod : punit × α ≃ᵤ α :=
(prod_comm _ _).trans (prod_punit _)

@[simp] lemma coe_punit_prod : ⇑(punit_prod α) = prod.snd := rfl

/-- Uniform equivalence between `ulift α` and `α`. -/
def ulift : ulift.{v u} α ≃ᵤ α :=
{ uniform_continuous_to_fun := uniform_continuous_comap,
  uniform_continuous_inv_fun := begin
    have hf : uniform_inducing (@equiv.ulift.{v u} α).to_fun, from ⟨rfl⟩,
    simp_rw [hf.uniform_continuous_iff],
    exact uniform_continuous_id,
  end,
  .. equiv.ulift }

end

/-- If `ι` has a unique element, then `ι → α` is homeomorphic to `α`. -/
@[simps { fully_applied := ff }]
def fun_unique (ι α : Type*) [unique ι] [uniform_space α] : (ι → α) ≃ᵤ α :=
{ to_equiv := equiv.fun_unique ι α,
  uniform_continuous_to_fun := Pi.uniform_continuous_proj _ _,
  uniform_continuous_inv_fun := uniform_continuous_pi.mpr (λ _, uniform_continuous_id) }

/-- Uniform isomorphism between dependent functions `Π i : fin 2, α i` and `α 0 × α 1`. -/
@[simps { fully_applied := ff }]
def pi_fin_two (α : fin 2 → Type u) [Π i, uniform_space (α i)] : (Π i, α i) ≃ᵤ α 0 × α 1 :=
{ to_equiv := pi_fin_two_equiv α,
  uniform_continuous_to_fun :=
    (Pi.uniform_continuous_proj _ 0).prod_mk (Pi.uniform_continuous_proj _ 1),
  uniform_continuous_inv_fun := uniform_continuous_pi.mpr $
    fin.forall_fin_two.2 ⟨uniform_continuous_fst, uniform_continuous_snd⟩ }

/-- Uniform isomorphism between `α² = fin 2 → α` and `α × α`. -/
@[simps { fully_applied := ff }] def fin_two_arrow : (fin 2 → α) ≃ᵤ α × α :=
{ to_equiv := fin_two_arrow_equiv α, .. pi_fin_two (λ _, α) }

/--
A subset of a uniform space is uniformly isomorphic to its image under a uniform isomorphism.
-/
def image (e : α ≃ᵤ β) (s : set α) : s ≃ᵤ e '' s :=
{ uniform_continuous_to_fun :=
    (e.uniform_continuous.comp uniform_continuous_subtype_val).subtype_mk _,
  uniform_continuous_inv_fun :=
    (e.symm.uniform_continuous.comp uniform_continuous_subtype_val).subtype_mk _,
  to_equiv := e.to_equiv.image s }

end uniform_equiv

/-- A uniform inducing equiv between uniform spaces is a uniform isomorphism. -/
@[simps] def equiv.to_uniform_equiv_of_uniform_inducing [uniform_space α] [uniform_space β]
  (f : α ≃ β) (hf : uniform_inducing f) :
  α ≃ᵤ β :=
{ uniform_continuous_to_fun := hf.uniform_continuous,
  uniform_continuous_inv_fun := hf.uniform_continuous_iff.2 $ by simpa using uniform_continuous_id,
  .. f }


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import meta.univs
import tactic.lint
import tactic.ext

/-!
# Sigma types

This file proves basic results about sigma types.

A sigma type is a dependent pair type. Like `α × β` but where the type of the second component
depends on the first component. This can be seen as a generalization of the sum type `α ⊕ β`:
* `α ⊕ β` is made of stuff which is either of type `α` or `β`.
* Given `α : ι → Type*`, `sigma α` is made of stuff which is of type `α i` for some `i : ι`. One
  effectively recovers a type isomorphic to `α ⊕ β` by taking a `ι` with exactly two elements. See
  `equiv.sum_equiv_sigma_bool`.

`Σ x, A x` is notation for `sigma A` (note the difference with the big operator `∑`).
`Σ x y z ..., A x y z ...` is notation for `Σ x, Σ y, Σ z, ..., A x y z ...`. Here we have
`α : Type*`, `β : α → Type*`, `γ : Π a : α, β a → Type*`, ...,
`A : Π (a : α) (b : β a) (c : γ a b) ..., Type*`  with `x : α` `y : β x`, `z : γ x y`, ...

## Notes

The definition of `sigma` takes values in `Type*`. This effectively forbids `Prop`- valued sigma
types. To that effect, we have `psigma`, which takes value in `Sort*` and carries a more complicated
universe signature in consequence.
-/

section sigma
variables {α α₁ α₂ : Type*} {β : α → Type*} {β₁ : α₁ → Type*} {β₂ : α₂ → Type*}

namespace sigma

instance [inhabited α] [inhabited (β default)] : inhabited (sigma β) :=
⟨⟨default, default⟩⟩

instance [h₁ : decidable_eq α] [h₂ : ∀a, decidable_eq (β a)] : decidable_eq (sigma β)
| ⟨a₁, b₁⟩ ⟨a₂, b₂⟩ := match a₁, b₁, a₂, b₂, h₁ a₁ a₂ with
  | _, b₁, _, b₂, is_true (eq.refl a) :=
    match b₁, b₂, h₂ a b₁ b₂ with
    | _, _, is_true (eq.refl b) := is_true rfl
    | b₁, b₂, is_false n := is_false (assume h, sigma.no_confusion h (λe₁ e₂, n $ eq_of_heq e₂))
    end
  | a₁, _, a₂, _, is_false n := is_false (assume h, sigma.no_confusion h (λe₁ e₂, n e₁))
  end

@[simp, nolint simp_nf] -- sometimes the built-in injectivity support does not work
theorem mk.inj_iff {a₁ a₂ : α} {b₁ : β a₁} {b₂ : β a₂} :
  sigma.mk a₁ b₁ = ⟨a₂, b₂⟩ ↔ (a₁ = a₂ ∧ b₁ == b₂) :=
by simp

@[simp] theorem eta : ∀ x : Σ a, β a, sigma.mk x.1 x.2 = x
| ⟨i, x⟩ := rfl

@[ext]
lemma ext {x₀ x₁ : sigma β} (h₀ : x₀.1 = x₁.1) (h₁ : x₀.2 == x₁.2) : x₀ = x₁ :=
by { cases x₀, cases x₁, cases h₀, cases h₁, refl }

lemma ext_iff {x₀ x₁ : sigma β} : x₀ = x₁ ↔ x₀.1 = x₁.1 ∧ x₀.2 == x₁.2 :=
by { cases x₀, cases x₁, exact sigma.mk.inj_iff }

/-- A specialized ext lemma for equality of sigma types over an indexed subtype. -/
@[ext]
lemma subtype_ext {β : Type*} {p : α → β → Prop} :
  ∀ {x₀ x₁ : Σ a, subtype (p a)}, x₀.fst = x₁.fst → (x₀.snd : β) = x₁.snd → x₀ = x₁
| ⟨a₀, b₀, hb₀⟩ ⟨a₁, b₁, hb₁⟩ rfl rfl := rfl

lemma subtype_ext_iff {β : Type*} {p : α → β → Prop} {x₀ x₁ : Σ a, subtype (p a)} :
  x₀ = x₁ ↔ x₀.fst = x₁.fst ∧ (x₀.snd : β) = x₁.snd :=
⟨λ h, h ▸ ⟨rfl, rfl⟩, λ ⟨h₁, h₂⟩, subtype_ext h₁ h₂⟩

@[simp] theorem «forall» {p : (Σ a, β a) → Prop} :
  (∀ x, p x) ↔ (∀ a b, p ⟨a, b⟩) :=
⟨assume h a b, h ⟨a, b⟩, assume h ⟨a, b⟩, h a b⟩

@[simp] theorem «exists» {p : (Σ a, β a) → Prop} :
  (∃ x, p x) ↔ (∃ a b, p ⟨a, b⟩) :=
⟨assume ⟨⟨a, b⟩, h⟩, ⟨a, b, h⟩, assume ⟨a, b, h⟩, ⟨⟨a, b⟩, h⟩⟩

/-- Map the left and right components of a sigma -/
def map (f₁ : α₁ → α₂) (f₂ : Πa, β₁ a → β₂ (f₁ a)) (x : sigma β₁) : sigma β₂ :=
⟨f₁ x.1, f₂ x.1 x.2⟩

end sigma

lemma sigma_mk_injective {i : α} : function.injective (@sigma.mk α β i)
| _ _ rfl := rfl

lemma function.injective.sigma_map {f₁ : α₁ → α₂} {f₂ : Πa, β₁ a → β₂ (f₁ a)}
  (h₁ : function.injective f₁) (h₂ : ∀ a, function.injective (f₂ a)) :
  function.injective (sigma.map f₁ f₂)
| ⟨i, x⟩ ⟨j, y⟩ h :=
begin
  obtain rfl : i = j, from h₁ (sigma.mk.inj_iff.mp h).1,
  obtain rfl : x = y, from h₂ i (eq_of_heq (sigma.mk.inj_iff.mp h).2),
  refl
end

lemma function.surjective.sigma_map {f₁ : α₁ → α₂} {f₂ : Πa, β₁ a → β₂ (f₁ a)}
  (h₁ : function.surjective f₁) (h₂ : ∀ a, function.surjective (f₂ a)) :
  function.surjective (sigma.map f₁ f₂) :=
begin
  intros y,
  cases y with j y,
  cases h₁ j with i hi,
  subst j,
  cases h₂ i y with x hx,
  subst y,
  exact ⟨⟨i, x⟩, rfl⟩
end

/-- Interpret a function on `Σ x : α, β x` as a dependent function with two arguments.

This also exists as an `equiv` as `equiv.Pi_curry γ`. -/
def sigma.curry {γ : Π a, β a → Type*} (f : Π x : sigma β, γ x.1 x.2) (x : α) (y : β x) : γ x y :=
f ⟨x,y⟩

/-- Interpret a dependent function with two arguments as a function on `Σ x : α, β x`.

This also exists as an `equiv` as `(equiv.Pi_curry γ).symm`. -/
def sigma.uncurry {γ : Π a, β a → Type*} (f : Π x (y : β x), γ x y) (x : sigma β) : γ x.1 x.2 :=
f x.1 x.2

@[simp]
lemma sigma.uncurry_curry {γ : Π a, β a → Type*} (f : Π x : sigma β, γ x.1 x.2) :
  sigma.uncurry (sigma.curry f) = f :=
funext $ λ ⟨i, j⟩, rfl

@[simp]
lemma sigma.curry_uncurry {γ : Π a, β a → Type*} (f : Π x (y : β x), γ x y) :
  sigma.curry (sigma.uncurry f) = f :=
rfl

/-- Convert a product type to a Σ-type. -/
@[simp]
def prod.to_sigma {α β} : α × β → Σ _ : α, β
| ⟨x,y⟩ := ⟨x,y⟩

@[simp]
lemma prod.fst_to_sigma {α β} (x : α × β) : (prod.to_sigma x).fst = x.fst :=
by cases x; refl

@[simp]
lemma prod.snd_to_sigma {α β} (x : α × β) : (prod.to_sigma x).snd = x.snd :=
by cases x; refl

-- we generate this manually as `@[derive has_reflect]` fails
@[instance]
protected meta def {u v} sigma.reflect [reflected_univ.{u}] [reflected_univ.{v}]
  {α : Type u} (β : α → Type v)
  [reflected _ α] [reflected _ β] [hα : has_reflect α] [hβ : Π i, has_reflect (β i)] :
  has_reflect (Σ a, β a) :=
λ ⟨a, b⟩, (by reflect_name : reflected _ @sigma.mk.{u v}).subst₄ `(α) `(β) `(a) `(b)

end sigma

section psigma
variables {α : Sort*} {β : α → Sort*}

namespace psigma

/-- Nondependent eliminator for `psigma`. -/
def elim {γ} (f : ∀ a, β a → γ) (a : psigma β) : γ :=
psigma.cases_on a f

@[simp] theorem elim_val {γ} (f : ∀ a, β a → γ) (a b) : psigma.elim f ⟨a, b⟩ = f a b := rfl

instance [inhabited α] [inhabited (β default)] : inhabited (psigma β) :=
⟨⟨default, default⟩⟩

instance [h₁ : decidable_eq α] [h₂ : ∀a, decidable_eq (β a)] : decidable_eq (psigma β)
| ⟨a₁, b₁⟩ ⟨a₂, b₂⟩ := match a₁, b₁, a₂, b₂, h₁ a₁ a₂ with
  | _, b₁, _, b₂, is_true (eq.refl a) :=
    match b₁, b₂, h₂ a b₁ b₂ with
    | _, _, is_true (eq.refl b) := is_true rfl
    | b₁, b₂, is_false n := is_false (assume h, psigma.no_confusion h (λe₁ e₂, n $ eq_of_heq e₂))
    end
  | a₁, _, a₂, _, is_false n := is_false (assume h, psigma.no_confusion h (λe₁ e₂, n e₁))
  end

theorem mk.inj_iff {a₁ a₂ : α} {b₁ : β a₁} {b₂ : β a₂} :
  @psigma.mk α β a₁ b₁ = @psigma.mk α β a₂ b₂ ↔ (a₁ = a₂ ∧ b₁ == b₂) :=
iff.intro psigma.mk.inj $
  assume ⟨h₁, h₂⟩, match a₁, a₂, b₁, b₂, h₁, h₂ with _, _, _, _, eq.refl a, heq.refl b := rfl end

@[ext]
lemma ext {x₀ x₁ : psigma β} (h₀ : x₀.1 = x₁.1) (h₁ : x₀.2 == x₁.2) : x₀ = x₁ :=
by { cases x₀, cases x₁, cases h₀, cases h₁, refl }

lemma ext_iff {x₀ x₁ : psigma β} : x₀ = x₁ ↔ x₀.1 = x₁.1 ∧ x₀.2 == x₁.2 :=
by { cases x₀, cases x₁, exact psigma.mk.inj_iff }

@[simp] theorem «forall» {p : (Σ' a, β a) → Prop} :
  (∀ x, p x) ↔ (∀ a b, p ⟨a, b⟩) :=
⟨assume h a b, h ⟨a, b⟩, assume h ⟨a, b⟩, h a b⟩

@[simp] theorem «exists» {p : (Σ' a, β a) → Prop} :
  (∃ x, p x) ↔ (∃ a b, p ⟨a, b⟩) :=
⟨assume ⟨⟨a, b⟩, h⟩, ⟨a, b, h⟩, assume ⟨a, b, h⟩, ⟨⟨a, b⟩, h⟩⟩

/-- A specialized ext lemma for equality of psigma types over an indexed subtype. -/
@[ext]
lemma subtype_ext {β : Sort*} {p : α → β → Prop} :
  ∀ {x₀ x₁ : Σ' a, subtype (p a)}, x₀.fst = x₁.fst → (x₀.snd : β) = x₁.snd → x₀ = x₁
| ⟨a₀, b₀, hb₀⟩ ⟨a₁, b₁, hb₁⟩ rfl rfl := rfl

lemma subtype_ext_iff {β : Sort*} {p : α → β → Prop} {x₀ x₁ : Σ' a, subtype (p a)} :
  x₀ = x₁ ↔ x₀.fst = x₁.fst ∧ (x₀.snd : β) = x₁.snd :=
⟨λ h, h ▸ ⟨rfl, rfl⟩, λ ⟨h₁, h₂⟩, subtype_ext h₁ h₂⟩

variables {α₁ : Sort*} {α₂ : Sort*} {β₁ : α₁ → Sort*} {β₂ : α₂ → Sort*}

/-- Map the left and right components of a sigma -/
def map (f₁ : α₁ → α₂) (f₂ : Πa, β₁ a → β₂ (f₁ a)) : psigma β₁ → psigma β₂
| ⟨a, b⟩ := ⟨f₁ a, f₂ a b⟩

end psigma

end psigma


-- Copyright (c) 2017 Scott Morrison. All rights reserved.
-- Released under Apache 2.0 license as described in the file LICENSE.
-- Authors: Stephen Morgan, Scott Morrison

import .cones

open category_theory
open category_theory.initial

namespace category_theory.universal

/-
We give "explicit" definitions of (co)equalizers, and (finite) (co)products. Of course these are special cases of (co)limits,
but they are used so pervasively that they need a convenient interface.

TODO: pullbacks and pushouts should be here too.
-/

universes u v w
variables {C : Type u} [𝒞 : category.{u v} C]
include 𝒞
variables {X Y : C}

structure Equalizer (f g : X ⟶ Y) :=
(equalizer     : C)
(inclusion     : equalizer ⟶ X)
(map           : ∀ {Z : C} (k : Z ⟶ X) (w : k ≫ f = k ≫ g), Z ⟶ equalizer)
(witness       : inclusion ≫ f = inclusion ≫ g . obviously)
(factorisation : ∀ {Z : C} (k : Z ⟶ X) (w : k ≫ f = k ≫ g), (map k w) ≫ inclusion = k . obviously)
(uniqueness    : ∀ {Z : C} (a b : Z ⟶ equalizer) (witness : a ≫ inclusion = b ≫ inclusion), a = b . obviously)

restate_axiom Equalizer.witness
restate_axiom Equalizer.factorisation
restate_axiom Equalizer.uniqueness
attribute [simp,ematch] Equalizer.factorisation_lemma
attribute [back] Equalizer.inclusion Equalizer.map
attribute [back] Equalizer.uniqueness_lemma

structure BinaryProduct (X Y : C) :=
(product             : C)
(left_projection     : product ⟶ X)
(right_projection    : product ⟶ Y)
(map                 : ∀ {Z : C} (f : Z ⟶ X) (g : Z ⟶ Y), Z ⟶ product)
(left_factorisation  : ∀ {Z : C} (f : Z ⟶ X) (g : Z ⟶ Y), (map f g) ≫ left_projection  = f . obviously)
(right_factorisation : ∀ {Z : C} (f : Z ⟶ X) (g : Z ⟶ Y), (map f g) ≫ right_projection = g . obviously)
(uniqueness          : ∀ {Z : C} (f g : Z ⟶ product)
                          (left_witness  : f ≫ left_projection  = g ≫ left_projection )
                          (right_witness : f ≫ right_projection = g ≫ right_projection), f = g . obviously)

restate_axiom BinaryProduct.left_factorisation
restate_axiom BinaryProduct.right_factorisation
restate_axiom BinaryProduct.uniqueness
attribute [simp,ematch] BinaryProduct.left_factorisation_lemma BinaryProduct.right_factorisation_lemma
attribute [back] BinaryProduct.left_projection BinaryProduct.right_projection BinaryProduct.map
attribute [back] BinaryProduct.uniqueness_lemma

structure Product {I : Type w} (F : I → C) :=
(product       : C)
(projection    : Π i : I, product ⟶ (F i))
(map           : ∀ {Z : C} (f : Π i : I, Z ⟶ (F i)), Z ⟶ product)
(factorisation : ∀ {Z : C} (f : Π i : I, Z ⟶ (F i)) (i : I), (map f) ≫ (projection i) = f i . obviously)
(uniqueness    : ∀ {Z : C} (f g : Z ⟶ product) (witness : ∀ i : I, f ≫ (projection i) = g ≫ (projection i)), f = g . obviously)

restate_axiom Product.factorisation
restate_axiom Product.uniqueness
attribute [simp,ematch] Product.factorisation_lemma
attribute [back] Product.projection Product.map
attribute [back] Product.uniqueness_lemma

structure Coequalizer (f g : X ⟶ Y) :=
(coequalizer   : C)
(projection    : Y ⟶ coequalizer)
(map           : ∀ {Z : C} (k : Y ⟶ Z) (w : f ≫ k = g ≫ k), coequalizer ⟶ Z)
(witness       : f ≫ projection = g ≫ projection . obviously)
(factorisation : ∀ {Z : C} (k : Y ⟶ Z) (w : f ≫ k = g ≫ k), projection ≫ (map k w) = k . obviously)
(uniqueness    : ∀ {Z : C} (a b : coequalizer ⟶ Z) (witness : projection ≫ a = projection ≫ b), a = b . obviously)

restate_axiom Coequalizer.witness
restate_axiom Coequalizer.factorisation
restate_axiom Coequalizer.uniqueness
attribute [simp,ematch] Coequalizer.factorisation_lemma
attribute [back] Coequalizer.projection Coequalizer.map
attribute [back] Coequalizer.uniqueness_lemma

structure BinaryCoproduct (X Y : C) :=
(coproduct           : C)
(left_inclusion      : X ⟶ coproduct)
(right_inclusion     : Y ⟶ coproduct)
(map                 : ∀ {Z : C} (f : X ⟶ Z) (g : Y ⟶ Z), coproduct ⟶ Z)
(left_factorisation  : ∀ {Z : C} (f : X ⟶ Z) (g : Y ⟶ Z), left_inclusion ≫ (map f g)  = f . obviously)
(right_factorisation : ∀ {Z : C} (f : X ⟶ Z) (g : Y ⟶ Z), right_inclusion ≫ (map f g) = g . obviously)
(uniqueness          : ∀ {Z : C} (f g : coproduct ⟶ Z)
                          (left_witness  : left_inclusion ≫ f = left_inclusion ≫ g)
                          (right_witness : right_inclusion ≫ f = right_inclusion ≫ g), f = g . obviously)

restate_axiom BinaryCoproduct.left_factorisation
restate_axiom BinaryCoproduct.right_factorisation
restate_axiom BinaryCoproduct.uniqueness
attribute [simp,ematch] BinaryCoproduct.left_factorisation_lemma BinaryCoproduct.right_factorisation_lemma
attribute [back] BinaryCoproduct.left_inclusion BinaryCoproduct.right_inclusion BinaryCoproduct.map
attribute [back] BinaryCoproduct.uniqueness_lemma

structure Coproduct {I : Type w} (X : I → C) :=
(coproduct     : C)
(inclusion     : Π i : I, (X i) ⟶ coproduct)
(map           : ∀ {Z : C} (f : Π i : I, (X i) ⟶ Z), coproduct ⟶ Z)
(factorisation : ∀ {Z : C} (f : Π i : I, (X i) ⟶ Z) (i : I), (inclusion i) ≫ (map f) = f i . obviously)
(uniqueness    : ∀ {Z : C} (f g : coproduct ⟶ Z) (witness : ∀ i : I, (inclusion i) ≫ f = (inclusion i) ≫ g), f = g . obviously)

restate_axiom Coproduct.factorisation
restate_axiom Coproduct.uniqueness
attribute [simp,ematch] Coproduct.factorisation_lemma
attribute [back] Coproduct.inclusion Coproduct.map
attribute [back] Coproduct.uniqueness_lemma

structure Pullback {X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) :=
(pullback : C)
(h : pullback ⟶ X)
(k : pullback ⟶ Y)
(commutativity : h ≫ f = k ≫ g)
(map : ∀ {P} {h' : P ⟶ X} {k' : P ⟶ Y} (w : h' ≫ f = k' ≫ g), P ⟶ pullback)
(factorisation : ∀ {P} {h' : P ⟶ X} {k' : P ⟶ Y} (w : h' ≫ f = k' ≫ g), (map w ≫ h) = h' ∧ (map w ≫ k) = k')
(uniqueness : ∀ {P} {h' : P ⟶ X} {k' : P ⟶ Y} (w : h' ≫ f = k' ≫ g) (m n : P ⟶ pullback) (w' : (m ≫ h) = h' ∧ (m ≫ k) = k' ∧ (n ≫ h) = h' ∧ (n ≫ k) = k'), m = n)

-- Coming in later PRs: all these things special cases of (co)limits, and hence are unique up to unique isomorphism.

end category_theory.universal


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

! This file was ported from Lean 3 source module analysis.complex.abs_max
! 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.Analysis.Complex.CauchyIntegral
import Mathbin.Analysis.NormedSpace.Completion
import Mathbin.Analysis.NormedSpace.Extr
import Mathbin.Topology.Algebra.Order.ExtrClosure

/-!
# Maximum modulus principle

In this file we prove several versions of the maximum modulus principle. There are several
statements that can be called "the maximum modulus principle" for maps between normed complex
spaces. They differ by assumptions on the domain (any space, a nontrivial space, a finite
dimensional space), assumptions on the codomain (any space, a strictly convex space), and by
conclusion (either equality of norms or of the values of the function).

## Main results

### Theorems for any codomain

Consider a function `f : E → F` that is complex differentiable on a set `s`, is continuous on its
closure, and `‖f x‖` has a maximum on `s` at `c`. We prove the following theorems.

- `complex.norm_eq_on_closed_ball_of_is_max_on`: if `s = metric.ball c r`, then `‖f x‖ = ‖f c‖` for
  any `x` from the corresponding closed ball;

- `complex.norm_eq_norm_of_is_max_on_of_ball_subset`: if `metric.ball c (dist w c) ⊆ s`, then
  `‖f w‖ = ‖f c‖`;

- `complex.norm_eq_on_of_is_preconnected_of_is_max_on`: if `U` is an open (pre)connected set, `f` is
  complex differentiable on `U`, and `‖f x‖` has a maximum on `U` at `c ∈ U`, then `‖f x‖ = ‖f c‖`
  for all `x ∈ U`;

- `complex.norm_eq_on_closure_of_is_preconnected_of_is_max_on`: if `s` is open and (pre)connected
  and `c ∈ s`, then `‖f x‖ = ‖f c‖` for all `x ∈ closure s`;

- `complex.norm_eventually_eq_of_is_local_max`: if `f` is complex differentiable in a neighborhood
  of `c` and `‖f x‖` has a local maximum at `c`, then `‖f x‖` is locally a constant in a
  neighborhood of `c`.

### Theorems for a strictly convex codomain

If the codomain `F` is a strictly convex space, then in the lemmas from the previous section we can
prove `f w = f c` instead of `‖f w‖ = ‖f c‖`, see
`complex.eq_on_of_is_preconnected_of_is_max_on_norm`,
`complex.eq_on_closure_of_is_preconnected_of_is_max_on_norm`,
`complex.eq_of_is_max_on_of_ball_subset`, `complex.eq_on_closed_ball_of_is_max_on_norm`, and
`complex.eventually_eq_of_is_local_max_norm`.

### Values on the frontier

Finally, we prove some corollaries that relate the (norm of the) values of a function on a set to
its values on the frontier of the set. All these lemmas assume that `E` is a nontrivial space.  In
this section `f g : E → F` are functions that are complex differentiable on a bounded set `s` and
are continuous on its closure. We prove the following theorems.

- `complex.exists_mem_frontier_is_max_on_norm`: If `E` is a finite dimensional space and `s` is a
  nonempty bounded set, then there exists a point `z ∈ frontier s` such that `λ z, ‖f z‖` takes it
  maximum value on `closure s` at `z`.

- `complex.norm_le_of_forall_mem_frontier_norm_le`: if `‖f z‖ ≤ C` for all `z ∈ frontier s`, then
  `‖f z‖ ≤ C` for all `z ∈ s`; note that this theorem does not require `E` to be a finite
  dimensional space.

- `complex.eq_on_closure_of_eq_on_frontier`: if `f x = g x` on the frontier of `s`, then `f x = g x`
  on `closure s`;

- `complex.eq_on_of_eq_on_frontier`: if `f x = g x` on the frontier of `s`, then `f x = g x`
  on `s`.

## Tags

maximum modulus principle, complex analysis
-/

open TopologicalSpace Metric Set Filter Asymptotics Function MeasureTheory AffineMap

open Topology Filter NNReal Real

universe u v w

variable {E : Type u} [NormedAddCommGroup E] [NormedSpace ℂ E] {F : Type v} [NormedAddCommGroup F]
  [NormedSpace ℂ F]

-- mathport name: «expr ̂»
local postfix:100 "̂" => UniformSpace.Completion

namespace Complex

/-!
### Auxiliary lemmas

We split the proof into a series of lemmas. First we prove the principle for a function `f : ℂ → F`
with an additional assumption that `F` is a complete space, then drop unneeded assumptions one by
one.

The lemmas with names `*_auxₙ` are considered to be private and should not be used outside of this
file.
-/

theorem norm_max_aux₁ [CompleteSpace F] {f : ℂ → F} {z w : ℂ}
    (hd : DiffContOnCl ℂ f (ball z (dist w z)))
    (hz : IsMaxOn (norm ∘ f) (closedBall z (dist w z)) z) : ‖f w‖ = ‖f z‖ :=
  by
  -- Consider a circle of radius `r = dist w z`.
  set r : ℝ := dist w z
  have hw : w ∈ closed_ball z r := mem_closed_ball.2 le_rfl
  -- Assume the converse. Since `‖f w‖ ≤ ‖f z‖`, we have `‖f w‖ < ‖f z‖`.
  refine' (isMaxOn_iff.1 hz _ hw).antisymm (not_lt.1 _)
  rintro hw_lt : ‖f w‖ < ‖f z‖
  have hr : 0 < r := dist_pos.2 (ne_of_apply_ne (norm ∘ f) hw_lt.ne)
  -- Due to Cauchy integral formula, it suffices to prove the following inequality.
  suffices ‖∮ ζ in C(z, r), (ζ - z)⁻¹ • f ζ‖ < 2 * π * ‖f z‖
    by
    refine' this.ne _
    have A : (∮ ζ in C(z, r), (ζ - z)⁻¹ • f ζ) = (2 * π * I : ℂ) • f z :=
      hd.circle_integral_sub_inv_smul (mem_ball_self hr)
    simp [A, norm_smul, real.pi_pos.le]
  suffices ‖∮ ζ in C(z, r), (ζ - z)⁻¹ • f ζ‖ < 2 * π * r * (‖f z‖ / r) by
    rwa [mul_assoc, mul_div_cancel' _ hr.ne'] at this
  /- This inequality is true because `‖(ζ - z)⁻¹ • f ζ‖ ≤ ‖f z‖ / r` for all `ζ` on the circle and
    this inequality is strict at `ζ = w`. -/
  have hsub : sphere z r ⊆ closed_ball z r := sphere_subset_closed_ball
  refine' circleIntegral.norm_integral_lt_of_norm_le_const_of_lt hr _ _ ⟨w, rfl, _⟩
  show ContinuousOn (fun ζ : ℂ => (ζ - z)⁻¹ • f ζ) (sphere z r)
  · refine'
      ((continuous_on_id.sub continuousOn_const).inv₀ _).smul (hd.continuous_on_ball.mono hsub)
    exact fun ζ hζ => sub_ne_zero.2 (ne_of_mem_sphere hζ hr.ne')
  show ∀ ζ ∈ sphere z r, ‖(ζ - z)⁻¹ • f ζ‖ ≤ ‖f z‖ / r
  · rintro ζ (hζ : abs (ζ - z) = r)
    rw [le_div_iff hr, norm_smul, norm_inv, norm_eq_abs, hζ, mul_comm, mul_inv_cancel_left₀ hr.ne']
    exact hz (hsub hζ)
  show ‖(w - z)⁻¹ • f w‖ < ‖f z‖ / r
  · rw [norm_smul, norm_inv, norm_eq_abs, ← div_eq_inv_mul]
    exact (div_lt_div_right hr).2 hw_lt
#align complex.norm_max_aux₁ Complex.norm_max_aux₁

/-!
Now we drop the assumption `complete_space F` by embedding `F` into its completion.
-/

theorem norm_max_aux₂ {f : ℂ → F} {z w : ℂ} (hd : DiffContOnCl ℂ f (ball z (dist w z)))
    (hz : IsMaxOn (norm ∘ f) (closedBall z (dist w z)) z) : ‖f w‖ = ‖f z‖ :=
  by
  set e : F →L[ℂ] F̂ := UniformSpace.Completion.toComplL
  have he : ∀ x, ‖e x‖ = ‖x‖ := UniformSpace.Completion.norm_coe
  replace hz : IsMaxOn (norm ∘ e ∘ f) (closed_ball z (dist w z)) z
  · simpa only [IsMaxOn, (· ∘ ·), he] using hz
  simpa only [he] using norm_max_aux₁ (e.differentiable.comp_diff_cont_on_cl hd) hz
#align complex.norm_max_aux₂ Complex.norm_max_aux₂

/-!
Then we replace the assumption `is_max_on (norm ∘ f) (closed_ball z r) z` with a seemingly weaker
assumption `is_max_on (norm ∘ f) (ball z r) z`.
-/

theorem norm_max_aux₃ {f : ℂ → F} {z w : ℂ} {r : ℝ} (hr : dist w z = r)
    (hd : DiffContOnCl ℂ f (ball z r)) (hz : IsMaxOn (norm ∘ f) (ball z r) z) : ‖f w‖ = ‖f z‖ :=
  by
  subst r
  rcases eq_or_ne w z with (rfl | hne); · rfl
  rw [← dist_ne_zero] at hne
  exact norm_max_aux₂ hd (closure_ball z hne ▸ hz.closure hd.continuous_on.norm)
#align complex.norm_max_aux₃ Complex.norm_max_aux₃

/-!
### Maximum modulus principle for any codomain

If we do not assume that the codomain is a strictly convex space, then we can only claim that the
**norm** `‖f x‖` is locally constant.
-/

/-!
Finally, we generalize the theorem from a disk in `ℂ` to a closed ball in any normed space.
-/

/-- **Maximum modulus principle** on a closed ball: if `f : E → F` is continuous on a closed ball,
is complex differentiable on the corresponding open ball, and the norm `‖f w‖` takes its maximum
value on the open ball at its center, then the norm `‖f w‖` is constant on the closed ball.  -/
theorem norm_eqOn_closedBall_of_isMaxOn {f : E → F} {z : E} {r : ℝ}
    (hd : DiffContOnCl ℂ f (ball z r)) (hz : IsMaxOn (norm ∘ f) (ball z r) z) :
    EqOn (norm ∘ f) (const E ‖f z‖) (closedBall z r) :=
  by
  intro w hw
  rw [mem_closed_ball, dist_comm] at hw
  rcases eq_or_ne z w with (rfl | hne)
  · rfl
  set e : ℂ → E := line_map z w
  have hde : Differentiable ℂ e := (differentiable_id.smul_const (w - z)).AddConst z
  suffices ‖(f ∘ e) (1 : ℂ)‖ = ‖(f ∘ e) (0 : ℂ)‖ by simpa [e]
  have hr : dist (1 : ℂ) 0 = 1 := by simp
  have hball : maps_to e (ball 0 1) (ball z r) :=
    by
    refine'
      ((lipschitzWith_lineMap z w).mapsTo_ball (mt nndist_eq_zero.1 hne) 0 1).mono subset.rfl _
    simpa only [line_map_apply_zero, mul_one, coe_nndist] using ball_subset_ball hw
  exact
    norm_max_aux₃ hr (hd.comp hde.diff_cont_on_cl hball)
      (hz.comp_maps_to hball (line_map_apply_zero z w))
#align complex.norm_eq_on_closed_ball_of_is_max_on Complex.norm_eqOn_closedBall_of_isMaxOn

/-- **Maximum modulus principle**: if `f : E → F` is complex differentiable on a set `s`, the norm
of `f` takes it maximum on `s` at `z`, and `w` is a point such that the closed ball with center `z`
and radius `dist w z` is included in `s`, then `‖f w‖ = ‖f z‖`. -/
theorem norm_eq_norm_of_isMaxOn_of_ball_subset {f : E → F} {s : Set E} {z w : E}
    (hd : DiffContOnCl ℂ f s) (hz : IsMaxOn (norm ∘ f) s z) (hsub : ball z (dist w z) ⊆ s) :
    ‖f w‖ = ‖f z‖ :=
  norm_eqOn_closedBall_of_isMaxOn (hd.mono hsub) (hz.on_subset hsub) (mem_closedBall.2 le_rfl)
#align complex.norm_eq_norm_of_is_max_on_of_ball_subset Complex.norm_eq_norm_of_isMaxOn_of_ball_subset

/-- **Maximum modulus principle**: if `f : E → F` is complex differentiable in a neighborhood of `c`
and the norm `‖f z‖` has a local maximum at `c`, then `‖f z‖` is locally constant in a neighborhood
of `c`. -/
theorem norm_eventually_eq_of_isLocalMax {f : E → F} {c : E}
    (hd : ∀ᶠ z in 𝓝 c, DifferentiableAt ℂ f z) (hc : IsLocalMax (norm ∘ f) c) :
    ∀ᶠ y in 𝓝 c, ‖f y‖ = ‖f c‖ :=
  by
  rcases nhds_basis_closed_ball.eventually_iff.1 (hd.and hc) with ⟨r, hr₀, hr⟩
  exact
    nhds_basis_closed_ball.eventually_iff.2
      ⟨r, hr₀,
        norm_eq_on_closed_ball_of_is_max_on
          (DifferentiableOn.diffContOnCl fun x hx =>
            (hr <| closure_ball_subset_closed_ball hx).1.DifferentiableWithinAt)
          fun x hx => (hr <| ball_subset_closed_ball hx).2⟩
#align complex.norm_eventually_eq_of_is_local_max Complex.norm_eventually_eq_of_isLocalMax

theorem isOpen_setOf_mem_nhds_and_isMaxOn_norm {f : E → F} {s : Set E}
    (hd : DifferentiableOn ℂ f s) : IsOpen { z | s ∈ 𝓝 z ∧ IsMaxOn (norm ∘ f) s z } :=
  by
  refine' isOpen_iff_mem_nhds.2 fun z hz => (eventually_eventually_nhds.2 hz.1).And _
  replace hd : ∀ᶠ w in 𝓝 z, DifferentiableAt ℂ f w; exact hd.eventually_differentiable_at hz.1
  exact
    (norm_eventually_eq_of_is_local_max hd <| hz.2.IsLocalMax hz.1).mono fun x hx y hy =>
      le_trans (hz.2 hy) hx.ge
#align complex.is_open_set_of_mem_nhds_and_is_max_on_norm Complex.isOpen_setOf_mem_nhds_and_isMaxOn_norm

/-- **Maximum modulus principle** on a connected set. Let `U` be a (pre)connected open set in a
complex normed space. Let `f : E → F` be a function that is complex differentiable on `U`. Suppose
that `‖f x‖` takes its maximum value on `U` at `c ∈ U`. Then `‖f x‖ = ‖f c‖` for all `x ∈ U`. -/
theorem norm_eqOn_of_isPreconnected_of_isMaxOn {f : E → F} {U : Set E} {c : E}
    (hc : IsPreconnected U) (ho : IsOpen U) (hd : DifferentiableOn ℂ f U) (hcU : c ∈ U)
    (hm : IsMaxOn (norm ∘ f) U c) : EqOn (norm ∘ f) (const E ‖f c‖) U :=
  by
  set V := U ∩ { z | IsMaxOn (norm ∘ f) U z }
  have hV : ∀ x ∈ V, ‖f x‖ = ‖f c‖ := fun x hx => le_antisymm (hm hx.1) (hx.2 hcU)
  suffices : U ⊆ V
  exact fun x hx => hV x (this hx)
  have hVo : IsOpen V := by
    simpa only [ho.mem_nhds_iff, set_of_and, set_of_mem_eq] using
      is_open_set_of_mem_nhds_and_is_max_on_norm hd
  have hVne : (U ∩ V).Nonempty := ⟨c, hcU, hcU, hm⟩
  set W := U ∩ { z | ‖f z‖ ≠ ‖f c‖ }
  have hWo : IsOpen W := hd.continuous_on.norm.preimage_open_of_open ho isOpen_ne
  have hdVW : Disjoint V W := disjoint_left.mpr fun x hxV hxW => hxW.2 (hV x hxV)
  have hUVW : U ⊆ V ∪ W := fun x hx =>
    (eq_or_ne ‖f x‖ ‖f c‖).imp (fun h => ⟨hx, fun y hy => (hm hy).out.trans_eq h.symm⟩)
      (And.intro hx)
  exact hc.subset_left_of_subset_union hVo hWo hdVW hUVW hVne
#align complex.norm_eq_on_of_is_preconnected_of_is_max_on Complex.norm_eqOn_of_isPreconnected_of_isMaxOn

/-- **Maximum modulus principle** on a connected set. Let `U` be a (pre)connected open set in a
complex normed space.  Let `f : E → F` be a function that is complex differentiable on `U` and is
continuous on its closure. Suppose that `‖f x‖` takes its maximum value on `U` at `c ∈ U`. Then
`‖f x‖ = ‖f c‖` for all `x ∈ closure U`. -/
theorem norm_eqOn_closure_of_isPreconnected_of_isMaxOn {f : E → F} {U : Set E} {c : E}
    (hc : IsPreconnected U) (ho : IsOpen U) (hd : DiffContOnCl ℂ f U) (hcU : c ∈ U)
    (hm : IsMaxOn (norm ∘ f) U c) : EqOn (norm ∘ f) (const E ‖f c‖) (closure U) :=
  (norm_eqOn_of_isPreconnected_of_isMaxOn hc ho hd.DifferentiableOn hcU hm).of_subset_closure
    hd.ContinuousOn.norm continuousOn_const subset_closure Subset.rfl
#align complex.norm_eq_on_closure_of_is_preconnected_of_is_max_on Complex.norm_eqOn_closure_of_isPreconnected_of_isMaxOn

section StrictConvex

/-!
### The case of a strictly convex codomain

If the codomain `F` is a strictly convex space, then we can claim equalities like `f w = f z`
instead of `‖f w‖ = ‖f z‖`.

Instead of repeating the proof starting with lemmas about integrals, we apply a corresponding lemma
above twice: for `f` and for `λ x, f x + f c`.  Then we have `‖f w‖ = ‖f z‖` and
`‖f w + f z‖ = ‖f z + f z‖`, thus `‖f w + f z‖ = ‖f w‖ + ‖f z‖`. This is only possible if
`f w = f z`, see `eq_of_norm_eq_of_norm_add_eq`.
-/

variable [StrictConvexSpace ℝ F]

/-- **Maximum modulus principle** on a connected set. Let `U` be a (pre)connected open set in a
complex normed space.  Let `f : E → F` be a function that is complex differentiable on `U`. Suppose
that `‖f x‖` takes its maximum value on `U` at `c ∈ U`. Then `f x = f c` for all `x ∈ U`.

TODO: change assumption from `is_max_on` to `is_local_max`. -/
theorem eqOn_of_isPreconnected_of_isMaxOn_norm {f : E → F} {U : Set E} {c : E}
    (hc : IsPreconnected U) (ho : IsOpen U) (hd : DifferentiableOn ℂ f U) (hcU : c ∈ U)
    (hm : IsMaxOn (norm ∘ f) U c) : EqOn f (const E (f c)) U := fun x hx =>
  have H₁ : ‖f x‖ = ‖f c‖ := norm_eqOn_of_isPreconnected_of_isMaxOn hc ho hd hcU hm hx
  have H₂ : ‖f x + f c‖ = ‖f c + f c‖ :=
    norm_eqOn_of_isPreconnected_of_isMaxOn hc ho (hd.AddConst _) hcU hm.norm_add_self hx
  eq_of_norm_eq_of_norm_add_eq H₁ <| by simp only [H₂, same_ray.rfl.norm_add, H₁]
#align complex.eq_on_of_is_preconnected_of_is_max_on_norm Complex.eqOn_of_isPreconnected_of_isMaxOn_norm

/-- **Maximum modulus principle** on a connected set. Let `U` be a (pre)connected open set in a
complex normed space.  Let `f : E → F` be a function that is complex differentiable on `U` and is
continuous on its closure. Suppose that `‖f x‖` takes its maximum value on `U` at `c ∈ U`. Then
`f x = f c` for all `x ∈ closure U`. -/
theorem eqOn_closure_of_isPreconnected_of_isMaxOn_norm {f : E → F} {U : Set E} {c : E}
    (hc : IsPreconnected U) (ho : IsOpen U) (hd : DiffContOnCl ℂ f U) (hcU : c ∈ U)
    (hm : IsMaxOn (norm ∘ f) U c) : EqOn f (const E (f c)) (closure U) :=
  (eqOn_of_isPreconnected_of_isMaxOn_norm hc ho hd.DifferentiableOn hcU hm).of_subset_closure
    hd.ContinuousOn continuousOn_const subset_closure Subset.rfl
#align complex.eq_on_closure_of_is_preconnected_of_is_max_on_norm Complex.eqOn_closure_of_isPreconnected_of_isMaxOn_norm

/-- **Maximum modulus principle**. Let `f : E → F` be a function between complex normed spaces.
Suppose that the codomain `F` is a strictly convex space, `f` is complex differentiable on a set
`s`, `f` is continuous on the closure of `s`, the norm of `f` takes it maximum on `s` at `z`, and
`w` is a point such that the closed ball with center `z` and radius `dist w z` is included in `s`,
then `f w = f z`. -/
theorem eq_of_isMaxOn_of_ball_subset {f : E → F} {s : Set E} {z w : E} (hd : DiffContOnCl ℂ f s)
    (hz : IsMaxOn (norm ∘ f) s z) (hsub : ball z (dist w z) ⊆ s) : f w = f z :=
  have H₁ : ‖f w‖ = ‖f z‖ := norm_eq_norm_of_isMaxOn_of_ball_subset hd hz hsub
  have H₂ : ‖f w + f z‖ = ‖f z + f z‖ :=
    norm_eq_norm_of_isMaxOn_of_ball_subset (hd.AddConst _) hz.norm_add_self hsub
  eq_of_norm_eq_of_norm_add_eq H₁ <| by simp only [H₂, same_ray.rfl.norm_add, H₁]
#align complex.eq_of_is_max_on_of_ball_subset Complex.eq_of_isMaxOn_of_ball_subset

/-- **Maximum modulus principle** on a closed ball. Suppose that a function `f : E → F` from a
normed complex space to a strictly convex normed complex space has the following properties:

- it is continuous on a closed ball `metric.closed_ball z r`,
- it is complex differentiable on the corresponding open ball;
- the norm `‖f w‖` takes its maximum value on the open ball at its center.

Then `f` is a constant on the closed ball.  -/
theorem eqOn_closedBall_of_isMaxOn_norm {f : E → F} {z : E} {r : ℝ}
    (hd : DiffContOnCl ℂ f (ball z r)) (hz : IsMaxOn (norm ∘ f) (ball z r) z) :
    EqOn f (const E (f z)) (closedBall z r) := fun x hx =>
  eq_of_isMaxOn_of_ball_subset hd hz <| ball_subset_ball hx
#align complex.eq_on_closed_ball_of_is_max_on_norm Complex.eqOn_closedBall_of_isMaxOn_norm

/-- **Maximum modulus principle**: if `f : E → F` is complex differentiable in a neighborhood of `c`
and the norm `‖f z‖` has a local maximum at `c`, then `f` is locally constant in a neighborhood
of `c`. -/
theorem eventually_eq_of_isLocalMax_norm {f : E → F} {c : E}
    (hd : ∀ᶠ z in 𝓝 c, DifferentiableAt ℂ f z) (hc : IsLocalMax (norm ∘ f) c) :
    ∀ᶠ y in 𝓝 c, f y = f c :=
  by
  rcases nhds_basis_closed_ball.eventually_iff.1 (hd.and hc) with ⟨r, hr₀, hr⟩
  exact
    nhds_basis_closed_ball.eventually_iff.2
      ⟨r, hr₀,
        eq_on_closed_ball_of_is_max_on_norm
          (DifferentiableOn.diffContOnCl fun x hx =>
            (hr <| closure_ball_subset_closed_ball hx).1.DifferentiableWithinAt)
          fun x hx => (hr <| ball_subset_closed_ball hx).2⟩
#align complex.eventually_eq_of_is_local_max_norm Complex.eventually_eq_of_isLocalMax_norm

theorem eventually_eq_or_eq_zero_of_isLocalMin_norm {f : E → ℂ} {c : E}
    (hf : ∀ᶠ z in 𝓝 c, DifferentiableAt ℂ f z) (hc : IsLocalMin (norm ∘ f) c) :
    (∀ᶠ z in 𝓝 c, f z = f c) ∨ f c = 0 :=
  by
  refine' or_iff_not_imp_right.mpr fun h => _
  have h1 : ∀ᶠ z in 𝓝 c, f z ≠ 0 := hf.self_of_nhds.continuous_at.eventually_ne h
  have h2 : IsLocalMax (norm ∘ f)⁻¹ c := hc.inv (h1.mono fun z => norm_pos_iff.mpr)
  have h3 : IsLocalMax (norm ∘ f⁻¹) c := by refine' h2.congr (eventually_of_forall _) <;> simp
  have h4 : ∀ᶠ z in 𝓝 c, DifferentiableAt ℂ f⁻¹ z := by filter_upwards [hf, h1]with z h using h.inv
  filter_upwards [eventually_eq_of_is_local_max_norm h4 h3]with z using inv_inj.mp
#align complex.eventually_eq_or_eq_zero_of_is_local_min_norm Complex.eventually_eq_or_eq_zero_of_isLocalMin_norm

end StrictConvex

/-!
### Maximum on a set vs maximum on its frontier

In this section we prove corollaries of the maximum modulus principle that relate the values of a
function on a set to its values on the frontier of this set.
-/

variable [Nontrivial E]

/-- **Maximum modulus principle**: if `f : E → F` is complex differentiable on a nonempty bounded
set `U` and is continuous on its closure, then there exists a point `z ∈ frontier U` such that
`λ z, ‖f z‖` takes it maximum value on `closure U` at `z`. -/
theorem exists_mem_frontier_isMaxOn_norm [FiniteDimensional ℂ E] {f : E → F} {U : Set E}
    (hb : Bounded U) (hne : U.Nonempty) (hd : DiffContOnCl ℂ f U) :
    ∃ z ∈ frontier U, IsMaxOn (norm ∘ f) (closure U) z :=
  by
  have hc : IsCompact (closure U) := hb.is_compact_closure
  obtain ⟨w, hwU, hle⟩ : ∃ w ∈ closure U, IsMaxOn (norm ∘ f) (closure U) w
  exact hc.exists_forall_ge hne.closure hd.continuous_on.norm
  rw [closure_eq_interior_union_frontier, mem_union] at hwU
  cases hwU
  rotate_left
  · exact ⟨w, hwU, hle⟩
  have : interior U ≠ univ := ne_top_of_le_ne_top hc.ne_univ interior_subset_closure
  rcases exists_mem_frontier_infDist_compl_eq_dist hwU this with ⟨z, hzU, hzw⟩
  refine' ⟨z, frontier_interior_subset hzU, fun x hx => (mem_set_of_eq.mp <| hle hx).trans_eq _⟩
  refine' (norm_eq_norm_of_is_max_on_of_ball_subset hd (hle.on_subset subset_closure) _).symm
  rw [dist_comm, ← hzw]
  exact ball_inf_dist_compl_subset.trans interior_subset
#align complex.exists_mem_frontier_is_max_on_norm Complex.exists_mem_frontier_isMaxOn_norm

/-- **Maximum modulus principle**: if `f : E → F` is complex differentiable on a bounded set `U` and
`‖f z‖ ≤ C` for any `z ∈ frontier U`, then the same is true for any `z ∈ closure U`. -/
theorem norm_le_of_forall_mem_frontier_norm_le {f : E → F} {U : Set E} (hU : Bounded U)
    (hd : DiffContOnCl ℂ f U) {C : ℝ} (hC : ∀ z ∈ frontier U, ‖f z‖ ≤ C) {z : E}
    (hz : z ∈ closure U) : ‖f z‖ ≤ C :=
  by
  rw [closure_eq_self_union_frontier, union_comm, mem_union] at hz
  cases hz
  · exact hC z hz
  /- In case of a finite dimensional domain, one can just apply
    `complex.exists_mem_frontier_is_max_on_norm`. To make it work in any Banach space, we restrict
    the function to a line first. -/
  rcases exists_ne z with ⟨w, hne⟩
  set e : ℂ → E := line_map z w
  have hde : Differentiable ℂ e := (differentiable_id.smul_const (w - z)).AddConst z
  have hL : AntilipschitzWith (nndist z w)⁻¹ e := antilipschitzWith_lineMap hne.symm
  replace hd : DiffContOnCl ℂ (f ∘ e) (e ⁻¹' U)
  exact hd.comp hde.diff_cont_on_cl (maps_to_preimage _ _)
  have h₀ : (0 : ℂ) ∈ e ⁻¹' U := by simpa only [e, mem_preimage, line_map_apply_zero]
  rcases exists_mem_frontier_is_max_on_norm (hL.bounded_preimage hU) ⟨0, h₀⟩ hd with ⟨ζ, hζU, hζ⟩
  calc
    ‖f z‖ = ‖f (e 0)‖ := by simp only [e, line_map_apply_zero]
    _ ≤ ‖f (e ζ)‖ := (hζ (subset_closure h₀))
    _ ≤ C := hC _ (hde.continuous.frontier_preimage_subset _ hζU)

#align complex.norm_le_of_forall_mem_frontier_norm_le Complex.norm_le_of_forall_mem_frontier_norm_le

/-- If two complex differentiable functions `f g : E → F` are equal on the boundary of a bounded set
`U`, then they are equal on `closure U`. -/
theorem eqOn_closure_of_eqOn_frontier {f g : E → F} {U : Set E} (hU : Bounded U)
    (hf : DiffContOnCl ℂ f U) (hg : DiffContOnCl ℂ g U) (hfg : EqOn f g (frontier U)) :
    EqOn f g (closure U) :=
  by
  suffices H : ∀ z ∈ closure U, ‖(f - g) z‖ ≤ 0; · simpa [sub_eq_zero] using H
  refine' fun z hz => norm_le_of_forall_mem_frontier_norm_le hU (hf.sub hg) (fun w hw => _) hz
  simp [hfg hw]
#align complex.eq_on_closure_of_eq_on_frontier Complex.eqOn_closure_of_eqOn_frontier

/-- If two complex differentiable functions `f g : E → F` are equal on the boundary of a bounded set
`U`, then they are equal on `U`. -/
theorem eqOn_of_eqOn_frontier {f g : E → F} {U : Set E} (hU : Bounded U) (hf : DiffContOnCl ℂ f U)
    (hg : DiffContOnCl ℂ g U) (hfg : EqOn f g (frontier U)) : EqOn f g U :=
  (eqOn_closure_of_eqOn_frontier hU hf hg hfg).mono subset_closure
#align complex.eq_on_of_eq_on_frontier Complex.eqOn_of_eqOn_frontier

end Complex


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Aaron Anderson
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.finset.fold
import Mathlib.data.multiset.gcd
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# GCD and LCM operations on finsets

## Main definitions

- `finset.gcd` - the greatest common denominator of a `finset` of elements of a `gcd_monoid`
- `finset.lcm` - the least common multiple of a `finset` of elements of a `gcd_monoid`

## Implementation notes

Many of the proofs use the lemmas `gcd.def` and `lcm.def`, which relate `finset.gcd`
and `finset.lcm` to `multiset.gcd` and `multiset.lcm`.

TODO: simplify with a tactic and `data.finset.lattice`

## Tags

finset, gcd
-/

namespace finset

/-! ### lcm -/

/-- Least common multiple of a finite set -/
def lcm {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α] (s : finset β) (f : β → α) : α :=
  fold lcm 1 f s

theorem lcm_def {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α] {s : finset β} {f : β → α} : lcm s f = multiset.lcm (multiset.map f (val s)) :=
  rfl

@[simp] theorem lcm_empty {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α] {f : β → α} : lcm ∅ f = 1 :=
  fold_empty

@[simp] theorem lcm_dvd_iff {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α] {s : finset β} {f : β → α} {a : α} : lcm s f ∣ a ↔ ∀ (b : β), b ∈ s → f b ∣ a := sorry

theorem lcm_dvd {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α] {s : finset β} {f : β → α} {a : α} : (∀ (b : β), b ∈ s → f b ∣ a) → lcm s f ∣ a :=
  iff.mpr lcm_dvd_iff

theorem dvd_lcm {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α] {s : finset β} {f : β → α} {b : β} (hb : b ∈ s) : f b ∣ lcm s f :=
  iff.mp lcm_dvd_iff (dvd_refl (lcm s f)) b hb

@[simp] theorem lcm_insert {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α] {s : finset β} {f : β → α} [DecidableEq β] {b : β} : lcm (insert b s) f = lcm (f b) (lcm s f) := sorry

@[simp] theorem lcm_singleton {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α] {f : β → α} {b : β} : lcm (singleton b) f = coe_fn normalize (f b) :=
  multiset.lcm_singleton

@[simp] theorem normalize_lcm {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α] {s : finset β} {f : β → α} : coe_fn normalize (lcm s f) = lcm s f := sorry

theorem lcm_union {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α] {s₁ : finset β} {s₂ : finset β} {f : β → α} [DecidableEq β] : lcm (s₁ ∪ s₂) f = lcm (lcm s₁ f) (lcm s₂ f) := sorry

theorem lcm_congr {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α] {s₁ : finset β} {s₂ : finset β} {f : β → α} {g : β → α} (hs : s₁ = s₂) (hfg : ∀ (a : β), a ∈ s₂ → f a = g a) : lcm s₁ f = lcm s₂ g :=
  Eq._oldrec (fun (hfg : ∀ (a : β), a ∈ s₁ → f a = g a) => fold_congr hfg) hs hfg

theorem lcm_mono_fun {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α] {s : finset β} {f : β → α} {g : β → α} (h : ∀ (b : β), b ∈ s → f b ∣ g b) : lcm s f ∣ lcm s g :=
  lcm_dvd fun (b : β) (hb : b ∈ s) => dvd_trans (h b hb) (dvd_lcm hb)

theorem lcm_mono {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α] {s₁ : finset β} {s₂ : finset β} {f : β → α} (h : s₁ ⊆ s₂) : lcm s₁ f ∣ lcm s₂ f :=
  lcm_dvd fun (b : β) (hb : b ∈ s₁) => dvd_lcm (h hb)

/-! ### gcd -/

/-- Greatest common divisor of a finite set -/
def gcd {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α] (s : finset β) (f : β → α) : α :=
  fold gcd 0 f s

theorem gcd_def {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α] {s : finset β} {f : β → α} : gcd s f = multiset.gcd (multiset.map f (val s)) :=
  rfl

@[simp] theorem gcd_empty {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α] {f : β → α} : gcd ∅ f = 0 :=
  fold_empty

theorem dvd_gcd_iff {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α] {s : finset β} {f : β → α} {a : α} : a ∣ gcd s f ↔ ∀ (b : β), b ∈ s → a ∣ f b := sorry

theorem gcd_dvd {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α] {s : finset β} {f : β → α} {b : β} (hb : b ∈ s) : gcd s f ∣ f b :=
  iff.mp dvd_gcd_iff (dvd_refl (gcd s f)) b hb

theorem dvd_gcd {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α] {s : finset β} {f : β → α} {a : α} : (∀ (b : β), b ∈ s → a ∣ f b) → a ∣ gcd s f :=
  iff.mpr dvd_gcd_iff

@[simp] theorem gcd_insert {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α] {s : finset β} {f : β → α} [DecidableEq β] {b : β} : gcd (insert b s) f = gcd (f b) (gcd s f) := sorry

@[simp] theorem gcd_singleton {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α] {f : β → α} {b : β} : gcd (singleton b) f = coe_fn normalize (f b) :=
  multiset.gcd_singleton

@[simp] theorem normalize_gcd {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α] {s : finset β} {f : β → α} : coe_fn normalize (gcd s f) = gcd s f := sorry

theorem gcd_union {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α] {s₁ : finset β} {s₂ : finset β} {f : β → α} [DecidableEq β] : gcd (s₁ ∪ s₂) f = gcd (gcd s₁ f) (gcd s₂ f) := sorry

theorem gcd_congr {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α] {s₁ : finset β} {s₂ : finset β} {f : β → α} {g : β → α} (hs : s₁ = s₂) (hfg : ∀ (a : β), a ∈ s₂ → f a = g a) : gcd s₁ f = gcd s₂ g :=
  Eq._oldrec (fun (hfg : ∀ (a : β), a ∈ s₁ → f a = g a) => fold_congr hfg) hs hfg

theorem gcd_mono_fun {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α] {s : finset β} {f : β → α} {g : β → α} (h : ∀ (b : β), b ∈ s → f b ∣ g b) : gcd s f ∣ gcd s g :=
  dvd_gcd fun (b : β) (hb : b ∈ s) => dvd_trans (gcd_dvd hb) (h b hb)

theorem gcd_mono {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α] {s₁ : finset β} {s₂ : finset β} {f : β → α} (h : s₁ ⊆ s₂) : gcd s₂ f ∣ gcd s₁ f :=
  dvd_gcd fun (b : β) (hb : b ∈ s₁) => gcd_dvd (h hb)

theorem gcd_eq_zero_iff {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α] {s : finset β} {f : β → α} : gcd s f = 0 ↔ ∀ (x : β), x ∈ s → f x = 0 := sorry

theorem gcd_eq_gcd_filter_ne_zero {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α] {s : finset β} {f : β → α} [decidable_pred fun (x : β) => f x = 0] : gcd s f = gcd (filter (fun (x : β) => f x ≠ 0) s) f := sorry

theorem gcd_mul_left {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α] {s : finset β} {f : β → α} {a : α} : (gcd s fun (x : β) => a * f x) = coe_fn normalize a * gcd s f := sorry

theorem gcd_mul_right {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α] {s : finset β} {f : β → α} {a : α} : (gcd s fun (x : β) => f x * a) = gcd s f * coe_fn normalize a := sorry

end finset

namespace finset

theorem gcd_eq_of_dvd_sub {α : Type u_1} {β : Type u_2} [nontrivial β] [integral_domain α] [gcd_monoid α] {s : finset β} {f : β → α} {g : β → α} {a : α} (h : ∀ (x : β), x ∈ s → a ∣ f x - g x) : gcd a (gcd s f) = gcd a (gcd s g) := sorry


/-
Copyright (c) 2019 Scott Morrison All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.groupoid
import Mathlib.control.equiv_functor
import Mathlib.category_theory.types
import Mathlib.PostPort

universes u₁ v₁ u₂ v₂

namespace Mathlib

namespace category_theory

/-- The core of a category C is the groupoid whose morphisms are all the
isomorphisms of C. -/
def core (C : Type u₁) := C

protected instance core_category {C : Type u₁} [category C] : groupoid (core C) :=
  groupoid.mk fun (X Y : core C) (f : X ⟶ Y) => iso.symm f

namespace core

@[simp] theorem id_hom {C : Type u₁} [category C] (X : core C) : iso.hom 𝟙 = 𝟙 := rfl

@[simp] theorem comp_hom {C : Type u₁} [category C] {X : core C} {Y : core C} {Z : core C}
    (f : X ⟶ Y) (g : Y ⟶ Z) : iso.hom (f ≫ g) = iso.hom f ≫ iso.hom g :=
  rfl

/-- The core of a category is naturally included in the category. -/
def inclusion {C : Type u₁} [category C] : core C ⥤ C :=
  functor.mk id fun (X Y : core C) (f : X ⟶ Y) => iso.hom f

/-- A functor from a groupoid to a category C factors through the core of C. -/
-- Note that this function is not functorial

-- (consider the two functors from [0] to [1], and the natural transformation between them).

def functor_to_core {C : Type u₁} [category C] {G : Type u₂} [groupoid G] (F : G ⥤ C) :
    G ⥤ core C :=
  functor.mk (fun (X : G) => functor.obj F X)
    fun (X Y : G) (f : X ⟶ Y) => iso.mk (functor.map F f) (functor.map F (inv f))

/--
We can functorially associate to any functor from a groupoid to the core of a category `C`,
a functor from the groupoid to `C`, simply by composing with the embedding `core C ⥤ C`.
-/
end core

def core.forget_functor_to_core {C : Type u₁} [category C] {G : Type u₂} [groupoid G] :
    (G ⥤ core C) ⥤ G ⥤ C :=
  functor.obj (whiskering_right G (core C) C) core.inclusion

/--
`of_equiv_functor m` lifts a type-level `equiv_functor`
to a categorical functor `core (Type u₁) ⥤ core (Type u₂)`.
-/
def of_equiv_functor (m : Type u₁ → Type u₂) [equiv_functor m] : core (Type u₁) ⥤ core (Type u₂) :=
  functor.mk m
    fun (α β : core (Type u₁)) (f : α ⟶ β) =>
      equiv.to_iso (equiv_functor.map_equiv m (iso.to_equiv f))

end Mathlib


import .replace_free
import .misc_list

import data.finset

set_option pp.parens true

open formula

def simult_replace_free_aux (σ : variable_ → variable_) : finset variable_ → formula → formula
| _ true_ := true_
| binders (pred_ name args) :=
    pred_
    name
    (args.map (fun (x : variable_), if x ∈ binders then x else σ x))
| binders (eq_ x y) :=
    eq_
    (if x ∈ binders then x else σ x)
    (if y ∈ binders then y else σ y)
| binders (not_ P) := not_ (simult_replace_free_aux binders P)
| binders (imp_ P Q) :=
    imp_
    (simult_replace_free_aux binders P)
    (simult_replace_free_aux binders Q)
| binders (forall_ x P) :=
    forall_ x (simult_replace_free_aux (binders ∪ {x}) P)

def simult_replace_free (σ : variable_ → variable_) (P : formula) : formula := simult_replace_free_aux σ ∅ P

/--
  Specialized version of function.update.
-/
def function.update_ite
  {α β : Type}
  [decidable_eq α]
  (f : α → β)
  (a' : α) (b : β) (a : α) :=
  if a = a' then b else f a

/--
  fast_simult_replace_free σ P := The simultaneous replacement of each free occurence of any variable v in the formula P by σ v.
-/
def fast_simult_replace_free : (variable_ → variable_) → formula → formula
| _ true_ := true_
| σ (pred_ name args) := pred_ name (args.map σ)
| σ (eq_ x y) := eq_ (σ x) (σ y)
| σ (not_ P) := not_ (fast_simult_replace_free σ P)
| σ (imp_ P Q) := imp_ (fast_simult_replace_free σ P) (fast_simult_replace_free σ Q)
| σ (forall_ x P) := forall_ x (fast_simult_replace_free (function.update_ite σ x x) P)

@[simp]
lemma function.update_ite_idem
  {α β : Type}
  [decidable_eq α]
  (f : α → β)
  (a : α)
  (x y : β)  :
  function.update_ite (function.update_ite f a x) a y =
    function.update_ite f a y :=
begin
  funext,
  unfold function.update_ite,
  split_ifs,
  {
    refl,
  },
  {
    refl,
  }
end

lemma function.update_ite_id
  {α : Type}
  [decidable_eq α]
  (x : α) :
  function.update_ite (id : α → α) x x = id :=
begin
  funext,
  unfold function.update_ite,
  split_ifs,
  {
    subst h,
    simp only [id.def],
  },
  {
    refl,
  }
end

lemma fast_simult_replace_free_id
  (P : formula) :
  fast_simult_replace_free id P = P :=
begin
  induction P,
  case formula.true_
  {
    refl,
  },
  case formula.pred_ : name args
  {
    unfold fast_simult_replace_free,
    simp only [list.map_id, eq_self_iff_true, and_self],
  },
  case formula.eq_ : x y
  {
    refl,
  },
  case formula.not_ : P P_ih
  {
    solve_by_elim,
  },
  case formula.imp_ : P Q P_ih Q_ih
  {
    unfold fast_simult_replace_free,
    congr,
    {
      exact P_ih,
    },
    {
      exact Q_ih,
    }
  },
  case formula.forall_ : x P P_ih
  {
    unfold fast_simult_replace_free,
    simp only [eq_self_iff_true, true_and],
    simp only [function.update_ite_id],
    exact P_ih,
  },
end

example
  (P : formula)
  (v t : variable_) :
  fast_simult_replace_free (function.update_ite id v t) P = fast_replace_free v t P :=
begin
  induction P,
  case formula.true_
  {
    refl,
  },
  case formula.pred_ : name args
  {
    refl,
  },
  case formula.eq_ : x y
  {
    refl,
  },
  case formula.not_ : P P_ih
  {
    unfold fast_simult_replace_free,
    unfold fast_replace_free,
    congr,
    exact P_ih,
  },
  case formula.imp_ : P Q P_ih Q_ih
  {
    unfold fast_simult_replace_free,
    unfold fast_replace_free,
    congr,
    {
      exact P_ih,
    },
    {
      exact Q_ih,
    }
  },
  case formula.forall_ : x P P_ih
  {
    unfold fast_simult_replace_free,
    unfold fast_replace_free,
    split_ifs,
    {
      subst h,
      simp only [eq_self_iff_true, function.update_ite_idem, true_and],

      simp only [function.update_ite_id],
      apply fast_simult_replace_free_id,
    },
    {
      have s1 : (function.update_ite (function.update_ite (id : variable_ → variable_) v t) x x) = function.update_ite id v t,
      funext,
      unfold function.update_ite,
      split_ifs,
      {
        subst h_1,
        tauto,
      },
      {
        subst h_1,
        simp only [id.def],
      },
      {
        refl,
      },
      {
        refl,
      },

      simp only [eq_self_iff_true, true_and],
      simp only [s1],
      exact P_ih,
    }
  },
end

lemma huh
  (P : formula)
  (σ σ' : variable_ → variable_)
  (binders : finset variable_)
  (h1 : ∀ (v : variable_), v ∉ binders → σ v = σ' v) :
  simult_replace_free_aux σ binders P =
    simult_replace_free_aux σ' binders P :=
begin
  induction P generalizing binders,
  case formula.true_ : binders h1
  { admit },
  case formula.pred_ : name args binders h1
  {
    unfold simult_replace_free_aux,
    congr' 1,
    simp only [list.map_eq_map_iff],
    intros x a1,
    split_ifs,
    refl,
    exact h1 x h,
  },
  case formula.eq_ : P_ᾰ P_ᾰ_1 binders h1
  { admit },
  case formula.not_ : P_ᾰ P_ih binders h1
  { admit },
  case formula.imp_ : P_ᾰ P_ᾰ_1 P_ih_ᾰ P_ih_ᾰ_1 binders h1
  { admit },
  case formula.forall_ : x P P_ih binders h1
  {
    unfold simult_replace_free_aux,
    congr' 1,
    apply P_ih,
    intros v a1,
    simp only [finset.mem_union, finset.mem_singleton] at a1,
    push_neg at a1,
    cases a1,
    apply h1 v a1_left,
  },
end

example
  (P : formula)
  (σ : variable_ → variable_)
  (binders : finset variable_)
  (h1 : ∀ (v : variable_), v ∈ binders → v = σ v) :
  simult_replace_free_aux σ binders P =
    fast_simult_replace_free σ P :=
begin
  induction P generalizing binders σ,
  case formula.true_ : binders h1
  { admit },
  case formula.pred_ : name args binders σ h1
  {
    unfold fast_simult_replace_free,
    unfold simult_replace_free_aux,
    congr' 1,
    simp only [list.map_eq_map_iff],
    intros x a1,
    split_ifs,
    exact h1 x h,
    refl,
  },
  case formula.eq_ : P_ᾰ P_ᾰ_1 binders σ h1
  { admit },
  case formula.not_ : P_ᾰ P_ih binders σ h1
  { admit },
  case formula.imp_ : P_ᾰ P_ᾰ_1 P_ih_ᾰ P_ih_ᾰ_1 binders σ h1
  { admit },
  case formula.forall_ : x P P_ih binders σ h1
  {
    unfold fast_simult_replace_free,
    unfold simult_replace_free_aux,
    congr,

    rewrite huh P σ (function.update_ite σ x x),
    apply P_ih,
    {
      intros v a1,
      unfold function.update_ite,
      split_ifs,
      {
        exact h,
      },
      {
        simp only [finset.mem_union, finset.mem_singleton] at a1,
        tauto,
      },
    },
    {
      simp only [finset.mem_union, finset.mem_singleton, eq_self_iff_true, or_true],
      push_neg,
      intros v a1,
      cases a1,
      unfold function.update_ite,
      split_ifs,
      contradiction,
      refl,
    }
  },
end


import loops.reparametrization
import to_mathlib.analysis.cut_off
import to_mathlib.topology.hausdorff_distance

noncomputable theory

open set function finite_dimensional prod int topological_space metric filter
open measure_theory measure_theory.measure real
open_locale topology unit_interval

variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E]
          {F : Type*} [normed_add_comm_group F]
          {g b : E → F} {Ω : set (E × F)} {U K C : set E}
variables [normed_space ℝ F] [finite_dimensional ℝ F]

lemma exist_loops_aux1
  (hK : is_compact K)
  (hΩ_op : is_open Ω)
  (hb : 𝒞 ∞ b)
  (hgK : ∀ᶠ x near K, g x = b x)
  (hconv : ∀ x, g x ∈ hull (connected_component_in (prod.mk x ⁻¹' Ω) $ b x)) :
  ∃ (γ : E → ℝ → loop F) (V ∈ 𝓝ˢ K) (ε > 0), surrounding_family_in g b γ V Ω ∧
  (∀ (x ∈ V), ball (x, b x) (ε + ε) ⊆ Ω) ∧
  ∀ (x ∈ V) t s, dist (γ x t s) (b x) < ε :=
begin
  have b_in : ∀ x, (x, b x) ∈ Ω :=
    λ x, (connected_component_in_nonempty_iff.mp (convex_hull_nonempty_iff.mp ⟨g x, hconv x⟩) : _),
  have h2Ω : is_open (Ω ∩ fst ⁻¹' univ), { rwa [preimage_univ, inter_univ] },

  -- we could probably get away with something simpler to get γ₀.
  obtain ⟨γ₀, hγ₀_cont, hγ₀, h2γ₀, h3γ₀, -, hγ₀_surr⟩ := -- γ₀ is γ* in notes
    surrounding_loop_of_convex_hull is_open_univ is_connected_univ
    (by { rw [convex_hull_univ], exact mem_univ 0 }) (mem_univ (0 : F)),
  obtain ⟨ε₀, hε₀, V, hV, hεΩ⟩ :=
    hK.exists_thickening_image hΩ_op (continuous_id.prod_mk hb.continuous) (λ x _, b_in x),
  let range_γ₀ := (λ i : ℝ × ℝ, ‖γ₀ i.1 i.2‖) '' (I ×ˢ I),
  have h4γ₀ : bdd_above range_γ₀ :=
  (is_compact_Icc.prod is_compact_Icc).bdd_above_image (hγ₀_cont.norm.continuous_on),
  have h0 : 0 < 1 + Sup range_γ₀ := add_pos_of_pos_of_nonneg zero_lt_one (le_cSup_of_le h4γ₀
    (mem_image_of_mem _ $ mk_mem_prod unit_interval.zero_mem unit_interval.zero_mem) $
    norm_nonneg _),
  generalize' h0ε₁ : ε₀ / 2 = ε₁,
  have hε₁ : 0 < ε₁ := h0ε₁ ▸ div_pos hε₀ two_pos,
  let ε := ε₁ / (1 + Sup range_γ₀),
  have hε : 0 < ε := div_pos hε₁ h0,
  have h2ε : ∀ t s : ℝ, ‖ε • γ₀ t s‖ < ε₁,
  { intros t s, simp [norm_smul, mul_comm_div, real.norm_eq_abs, abs_eq_self.mpr, hε.le],
    refine lt_of_lt_of_le _ (mul_one _).le,
    rw [mul_lt_mul_left hε₁, div_lt_one h0],
    refine (zero_add _).symm.le.trans_lt _,
    refine add_lt_add_of_lt_of_le zero_lt_one (le_cSup h4γ₀ _),
    rw [← loop.fract_eq, ← h3γ₀],
    refine mem_image_of_mem _ (mk_mem_prod proj_I_mem_Icc $ unit_interval.fract_mem _) },
  let γ₁ : E → ℝ → loop F := λ x t, (γ₀ t).transform (λ y, b x + ε • y), -- `γ₁ x` is `γₓ` in notes
  refine ⟨γ₁, _⟩,
  have hbV : ∀ᶠ x near K, x ∈ V := hV,
  have h1 : ∀ (x ∈ V) (t s : ℝ), ball (x, b x) (ε₁ + ε₁) ⊆ Ω,
  { intros x hx t s,
    simp [← h0ε₁],
    refine (ball_subset_thickening (mem_image_of_mem _ hx) _).trans hεΩ },
  refine ⟨_, hgK.and hbV, ε₁, hε₁, ⟨⟨by simp [γ₁, hγ₀], by simp [γ₁, h2γ₀], _, _, _⟩, _⟩, _, _⟩,
  { intros x t s, simp [γ₁, h3γ₀] },
  { rintro x ⟨hx, -⟩, simp_rw [hx, γ₁],
    exact (hγ₀_surr.smul0 hε.ne').vadd0 },
  { refine hb.continuous.fst'.add (continuous_const.smul $ hγ₀_cont.snd') },
  { rintro x ⟨-, hx⟩ t ht s hs,
    have : ‖ε • γ₀ t s‖ < ε₀ := (h2ε t s).trans (h0ε₁ ▸ half_lt_self hε₀),
    refine h1 x hx t s (by simp [← h0ε₁, this]) },
  { intros x hx,
    rw [← h0ε₁, add_halves'],
    refine (ball_subset_thickening (mem_image_of_mem _ hx.2) _).trans hεΩ },
  { rintro x ⟨-, hx⟩ t s, simp [h2ε] }
end

/- Some remarks about `exist_loops_aux2`:
  `δ`: loop after smoothing
  `γ`: loop before smoothing (defined on all of `E`)
  Requirements:
  (0) `δ x t` is a loop
  (1) `δ` lands in `Ω`
  (2) `δ` has the correct values: for `s = 0` and `t = 0` it should be `b`
  (3) `δ` should be constant on `t ≤ 0` and for `t ≥ 1`.
  (4) `δ x 1` surrounds `g x`.
  (5) Near `K`, the line connecting `b` and `δ` lies in `Ω`

  Strategy:
  (a) We need `ε₁` satisfying the following conditions:
  (a1) We need to ensure that an `ε₁ x`-ball around `(x, δ x s t)` lies in `Ω` for some
    continuous `ε₁`.
  (a4) Furthermore, `ε₁` should be small enough so that any function with that
    distance from `γ` still surrounds `g`, using `surrounding_family.surrounds_of_close`.
  (a5): `ε₁ x < ε₀` (obtained from `exist_loops_aux1`)
  (b) Replace `γ x t s` by `γ x (linear_reparam t) (linear_reparam s)`.
  (e) Let `δ' x` be a family of loops that is at most `ε₁` away from `γ` using
    `exists_smooth_and_eq_on`. Since `γ` is smooth near `s ∈ ℤ` and `t ≤ 0` we can also
    ensure that `δ' = γ` for those values (*).
    Now let `δ x t s = δ' x (smooth_transition t) (fract s)`
    We immediately get (0) and (3). We get (2) by (*).
    This is still smooth, since `δ'` is doesn't depend on `s` near `s ∈ ℤ`.
  (f) (a1) gives (1), (a4) gives (4) and (a5) gives (5).

  Note: to ensure (2) the reparamerization strategy that was originally in the blueprint
  (ensuring that `γ` is locally constant in the `t` and `s` directions)
  didn't work. Indeed it needed to take the convolution in the `x`-direction,
  meaning that the value won't stay the same, since `γ` is not constant in the `x`-direction.

  -/

lemma exist_loops_aux2 [finite_dimensional ℝ E]
  (hK : is_compact K)
  (hΩ_op : is_open Ω)
  (hg : 𝒞 ∞ g) (hb : 𝒞 ∞ b)
  (hgK : ∀ᶠ x near K, g x = b x)
  (hconv : ∀ x, g x ∈ hull (connected_component_in (prod.mk x ⁻¹' Ω) $ b x)) :
  ∃ (γ : E → ℝ → loop F), surrounding_family_in g b γ univ Ω ∧ 𝒞 ∞ ↿γ ∧
  ∀ᶠ x near K, ∀ t s, closed_ball (x, b x) (dist (γ x t s) (b x)) ⊆ Ω :=
begin
  obtain ⟨γ₁, V, hV, ε₀, hε₀, hγ₁, hΩ, h2γ₁⟩ := exist_loops_aux1 hK hΩ_op hb hgK hconv,
  obtain ⟨γ₂, hγ₂, hγ₂₁⟩ :=
    exists_surrounding_loops hK.is_closed hΩ_op
    (λ x, hg.continuous.continuous_at) hb.continuous (λ x, hconv x) ⟨V, hV, hγ₁⟩,
  let γ₃ : E → ℝ → loop F := λ x t, (γ₂ x (linear_reparam t)).reparam linear_reparam,
  have hγ₃ : surrounding_family_in g b γ₃ univ Ω := hγ₂.reparam,
  obtain ⟨ε₁, hε₁, hcε₁, hγε₁⟩ := hγ₃.to_sf.surrounds_of_close_univ hg.continuous,
  classical,
  let f : E → ℝ × ℝ → ℝ := λ x y, if Ωᶜ.nonempty then inf_dist (x, γ₃ x y.1 y.2) Ωᶜ else 1,
  have hI : is_compact (I ×ˢ I) := is_compact_Icc.prod is_compact_Icc,
  have h1f : continuous ↿f :=
    (continuous_fst.prod_mk hγ₃.cont).inf_dist.if_const _ continuous_const,
  have h2f : ∀ x : E, continuous (f x) :=
    λ x, h1f.comp₂ continuous_const continuous_id,
  have h3f : ∀ {x y}, 0 < f x y,
  { intros x y, by_cases hΩ : Ωᶜ.nonempty,
    { simp_rw [f, if_pos hΩ, ← hΩ_op.is_closed_compl.not_mem_iff_inf_dist_pos hΩ, not_mem_compl_iff,
      hγ₃.val_in (mem_univ _)] },
    { simp_rw [f, if_neg hΩ, zero_lt_one] }},
  let ε₂ : E → ℝ := λ x, min (min ε₀ (ε₁ x)) (Inf (f x '' (I ×ˢ I))),
  have hcε₂ : continuous ε₂ :=
    (continuous_const.min hcε₁).min (hI.continuous_Inf h1f),
  have hε₂ : ∀ {x}, 0 < ε₂ x := λ x, lt_min (lt_min hε₀ (hε₁ x))
    ((hI.lt_Inf_iff_of_continuous
      ((nonempty_Icc.mpr zero_le_one).prod (nonempty_Icc.mpr zero_le_one))
      (h2f x).continuous_on _).mpr $ λ x hx, h3f),
  let γ₄ := ↿γ₃,
  have h0γ₄ : ∀ x t s, γ₄ (x, t, s) = γ₃ x t s := λ x t s, rfl,
  have hγ₄ : continuous γ₄ := hγ₃.cont,
  let C₁ : set ℝ := Iic (5⁻¹  : ℝ) ∪ Ici (4 / 5),
  have h0C₁ : (0 : ℝ) ∈ C₁ := or.inl (by { rw [mem_Iic], norm_num1 }),
  have h1C₁ : (1 : ℝ) ∈ C₁ := or.inr (by { rw [mem_Ici], norm_num1 }),
  have h2C₁ : ∀ (s : ℝ) (hs : fract s = 0), fract ⁻¹' C₁ ∈ 𝓝 s,
  { intros s hs,
    refine fract_preimage_mem_nhds _ (λ _, _),
    { rw [hs], refine mem_of_superset (Iic_mem_nhds $ by norm_num) (subset_union_left _ _) },
    { refine mem_of_superset (Ici_mem_nhds $ by norm_num) (subset_union_right _ _) } },
  let C : set (E × ℝ × ℝ) := (λ x, x.2.1) ⁻¹' Iic (5⁻¹ : ℝ) ∪ (λ x, fract x.2.2) ⁻¹' C₁,
  have hC : is_closed C,
  { refine (is_closed_Iic.preimage continuous_snd.fst).union _,
    refine ((is_closed_Iic.union is_closed_Ici).preimage_fract _).preimage continuous_snd.snd,
    exact λ x, or.inl (show (0 : ℝ) ≤ 5⁻¹, by norm_num) },
  let U₁ : set ℝ := Iio (4⁻¹ : ℝ) ∪ Ioi (3 / 4),
  let U : set (E × ℝ × ℝ) := (λ x, x.2.1) ⁻¹' Iio (4⁻¹ : ℝ) ∪ (λ x, fract x.2.2) ⁻¹' U₁,
  have hUC : U ∈ 𝓝ˢ C,
  { have hU : is_open U,
    { refine (is_open_Iio.preimage continuous_snd.fst).union _,
      refine ((is_open_Iio.union is_open_Ioi).preimage_fract _).preimage continuous_snd.snd,
      exact λ x, or.inr (show (3/4 : ℝ) < 1, by norm_num) },
    exact hU.mem_nhds_set.mpr (union_subset_union (λ x hx, lt_of_le_of_lt hx (by norm_num)) $
      union_subset_union (λ x hx, lt_of_le_of_lt hx (by norm_num))
      (λ x hx, lt_of_lt_of_le (by norm_num) hx)) },
  have h2γ₄ : eq_on γ₄ (λ x, b x.1) U,
  { rintro ⟨x, t, s⟩ hxts,
    simp_rw [h0γ₄, γ₃, loop.reparam_apply],
    cases hxts with ht hs,
    { refine hγ₂.to_sf.t_le_zero_eq_b x (linear_reparam s) (linear_reparam_nonpos (le_of_lt ht)) },
    { rw [← loop.fract_eq, fract_linear_reparam_eq_zero, hγ₂.base],
      exact or.imp le_of_lt le_of_lt hs } },
  have h3γ₄ : smooth_on γ₄ U := hb.fst'.cont_diff_on.congr h2γ₄,
  obtain ⟨γ₅, hγ₅, hγ₅₄, hγ₅C⟩ :=
    exists_smooth_and_eq_on hγ₄ hcε₂.fst' (λ x, hε₂) hC ⟨U, hUC, h3γ₄⟩,
  let γ : E → ℝ → loop F := λ x t, ⟨λ s, γ₅ (x, smooth_transition t, fract s),
    λ s, by rw [fract_add_one s]⟩,
  have hγ : 𝒞 ∞ ↿γ,
  { rw [cont_diff_iff_cont_diff_at],
    rintro ⟨x, t, s⟩, by_cases hs : fract s = 0,
    { have : (λ x, γ x.1 x.2.1 x.2.2) =ᶠ[𝓝 (x, t, s)] λ x, b x.1,
      { have : (λ x : E × ℝ × ℝ, (x.1, smooth_transition x.2.1, fract x.2.2)) ⁻¹' C ∈ 𝓝 (x, t, s),
        { simp_rw [C, @preimage_union _ _ _ (_ ⁻¹' _), preimage_preimage, fract_fract],
          refine mem_of_superset _ (subset_union_right _ _),
          refine continuous_at_id.snd'.snd'.preimage_mem_nhds (h2C₁ s hs) },
        refine eventually_of_mem this _,
        intros x hx,
        simp_rw [γ, loop.coe_mk],
        refine (hγ₅C hx).trans
          (h2γ₄ $ (subset_interior_iff_mem_nhds_set.mpr hUC).trans interior_subset hx) },
      exact hb.fst'.cont_diff_at.congr_of_eventually_eq this },
    { exact (hγ₅.comp₃ cont_diff_fst smooth_transition.cont_diff.fst'.snd' $ cont_diff_snd.snd'.sub
        cont_diff_const).cont_diff_at.congr_of_eventually_eq
        ((eventually_eq.rfl.prod_mk $ eventually_eq.rfl.prod_mk $
        (fract_eventually_eq hs).comp_tendsto continuous_at_id.snd'.snd').fun_comp ↿γ₅) } },
  refine ⟨γ, ⟨⟨_, _, _, _, hγ.continuous⟩, _⟩, hγ, _⟩,
  { intros x t, simp_rw [γ, loop.coe_mk, fract_zero], rw [hγ₅C], exact hγ₃.base x _,
    exact or.inr (by { rw [mem_preimage, fract_zero], exact h0C₁ }) },
  { intros x s, simp_rw [γ, loop.coe_mk, smooth_transition.zero_of_nonpos le_rfl], rw [hγ₅C],
    exact hγ₃.t₀ x (fract s),
    exact or.inl (show (0 : ℝ) ≤ 5⁻¹, by norm_num) },
  { intros x t s, simp_rw [γ, loop.coe_mk, smooth_transition_proj_I] },
  { rintro x -, apply hγε₁, intro s,
    simp_rw [← (γ₃ x 1).fract_eq s, γ, loop.coe_mk, smooth_transition.one_of_one_le le_rfl],
    exact (hγ₅₄ (x, 1, fract s)).trans_le ((min_le_left _ _).trans $ min_le_right _ _) },
  { rintro x - t - s -, rw [← not_mem_compl_iff],
    by_cases hΩ : Ωᶜ.nonempty, swap,
    { rw [not_nonempty_iff_eq_empty] at hΩ, rw [hΩ], apply not_mem_empty },
    refine not_mem_of_dist_lt_inf_dist _,
    exact (x, γ₃ x (smooth_transition t) (fract s)),
    rw [dist_comm, dist_prod_same_left],
    refine (hγ₅₄ (x, _, fract s)).trans_le ((min_le_right _ _).trans $ cInf_le _ _),
    refine (is_compact_Icc.prod is_compact_Icc).bdd_below_image (h2f x).continuous_on,
    rw [← hγ₃.proj_I],
    simp_rw [f, if_pos hΩ],
    apply mem_image_of_mem _ (mk_mem_prod proj_I_mem_Icc (unit_interval.fract_mem s)) },
  { refine eventually_of_mem (filter.inter_mem hV hγ₂₁) (λ x hx t s, _),
    refine (closed_ball_subset_ball _).trans (hΩ x hx.1),
    refine (dist_triangle _ _ _).trans_lt (add_lt_add_of_le_of_lt
      ((hγ₅₄ (x, _, fract s)).le.trans $ (min_le_left _ _).trans $ min_le_left _ _) _),
    simp_rw [γ₄, has_uncurry.uncurry, γ₃, loop.reparam_apply, show γ₂ x = γ₁ x, from hx.2],
    exact h2γ₁ x hx.1 _ _ }
end

variables (g b Ω U K)
variables [measurable_space F] [borel_space F]

/-- A "nice" family of loops consists of all the properties we want from the `exist_loops` lemma:
it is a smooth homotopy in `Ω` with fixed endpoints from the constant loop at `b x` to a loop with
average `g x` that is also constantly `b x` near `K`.
The first two conditions are implementation specific: the homotopy is constant outside the unit
interval. -/
structure nice_loop (γ : ℝ → E → loop F) : Prop :=
(t_le_zero : ∀ x, ∀ t ≤ 0, γ t x = γ 0 x)
(t_ge_one : ∀ x, ∀ t ≥ 1, γ t x = γ 1 x)
(t_zero : ∀ x s, γ 0 x s = b x)
(s_zero : ∀ x t, γ t x 0 = b x)
(avg : ∀ x, (γ 1 x).average = g x)
(mem_Ω : ∀ x t s, (x, γ t x s) ∈ Ω)
(smooth : 𝒞 ∞ ↿γ)
(rel_K : ∀ᶠ x in 𝓝ˢ K, ∀ t s, γ t x s = b x)

variables {g b Ω U K}

theorem exist_loops [finite_dimensional ℝ E]
  (hK : is_compact K)
  (hΩ_op : is_open Ω)
  (hg : 𝒞 ∞ g) (hb : 𝒞 ∞ b)
  (hgK : ∀ᶠ x near K, g x = b x)
  (hconv : ∀ x, g x ∈ hull (connected_component_in (prod.mk x ⁻¹' Ω) $ b x)) :
  ∃ γ : ℝ → E → loop F, nice_loop g b Ω K γ :=
begin
  obtain ⟨γ₁, hγ₁, hsγ₁, h2γ₁⟩ := exist_loops_aux2 hK hΩ_op hg hb hgK hconv,
  let γ₂ : smooth_surrounding_family g :=
    ⟨hg, λ x, γ₁ x 1, hsγ₁.comp₃ cont_diff_fst cont_diff_const cont_diff_snd,
      λ x, hγ₁.surrounds x (mem_univ _)⟩,
  classical,
  let γ₃ : ℝ → E → loop F :=
  λ t x, (γ₁ x t).reparam $ (γ₂.reparametrize x).equivariant_map,
  have hγ₃ : 𝒞 ∞ ↿γ₃ :=
    hsγ₁.comp₃ cont_diff_snd.fst cont_diff_fst (γ₂.reparametrize_smooth.snd'),
  obtain ⟨χ, hχ, h1χ, h0χ, h2χ⟩ := exists_cont_diff_one_nhds_of_interior hK.is_closed
    (subset_interior_iff_mem_nhds_set.mpr $ hgK.and h2γ₁),
  simp_rw [← or_iff_not_imp_left] at h0χ,
  let γ : ℝ → E → loop F :=
  λ t x, χ x • loop.const (b x) + (1 - χ x) • γ₃ t x,
  have h1γ : ∀ x, ∀ t ≤ 0, γ t x = γ 0 x,
  { intros x t ht, ext s, simp [hγ₁.to_sf.t_le_zero _ _ ht] },
  have h2γ : ∀ x, ∀ t ≥ 1, γ t x = γ 1 x,
  { intros x t ht, ext s, simp [hγ₁.to_sf.t_ge_one _ _ ht] },
  refine ⟨γ, h1γ, h2γ, _, _, _, _, _, _⟩,
  { intros x t, simp [hγ₁.t₀] },
  { intros x t, simp [hγ₁.base] },
  { intros x,
    have h1 : interval_integrable (χ x • loop.const (b x) : loop F) volume 0 1,
    { show interval_integrable (λ t, χ x • b x) volume (0 : ℝ) (1 : ℝ),
      exact interval_integrable_const, },
    have h2 : interval_integrable ((1 - χ x) • γ₃ 1 x : loop F) volume 0 1 :=
    ((hγ₃.comp₃ cont_diff_const cont_diff_const cont_diff_id)
      .continuous.interval_integrable _ _).smul _,
    have h3 : (γ₃ 1 x).average = g x := γ₂.reparametrize_average x,
    simp [h1, h2, h3],
    rcases h0χ x with ⟨hx,-⟩|hx,
    { rw [hx, smul_add_one_sub_smul] },
    { simp [hx] } },
  { intros x t s,
    have : ∀ (P : F → Prop) t, (∀ t ∈ I, P (γ t x s)) → P (γ t x s),
    { intros P t hP,
      rcases le_total 0 t with h1t|h1t, rcases le_total t 1 with h2t|h2t,
      { exact hP t ⟨h1t, h2t⟩},
      { rw [h2γ x t h2t], exact hP 1 ⟨zero_le_one, le_rfl⟩ },
      { rw [h1γ x t h1t], exact hP 0 ⟨le_rfl, zero_le_one⟩ } },
    refine this (λ y, (x, y) ∈ Ω) t (λ t ht, _),
    rcases h0χ x with ⟨hx, h2x⟩|hx,
    { refine h2x t (γ₂.reparametrize x s) _, simp [γ, dist_smul_add_one_sub_smul_le (h2χ x)] },
    { simp [hx], apply hγ₁.val_in (mem_univ _) } },
  { exact (hχ.fst'.snd'.smul hb.fst'.snd').add ((cont_diff_const.sub hχ.fst'.snd').smul hγ₃) },
  { exact h1χ.mono (λ x (hx : χ x = 1), by simp [hx]), }
end