import eigenvectors.hermitian_form
-- import missing_mathlib.linear_algebra.basic

noncomputable theory
open_locale classical

variables {R : Type*} {M : Type*} [ring R] [add_comm_group M] [module R M]
variables {I : R ≃+* Rᵒᵖ} {H : hermitian_form R M I}

namespace linear_map

def has_adjoint (F G : M →ₗ[R] M) (H : hermitian_form R M I) : Prop :=
∀ x y, H (F x) y = H x (G y)

lemma has_adjoint_def {F G : M →ₗ[R] M} (hG : F.has_adjoint G H) :
  ∀ x y, H (F x) y = H x (G y) := hG

lemma has_adjoint_symm {F G : M →ₗ[R] M} :
  F.has_adjoint G H ↔ G.has_adjoint F H :=
begin
  unfold has_adjoint,
  split,
  repeat
  { intros h x y,
    rw [←H.comm y _, ←H.comm _ x, h y x], }
end

lemma has_adjoint_unique_left {F F' G : M →ₗ[R] M}
  (hF : has_adjoint F G) (hF' : has_adjoint F' G) : F = F' :=
begin
  ext,
  rw ←sub_eq_zero,
  apply inner_product_space.definite,
  simp only [inner_sub_left, inner_sub_right],
  simp [has_adjoint_def hF, has_adjoint_def hF']
end

lemma has_adjoint_unique_right {F G G' : V →ₗ[ℝ] V}
  (hG : has_adjoint F G) (hG' : has_adjoint F G') : G = G' :=
begin
  rw has_adjoint_symm at *,
  apply has_adjoint_unique_left hG hG'
end

lemma has_adjoint_zero : has_adjoint (0 : V →ₗ[ℝ] V) 0 :=
by simp [has_adjoint, linear_map.zero_apply, inner_zero_left, inner_zero_right]

lemma has_adjoint_id : has_adjoint (id : V →ₗ[ℝ] V) id :=
by simp [has_adjoint, linear_map.id_apply]

lemma has_adjoint_smul {F G : V →ₗ[ℝ] V} (c : ℝ) :
  has_adjoint F G → has_adjoint (c • F) (c • G) :=
by simp [has_adjoint, inner_smul_left, inner_smul_right] {contextual := tt}

lemma has_adjoint_neg {F G : V →ₗ[ℝ] V} :
  has_adjoint F G → has_adjoint (- F) (- G) :=
begin
  rw ← neg_one_smul _ F,
  rw ← neg_one_smul _ G,
  apply has_adjoint_smul (-1),
end

lemma has_adjoint_add {F G F' G' : V →ₗ[ℝ] V} :
  has_adjoint F G → has_adjoint F' G' → has_adjoint (F + F') (G + G') :=
by simp [has_adjoint, inner_add_left, inner_add_right] {contextual := tt}

lemma has_adjoint_sub {F G F' G' : V →ₗ[ℝ] V} :
  has_adjoint F G → has_adjoint F' G' → has_adjoint (F - F') (G - G') :=
by simp [has_adjoint, inner_add_left, inner_add_right] {contextual := tt}

def adjoint (F : V →ₗ[ℝ] V) : V →ₗ[ℝ] V :=
if h : ∃ G, has_adjoint F G then classical.some h else 0

lemma adjoint_of_has_adjoint {F G : V →ₗ[ℝ] V} (hF : has_adjoint F G) :
  F.adjoint = G :=
begin
  apply has_adjoint_unique_right _ hF,
  rw [adjoint, dif_pos],
  apply classical.some_spec ⟨G, hF⟩,
end

lemma has_adjoint_adjoint {F : V →ₗ[ℝ] V} (h : ∃ G, has_adjoint F G) :
  has_adjoint F (adjoint F) :=
begin
  rcases h with ⟨w, hw⟩,
  rw adjoint_of_has_adjoint hw,
  apply hw,
end

lemma inner_adjoint {F : V →ₗ[ℝ] V} (h : ∃ G, has_adjoint F G) :
  ∀ x y, inner (F x) y = inner x (F.adjoint y) :=
has_adjoint_def (has_adjoint_adjoint h)

lemma adjoint_adjoint {F : V →ₗ[ℝ] V} (h : ∃ G, has_adjoint F G) :
   F.adjoint.adjoint = F :=
begin
  rw adjoint_of_has_adjoint,
  rw has_adjoint_symm,
  apply has_adjoint_adjoint h,
end

lemma adjoint_zero : (0 : V →ₗ[ℝ] V).adjoint = 0 :=
adjoint_of_has_adjoint has_adjoint_zero

lemma adjoint_id : (id : V →ₗ[ℝ] V).adjoint = id :=
adjoint_of_has_adjoint has_adjoint_id

lemma adjoint_smul (c : ℝ) (F : V →ₗ[ℝ] V) (h : ∃ G, has_adjoint F G) :
  (c • F).adjoint = c • F.adjoint :=
adjoint_of_has_adjoint (has_adjoint_smul c (has_adjoint_adjoint h))

lemma adjoint_neg (F : V →ₗ[ℝ] V) (h : ∃ G, has_adjoint F G) :
  (- F).adjoint = - F.adjoint :=
adjoint_of_has_adjoint (has_adjoint_neg (has_adjoint_adjoint h))

lemma adjoint_add (F G : V →ₗ[ℝ] V)
  (hF : ∃ F', has_adjoint F F') (hG : ∃ G', has_adjoint G G'):
  (F + G).adjoint = F.adjoint + G.adjoint :=
adjoint_of_has_adjoint (has_adjoint_add (has_adjoint_adjoint hF) (has_adjoint_adjoint hG))

lemma adjoint_sub (F G : V →ₗ[ℝ] V)
  (hF : ∃ F', has_adjoint F F') (hG : ∃ G', has_adjoint G G'):
  (F - G).adjoint = F.adjoint - G.adjoint :=
adjoint_of_has_adjoint (has_adjoint_sub (has_adjoint_adjoint hF) (has_adjoint_adjoint hG))

def normal (F : V →ₗ[ℝ] V) : Prop :=
∃ G, has_adjoint F G ∧ F.comp G = G.comp F

lemma has_adjoint_of_normal {F : V →ₗ[ℝ] V} (h : normal F) :
  ∃ G, has_adjoint F G :=
begin
  unfold normal at h,
  rcases h with ⟨w, hw⟩,
  use w,
  apply hw.left,
end

lemma adjoint_comm_of_normal {F : V →ₗ[ℝ] V} (h : normal F) :
  F.comp F.adjoint = F.adjoint.comp F :=
begin
  unfold normal at h,
  rcases h with ⟨w, hw⟩,
  rw adjoint_of_has_adjoint hw.left,
  apply hw.right,
end

lemma normal_adjoint_of_normal {F : V →ₗ[ℝ] V} (h : normal F) :
  normal F.adjoint :=
begin
  use F,
  split,
  { rw has_adjoint_symm,
    apply has_adjoint_adjoint (has_adjoint_of_normal h) },
  { rw adjoint_comm_of_normal h },
end

lemma normal_of_has_adjoint_self {F : V →ₗ[ℝ] V} (h : has_adjoint F F) :
  normal F :=
⟨F, ⟨h, rfl⟩⟩

lemma normal_zero : normal (0 : V →ₗ[ℝ] V) :=
normal_of_has_adjoint_self has_adjoint_zero

lemma normal_id : normal (id : V →ₗ[ℝ] V) :=
normal_of_has_adjoint_self has_adjoint_id

lemma normal_smul_of_normal {F : V →ₗ[ℝ] V} (c : ℝ) (h : normal F) :
  normal (c • F) :=
begin
  rcases h with ⟨G, hG_adjoint, hG_comm⟩,
  refine ⟨c • G, ⟨has_adjoint_smul c hG_adjoint, _⟩⟩,
  simp only [comp_smul, smul_comp, hG_comm]
end

lemma normal_neg_of_normal {F : V →ₗ[ℝ] V} (h : normal F) :
  normal (- F) :=
begin
  rw ← neg_one_smul _ F,
  apply normal_smul_of_normal (-1) h,
end

lemma normal_sub_algebra_map_of_normal
  {F G : V →ₗ[ℝ] V} (c : ℝ) (hF : normal F) :
  normal (F - algebra_map _ c) :=
begin
  rcases hF with ⟨G, hG_adjoint, hG_comm⟩,
  refine ⟨G - algebra_map _ c, ⟨has_adjoint_sub hG_adjoint (has_adjoint_smul c has_adjoint_id), _⟩⟩,
  simp only [comp_eq_mul] at *,
  simp [add_mul, mul_add, hG_comm, algebra.commutes]
end

lemma inner_adjoint_eq_inner_of_normal {F : V →ₗ[ℝ] V} (h : normal F) :
  ∀ x, inner (F.adjoint x) (F.adjoint x) = inner (F x) (F x) :=
begin
  intros x,
  rw inner_adjoint (has_adjoint_of_normal h),
  rw ←comp_apply,
  rw ←inner_adjoint (has_adjoint_of_normal h),
  rw ←comp_apply,
  rw adjoint_comm_of_normal h,
  apply inner_comm
end

lemma ker_adjoint_of_normal {F : V →ₗ[ℝ] V} (h : normal F) :
  F.adjoint.ker = F.ker :=
begin
  ext,
  rw [mem_ker, ←inner_self_eq_zero, inner_adjoint_eq_inner_of_normal h,
      mem_ker, ←inner_self_eq_zero],
end

lemma ker_pow_eq_ker_of_normal
  {F : V →ₗ[ℝ] V} (k : ℕ) (hn : normal F) :
  (F ^ k.succ).ker = F.ker :=
begin
  induction k with k ih,
  { refl },
  { ext,
    split,
    { assume h : x ∈ ker (F ^ k.succ.succ),
      have h0 : F.adjoint ((F ^ k.succ) x) = 0,
      { rw [mem_ker, pow_succ, mul_app, ←mem_ker,
          ←ker_adjoint_of_normal hn, mem_ker] at h,
        exact h },
      show x ∈ ker F,
        by rw [←ih, mem_ker, ←inner_self_eq_zero, pow_succ, mul_app,
          inner_adjoint (has_adjoint_of_normal hn), ←mul_app F,
          ←pow_succ, h0, inner_zero_right] },
    { intro h,
      rw [mem_ker] at *,
      rw [pow_succ', mul_app, h, map_zero] } }
end

end linear_map


example : ∃ x, x + 2 = 8 :=
begin
  let a : ℕ := 3 * 2,
  existsi a,
  reflexivity
end


import tactic
import subgroup.lattice

/-!

Group homomorphisms

Definition file -- not for beginner mathematicians
-/

-- We're always overwriting group theory here so we always work in
-- a namespace
namespace mygroup

/- homomorphisms of groups -/

/-- Bundled group homomorphisms -/
structure group_hom (G H : Type) [group G] [group H] :=
(to_fun : G → H)
(map_mul' : ∀ x y, to_fun (x * y) = to_fun x * to_fun y)

-- notation
infixr ` →* `:25 := group_hom

-- coercion to a function
instance {G H : Type} [group G] [group H] :
  has_coe_to_fun (G →* H) := ⟨_, group_hom.to_fun⟩

@[simp] lemma to_fun_eq_coe {G H : Type} [group G] [group H]
  (f : G →* H) : f.to_fun = f := rfl

@[ext] lemma ext_hom {G H : Type} [group G] [group H] (φ ψ : G →* H) :
  φ = ψ ↔ φ.to_fun = ψ.to_fun :=
begin
 split,
 cc,
 intro h,
 cases φ with φ1 φ2,
 cases ψ with ψ1 ψ2,
 simp * at *,
end

@[ext] lemma ext {G H : Type} [group G] [group H] (φ ψ : G →* H)
  (h : ∀ g : G, φ g = ψ g) : φ = ψ :=
begin
  rw ext_hom,
  ext g,
  exact h g,
end

-- the identity homomorphism
def id_hom {G : Type} [group G] : G →* G := ⟨id, λ x y, rfl⟩

/-- Group isomorphism as a bijective group homomorphism -/
structure group_iso (G H : Type) [group G] [group H] extends group_hom G H :=
(is_bijective : function.bijective to_fun)
notation G ` ≅ ` H := group_iso G H

-- Coercion from `group_iso` to `group_hom`
instance {G H : Type} [group G] [group H] :
  has_coe_t (G ≅ H) (G →* H) := ⟨group_iso.to_group_hom⟩

instance coe_iso_to_fun {G H : Type} [group G] [group H] :
  has_coe_to_fun (G ≅ H) := ⟨_, group_iso.to_group_hom⟩

-- Should we define it this way or as an extension of equiv that preserves mul?

/- Alternative definition
structure group_equiv (G H : Type) [group G] [group H] extends G ≃ H :=
(map_mul' : ∀ x y : G, to_fun (x * y) = to_fun x * to_fun y)

notation G ` ≅ ` H := group_equiv G H

-- Coercion from `group_equiv` to `group_hom`
instance {G H : Type} [group G] [group H] :
  has_coe (G ≅ H) (G →* H) := ⟨λ f, ⟨f.to_fun, f.map_mul'⟩⟩ -/

namespace group_hom

variables {G H K : Type} [group G] [group H] [group K]

/-- If f is a group homomorphism then f (a * b) = f a * f b. -/
@[simp]
lemma map_mul (f : G →* H) (a b : G) : f (a * b) = f a * f b :=
f.map_mul' a b

/-- The composition of two group homomorphisms form a group homomorphism -/
def map_comp (f : G →* H) (g : H →* K) : G →* K :=
{ to_fun   := g ∘ f,
  map_mul' := λ x y, by simp }
notation g ` ∘* ` f := map_comp f g

@[simp] lemma coe_map_comp (f : G →* H) (g : H →* K) : ((g ∘* f) : G → K) =
  g ∘ f := rfl

/-- A group is isomorphic to itself by the identity homomorphism -/
def iso_refl : G ≅ G :=
{ is_bijective := function.bijective_id, .. id_hom }

/-- The composition of two group isomorphisms form a group isomorphism -/
def iso_comp (f : G ≅ H) (g : H ≅ K) : G ≅ K :=
{ is_bijective := function.bijective.comp g.is_bijective f.is_bijective,
  .. (g : group_hom H K) ∘* (f : group_hom G H) }

/-- An equiv between two groups that preserves multiplication forms an isomorphism -/
def iso_of_mul_equiv (f : G ≃* H) : G ≅ H :=
{ to_fun := f, map_mul' := f.map_mul',
  is_bijective := equiv.bijective f.to_equiv }

/-- An isomorphism between two groups from an mul_equiv -/
noncomputable def mul_equiv_of_iso (f : G ≅ H) : G ≃* H :=
{ map_mul' := map_mul f, .. equiv.of_bijective _ f.is_bijective }

/-- If the group `G` is isomorphic to the group `H`, then `H` is isomorphic to `G`-/
noncomputable def iso_symm (f : G ≅ H) : H ≅ G :=
  iso_of_mul_equiv $ mul_equiv.symm $ mul_equiv_of_iso f

def to_prod (H : subgroup G) (N : normal G) : H →* H ⨯ N :=
{ to_fun := λ h, ⟨h.1, h.1, h.2, 1, subgroup.one_mem N, (group.mul_one _).symm⟩,
  map_mul' := λ ⟨x, hx⟩ ⟨y, hy⟩, subtype.val_injective rfl }

@[simp] lemma to_prod_apply (H : subgroup G) (N : normal G) (h : H) :
  to_prod H N h = ⟨h.1, h.1, h.2, 1, subgroup.one_mem N, (group.mul_one _).symm⟩ :=
rfl

@[simp] lemma to_prod_mul {H : subgroup G} {K : normal G} (x y : H) :
  (to_prod H K x) * (to_prod H K y) = to_prod H K (x * y) := rfl

def to_prod' (H : subgroup G) (N : normal G) : N.to_subgroup →* H ⨯ N :=
{ to_fun := λ n, ⟨n.1, 1, H.one_mem, n.1, n.2, (group.one_mul _).symm⟩,
  map_mul' := λ ⟨x, hx⟩ ⟨y, hy⟩, subtype.val_injective rfl }

end group_hom -- namespace for group homs

end mygroup -- namespace for the project


import category_theory.limits.shapes.products
import for_mathlib.Profinite.compat_discrete_quotient
import topology.category.Profinite
import for_mathlib.quotient_map
import category_theory.limits.shapes.finite_limits

/-!

In this file we show that a finite disjoint union of profinite sets agrees with the coproduct.
*Note:* The existence of the coproduct is currently shown using some abstract nonsense.

-/

namespace Profinite

universe u
variables {α : Type u} [fintype α] (X : α → Profinite.{u})

def empty : Profinite.{u} := Profinite.of pempty
def empty.elim (X : Profinite.{u}) : empty ⟶ X :=  { to_fun := pempty.elim }

def sum (X Y : Profinite.{u}) : Profinite.{u} :=
Profinite.of $ X ⊕ Y

def sum.inl (X Y : Profinite.{u}) : X ⟶ sum X Y :=
{ to_fun := _root_.sum.inl }

def sum.inr (X Y : Profinite.{u}) : Y ⟶ sum X Y :=
{ to_fun := _root_.sum.inr }

def sum.desc {Z} (X Y : Profinite.{u}) (f : X ⟶ Z) (g : Y ⟶ Z) : sum X Y ⟶ Z :=
{ to_fun := λ x, _root_.sum.rec_on x f g,
  continuous_to_fun := begin
    apply continuous_sup_dom,
    { apply continuous_coinduced_dom, exact f.continuous },
    { apply continuous_coinduced_dom, exact g.continuous }
  end }

@[simp, reassoc]
lemma sum.inl_desc {Z} (X Y : Profinite.{u}) (f : X ⟶ Z) (g : Y ⟶ Z) :
  sum.inl X Y ≫ sum.desc X Y f g = f := by { ext, refl }

@[simp, reassoc]
lemma sum.inr_desc {Z} (X Y : Profinite.{u}) (f : X ⟶ Z) (g : Y ⟶ Z) :
  sum.inr X Y ≫ sum.desc X Y f g = g := by { ext, refl }

lemma sum.hom_ext {Z} (X Y : Profinite.{u}) (e₁ e₂ : sum X Y ⟶ Z)
  (hl : sum.inl X Y ≫ e₁ = sum.inl X Y ≫ e₂) (hr : sum.inr X Y ≫ e₁ = sum.inr X Y ≫ e₂) :
  e₁ = e₂ :=
begin
  ext (u|u),
  { apply_fun (λ e, e u) at hl, exact hl },
  { apply_fun (λ e, e u) at hr, exact hr },
end

def sigma : Profinite.{u} :=
Profinite.of $ Σ a, X a

def sigma.ι (a : α) : X a ⟶ sigma X :=
{ to_fun := λ t, ⟨_,t⟩,
  continuous_to_fun := begin
    apply continuous_Sup_rng,
    exact ⟨a,rfl⟩,
    apply continuous_coinduced_rng,
  end }

lemma sigma.ι_injective (a : α) : function.injective (sigma.ι X a) :=
by { dsimp [sigma.ι], exact sigma_mk_injective }

lemma sigma.ι_jointly_surjective (t : sigma X) : ∃ a (x : X a), sigma.ι X a x = t :=
by { rcases t with ⟨a,t⟩, exact ⟨a,t,rfl⟩ }

def sigma.desc {Y} (f : Π a, X a ⟶ Y) : sigma X ⟶ Y :=
{ to_fun := λ ⟨a,t⟩, f a t,
  continuous_to_fun := begin
    apply continuous_Sup_dom,
    rintros _ ⟨a,rfl⟩,
    resetI,
    apply continuous_coinduced_dom,
    exact (f a).continuous
  end }

lemma sigma.desc_surjective {Y} (f : Π a, X a ⟶ Y) (surj : ∀ y, ∃ a (x : X a), f a x = y) :
  function.surjective (sigma.desc X f) :=
begin
  intros y,
  obtain ⟨a,x,hx⟩ := surj y,
  exact ⟨⟨a,x⟩,hx⟩,
end

@[simp, reassoc]
lemma sigma.ι_desc {Y} (a) (f : Π a, X a ⟶ Y) : sigma.ι X a ≫ sigma.desc X f = f a :=
by { ext, refl }

lemma sigma.hom_ext {Y} (f g : sigma X ⟶ Y) (w : ∀ a, sigma.ι X a ≫ f = sigma.ι X a ≫ g) :
  f = g :=
begin
  ext ⟨a,t⟩,
  specialize w a,
  apply_fun (λ e, e t) at w,
  exact w,
end

open category_theory

def sigma_cofan : limits.cofan X :=
limits.cofan.mk (sigma X) (sigma.ι X)

def sigma_cofan_is_colimit : limits.is_colimit (sigma_cofan X) :=
{ desc := λ S, sigma.desc _ $ λ a, S.ι.app a,
  uniq' := begin
    intros S m h,
    apply sigma.hom_ext,
    intros a,
    convert h a,
    simp,
  end }

def pullback {X Y B : Profinite.{u}} (f : X ⟶ B) (g : Y ⟶ B) : Profinite :=
{ to_CompHaus :=
  { to_Top := Top.of { a : X × Y | f a.1 = g a.2 },
    is_compact := begin
      erw ← is_compact_iff_compact_space,
      apply is_closed.is_compact,
      apply is_closed_eq,
      all_goals { continuity },
    end,
    is_hausdorff := begin
      change t2_space { a : X × Y | f a.1 = g a.2 },
      apply_instance
    end },
  is_totally_disconnected := subtype.totally_disconnected_space }

def pullback.fst {X Y B : Profinite.{u}} (f : X ⟶ B) (g : Y ⟶ B) :
  pullback f g ⟶ X := { to_fun := λ a, a.1.1 }

def pullback.snd {X Y B : Profinite.{u}} (f : X ⟶ B) (g : Y ⟶ B) :
  pullback f g ⟶ Y := { to_fun := λ a, a.1.2 }

@[reassoc]
lemma pullback.condition {X Y B : Profinite.{u}} (f : X ⟶ B) (g : Y ⟶ B) :
  pullback.fst f g ≫ f = pullback.snd f g ≫ g := by { ext ⟨t,ht⟩, exact ht }

def pullback.lift {W X Y B : Profinite.{u}} (f : X ⟶ B) (g : Y ⟶ B)
  (e₁ : W ⟶ X) (e₂ : W ⟶ Y) (w : e₁ ≫ f = e₂ ≫ g) : W ⟶ pullback f g :=
{ to_fun := λ t, ⟨(e₁ t, e₂ t), by { apply_fun (λ ee, ee t) at w, exact w }⟩ }

@[simp, reassoc]
lemma pullback.lift_fst {W X Y B : Profinite.{u}} (f : X ⟶ B) (g : Y ⟶ B)
  (e₁ : W ⟶ X) (e₂ : W ⟶ Y) (w : e₁ ≫ f = e₂ ≫ g) :
  pullback.lift f g e₁ e₂ w ≫ pullback.fst f g = e₁ := by { ext, refl }

@[simp, reassoc]
lemma pullback.lift_snd {W X Y B : Profinite.{u}} (f : X ⟶ B) (g : Y ⟶ B)
  (e₁ : W ⟶ X) (e₂ : W ⟶ Y) (w : e₁ ≫ f = e₂ ≫ g) :
  pullback.lift f g e₁ e₂ w ≫ pullback.snd f g = e₂ := by { ext, refl }

lemma pullback.hom_ext {W X Y B : Profinite.{u}} (f : X ⟶ B) (g : Y ⟶ B) (e₁ e₂ : W ⟶ pullback f g)
  (w₁ : e₁ ≫ pullback.fst f g = e₂ ≫ pullback.fst f g)
  (w₂ : e₁ ≫ pullback.snd f g = e₂ ≫ pullback.snd f g) : e₁ = e₂ :=
begin
  ext t,
  { apply_fun (λ e, e t) at w₁, exact w₁ },
  { apply_fun (λ e, e t) at w₂, exact w₂ },
end

def sigma_pullback_to_pullback_sigma {B} (f : Π a, X a ⟶ B) :
  sigma (λ a : α × α, pullback (f a.1) (f a.2)) ⟶ pullback (sigma.desc X f) (sigma.desc X f) :=
sigma.desc _ $ λ a, pullback.lift _ _
  (pullback.fst _ _ ≫ sigma.ι _ _) (pullback.snd _ _ ≫ sigma.ι _ _) begin
    cases a, dsimp at *, ext1 x, cases x, assumption,
  end

instance {B} (f : Π a, X a ⟶ B) : is_iso (sigma_pullback_to_pullback_sigma X f) :=
is_iso_of_bijective _
begin
  split,
  { rintros ⟨⟨a,b⟩,⟨⟨x₁,x₂⟩,hx⟩⟩ ⟨⟨a',b'⟩,⟨⟨x'₁,x'₂⟩,hx'⟩⟩ h,
    dsimp [sigma_pullback_to_pullback_sigma, sigma.desc, pullback.lift,
      sigma.ι, pullback.fst, pullback.snd] at *,
    tidy },
  { rintros ⟨⟨⟨a,x⟩,⟨b,y⟩⟩,h⟩,
    refine ⟨⟨⟨a,b⟩,⟨⟨x,y⟩,h⟩⟩,rfl⟩ }
end

@[simp]
lemma sigma_pullback_to_pullback_sigma_fst {B} (f : Π a, X a ⟶ B) :
  sigma_pullback_to_pullback_sigma X f ≫ pullback.fst _ _ =
  sigma.desc _ (λ a, pullback.fst _ _ ≫ sigma.ι _ a.1) := by ext ⟨_,_⟩; refl

@[simp]
lemma sigma_pullback_to_pullback_sigma_snd {B} (f : Π a, X a ⟶ B) :
  sigma_pullback_to_pullback_sigma X f ≫ pullback.snd _ _ =
  sigma.desc _ (λ a, pullback.snd _ _ ≫ sigma.ι _ a.2) := by ext ⟨_,_⟩; refl

lemma sigma_iso_of_equiv_aux
  {α β : Type u}
  [fintype α]
  [fintype β]
  (e : α ≃ β)
  (X : β → Profinite.{u})
  (b : β)
  (h : b = (e ((e.symm) b))) :
  eq_to_hom (by rw h) ≫ sigma.ι _ _ = sigma.ι X b :=
begin
  induction h,
  simp,
end

def sigma_iso_of_equiv {α β : Type u} [fintype α] [fintype β] (e : α ≃ β)
  (X : β → Profinite.{u}) :
  sigma (X ∘ e) ≅ sigma X :=
{ hom := sigma.desc _ $ λ a, sigma.ι _ (e a),
  inv := sigma.desc _ $ λ b, eq_to_hom (by simp) ≫ sigma.ι _ (e.symm b),
  hom_inv_id' := begin
    apply sigma.hom_ext,
    intros a,
    dsimp,
    simp only [sigma.ι_desc_assoc, sigma.ι_desc, category.comp_id],
    apply sigma_iso_of_equiv_aux,
    simp,
  end,
  inv_hom_id' := begin
    apply sigma.hom_ext,
    intros b,
    dsimp,
    simp only [sigma.ι_desc_assoc, category.assoc, sigma.ι_desc, category.comp_id],
    apply sigma_iso_of_equiv_aux,
    simp,
  end }

def sigma_iso_empty : sigma pempty.elim ≅ empty :=
{ hom := sigma.desc _ $ λ a, a.elim,
  inv := empty.elim _,
  hom_inv_id' := begin
    apply sigma.hom_ext,
    rintros ⟨⟩
  end,
  inv_hom_id' := begin
    ext ⟨⟩
  end }

-- fin_zero_elim is terrible!
def sigma_iso_empty' (X : (pempty : Type u) → Profinite.{u}) : sigma X ≅ (empty : Profinite.{u}) :=
{ hom := sigma.desc _ $ λ i, i.elim,
  inv := empty.elim _,
  hom_inv_id' := begin
    apply sigma.hom_ext,
    rintros ⟨⟩,
  end,
  inv_hom_id' := by { ext ⟨⟩ } }

def sigma_sum_iso {α β : Type u} [fintype α] [fintype β]
  (X : α → Profinite.{u}) (Y : β → Profinite.{u}) :
  sigma (λ (x : α ⊕ β), sum.rec_on x X Y) ≅ sum (sigma X) (sigma Y) :=
{ hom := sigma.desc _ $ λ x, sum.rec_on x
    (λ a, by { dsimp, exact sigma.ι _ _ } ≫ Profinite.sum.inl _ _)
    (λ b, by { dsimp, exact sigma.ι _ _ } ≫ Profinite.sum.inr _ _),
  inv := sum.desc _ _
    (sigma.desc _ $ λ a, begin
        refine _ ≫ sigma.ι _ (_root_.sum.inl a),
        exact 𝟙 _
      end)
    (sigma.desc _ $ λ b, begin
        refine _ ≫ sigma.ι _ (_root_.sum.inr b),
        exact 𝟙 _
    end),
  hom_inv_id' := begin
    apply sigma.hom_ext,
    rintros (a|b),
    all_goals { dsimp, simp }
  end,
  inv_hom_id' := begin
    apply sum.hom_ext,
    all_goals
    { dsimp,
      simp,
      apply sigma.hom_ext,
      intros,
      simp },
  end }

def sigma_sum_iso' {α β : Type u} [fintype α] [fintype β]
  (X : α ⊕ β → Profinite.{u}) :
  sigma X ≅ sum (sigma (X ∘ _root_.sum.inl)) (sigma (X ∘ _root_.sum.inr)) :=
{ hom := sigma.desc _ $ λ x, sum.rec_on x (λ a, begin
    exact sigma.ι (X ∘ _root_.sum.inl) a,
  end ≫ sum.inl _ _) (λ b, begin
    exact sigma.ι (X ∘ _root_.sum.inr) b
  end ≫ sum.inr _ _),
  inv := sum.desc _ _ (sigma.desc _ $ λ a, sigma.ι _ _) (sigma.desc _ $ λ b, sigma.ι _ _),
  hom_inv_id' := begin
    apply sigma.hom_ext,
    rintros (a|b),
    all_goals { dsimp, simp },
  end,
  inv_hom_id' := begin
    apply sum.hom_ext,
    all_goals
    { dsimp,
      simp,
      apply sigma.hom_ext,
      intros, simp }
  end }

def sigma_punit_iso (X : (punit : Type u) → Profinite.{u}) :
  X punit.star ≅ sigma X :=
{ hom := sigma.ι _ _,
  inv := sigma.desc _ $ λ ⟨⟩, 𝟙 _ }

def sigma_walking_pair_iso (X : limits.walking_pair.{u} → Profinite.{u}) :
  sigma X ≅ (X limits.walking_pair.left).sum (X limits.walking_pair.right) :=
{ hom := sigma.desc _ $ λ a, limits.walking_pair.rec_on a (sum.inl _ _) (sum.inr _ _),
  inv := sum.desc _ _ (sigma.ι _ _) (sigma.ι _ _),
  hom_inv_id' := begin
    apply sigma.hom_ext,
    rintros (a|b),
    all_goals { dsimp, simp }
  end,
  inv_hom_id' := begin
    apply sum.hom_ext,
    all_goals { dsimp, simp }
  end }

--TODO: Finish off the api for the explicit pullback

def equalizer {X Y : Profinite.{u}} (f g : X ⟶ Y) : Profinite :=
{ to_CompHaus :=
  { to_Top := Top.of { x | f x = g x },
    is_compact := begin
      erw ← is_compact_iff_compact_space,
      apply is_closed.is_compact,
      apply is_closed_eq,
      exact f.continuous,
      exact g.continuous
    end,
    is_hausdorff := begin
      change t2_space { x | f x = g x },
      apply_instance
    end },
  is_totally_disconnected := subtype.totally_disconnected_space }

def equalizer.ι {X Y : Profinite.{u}} (f g : X ⟶ Y) : equalizer f g ⟶ X := { to_fun := λ x, x.1 }

def equalizer.lift {W X Y : Profinite.{u}} (f g : X ⟶ Y) (e : W ⟶ X) (w : e ≫ f = e ≫ g) :
  W ⟶ equalizer f g :=
{ to_fun := λ t, ⟨e t, by { apply_fun (λ ee, ee t) at w, exact w }⟩ }

@[simp, reassoc]
lemma equalizer.lift_ι {W X Y : Profinite.{u}} (f g : X ⟶ Y) (e : W ⟶ X)
  (w : e ≫ f = e ≫ g) : equalizer.lift f g e w ≫ equalizer.ι f g = e := by { ext, refl }

lemma equalizer.hom_ext {W X Y : Profinite.{u}} (f g : X ⟶ Y) (e₁ e₂ : W ⟶ equalizer f g)
  (w : e₁ ≫ equalizer.ι f g = e₂ ≫ equalizer.ι f g) : e₁ = e₂ :=
begin
  ext t,
  apply_fun (λ ee, ee t) at w,
  exact w,
end

/-- Descend a morphism along a surjective morphism. -/
noncomputable
def descend {X B Y : Profinite} (π : X ⟶ B) (t : X ⟶ Y) (hπ : function.surjective π)
  (w : pullback.fst π π ≫ t = pullback.snd π π ≫ t) : B ⟶ Y :=
{ to_fun := (λ i, quotient.lift_on' i t begin
    rintros a b (h : π _ = π _),
    apply_fun (λ e, e ⟨(a,b),h⟩) at w,
    exact w,
  end : quotient (setoid.ker π) → Y) ∘ (Profinite.quotient_map π hπ).homeomorph.symm,
  continuous_to_fun := begin
    apply continuous.comp,
    { apply continuous_quot_lift, exact t.continuous },
    { exact (quotient_map π hπ).homeomorph.symm.continuous }
  end }

-- TODO: Define `foo_to_Top` analogues for the colimit-like constructions above.
noncomputable
def descend_to_Top {X B : Profinite} {Y : Top} (π : X ⟶ B) (t : Profinite.to_Top.obj X ⟶ Y)
  (hπ : function.surjective π)
  (w : Profinite.to_Top.map (pullback.fst π π) ≫ t =
    Profinite.to_Top.map (pullback.snd π π) ≫ t) : Profinite.to_Top.obj B ⟶ Y :=
{ to_fun := (λ i, quotient.lift_on' i t begin
    rintros a b (h : π _ = π _),
    apply_fun (λ e, e ⟨(a,b),h⟩) at w,
    exact w,
  end : quotient (setoid.ker π) → Y) ∘ (Profinite.quotient_map π hπ).homeomorph.symm,
  continuous_to_fun := begin
    apply continuous.comp,
    { apply continuous_quot_lift, exact t.continuous },
    { exact (quotient_map π hπ).homeomorph.symm.continuous }
  end }

@[simp]
lemma π_descend {X B Y : Profinite} (π : X ⟶ B) (t : X ⟶ Y) (hπ : function.surjective π)
  (w : pullback.fst π π ≫ t = pullback.snd π π ≫ t) :
  π ≫ descend π t hπ w = t :=
begin
  ext i,
  dsimp [descend, setoid.quotient_ker_equiv_of_surjective,
    setoid.quotient_ker_equiv_of_right_inverse, quotient_map.homeomorph],
  let c : pullback π π := ⟨(function.surj_inv hπ (π i), i), function.surj_inv_eq hπ (π i)⟩,
  apply_fun (λ e, e c) at w,
  exact w,
end

lemma π_descend_to_Top {X B : Profinite} {Y : Top} (π : X ⟶ B) (t : Profinite.to_Top.obj X ⟶ Y)
  (hπ : function.surjective π)
  (w : Profinite.to_Top.map (pullback.fst π π) ≫ t =
    Profinite.to_Top.map (pullback.snd π π) ≫ t) :
  Profinite.to_Top.map π ≫ descend_to_Top π t hπ w = t :=
begin
  ext i,
  dsimp [descend_to_Top, setoid.quotient_ker_equiv_of_surjective,
    setoid.quotient_ker_equiv_of_right_inverse, quotient_map.homeomorph],
  let c : pullback π π := ⟨(function.surj_inv hπ (π i), i), function.surj_inv_eq hπ (π i)⟩,
  apply_fun (λ e, e c) at w,
  exact w,
end

def product {α : Type} (X : α → Profinite.{u}) : Profinite :=
  Profinite.of $ Π a, X a

def product.π {α : Type} (X : α → Profinite.{u}) (a : α) :
  product X ⟶ X a := ⟨λ t, t a, continuous_apply _⟩

def product.lift {α : Type} {Y : Profinite.{u}} (X : α → Profinite.{u})
  (f : Π a, Y ⟶ X a) : Y ⟶ product X :=
⟨λ y a, f a y, begin
  apply continuous_pi,
  intros i,
  exact (f i).2,
end⟩

@[simp, reassoc]
lemma product.lift_π {α : Type} {Y : Profinite.{u}} (X : α → Profinite.{u})
  (f : Π a, Y ⟶ X a) (a) : product.lift X f ≫ product.π X a = f _ := by { ext, refl }

lemma product.hom_ext {α : Type} {Y : Profinite.{u}} (X : α → Profinite.{u})
  (f g : Y ⟶ product X) (h : ∀ a, f ≫ product.π X a = g ≫ product.π X a) : f = g :=
begin
  ext y a,
  specialize h a,
  apply_fun (λ e, e y) at h,
  exact h,
end

def punit : Profinite.{u} := Profinite.of punit

def punit.elim (X : Profinite.{u}) : X ⟶ punit :=
⟨λ x, punit.star, by tidy⟩

lemma punit.hom_ext (X : Profinite.{u}) (f g : X ⟶ punit) : f = g :=
by ext

def from_punit {X : Profinite.{u}} (x : X) : punit ⟶ X :=
⟨λ _, x, by tidy⟩

def pow (X : Profinite.{u}) (n : ℕ) : Profinite.{u} :=
Profinite.product (λ i : fin n, X)

def map_pow {X Y : Profinite.{u}} (f : X ⟶ Y) (n : ℕ) :
  X.pow n ⟶ Y.pow n :=
Profinite.product.lift _ $ λ n, Profinite.product.π _ n ≫ f

end Profinite


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Eric Wieser

! This file was ported from Lean 3 source module algebra.hierarchy_design
! leanprover-community/mathlib commit 41cf0cc2f528dd40a8f2db167ea4fb37b8fde7f3
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Std.Util.LibraryNote

/-!
# Documentation of the algebraic hierarchy

A library note giving advice on modifying the algebraic hierarchy.
(It is not intended as a "tour".) This is ported directly from the Lean3 version, so may
refer to files/types that currently only exist in mathlib3.

TODO: Add sections about interactions with topological typeclasses, and order typeclasses.

-/

library_note "the algebraic hierarchy"/-- # The algebraic hierarchy

In any theorem proving environment,
there are difficult decisions surrounding the design of the "algebraic hierarchy".

There is a danger of exponential explosion in the number of gadgets,
especially once interactions between algebraic and order/topological/etc structures are considered.

In mathlib, we try to avoid this by only introducing new algebraic typeclasses either
1. when there is "real mathematics" to be done with them, or
2. when there is a meaninful gain in simplicity by factoring out a common substructure.

(As examples, at this point we don't have `Loop`, or `UnitalMagma`,
but we do have `LieSubmodule` and `TopologicalField`!
We also have `GroupWithZero`, as an exemplar of point 2.)

Generally in mathlib we use the extension mechanism (so `CommRing` extends `Ring`)
rather than mixins (e.g. with separate `Ring` and `CommMul` classes),
in part because of the potential blow-up in term sizes described at
https://www.ralfj.de/blog/2019/05/15/typeclasses-exponential-blowup.html
However there is tension here, as it results in considerable duplication in the API,
particularly in the interaction with order structures.

This library note is not intended as a design document
justifying and explaining the history of mathlib's algebraic hierarchy!
Instead it is intended as a developer's guide, for contributors wanting to extend
(either new leaves, or new intermediate classes) the algebraic hierarchy as it exists.

(Ideally we would have both a tour guide to the existing hierarchy,
and an account of the design choices.
See https://arxiv.org/abs/1910.09336 for an overview of mathlib as a whole,
with some attention to the algebraic hierarchy and
https://leanprover-community.github.io/mathlib-overview.html
for a summary of what is in mathlib today.)

## Instances

When adding a new typeclass `Z` to the algebraic hierarchy
one should attempt to add the following constructions and results,
when applicable:

* Instances transferred elementwise to products, like `Prod.Monoid`.
  See `Mathilb.Algebra.Group.Prod` for more examples.
  ```
  instance Prod.Z [Z M] [Z N] : Z (M × N) := ...
  ```
* Instances transferred elementwise to pi types, like `Pi.Monoid`.
  See `Mathilb.Algebra.Group.Pi` for more examples.
  ```
  instance Pi.Z [∀ i, Z $ f i] : Z (Π i : I, f i) := ...
  ```
* Instances transferred to `MulOpposite M`, like `MulOpposite.Monoid`.
  See `Mathilb.Algebra.Opposites` for more examples.
  ```
  instance MulOpposite.Z [Z M] : Z (MulOpposite M) := ...
  ```
* Instances transferred to `ULift M`, like `ULift.Monoid`.
  See `Mathilb.Algebra.Group.ULift` for more examples.
  ```
  instance ULift.Z [Z M] : Z (ULift M) := ...
  ```
* Definitions for transferring the proof fields of instances along
  injective or surjective functions that agree on the data fields,
  like `Function.Injective.monoid` and `Function.Surjective.monoid`.
  We make these definitions `@[reducible]`, see note [reducible non-instances].
  See `Mathilb.Algebra.Group.InjSurj` for more examples.
  ```
  @[reducible]
  def Function.Injective.Z [Z M₂] (f : M₁ → M₂) (hf : f.Injective)
    (one : f 1 = 1) (mul : ∀ x y, f (x * y) = f x * f y) : Z M₁ := ...

  @[reducible]
  def Function.Surjective.Z [Z M₁] (f : M₁ → M₂) (hf : f.Surjective)
    (one : f 1 = 1) (mul : ∀ x y, f (x * y) = f x * f y) : Z M₂ := ...
  ```
* Instances transferred elementwise to `Finsupp`s, like `Finsupp.semigroup`.
  See `Mathilb.Data.Finsupp.Pointwise` for more examples.
  ```
  instance FinSupp.Z [Z β] : Z (α →₀ β) := ...
  ```
* Instances transferred elementwise to `Set`s, like `Set.monoid`.
  See `Mathilb.Algebra.Pointwise` for more examples.
  ```
  instance Set.Z [Z α] : Z (Set α) := ...
  ```
* Definitions for transferring the entire structure across an equivalence, like `Equiv.monoid`.
  See `Mathilb.Data.Equiv.TransferInstance` for more examples. See also the `transport` tactic.
  ```
  def Equiv.Z (e : α ≃ β) [Z β] : Z α := ...
  /- When there is a new notion of `Z`-equiv: -/
  def Equiv.ZEquiv (e : α ≃ β) [Z β] : by { letI := Equiv.Z e, exact α ≃Z β } := ...
  ```

## Subobjects

When a new typeclass `Z` adds new data fields,
you should also create a new `SubZ` `structure` with a `carrier` field.

This can be a lot of work; for now try to closely follow the existing examples
(e.g. `Submonoid`, `Subring`, `Subalgebra`).
We would very much like to provide some automation here, but a prerequisite will be making
all the existing APIs more uniform.

If `Z` extends `Y`, then `SubZ` should usually extend `SubY`.

When `Z` adds only new proof fields to an existing structure `Y`,
you should provide instances transferring
`Z α` to `Z (SubY α)`, like `Submonoid.toCommMonoid`.
Typically this is done using the `Function.Injective.Z` definition mentioned above.
```
instance SubY.toZ [Z α] : Z (SubY α) :=
coe_injective.Z coe ...
```

## Morphisms and equivalences

## Category theory

For many algebraic structures, particularly ones used in representation theory, algebraic geometry,
etc., we also define "bundled" versions, which carry `category` instances.

These bundled versions are usually named by appending `Cat`,
so for example we have `AddCommGroupCat` as a bundled `AddCommGroup`, and `TopCommRingCat`
(which bundles together `CommRing`, `TopologicalSpace`, and `TopologicalRing`).

These bundled versions have many appealing features:
* a uniform notation for morphisms `X ⟶ Y`
* a uniform notation (and definition) for isomorphisms `X ≅ Y`
* a uniform API for subobjects, via the partial order `Subobject X`
* interoperability with unbundled structures, via coercions to `Type`
  (so if `G : AddCommGroupCat`, you can treat `G` as a type,
  and it automatically has an `AddCommGroup` instance)
  and lifting maps `AddCommGroupCat.of G`, when `G` is a type with an `AddCommGroup` instance.

If, for example you do the work of proving that a typeclass `Z` has a good notion of tensor product,
you are strongly encouraged to provide the corresponding `MonoidalCategory` instance
on a bundled version.
This ensures that the API for tensor products is complete, and enables use of general machinery.
Similarly if you prove universal properties, or adjunctions, you are encouraged to state these
using categorical language!

One disadvantage of the bundled approach is that we can only speak of morphisms between
objects living in the same type-theoretic universe.
In practice this is rarely a problem.

# Making a pull request

With so many moving parts, how do you actually go about changing the algebraic hierarchy?

We're still evolving how to handle this, but the current suggestion is:

* If you're adding a new "leaf" class, the requirements are lower,
  and an initial PR can just add whatever is immediately needed.
* A new "intermediate" class, especially low down in the hierarchy,
  needs to be careful about leaving gaps.

In a perfect world, there would be a group of simultaneous PRs that basically cover everything!
(Or at least an expectation that PRs may not be merged immediately while waiting on other
PRs that fill out the API.)

However "perfect is the enemy of good", and it would also be completely reasonable
to add a TODO list in the main module doc-string for the new class,
briefly listing the parts of the API which still need to be provided.
Hopefully this document makes it easy to assemble this list.

Another alternative to a TODO list in the doc-strings is adding Github issues.

-/

library_note "reducible non-instances"/--
Some definitions that define objects of a class cannot be instances, because they have an
explicit argument that does not occur in the conclusion. An example is `Preorder.lift` that has a
function `f : α → β` as an explicit argument to lift a preorder on `β` to a preorder on `α`.

If these definitions are used to define instances of this class *and* this class is an argument to
some other type-class so that type-class inference will have to unfold these instances to check
for definitional equality, then these definitions should be marked `@[reducible]`.

For example, `Preorder.lift` is used to define `Units.Preorder` and `PartialOrder.lift` is used
to define `Units.PartialOrder`. In some cases it is important that type-class inference can
recognize that `Units.Preorder` and `Units.PartialOrder` give rise to the same `LE` instance.
For example, you might have another class that takes `[LE α]` as an argument, and this argument
sometimes comes from `Units.Preorder` and sometimes from `Units.PartialOrder`.
Therefore, `Preorder.lift` and `PartialOrder.lift` are marked `@[reducible]`.
-/


/-
Copyright (c) 2021 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import combinatorics.simplicial_complex.to_move.convex
import linear_algebra.affine_space.finite_dimensional

variables {m n : ℕ} {E : Type*} [normed_group E] [normed_space ℝ E]
open_locale big_operators
open finset

lemma convex_subspace (M : Type*) [add_comm_group M] [module ℝ M] (s : affine_subspace ℝ M) :
  convex (s : set M) :=
λ x y hxs hys a b ha hb hab,
calc a • x + b • y = b • (y - x) + x : convex.combo_to_vadd hab
               ... ∈ s : s.2 _ hys hxs hxs

lemma convex_hull_subset_span_points (X : set E) :
  convex_hull X ⊆ affine_span ℝ X :=
convex_hull_min (subset_affine_span ℝ X) (convex_subspace E _)

lemma affine_combination_eq_center_mass {ι : Type*} {t : finset ι} {p : ι → E} {w : ι → ℝ}
  (hw₂ : ∑ i in t, w i = 1) :
  affine_combination t p w = center_mass t w p :=
begin
  rw affine_combination_eq_weighted_vsub_of_point_vadd_of_sum_eq_one _ w _ hw₂ (0 : E),
  simp only [vsub_eq_sub, add_zero, finset.weighted_vsub_of_point_apply, vadd_eq_add, sub_zero],
  rw center_mass_eq_of_sum_1 _ _ hw₂,
end

lemma nontrivial_sum_of_affine_independent {X : finset E}
  (hX : affine_independent ℝ (λ p, p : (X : set E) → E))
  (w : E → ℝ) (hw₀ : ∑ i in X, w i = 0) (hw₁ : ∑ i in X, w i • i = 0) :
∀ i ∈ X, w i = 0 :=
begin
  have hw₀' : ∑ (i : (X : set E)), w i = 0,
  { rwa [sum_finset_coe] },
  specialize hX _ _ hw₀' _,
  { rw finset.weighted_vsub_eq_weighted_vsub_of_point_of_sum_eq_zero _ _ _ hw₀' (0 : E),
    rw finset.weighted_vsub_of_point_apply,
    simpa only [vsub_eq_sub, sub_zero, sum_finset_coe (λ i, w i • i)] },
  intros i hi,
  apply hX ⟨i, hi⟩ (mem_univ _)
end

lemma unique_combination {X : finset E} (hX : affine_independent ℝ (λ p, p : (X : set E) → E))
  (w₁ w₂ : E → ℝ) (hw₁ : ∑ i in X, w₁ i = 1) (hw₂ : ∑ i in X, w₂ i = 1)
  (same : X.center_mass w₁ id = X.center_mass w₂ id) :
  ∀ i ∈ X, w₁ i = w₂ i :=
begin
  let w := w₁ - w₂,
  suffices : ∀ i ∈ X, w i = 0,
  { intros i hi,
    apply eq_of_sub_eq_zero (this i hi) },
  apply nontrivial_sum_of_affine_independent hX w,
  { change ∑ i in X, (w₁ i - w₂ i) = _,
    rw [finset.sum_sub_distrib, hw₁, hw₂, sub_self] },
  { change ∑ i in X, (w₁ i - w₂ i) • i = _,
    simp_rw [sub_smul, finset.sum_sub_distrib, ←finset.center_mass_eq_of_sum_1 _ _ hw₁,
      ←finset.center_mass_eq_of_sum_1 _ _ hw₂],
    apply sub_eq_zero_of_eq same }
end

lemma affine_span_convex_hull_eq {X : set E} :
  affine_span ℝ (convex_hull X) = affine_span ℝ X :=
le_antisymm
  (((affine_subspace.gi _ _ _).gc _ _).2 (convex_hull_subset_span_points X))
  (affine_span_mono ℝ (subset_convex_hull X))

lemma disjoint_convex_hull_of_subsets {X : finset E}
  (hX : affine_independent ℝ (λ p, p : (X : set E) → E)) {Y₁ Y₂ : finset E}
  (hY₁ : Y₁ ⊆ X) (hY₂ : Y₂ ⊆ X) :
  convex_hull (Y₁ : set E) ∩ convex_hull (Y₂ : set E) ⊆ convex_hull (Y₁ ∩ Y₂ : set E) :=
begin
  classical,
  rintro x ⟨hx₁, hx₂⟩,
  rw ←coe_inter,
  rw finset.convex_hull_eq at hx₁ hx₂,
  rcases hx₁ with ⟨w₁, h₁w₁, h₂w₁, h₃w₁⟩,
  rcases hx₂ with ⟨w₂, h₁w₂, h₂w₂, h₃w₂⟩,
  rw center_mass_eq_of_sum_1 _ _ h₂w₁ at h₃w₁,
  rw center_mass_eq_of_sum_1 _ _ h₂w₂ at h₃w₂,
  dsimp at h₃w₁ h₃w₂,
  let w : E → ℝ,
  { intro x,
    apply (if x ∈ Y₁ then w₁ x else 0) - (if x ∈ Y₂ then w₂ x else 0) },
  have h₁w : ∑ i in X, w i = 0,
  { rw [finset.sum_sub_distrib, ←sum_filter, filter_mem_eq_inter, ←sum_filter,
      filter_mem_eq_inter, (finset.inter_eq_right_iff_subset _ _).2 hY₁,
      (finset.inter_eq_right_iff_subset _ _).2 hY₂, h₂w₁, h₂w₂],
    simp only [sub_self] },
  have : ∑ (i : E) in X, w i • i = 0,
  { simp only [sub_smul, zero_smul, ite_smul, finset.sum_sub_distrib, ←finset.sum_filter, h₃w₁,
      finset.filter_mem_eq_inter, (finset.inter_eq_right_iff_subset _ _).2 hY₁,
      (finset.inter_eq_right_iff_subset _ _).2 hY₂, h₃w₂, sub_self] },
  have hX' := nontrivial_sum_of_affine_independent hX w h₁w this,
  have t₁ : ∀ x, x ∈ Y₁ → x ∉ Y₂ → w₁ x = 0,
  { intros x hx₁ hx₂,
    have : ite (x ∈ Y₁) (w₁ x) 0 - ite (x ∈ Y₂) (w₂ x) 0 = 0 := hX' x (hY₁ hx₁),
    simpa [hx₁, hx₂] using this },
  have h₄w₁ : ∑ (y : E) in Y₁ ∩ Y₂, w₁ y = 1,
  { rw [finset.sum_subset (finset.inter_subset_left Y₁ Y₂), h₂w₁],
    simp_intros x hx₁ hx₂,
    exact t₁ x hx₁ (hx₂ hx₁)},
  rw finset.convex_hull_eq,
  refine ⟨w₁, _, h₄w₁, _⟩,
  { simp only [and_imp, finset.mem_inter],
    intros y hy₁ hy₂,
    exact h₁w₁ y hy₁},
  { rw finset.center_mass_eq_of_sum_1 _ _ h₄w₁,
    dsimp only [id.def],
    rw [finset.sum_subset (finset.inter_subset_left Y₁ Y₂), h₃w₁],
    simp_intros x hx₁ hx₂,
    left,
    exact t₁ x hx₁ (hx₂ hx₁) },
end

lemma finrank_le_finrank_of_le {x y : submodule ℝ E} (h : x ≤ y) [finite_dimensional ℝ y] :
  finite_dimensional.finrank ℝ x ≤ finite_dimensional.finrank ℝ y :=
begin
  let f : x →ₗ[ℝ] y := submodule.of_le h,
  have hf : function.injective f,
  { intros x₁ x₂ h',
    apply subtype.ext,
    apply subtype.ext_iff.1 h' },
  haveI : finite_dimensional ℝ x := submodule.finite_dimensional_of_le h,
  apply linear_map.finrank_le_finrank_of_injective hf,
end

-- convex_hull ↑X ⊆ convex_hull ↑Y implies that X.card <= Y.card if X is independent
theorem card_le_of_convex_hull_subset {X Y : finset E}
  (hX : affine_independent ℝ (λ p, p : (X : set E) → E))
  (hXY : convex_hull ↑X ⊆ convex_hull (Y : set E)) :
  X.card ≤ Y.card :=
begin
  cases X.eq_empty_or_nonempty with h₁ h₁,
  { subst h₁,
    simp },
  cases Y.eq_empty_or_nonempty with h₂ h₂,
  { subst h₂,
    simp only [finset.coe_empty, convex_hull_empty, set.subset_empty_iff, convex_hull_empty_iff,
      finset.coe_eq_empty] at hXY,
    subst hXY },
  have X_card_pos : 0 < X.card := finset.card_pos.2 h₁,
  have X_eq_succ : fintype.card (X : set E) = (X.card - 1) + 1,
  { simp [nat.sub_add_cancel ‹1 ≤ X.card›] },
  have Y_card_pos : 0 < Y.card := finset.card_pos.2 h₂,
  have Y_eq_succ : fintype.card (Y : set E) = (Y.card - 1) + 1,
  { simp [nat.sub_add_cancel ‹1 ≤ Y.card›] },
  have affine_span_le := affine_span_mono ℝ hXY,
  rw [affine_span_convex_hull_eq, affine_span_convex_hull_eq] at affine_span_le,
  have direction_le := affine_subspace.direction_le affine_span_le,
  letI : finite_dimensional ℝ (vector_span ℝ (Y : set E)),
  { apply finite_dimensional_vector_span_of_finite,
    exact Y.finite_to_set },
  rw direction_affine_span at direction_le,
  rw direction_affine_span at direction_le,
  have finrank_le := finrank_le_finrank_of_le direction_le,
  have dumb : set.range (λ (p : (X : set E)), ↑p) = (X : set E),
  { simp only [subtype.range_coe_subtype, finset.set_of_mem, finset.mem_coe] },
  rw ← dumb at finrank_le,
  rw finrank_vector_span_of_affine_independent hX X_eq_succ at finrank_le,
  have := finrank_vector_span_range_le ℝ (λ p, p : (Y : set E) → E) Y_eq_succ,
  have dumb₂ : set.range (λ (p : (Y : set E)), ↑p) = (Y : set E),
  { simp only [subtype.range_coe_subtype, finset.set_of_mem, finset.mem_coe] },
  rw dumb₂ at this,
  have := le_trans finrank_le this,
  rwa nat.sub_le_sub_right_iff at this,
  exact Y_card_pos,
end

lemma size_bound [finite_dimensional ℝ E] {X : finset E}
  (hX : affine_independent ℝ (λ p, p : (X : set E) → E)) :
  X.card ≤ finite_dimensional.finrank ℝ E + 1 :=
begin
  classical,
  cases X.eq_empty_or_nonempty,
  { simp [h] },
  rcases h with ⟨y, hy⟩,
  have y_mem : y ∈ (X : set E) := hy,
  have Xy : (↑X \ {y}) = (↑(X.erase y) : set E),
  { simp },
  have := hX,
  rw @affine_independent_set_iff_linear_independent_vsub ℝ _ _ _ _ _ _ ↑X y y_mem at this,
  letI q : fintype ↥((λ (p : E), p -ᵥ y) '' (↑X \ {y})),
  { apply set.fintype_image _ _,
    { apply_instance },
    rw Xy,
    exact finset_coe.fintype _ },
  have hX := finite_dimensional.fintype_card_le_finrank_of_linear_independent this,
  simp only [vsub_eq_sub, finite_dimensional.finrank_fin_fun, fintype.card_of_finset] at hX,
  rw finset.card_image_of_injective at hX,
  { simp only [set.to_finset_card] at hX,
    rw fintype.card_of_finset' (X.erase y) at hX,
    { rwa [finset.card_erase_of_mem hy, nat.pred_le_iff] at hX },
    { simp [and_comm] } },
  rintro p q h,
  simpa using h,
end.


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import algebra.hom.group
import logic.equiv.basic
/-!
# Type tags that turn additive structures into multiplicative, and vice versa

We define two type tags:

* `additive α`: turns any multiplicative structure on `α` into the corresponding
  additive structure on `additive α`;
* `multiplicative α`: turns any additive structure on `α` into the corresponding
  multiplicative structure on `multiplicative α`.

We also define instances `additive.*` and `multiplicative.*` that actually transfer the structures.

## See also

This file is similar to `order.synonym`.
-/

universes u v
variables {α : Type u} {β : Type v}

/-- If `α` carries some multiplicative structure, then `additive α` carries the corresponding
additive structure. -/
def additive (α : Type*) := α
/-- If `α` carries some additive structure, then `multiplicative α` carries the corresponding
multiplicative structure. -/
def multiplicative (α : Type*) := α

namespace additive

/-- Reinterpret `x : α` as an element of `additive α`. -/
def of_mul : α ≃ additive α := ⟨λ x, x, λ x, x, λ x, rfl, λ x, rfl⟩

/-- Reinterpret `x : additive α` as an element of `α`. -/
def to_mul : additive α ≃ α := of_mul.symm

@[simp] lemma of_mul_symm_eq : (@of_mul α).symm = to_mul := rfl

@[simp] lemma to_mul_symm_eq : (@to_mul α).symm = of_mul := rfl

end additive

namespace multiplicative

/-- Reinterpret `x : α` as an element of `multiplicative α`. -/
def of_add : α ≃ multiplicative α := ⟨λ x, x, λ x, x, λ x, rfl, λ x, rfl⟩

/-- Reinterpret `x : multiplicative α` as an element of `α`. -/
def to_add : multiplicative α ≃ α := of_add.symm

@[simp] lemma of_add_symm_eq : (@of_add α).symm = to_add := rfl

@[simp] lemma to_add_symm_eq : (@to_add α).symm = of_add := rfl

end multiplicative

@[simp] lemma to_add_of_add (x : α) : (multiplicative.of_add x).to_add = x := rfl
@[simp] lemma of_add_to_add (x : multiplicative α) : multiplicative.of_add x.to_add = x := rfl

@[simp] lemma to_mul_of_mul (x : α) : (additive.of_mul x).to_mul = x := rfl
@[simp] lemma of_mul_to_mul (x : additive α) : additive.of_mul x.to_mul = x := rfl

instance [inhabited α] : inhabited (additive α) := ⟨additive.of_mul default⟩
instance [inhabited α] : inhabited (multiplicative α) := ⟨multiplicative.of_add default⟩

instance [nontrivial α] : nontrivial (additive α) :=
additive.of_mul.injective.nontrivial

instance [nontrivial α] : nontrivial (multiplicative α) :=
multiplicative.of_add.injective.nontrivial

instance additive.has_add [has_mul α] : has_add (additive α) :=
{ add := λ x y, additive.of_mul (x.to_mul * y.to_mul) }

instance [has_add α] : has_mul (multiplicative α) :=
{ mul := λ x y, multiplicative.of_add (x.to_add + y.to_add) }

@[simp] lemma of_add_add [has_add α] (x y : α) :
  multiplicative.of_add (x + y) = multiplicative.of_add x * multiplicative.of_add y :=
rfl

@[simp] lemma to_add_mul [has_add α] (x y : multiplicative α) :
  (x * y).to_add = x.to_add + y.to_add :=
rfl

@[simp] lemma of_mul_mul [has_mul α] (x y : α) :
  additive.of_mul (x * y) = additive.of_mul x + additive.of_mul y :=
rfl

@[simp] lemma to_mul_add [has_mul α] (x y : additive α) :
  (x + y).to_mul = x.to_mul * y.to_mul :=
rfl

instance [semigroup α] : add_semigroup (additive α) :=
{ add_assoc := @mul_assoc α _,
  ..additive.has_add }

instance [add_semigroup α] : semigroup (multiplicative α) :=
{ mul_assoc := @add_assoc α _,
  ..multiplicative.has_mul }

instance [comm_semigroup α] : add_comm_semigroup (additive α) :=
{ add_comm := @mul_comm _ _,
  ..additive.add_semigroup }

instance [add_comm_semigroup α] : comm_semigroup (multiplicative α) :=
{ mul_comm := @add_comm _ _,
  ..multiplicative.semigroup }

instance [left_cancel_semigroup α] : add_left_cancel_semigroup (additive α) :=
{ add_left_cancel := @mul_left_cancel _ _,
  ..additive.add_semigroup }

instance [add_left_cancel_semigroup α] : left_cancel_semigroup (multiplicative α) :=
{ mul_left_cancel := @add_left_cancel _ _,
  ..multiplicative.semigroup }

instance [right_cancel_semigroup α] : add_right_cancel_semigroup (additive α) :=
{ add_right_cancel := @mul_right_cancel _ _,
  ..additive.add_semigroup }

instance [add_right_cancel_semigroup α] : right_cancel_semigroup (multiplicative α) :=
{ mul_right_cancel := @add_right_cancel _ _,
  ..multiplicative.semigroup }

instance [has_one α] : has_zero (additive α) := ⟨additive.of_mul 1⟩

@[simp] lemma of_mul_one [has_one α] : @additive.of_mul α 1 = 0 := rfl

@[simp] lemma of_mul_eq_zero {A : Type*} [has_one A] {x : A} :
  additive.of_mul x = 0 ↔ x = 1 := iff.rfl

@[simp] lemma to_mul_zero [has_one α] : (0 : additive α).to_mul = 1 := rfl

instance [has_zero α] : has_one (multiplicative α) := ⟨multiplicative.of_add 0⟩

@[simp] lemma of_add_zero [has_zero α] : @multiplicative.of_add α 0 = 1 := rfl

@[simp] lemma of_add_eq_one {A : Type*} [has_zero A] {x : A} :
  multiplicative.of_add x = 1 ↔ x = 0 := iff.rfl

@[simp] lemma to_add_one [has_zero α] : (1 : multiplicative α).to_add = 0 := rfl

instance [mul_one_class α] : add_zero_class (additive α) :=
{ zero     := 0,
  add      := (+),
  zero_add := one_mul,
  add_zero := mul_one }

instance [add_zero_class α] : mul_one_class (multiplicative α) :=
{ one     := 1,
  mul     := (*),
  one_mul := zero_add,
  mul_one := add_zero }

instance [h : monoid α] : add_monoid (additive α) :=
{ zero     := 0,
  add      := (+),
  nsmul    := @monoid.npow α h,
  nsmul_zero' := monoid.npow_zero',
  nsmul_succ' := monoid.npow_succ',
  ..additive.add_zero_class,
  ..additive.add_semigroup }

instance [h : add_monoid α] : monoid (multiplicative α) :=
{ one     := 1,
  mul     := (*),
  npow   := @add_monoid.nsmul α h,
  npow_zero' := add_monoid.nsmul_zero',
  npow_succ' := add_monoid.nsmul_succ',
  ..multiplicative.mul_one_class,
  ..multiplicative.semigroup }

instance [left_cancel_monoid α] : add_left_cancel_monoid (additive α) :=
{ zero := 0, add := (+), .. additive.add_monoid, .. additive.add_left_cancel_semigroup }

instance [add_left_cancel_monoid α] : left_cancel_monoid (multiplicative α) :=
{ one := 1, mul := (*), .. multiplicative.monoid, .. multiplicative.left_cancel_semigroup }

instance [right_cancel_monoid α] : add_right_cancel_monoid (additive α) :=
{ zero := 0, add := (+), .. additive.add_monoid, .. additive.add_right_cancel_semigroup }

instance [add_right_cancel_monoid α] : right_cancel_monoid (multiplicative α) :=
{ one := 1, mul := (*), .. multiplicative.monoid, .. multiplicative.right_cancel_semigroup }

instance [comm_monoid α] : add_comm_monoid (additive α) :=
{ zero := 0, add := (+), .. additive.add_monoid, .. additive.add_comm_semigroup }

instance [add_comm_monoid α] : comm_monoid (multiplicative α) :=
{ one := 1, mul := (*), ..multiplicative.monoid, .. multiplicative.comm_semigroup }

instance [has_inv α] : has_neg (additive α) := ⟨λ x, multiplicative.of_add x.to_mul⁻¹⟩

@[simp] lemma of_mul_inv [has_inv α] (x : α) : additive.of_mul x⁻¹ = -(additive.of_mul x) := rfl

@[simp] lemma to_mul_neg [has_inv α] (x : additive α) : (-x).to_mul = x.to_mul⁻¹ := rfl

instance [has_neg α] : has_inv (multiplicative α) := ⟨λ x, additive.of_mul (-x.to_add)⟩

@[simp] lemma of_add_neg [has_neg α] (x : α) :
  multiplicative.of_add (-x) = (multiplicative.of_add x)⁻¹ := rfl

@[simp] lemma to_add_inv [has_neg α] (x : multiplicative α) :
  (x⁻¹).to_add = -x.to_add := rfl

instance additive.has_sub [has_div α] : has_sub (additive α) :=
{ sub := λ x y, additive.of_mul (x.to_mul / y.to_mul) }

instance multiplicative.has_div [has_sub α] : has_div (multiplicative α) :=
{ div := λ x y, multiplicative.of_add (x.to_add - y.to_add) }

@[simp] lemma of_add_sub [has_sub α] (x y : α) :
  multiplicative.of_add (x - y) = multiplicative.of_add x / multiplicative.of_add y :=
rfl

@[simp] lemma to_add_div [has_sub α] (x y : multiplicative α) :
  (x / y).to_add = x.to_add - y.to_add :=
rfl

@[simp] lemma of_mul_div [has_div α] (x y : α) :
  additive.of_mul (x / y) = additive.of_mul x - additive.of_mul y :=
rfl

@[simp] lemma to_mul_sub [has_div α] (x y : additive α) :
  (x - y).to_mul = x.to_mul / y.to_mul :=
rfl

instance [has_involutive_inv α] : has_involutive_neg (additive α) :=
{ neg_neg := @inv_inv _ _,
  ..additive.has_neg }

instance [has_involutive_neg α] : has_involutive_inv (multiplicative α) :=
{ inv_inv := @neg_neg _ _,
  ..multiplicative.has_inv }

instance [div_inv_monoid α] : sub_neg_monoid (additive α) :=
{ sub_eq_add_neg := @div_eq_mul_inv α _,
  zsmul := @div_inv_monoid.zpow α _,
  zsmul_zero' := div_inv_monoid.zpow_zero',
  zsmul_succ' := div_inv_monoid.zpow_succ',
  zsmul_neg' := div_inv_monoid.zpow_neg',
  .. additive.has_neg, .. additive.has_sub, .. additive.add_monoid }

instance [sub_neg_monoid α] : div_inv_monoid (multiplicative α) :=
{ div_eq_mul_inv := @sub_eq_add_neg α _,
  zpow := @sub_neg_monoid.zsmul α _,
  zpow_zero' := sub_neg_monoid.zsmul_zero',
  zpow_succ' := sub_neg_monoid.zsmul_succ',
  zpow_neg' := sub_neg_monoid.zsmul_neg',
  .. multiplicative.has_inv, .. multiplicative.has_div, .. multiplicative.monoid }

instance [division_monoid α] : subtraction_monoid (additive α) :=
{ neg_add_rev := @mul_inv_rev _ _,
  neg_eq_of_add := @inv_eq_of_mul_eq_one_right _ _,
  .. additive.sub_neg_monoid, .. additive.has_involutive_neg }

instance [subtraction_monoid α] : division_monoid (multiplicative α) :=
{ mul_inv_rev := @neg_add_rev _ _,
  inv_eq_of_mul := @neg_eq_of_add_eq_zero_right _ _,
  .. multiplicative.div_inv_monoid, .. multiplicative.has_involutive_inv }

instance [division_comm_monoid α] : subtraction_comm_monoid (additive α) :=
{ .. additive.subtraction_monoid, .. additive.add_comm_semigroup }

instance [subtraction_comm_monoid α] : division_comm_monoid (multiplicative α) :=
{ .. multiplicative.division_monoid, .. multiplicative.comm_semigroup }

instance [group α] : add_group (additive α) :=
{ add_left_neg := @mul_left_inv α _,
  .. additive.sub_neg_monoid }

instance [add_group α] : group (multiplicative α) :=
{ mul_left_inv := @add_left_neg α _,
  .. multiplicative.div_inv_monoid }

instance [comm_group α] : add_comm_group (additive α) :=
{ .. additive.add_group, .. additive.add_comm_monoid }

instance [add_comm_group α] : comm_group (multiplicative α) :=
{ .. multiplicative.group, .. multiplicative.comm_monoid }

open multiplicative (of_add)
open additive (of_mul)

/-- Reinterpret `α →+ β` as `multiplicative α →* multiplicative β`. -/
@[simps] def add_monoid_hom.to_multiplicative [add_zero_class α] [add_zero_class β] :
  (α →+ β) ≃ (multiplicative α →* multiplicative β) :=
{ to_fun := λ f, ⟨λ a, of_add (f a.to_add), f.2, f.3⟩,
  inv_fun := λ f, ⟨λ a, (f (of_add a)).to_add, f.2, f.3⟩,
  left_inv := λ x, by { ext, refl, },
  right_inv := λ x, by { ext, refl, } }

/-- Reinterpret `α →* β` as `additive α →+ additive β`. -/
@[simps] def monoid_hom.to_additive [mul_one_class α] [mul_one_class β] :
  (α →* β) ≃ (additive α →+ additive β) :=
{ to_fun := λ f, ⟨λ a, of_mul (f a.to_mul), f.2, f.3⟩,
  inv_fun := λ f, ⟨λ a, (f (of_mul a)).to_mul, f.2, f.3⟩,
  left_inv := λ x, by { ext, refl, },
  right_inv := λ x, by { ext, refl, } }

/-- Reinterpret `additive α →+ β` as `α →* multiplicative β`. -/
@[simps] def add_monoid_hom.to_multiplicative' [mul_one_class α] [add_zero_class β] :
  (additive α →+ β) ≃ (α →* multiplicative β) :=
{ to_fun := λ f, ⟨λ a, of_add (f (of_mul a)), f.2, f.3⟩,
  inv_fun := λ f, ⟨λ a, (f a.to_mul).to_add, f.2, f.3⟩,
  left_inv := λ x, by { ext, refl, },
  right_inv := λ x, by { ext, refl, } }

/-- Reinterpret `α →* multiplicative β` as `additive α →+ β`. -/
@[simps] def monoid_hom.to_additive' [mul_one_class α] [add_zero_class β] :
  (α →* multiplicative β) ≃ (additive α →+ β) :=
add_monoid_hom.to_multiplicative'.symm

/-- Reinterpret `α →+ additive β` as `multiplicative α →* β`. -/
@[simps] def add_monoid_hom.to_multiplicative'' [add_zero_class α] [mul_one_class β] :
  (α →+ additive β) ≃ (multiplicative α →* β) :=
{ to_fun := λ f, ⟨λ a, (f a.to_add).to_mul, f.2, f.3⟩,
  inv_fun := λ f, ⟨λ a, of_mul (f (of_add a)), f.2, f.3⟩,
  left_inv := λ x, by { ext, refl, },
  right_inv := λ x, by { ext, refl, } }

/-- Reinterpret `multiplicative α →* β` as `α →+ additive β`. -/
@[simps] def monoid_hom.to_additive'' [add_zero_class α] [mul_one_class β] :
  (multiplicative α →* β) ≃ (α →+ additive β) :=
add_monoid_hom.to_multiplicative''.symm

/-- If `α` has some multiplicative structure and coerces to a function,
then `additive α` should also coerce to the same function.

This allows `additive` to be used on bundled function types with a multiplicative structure, which
is often used for composition, without affecting the behavior of the function itself.
-/
instance additive.has_coe_to_fun {α : Type*} {β : α → Sort*} [has_coe_to_fun α β] :
  has_coe_to_fun (additive α) (λ a, β a.to_mul) :=
⟨λ a, coe_fn a.to_mul⟩

/-- If `α` has some additive structure and coerces to a function,
then `multiplicative α` should also coerce to the same function.

This allows `multiplicative` to be used on bundled function types with an additive structure, which
is often used for composition, without affecting the behavior of the function itself.
-/
instance multiplicative.has_coe_to_fun {α : Type*} {β : α → Sort*} [has_coe_to_fun α β] :
  has_coe_to_fun (multiplicative α) (λ a, β a.to_add) :=
⟨λ a, coe_fn a.to_add⟩


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

import measure_theory.function.continuous_map_dense
import measure_theory.integral.integral_eq_improper
import measure_theory.group.integration
import topology.continuous_function.zero_at_infty
import analysis.fourier.fourier_transform

/-!
# The Riemann-Lebesgue Lemma

In this file we prove a weak form of the Riemann-Lebesgue lemma, stating that for any
compactly-supported continuous function `f` on `ℝ` (valued in some complete normed space `E`), the
integral

`∫ (x : ℝ), exp (↑(t * x) * I) • f x`

tends to zero as `t → ∞`. (The actual lemma is that this holds for all `L¹` functions `f`, which
follows from the result proved here together with the fact that continuous, compactly-supported
functions are dense in `L¹(ℝ)`, which will be proved in a future iteration.)

## Main results

- `tendsto_integral_mul_exp_at_top_of_continuous_compact_support`: the Riemann-Lebesgue lemma for
  continuous compactly-supported functions on `ℝ`.
-/

open measure_theory filter complex set
open_locale filter topology real ennreal

section continuous_compact_support

variables {E : Type*} [normed_add_comm_group E] [normed_space ℂ E] {f : ℝ → E}

/-- The integrand in the Riemann-Lebesgue lemma is integrable. -/
lemma fourier_integrand_integrable (hf : integrable f) (t : ℝ) :
  integrable (λ x:ℝ, exp (↑(t * x) * I) • f x) :=
begin
  rw ←integrable_norm_iff,
  simp_rw [norm_smul, norm_exp_of_real_mul_I, one_mul],
  exacts [hf.norm, (continuous.ae_strongly_measurable (by continuity)).smul hf.1],
end

variable [complete_space E]

/-- Shifting `f` by `π / t` negates the integral in the Riemann-Lebesgue lemma. -/
lemma fourier_integral_half_period_translate {t : ℝ} (ht : t ≠ 0) :
  ∫ x:ℝ, exp (↑(t * x) * I) • f (x + π / t) = -∫ x:ℝ, exp (↑(t * x) * I) • f x :=
begin
  have : (λ x:ℝ, exp (↑(t * x) * I) • f (x + π / t)) =
    (λ x:ℝ, (λ y:ℝ, -exp (↑(t * y) * I) • f y) (x + π / t)),
  { ext1 x, dsimp only,
    rw [of_real_mul, of_real_mul, of_real_add, mul_add, add_mul, exp_add, ←neg_mul],
    replace ht := complex.of_real_ne_zero.mpr ht,
    have : ↑t * ↑(π / t) * I = π * I, by { field_simp, ring },
    rw [this, exp_pi_mul_I], ring_nf, },
  rw [this, integral_add_right_eq_self],
  simp_rw [neg_smul, integral_neg],
end

/-- Rewrite the Riemann-Lebesgue integral in a form that allows us to use uniform continuity. -/
lemma fourier_integral_eq_half_sub_half_period_translate
  {t : ℝ} (ht : t ≠ 0) (hf : integrable f) :
  ∫ x:ℝ, exp (↑(t * x) * I) • f x =
  (1 / (2 : ℂ)) • ∫ x:ℝ, exp (↑(t * x) * I) • (f x - f (x + π / t)) :=
begin
  simp_rw [smul_sub],
  rw [integral_sub, fourier_integral_half_period_translate ht, sub_eq_add_neg, neg_neg,
    ←two_smul ℂ _, ←@smul_assoc _ _ _ _ _ _ (is_scalar_tower.left ℂ), smul_eq_mul],
  norm_num,
  exacts [fourier_integrand_integrable hf t,
    fourier_integrand_integrable (hf.comp_add_right (π / t)) t],
end

/-- Riemann-Lebesgue Lemma for continuous and compactly-supported functions: the integral
`∫ x, exp (t * x * I) • f x` tends to 0 as `t` gets large.  -/
lemma tendsto_integral_mul_exp_at_top_of_continuous_compact_support
  (hf1 : continuous f) (hf2 : has_compact_support f) :
  tendsto (λ t:ℝ, ∫ x:ℝ, exp (↑(t * x) * I) • f x) at_top (𝓝 0) :=
begin
  simp_rw [normed_add_comm_group.tendsto_nhds_zero, eventually_at_top, ge_iff_le],
  intros ε hε,
  -- Extract an explicit candidate bound on `t` from uniform continuity.
  obtain ⟨R, hR1, hR2⟩ := hf2.exists_pos_le_norm,
  obtain ⟨δ, hδ1, hδ2⟩ := metric.uniform_continuous_iff.mp
    (hf2.uniform_continuous_of_continuous hf1) (ε / (1 + 2 * R)) (div_pos hε (by positivity)),
  refine ⟨max π (1 + π / δ), λ t ht, _⟩,
  have tpos : 0 < t := lt_of_lt_of_le real.pi_pos ((le_max_left _ _).trans ht),
  -- Rewrite integral in terms of `f x - f (x + π / t)`.
  rw fourier_integral_eq_half_sub_half_period_translate (lt_of_lt_of_le
    (lt_max_of_lt_left real.pi_pos) ht).ne' (hf1.integrable_of_has_compact_support hf2),
  rw [norm_smul, norm_eq_abs, ←complex.of_real_one, ←of_real_bit0, ←of_real_div,
    complex.abs_of_nonneg one_half_pos.le],
  have : ε = (1 / 2) * (2 * ε), by { field_simp, ring, },
  rw [this, mul_lt_mul_left (one_half_pos : (0:ℝ) < 1/2)],
  have : ‖∫ (x : ℝ), exp (↑(t * x) * I) • (f x - f (x + π / t))‖ ≤ ∫ (x : ℝ),
    ‖exp (↑(t * x) * I) • (f x - f (x + π / t))‖, from norm_integral_le_integral_norm _,
  refine lt_of_le_of_lt this _,
  simp_rw [norm_smul, norm_exp_of_real_mul_I, one_mul],
  -- Show integral can be taken over `[-(R + 1), R] ⊂ ℝ`.
  let A := Icc (-(R + 1)) R,
  have int_Icc : ∫ (x : ℝ), ‖f x - f (x + π / t)‖ = ∫ x in A, ‖f x - f (x + π / t)‖,
  { refine (set_integral_eq_integral_of_forall_compl_eq_zero (λ x hx, _)).symm,
    rw [mem_Icc, not_and_distrib, not_le, not_le, lt_neg] at hx,
    suffices : (f x = 0 ∧ f (x + π / t) = 0), by { rw [this.1, this.2, sub_zero, norm_zero], },
    have tp : 0 < t := real.pi_pos.trans_le ((le_max_left _ _).trans ht),
    refine ⟨hR2 x $ le_abs.mpr _, hR2 _ $ le_abs.mpr _⟩,
    { cases hx,
      { exact or.inr ((le_add_of_nonneg_right zero_le_one).trans hx.le) },
      { exact or.inl hx.le } },
    { cases hx,
      { refine or.inr _,
        rw [neg_add, ←sub_eq_add_neg, le_sub_iff_add_le],
        refine le_trans (add_le_add_left _ R) hx.le,
        exact (div_le_one tp).mpr ((le_max_left _ _).trans ht) },
      { exact or.inl (hx.trans $ lt_add_of_pos_right _ $ div_pos real.pi_pos tp).le } } },
  rw int_Icc,
  -- Bound integral using fact that ‖f x - f (x + π / t)‖ is small.
  have bdA : ∀ x : ℝ, (x ∈ A) → ‖ ‖f x - f (x + π / t) ‖ ‖ ≤ ε / (1 + 2 * R),
  { simp_rw norm_norm,
    refine (λ x _, le_of_lt _),
    simp_rw dist_eq_norm at hδ2,
    apply hδ2,
    rw [sub_add_cancel', real.norm_eq_abs, abs_neg, abs_of_pos (div_pos real.pi_pos tpos),
      div_lt_iff tpos, mul_comm, ←div_lt_iff hδ1],
    linarith [(le_max_right π (1 + π / δ)).trans ht] },
  have bdA2 := norm_set_integral_le_of_norm_le_const (measure_Icc_lt_top : volume A < ∞) bdA _,
  swap, { apply continuous.ae_strongly_measurable,
    exact (continuous_norm.comp $ continuous.sub hf1 $ continuous.comp hf1 $
    continuous_id'.add continuous_const) },
  have : ‖ _ ‖ = ∫ (x : ℝ) in A, ‖f x - f (x + π / t)‖ :=
    real.norm_of_nonneg (set_integral_nonneg measurable_set_Icc (λ x hx, norm_nonneg _)),
  rw this at bdA2,
  refine lt_of_le_of_lt bdA2 _,
  rw [real.volume_Icc, (by ring : R - (-(R + 1)) = 1 + 2 * R)],
  have hh : 0 < 1 + 2 * R, by positivity,
  rw [ennreal.to_real_of_real hh.le, div_mul_cancel _ hh.ne', two_mul],
  exact lt_add_of_pos_left _ hε,
end

lemma tendsto_integral_mul_exp_at_bot_of_continuous_compact_support
  (hf1 : continuous f) (hf2 : has_compact_support f) :
  tendsto (λ t:ℝ, ∫ x:ℝ, exp (↑(t * x) * I) • f x) at_bot (𝓝 0) :=
begin
  have hg2 : has_compact_support (f ∘ has_neg.neg),
    by simpa only [neg_one_smul] using hf2.comp_smul (neg_ne_zero.mpr $ one_ne_zero' ℝ),
  convert (tendsto_integral_mul_exp_at_top_of_continuous_compact_support (hf1.comp continuous_neg)
    hg2).comp tendsto_neg_at_bot_at_top,
  ext1 t,
  simp_rw [function.comp_app, neg_mul, ←mul_neg],
  rw ←integral_neg_eq_self,
end

lemma zero_at_infty_integral_mul_exp_of_continuous_compact_support
  (hf1 : continuous f) (hf2 : has_compact_support f) :
  tendsto (λ t:ℝ, ∫ x:ℝ, exp (↑(t * x) * I) • f x) (cocompact ℝ) (𝓝 0) :=
begin
  rw [real.cocompact_eq, tendsto_sup],
  exact ⟨tendsto_integral_mul_exp_at_bot_of_continuous_compact_support hf1 hf2,
    tendsto_integral_mul_exp_at_top_of_continuous_compact_support hf1 hf2⟩
end

open_locale fourier_transform

/-- Riemann-Lebesgue lemma for continuous compactly-supported functions: the Fourier transform
tends to 0 at infinity. -/
lemma real.fourier_integral_zero_at_infty_of_continuous_compact_support
  (hc : continuous f) (hs : has_compact_support f) :
  tendsto (𝓕 f) (cocompact ℝ) (𝓝 0) :=
begin
  refine ((zero_at_infty_integral_mul_exp_of_continuous_compact_support hc hs).comp
    (tendsto_cocompact_mul_left₀
    (mul_ne_zero (neg_ne_zero.mpr two_ne_zero) real.pi_pos.ne'))).congr (λ w, _),
  rw [real.fourier_integral_eq_integral_exp_smul, function.comp_app],
  congr' 1 with x:1,
  ring_nf,
end

end continuous_compact_support