/-
Copyright (c) 2021 Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth, Frédéric Dupuis
-/
import analysis.inner_product_space.calculus
import analysis.inner_product_space.dual
import analysis.calculus.lagrange_multipliers
import linear_algebra.eigenspace

/-!
# The Rayleigh quotient

The Rayleigh quotient of a self-adjoint operator `T` on an inner product space `E` is the function
`λ x, ⟪T x, x⟫ / ∥x∥ ^ 2`.

The main results of this file are `is_self_adjoint.has_eigenvector_of_is_max_on` and
`is_self_adjoint.has_eigenvector_of_is_min_on`, which state that if `E` is complete, and if the
Rayleigh quotient attains its global maximum/minimum over some sphere at the point `x₀`, then `x₀`
is an eigenvector of `T`, and the `supr`/`infi` of `λ x, ⟪T x, x⟫ / ∥x∥ ^ 2` is the corresponding
eigenvalue.

The corollaries `is_self_adjoint.has_eigenvalue_supr_of_finite_dimensional` and
`is_self_adjoint.has_eigenvalue_supr_of_finite_dimensional` state that if `E` is finite-dimensional
and nontrivial, then `T` has some (nonzero) eigenvectors with eigenvalue the `supr`/`infi` of
`λ x, ⟪T x, x⟫ / ∥x∥ ^ 2`.

## TODO

A slightly more elaborate corollary is that if `E` is complete and `T` is a compact operator, then
`T` has some (nonzero) eigenvector with eigenvalue either `⨆ x, ⟪T x, x⟫ / ∥x∥ ^ 2` or
`⨅ x, ⟪T x, x⟫ / ∥x∥ ^ 2` (not necessarily both).

-/

variables {𝕜 : Type*} [is_R_or_C 𝕜]
variables {E : Type*} [inner_product_space 𝕜 E]

local notation `⟪`x`, `y`⟫` := @inner 𝕜 _ _ x y
open_locale nnreal

open module.End metric

namespace continuous_linear_map
variables (T : E →L[𝕜] E)
local notation `rayleigh_quotient` := λ x : E, T.re_apply_inner_self x / ∥(x:E)∥ ^ 2

lemma rayleigh_smul (x : E) {c : 𝕜} (hc : c ≠ 0) :
  rayleigh_quotient (c • x) = rayleigh_quotient x :=
begin
  by_cases hx : x = 0,
  { simp [hx] },
  have : ∥c∥ ≠ 0 := by simp [hc],
  have : ∥x∥ ≠ 0 := by simp [hx],
  field_simp [norm_smul, T.re_apply_inner_self_smul],
  ring
end

lemma image_rayleigh_eq_image_rayleigh_sphere {r : ℝ} (hr : 0 < r) :
  rayleigh_quotient '' {0}ᶜ = rayleigh_quotient '' (sphere 0 r) :=
begin
  ext a,
  split,
  { rintros ⟨x, (hx : x ≠ 0), hxT⟩,
    have : ∥x∥ ≠ 0 := by simp [hx],
    let c : 𝕜 := ↑∥x∥⁻¹ * r,
    have : c ≠ 0 := by simp [c, hx, hr.ne'],
    refine ⟨c • x, _, _⟩,
    { field_simp [norm_smul, is_R_or_C.norm_eq_abs, abs_of_nonneg hr.le] },
    { rw T.rayleigh_smul x this,
      exact hxT } },
  { rintros ⟨x, hx, hxT⟩,
    exact ⟨x, nonzero_of_mem_sphere hr ⟨x, hx⟩, hxT⟩ },
end

lemma infi_rayleigh_eq_infi_rayleigh_sphere {r : ℝ} (hr : 0 < r) :
  (⨅ x : {x : E // x ≠ 0}, rayleigh_quotient x) = ⨅ x : sphere (0:E) r, rayleigh_quotient x :=
show (⨅ x : ({0} : set E)ᶜ, rayleigh_quotient x) = _,
by simp only [@cinfi_set _ _ _ _ rayleigh_quotient, T.image_rayleigh_eq_image_rayleigh_sphere hr]

end continuous_linear_map

namespace is_self_adjoint

section real
variables {F : Type*} [inner_product_space ℝ F]

lemma has_strict_fderiv_at_re_apply_inner_self
  {T : F →L[ℝ] F} (hT : is_self_adjoint (T : F →ₗ[ℝ] F)) (x₀ : F) :
  has_strict_fderiv_at T.re_apply_inner_self (bit0 (inner_right (T x₀))) x₀ :=
begin
  convert T.has_strict_fderiv_at.inner (has_strict_fderiv_at_id x₀),
  ext y,
  simp [bit0, hT.apply_clm x₀ y, real_inner_comm x₀]
end

variables [complete_space F] {T : F →L[ℝ] F}
local notation `rayleigh_quotient` := λ x : F, T.re_apply_inner_self x / ∥(x:F)∥ ^ 2

lemma linearly_dependent_of_is_local_extr_on (hT : is_self_adjoint (T : F →ₗ[ℝ] F))
  {x₀ : F} (hextr : is_local_extr_on T.re_apply_inner_self (sphere (0:F) ∥x₀∥) x₀) :
  ∃ a b : ℝ, (a, b) ≠ 0 ∧ a • x₀ + b • T x₀ = 0 :=
begin
  have H : is_local_extr_on T.re_apply_inner_self {x : F | ∥x∥ ^ 2 = ∥x₀∥ ^ 2} x₀,
  { convert hextr,
    ext x,
    simp [dist_eq_norm] },
  -- find Lagrange multipliers for the function `T.re_apply_inner_self` and the
  -- hypersurface-defining function `λ x, ∥x∥ ^ 2`
  obtain ⟨a, b, h₁, h₂⟩ := is_local_extr_on.exists_multipliers_of_has_strict_fderiv_at_1d H
    (has_strict_fderiv_at_norm_sq x₀) (hT.has_strict_fderiv_at_re_apply_inner_self x₀),
  refine ⟨a, b, h₁, _⟩,
  apply (inner_product_space.to_dual_map ℝ F).injective,
  simp only [linear_isometry.map_add, linear_isometry.map_smul, linear_isometry.map_zero],
  change a • inner_right x₀ + b • inner_right (T x₀) = 0,
  apply smul_right_injective (F →L[ℝ] ℝ) (two_ne_zero : (2:ℝ) ≠ 0),
  simpa only [bit0, add_smul, smul_add, one_smul, add_zero] using h₂
end

lemma eq_smul_self_of_is_local_extr_on_real (hT : is_self_adjoint (T : F →ₗ[ℝ] F))
  {x₀ : F} (hextr : is_local_extr_on T.re_apply_inner_self (sphere (0:F) ∥x₀∥) x₀) :
  T x₀ = (rayleigh_quotient x₀) • x₀ :=
begin
  obtain ⟨a, b, h₁, h₂⟩ := hT.linearly_dependent_of_is_local_extr_on hextr,
  by_cases hx₀ : x₀ = 0,
  { simp [hx₀] },
  by_cases hb : b = 0,
  { have : a ≠ 0 := by simpa [hb] using h₁,
    refine absurd _ hx₀,
    apply smul_right_injective F this,
    simpa [hb] using h₂ },
  let c : ℝ := - b⁻¹ * a,
  have hc : T x₀ = c • x₀,
  { have : b * (b⁻¹ * a) = a := by field_simp [mul_comm],
    apply smul_right_injective F hb,
    simp [c, ← neg_eq_of_add_eq_zero h₂, ← mul_smul, this] },
  convert hc,
  have : ∥x₀∥ ≠ 0 := by simp [hx₀],
  field_simp,
  simpa [inner_smul_left, real_inner_self_eq_norm_mul_norm, sq] using congr_arg (λ x, ⟪x, x₀⟫_ℝ) hc,
end

end real

section complete_space
variables [complete_space E] {T : E →L[𝕜] E}
local notation `rayleigh_quotient` := λ x : E, T.re_apply_inner_self x / ∥(x:E)∥ ^ 2

lemma eq_smul_self_of_is_local_extr_on (hT : is_self_adjoint (T : E →ₗ[𝕜] E)) {x₀ : E}
  (hextr : is_local_extr_on T.re_apply_inner_self (sphere (0:E) ∥x₀∥) x₀) :
  T x₀ = (↑(rayleigh_quotient x₀) : 𝕜) • x₀ :=
begin
  letI := inner_product_space.is_R_or_C_to_real 𝕜 E,
  letI : is_scalar_tower ℝ 𝕜 E := restrict_scalars.is_scalar_tower _ _ _,
  let S : E →L[ℝ] E :=
    @continuous_linear_map.restrict_scalars 𝕜 E E _ _ _ _ _ _ _ ℝ _ _ _ _ T,
  have hSA : is_self_adjoint (S : E →ₗ[ℝ] E) := λ x y, by
  { have := hT x y,
    simp only [continuous_linear_map.coe_coe] at this,
    simp only [real_inner_eq_re_inner, this, continuous_linear_map.coe_restrict_scalars,
      continuous_linear_map.coe_coe, linear_map.coe_restrict_scalars_eq_coe] },
  exact eq_smul_self_of_is_local_extr_on_real hSA hextr,
end

/-- For a self-adjoint operator `T`, a local extremum of the Rayleigh quotient of `T` on a sphere
centred at the origin is an eigenvector of `T`. -/
lemma has_eigenvector_of_is_local_extr_on (hT : is_self_adjoint (T : E →ₗ[𝕜] E)) {x₀ : E}
  (hx₀ : x₀ ≠ 0) (hextr : is_local_extr_on T.re_apply_inner_self (sphere (0:E) ∥x₀∥) x₀) :
  has_eigenvector (T : E →ₗ[𝕜] E) ↑(rayleigh_quotient x₀) x₀ :=
begin
  refine ⟨_, hx₀⟩,
  rw module.End.mem_eigenspace_iff,
  exact hT.eq_smul_self_of_is_local_extr_on hextr
end

/-- For a self-adjoint operator `T`, a maximum of the Rayleigh quotient of `T` on a sphere centred
at the origin is an eigenvector of `T`, with eigenvalue the global supremum of the Rayleigh
quotient. -/
lemma has_eigenvector_of_is_max_on (hT : is_self_adjoint (T : E →ₗ[𝕜] E)) {x₀ : E}
  (hx₀ : x₀ ≠ 0) (hextr : is_max_on T.re_apply_inner_self (sphere (0:E) ∥x₀∥) x₀) :
  has_eigenvector (T : E →ₗ[𝕜] E) ↑(⨆ x : {x : E // x ≠ 0}, rayleigh_quotient x) x₀ :=
begin
  convert hT.has_eigenvector_of_is_local_extr_on hx₀ (or.inr hextr.localize),
  have hx₀' : 0 < ∥x₀∥ := by simp [hx₀],
  have hx₀'' : x₀ ∈ sphere (0:E) (∥x₀∥) := by simp,
  rw T.supr_rayleigh_eq_supr_rayleigh_sphere hx₀',
  refine is_max_on.supr_eq hx₀'' _,
  intros x hx,
  dsimp,
  have : ∥x∥ = ∥x₀∥ := by simpa using hx,
  rw this,
  exact div_le_div_of_le (sq_nonneg ∥x₀∥) (hextr hx)
end

/-- For a self-adjoint operator `T`, a minimum of the Rayleigh quotient of `T` on a sphere centred
at the origin is an eigenvector of `T`, with eigenvalue the global infimum of the Rayleigh
quotient. -/
lemma has_eigenvector_of_is_min_on (hT : is_self_adjoint (T : E →ₗ[𝕜] E)) {x₀ : E}
  (hx₀ : x₀ ≠ 0) (hextr : is_min_on T.re_apply_inner_self (sphere (0:E) ∥x₀∥) x₀) :
  has_eigenvector (T : E →ₗ[𝕜] E) ↑(⨅ x : {x : E // x ≠ 0}, rayleigh_quotient x) x₀ :=
begin
  convert hT.has_eigenvector_of_is_local_extr_on hx₀ (or.inl hextr.localize),
  have hx₀' : 0 < ∥x₀∥ := by simp [hx₀],
  have hx₀'' : x₀ ∈ sphere (0:E) (∥x₀∥) := by simp,
  rw T.infi_rayleigh_eq_infi_rayleigh_sphere hx₀',
  refine is_min_on.infi_eq hx₀'' _,
  intros x hx,
  dsimp,
  have : ∥x∥ = ∥x₀∥ := by simpa using hx,
  rw this,
  exact div_le_div_of_le (sq_nonneg ∥x₀∥) (hextr hx)
end

end complete_space

section finite_dimensional
variables [finite_dimensional 𝕜 E] [_i : nontrivial E] {T : E →ₗ[𝕜] E}

include _i

/-- The supremum of the Rayleigh quotient of a self-adjoint operator `T` on a nontrivial
finite-dimensional vector space is an eigenvalue for that operator. -/
lemma has_eigenvalue_supr_of_finite_dimensional (hT : is_self_adjoint T) :
  has_eigenvalue T ↑(⨆ x : {x : E // x ≠ 0}, is_R_or_C.re ⟪T x, x⟫ / ∥(x:E)∥ ^ 2) :=
begin
  let T' : E →L[𝕜] E := T.to_continuous_linear_map,
  have hT' : is_self_adjoint (T' : E →ₗ[𝕜] E) := hT,
  obtain ⟨x, hx⟩ : ∃ x : E, x ≠ 0 := exists_ne 0,
  have H₁ : is_compact (sphere (0:E) ∥x∥) := is_compact_sphere _ _,
  have H₂ : (sphere (0:E) ∥x∥).nonempty := ⟨x, by simp⟩,
  -- key point: in finite dimension, a continuous function on the sphere has a max
  obtain ⟨x₀, hx₀', hTx₀⟩ :=
    H₁.exists_forall_ge H₂ T'.re_apply_inner_self_continuous.continuous_on,
  have hx₀ : ∥x₀∥ = ∥x∥ := by simpa using hx₀',
  have : is_max_on T'.re_apply_inner_self (sphere 0 ∥x₀∥) x₀,
  { simpa only [← hx₀] using hTx₀ },
  have hx₀_ne : x₀ ≠ 0,
  { have : ∥x₀∥ ≠ 0 := by simp only [hx₀, norm_eq_zero, hx, ne.def, not_false_iff],
    simpa [← norm_eq_zero, ne.def] },
  exact has_eigenvalue_of_has_eigenvector (hT'.has_eigenvector_of_is_max_on hx₀_ne this)
end

/-- The infimum of the Rayleigh quotient of a self-adjoint operator `T` on a nontrivial
finite-dimensional vector space is an eigenvalue for that operator. -/
lemma has_eigenvalue_infi_of_finite_dimensional (hT : is_self_adjoint T) :
  has_eigenvalue T ↑(⨅ x : {x : E // x ≠ 0}, is_R_or_C.re ⟪T x, x⟫ / ∥(x:E)∥ ^ 2) :=
begin
  let T' : E →L[𝕜] E := T.to_continuous_linear_map,
  have hT' : is_self_adjoint (T' : E →ₗ[𝕜] E) := hT,
  obtain ⟨x, hx⟩ : ∃ x : E, x ≠ 0 := exists_ne 0,
  have H₁ : is_compact (sphere (0:E) ∥x∥) := is_compact_sphere _ _,
  have H₂ : (sphere (0:E) ∥x∥).nonempty := ⟨x, by simp⟩,
  -- key point: in finite dimension, a continuous function on the sphere has a min
  obtain ⟨x₀, hx₀', hTx₀⟩ :=
    H₁.exists_forall_le H₂ T'.re_apply_inner_self_continuous.continuous_on,
  have hx₀ : ∥x₀∥ = ∥x∥ := by simpa using hx₀',
  have : is_min_on T'.re_apply_inner_self (sphere 0 ∥x₀∥) x₀,
  { simpa only [← hx₀] using hTx₀ },
  have hx₀_ne : x₀ ≠ 0,
  { have : ∥x₀∥ ≠ 0 := by simp only [hx₀, norm_eq_zero, hx, ne.def, not_false_iff],
    simpa [← norm_eq_zero, ne.def] },
  exact has_eigenvalue_of_has_eigenvector (hT'.has_eigenvector_of_is_min_on hx₀_ne this)
end

omit _i

lemma subsingleton_of_no_eigenvalue_finite_dimensional
  (hT : is_self_adjoint T) (hT' : ∀ μ : 𝕜, module.End.eigenspace (T : E →ₗ[𝕜] E) μ = ⊥) :
  subsingleton E :=
(subsingleton_or_nontrivial E).resolve_right
  (λ h, by exactI absurd (hT' _) hT.has_eigenvalue_supr_of_finite_dimensional)

end finite_dimensional

end is_self_adjoint


import analysis.normed_space.basic
import tactic.basic

noncomputable theory

open real

variables {α : Type*} {β : Type*}

lemma awesome_mt {p q : Prop} [decidable p] [decidable q] : p → q ↔ (¬q → ¬p) :=
by {constructor, exact mt, have w := @mt ¬q ¬p, rw [not_not, not_not] at w, exact w}

class has_ℝ_inner_product (α : Type*) := (inner_product : α → α → ℝ)

export has_ℝ_inner_product (inner_product)

class ℝ_inner_product_space (α : Type*) [add_comm_group α] [vector_space ℝ α] extends has_ℝ_inner_product α :=
(conj_symm : ∀ (x y : α), inner_product x y = inner_product y x)
(linearity : ∀ (x y z : α), ∀ (a : ℝ), inner_product (a • x + y) z = a * inner_product x z + inner_product y z)
(pos_def : ∀ (x : α), x ≠ 0 → inner_product x x > 0)

variables [decidable_eq α] [add_comm_group α] [vector_space ℝ α] [ℝ_inner_product_space α]

notation `⟪` x `∥` y `⟫` := inner_product x y

section ℝ_inner_product_space

lemma conj_symm (x y : α) : ⟪x ∥ y⟫ = ⟪y ∥ x⟫ :=
by apply ℝ_inner_product_space.conj_symm

lemma linearity (x y z : α) (a : ℝ) : ⟪a • x + y ∥ z⟫ = a * ⟪x ∥ z⟫ + ⟪y ∥ z⟫ :=
by apply ℝ_inner_product_space.linearity

@[simp] lemma add_left (x y z : α) : ⟪x + y ∥ z⟫ = ⟪x ∥ z⟫ + ⟪y ∥ z⟫ :=
by {have h := linearity x y z 1,
    simp only [one_mul, one_smul] at h,
    exact h}

lemma pos_def (x : α) : x ≠ 0 → ⟪x ∥ x⟫ > 0 :=
by apply ℝ_inner_product_space.pos_def

@[simp] lemma right_orthog_to_zero (x : α) : ⟪0 ∥ x⟫ = 0 :=
by {have h := linearity 0 0 x 1,
    rw [add_zero, one_mul, smul_zero] at h,
    conv at h {to_lhs, rw [←add_zero ⟪0 ∥ x⟫]},
    exact (add_left_cancel h).symm}

@[simp] lemma left_orthog_to_zero (x : α) : ⟪x ∥ 0⟫ = 0 :=
by {rw [conj_symm],
    exact right_orthog_to_zero x}

lemma zero_of_right_orthog_to_all (y : α) (h : ∀ (x : α), ⟪x ∥ y⟫ = 0) : y = 0 :=
by {have w := mt (pos_def y),
    simp [le_iff_lt_or_eq] at w,
    exact (w (or.inr (h y)))}

lemma zero_of_left_orthog_to_all (y : α) (h : ∀ (x : α), ⟪y ∥ x⟫ = 0) : y = 0 :=
by {apply zero_of_right_orthog_to_all y, intros x, rw [conj_symm], exact h x}

@[simp] lemma mul_left (x z : α) (a : ℝ) : ⟪a•x ∥ z⟫ = a*⟪x ∥ z⟫ :=
by {rw [←add_zero (a•x), ←add_zero (a*⟪x ∥ z⟫), ←right_orthog_to_zero z],
    exact linearity x 0 z a}

lemma left_ext (x y : α) (h : ∀ (z : α), ⟪x ∥ z⟫ = ⟪y ∥ z⟫) : x = y :=
begin
    have k : ∀ (z : α), ⟪x-y ∥ z⟫ = 0 := begin
        intros z,
        simp,
        rw [←add_right_neg ⟪y ∥ z⟫, ←neg_one_mul, ←mul_left, neg_one_smul],
        apply (congr_arg (λ g, g + ⟪-y ∥ z⟫)),
        exact h z,
    end,
    have k' := zero_of_left_orthog_to_all _ k,
    exact sub_eq_zero.1 k',
end

lemma right_ext (x y : α) (h : ∀ (z : α), ⟪z ∥ x⟫ = ⟪z ∥ y⟫) : x = y :=
begin
    apply left_ext x y,
    intros z,
    rw [conj_symm, conj_symm y],
    exact h z,
end

@[reducible] def norm_sq : α → ℝ := λ x, ⟪x ∥ x⟫

@[simp] lemma norm_sq_zero : norm_sq (0 : α) = 0 := right_orthog_to_zero 0

lemma zero_of_norm_sq_zero (x : α) (h : norm_sq x = 0) : x = 0 :=
by {by_contradiction,
  exact ne_of_gt (pos_def x a) h}

lemma zero_iff_norm_sq_zero (x : α) : norm_sq x = 0 ↔ x = 0 :=
⟨zero_of_norm_sq_zero x, by { rintro rfl, simp }⟩

-- Scott:
-- If we want to PR lots of these will need to be golfed in similar ways.
lemma neq_zero_iff_norm_sq_neq_zero (x : α) : norm_sq x ≠ 0 ↔ x ≠ 0 :=
⟨by {apply mt, exact (zero_iff_norm_sq_zero x).2}, by {apply mt, exact (zero_iff_norm_sq_zero x).1}⟩

@[simp] lemma norm_sq_nonneg (x : α) : norm_sq x ≥ 0 :=
by {apply le_iff_eq_or_lt.2, by_cases (x=0),
    {left, rw [h], exact norm_sq_zero.symm},
    {right, exact pos_def x h}}

@[simp] lemma add_right (x y z : α) : ⟪x ∥ y + z⟫ = ⟪x ∥ y⟫ + ⟪x ∥ z⟫ :=
by {rw [conj_symm, add_left, conj_symm, conj_symm z]}

@[simp] lemma mul_right (x y : α) (a : ℝ) : ⟪x ∥ a • y⟫ = a * ⟪x ∥ y⟫ :=
by {rw [conj_symm, mul_left, conj_symm]}

@[simp] lemma norm_sq_add (x y : α) : norm_sq (x+y) = norm_sq x + 2*⟪x ∥ y⟫ + norm_sq y :=
by {dsimp [norm_sq], simp, rw [conj_symm], ring}

@[simp] lemma norm_sq_neg_eq (x : α) : norm_sq (-x) = norm_sq x :=
by {dsimp [norm_sq],
    rw [←neg_one_smul ℝ, mul_left, mul_right,
        ←mul_assoc, ←neg_eq_neg_one_mul, neg_neg, one_mul]}

end ℝ_inner_product_space


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Bhavik Mehta
-/
import category_theory.pempty
import category_theory.limits.has_limits
import category_theory.epi_mono
import category_theory.category.preorder

/-!
# Initial and terminal objects in a category.

## References
* [Stacks: Initial and final objects](https://stacks.math.columbia.edu/tag/002B)
-/

noncomputable theory

universes w w' v v₁ v₂ u u₁ u₂

open category_theory

namespace category_theory.limits

variables {C : Type u₁} [category.{v₁} C]

local attribute [tidy] tactic.discrete_cases

/-- Construct a cone for the empty diagram given an object. -/
@[simps] def as_empty_cone (X : C) : cone (functor.empty.{0} C) := { X := X, π := by tidy }
/-- Construct a cocone for the empty diagram given an object. -/
@[simps] def as_empty_cocone (X : C) : cocone (functor.empty.{0} C) := { X := X, ι := by tidy }

/-- `X` is terminal if the cone it induces on the empty diagram is limiting. -/
abbreviation is_terminal (X : C) := is_limit (as_empty_cone X)
/-- `X` is initial if the cocone it induces on the empty diagram is colimiting. -/
abbreviation is_initial (X : C) := is_colimit (as_empty_cocone X)

/-- An object `Y` is terminal iff for every `X` there is a unique morphism `X ⟶ Y`. -/
def is_terminal_equiv_unique (F : discrete.{0} pempty.{1} ⥤ C) (Y : C) :
  is_limit (⟨Y, by tidy⟩ : cone F) ≃ ∀ X : C, unique (X ⟶ Y) :=
{ to_fun := λ t X, { default := t.lift ⟨X, by tidy⟩,
    uniq := λ f, t.uniq ⟨X, by tidy⟩ f (by tidy) },
  inv_fun := λ u, { lift := λ s, (u s.X).default, uniq' := λ s _ _, (u s.X).2 _ },
  left_inv := by tidy,
  right_inv := by tidy }

/-- An object `Y` is terminal if for every `X` there is a unique morphism `X ⟶ Y`
    (as an instance). -/
def is_terminal.of_unique (Y : C) [h : Π X : C, unique (X ⟶ Y)] : is_terminal Y :=
{ lift := λ s, (h s.X).default }

/-- If `α` is a preorder with top, then `⊤` is a terminal object. -/
def is_terminal_top {α : Type*} [preorder α] [order_top α] : is_terminal (⊤ : α) :=
is_terminal.of_unique _

/-- Transport a term of type `is_terminal` across an isomorphism. -/
def is_terminal.of_iso {Y Z : C} (hY : is_terminal Y) (i : Y ≅ Z) : is_terminal Z :=
is_limit.of_iso_limit hY
{ hom := { hom := i.hom },
  inv := { hom := i.inv } }

/-- An object `X` is initial iff for every `Y` there is a unique morphism `X ⟶ Y`. -/
def is_initial_equiv_unique (F : discrete.{0} pempty.{1} ⥤ C) (X : C) :
  is_colimit (⟨X, by tidy⟩ : cocone F) ≃ ∀ Y : C, unique (X ⟶ Y) :=
{ to_fun := λ t X, { default := t.desc ⟨X, by tidy⟩,
    uniq := λ f, t.uniq ⟨X, by tidy⟩ f (by tidy) },
  inv_fun := λ u, { desc := λ s, (u s.X).default, uniq' := λ s _ _, (u s.X).2 _ },
  left_inv := by tidy,
  right_inv := by tidy }

/-- An object `X` is initial if for every `Y` there is a unique morphism `X ⟶ Y`
    (as an instance). -/
def is_initial.of_unique (X : C) [h : Π Y : C, unique (X ⟶ Y)] : is_initial X :=
{ desc := λ s, (h s.X).default }

/-- If `α` is a preorder with bot, then `⊥` is an initial object. -/
def is_initial_bot {α : Type*} [preorder α] [order_bot α] : is_initial (⊥ : α) :=
is_initial.of_unique _

/-- Transport a term of type `is_initial` across an isomorphism. -/
def is_initial.of_iso {X Y : C} (hX : is_initial X) (i : X ≅ Y) : is_initial Y :=
is_colimit.of_iso_colimit hX
{ hom := { hom := i.hom },
  inv := { hom := i.inv } }

/-- Give the morphism to a terminal object from any other. -/
def is_terminal.from {X : C} (t : is_terminal X) (Y : C) : Y ⟶ X :=
t.lift (as_empty_cone Y)

/-- Any two morphisms to a terminal object are equal. -/
lemma is_terminal.hom_ext {X Y : C} (t : is_terminal X) (f g : Y ⟶ X) : f = g :=
t.hom_ext (by tidy)

@[simp] lemma is_terminal.comp_from {Z : C} (t : is_terminal Z) {X Y : C} (f : X ⟶ Y) :
  f ≫ t.from Y = t.from X :=
t.hom_ext _ _

@[simp] lemma is_terminal.from_self {X : C} (t : is_terminal X) : t.from X = 𝟙 X :=
t.hom_ext _ _

/-- Give the morphism from an initial object to any other. -/
def is_initial.to {X : C} (t : is_initial X) (Y : C) : X ⟶ Y :=
t.desc (as_empty_cocone Y)

/-- Any two morphisms from an initial object are equal. -/
lemma is_initial.hom_ext {X Y : C} (t : is_initial X) (f g : X ⟶ Y) : f = g :=
t.hom_ext (by tidy)

@[simp] lemma is_initial.to_comp {X : C} (t : is_initial X) {Y Z : C} (f : Y ⟶ Z) :
  t.to Y ≫ f = t.to Z :=
t.hom_ext _ _

@[simp] lemma is_initial.to_self {X : C} (t : is_initial X) : t.to X = 𝟙 X :=
t.hom_ext _ _

/-- Any morphism from a terminal object is split mono. -/
def is_terminal.split_mono_from {X Y : C} (t : is_terminal X) (f : X ⟶ Y) : split_mono f :=
⟨t.from _, t.hom_ext _ _⟩

/-- Any morphism to an initial object is split epi. -/
def is_initial.split_epi_to {X Y : C} (t : is_initial X) (f : Y ⟶ X) : split_epi f :=
⟨t.to _, t.hom_ext _ _⟩

/-- Any morphism from a terminal object is mono. -/
lemma is_terminal.mono_from {X Y : C} (t : is_terminal X) (f : X ⟶ Y) : mono f :=
by haveI := t.split_mono_from f; apply_instance

/-- Any morphism to an initial object is epi. -/
lemma is_initial.epi_to {X Y : C} (t : is_initial X) (f : Y ⟶ X) : epi f :=
by haveI := t.split_epi_to f; apply_instance

/-- If `T` and `T'` are terminal, they are isomorphic. -/
@[simps]
def is_terminal.unique_up_to_iso {T T' : C} (hT : is_terminal T) (hT' : is_terminal T') : T ≅ T' :=
{ hom := hT'.from _,
  inv := hT.from _ }

/-- If `I` and `I'` are initial, they are isomorphic. -/
@[simps]
def is_initial.unique_up_to_iso {I I' : C} (hI : is_initial I) (hI' : is_initial I') : I ≅ I' :=
{ hom := hI.to _,
  inv := hI'.to _ }

variable (C)

/--
A category has a terminal object if it has a limit over the empty diagram.
Use `has_terminal_of_unique` to construct instances.
-/
abbreviation has_terminal := has_limits_of_shape (discrete.{0} pempty) C
/--
A category has an initial object if it has a colimit over the empty diagram.
Use `has_initial_of_unique` to construct instances.
-/
abbreviation has_initial := has_colimits_of_shape (discrete.{0} pempty) C

section univ

variables (X : C) {F₁ : discrete.{w} pempty ⥤ C} {F₂ : discrete.{w'} pempty ⥤ C}

/-- Being terminal is independent of the empty diagram, its universe, and the cone over it,
    as long as the cone points are isomorphic. -/
def is_limit_change_empty_cone {c₁ : cone F₁} (hl : is_limit c₁)
  (c₂ : cone F₂) (hi : c₁.X ≅ c₂.X) : is_limit c₂ :=
{ lift := λ c, hl.lift ⟨c.X, by tidy⟩ ≫ hi.hom,
  fac' := λ _ j, j.as.elim,
  uniq' := λ c f _, by { erw ← hl.uniq ⟨c.X, by tidy⟩ (f ≫ hi.inv) (λ j, j.as.elim), simp } }

/-- Replacing an empty cone in `is_limit` by another with the same cone point
    is an equivalence. -/
def is_limit_empty_cone_equiv (c₁ : cone F₁) (c₂ : cone F₂) (h : c₁.X ≅ c₂.X) :
  is_limit c₁ ≃ is_limit c₂ :=
{ to_fun := λ hl, is_limit_change_empty_cone C hl c₂ h,
  inv_fun := λ hl, is_limit_change_empty_cone C hl c₁ h.symm,
  left_inv := by tidy,
  right_inv := by tidy }

lemma has_terminal_change_diagram (h : has_limit F₁) : has_limit F₂ :=
⟨⟨⟨⟨limit F₁, by tidy⟩, is_limit_change_empty_cone C (limit.is_limit F₁) _ (eq_to_iso rfl)⟩⟩⟩

lemma has_terminal_change_universe [h : has_limits_of_shape (discrete.{w} pempty) C] :
  has_limits_of_shape (discrete.{w'} pempty) C :=
{ has_limit := λ J, has_terminal_change_diagram C (let f := h.1 in f (functor.empty C)) }

/-- Being initial is independent of the empty diagram, its universe, and the cocone over it,
    as long as the cocone points are isomorphic. -/
def is_colimit_change_empty_cocone {c₁ : cocone F₁} (hl : is_colimit c₁)
  (c₂ : cocone F₂) (hi : c₁.X ≅ c₂.X) : is_colimit c₂ :=
{ desc := λ c, hi.inv ≫ hl.desc ⟨c.X, by tidy⟩,
  fac' := λ _ j, j.as.elim,
  uniq' := λ c f _, by { erw ← hl.uniq ⟨c.X, by tidy⟩ (hi.hom ≫ f) (λ j, j.as.elim), simp } }

/-- Replacing an empty cocone in `is_colimit` by another with the same cocone point
    is an equivalence. -/
def is_colimit_empty_cocone_equiv (c₁ : cocone F₁) (c₂ : cocone F₂) (h : c₁.X ≅ c₂.X) :
  is_colimit c₁ ≃ is_colimit c₂ :=
{ to_fun := λ hl, is_colimit_change_empty_cocone C hl c₂ h,
  inv_fun := λ hl, is_colimit_change_empty_cocone C hl c₁ h.symm,
  left_inv := by tidy,
  right_inv := by tidy }

lemma has_initial_change_diagram (h : has_colimit F₁) : has_colimit F₂ :=
⟨⟨⟨⟨colimit F₁, by tidy⟩,
   is_colimit_change_empty_cocone C (colimit.is_colimit F₁) _ (eq_to_iso rfl)⟩⟩⟩

lemma has_initial_change_universe [h : has_colimits_of_shape (discrete.{w} pempty) C] :
  has_colimits_of_shape (discrete.{w'} pempty) C :=
{ has_colimit := λ J, has_initial_change_diagram C (let f := h.1 in f (functor.empty C)) }

end univ

/--
An arbitrary choice of terminal object, if one exists.
You can use the notation `⊤_ C`.
This object is characterized by having a unique morphism from any object.
-/
abbreviation terminal [has_terminal C] : C := limit (functor.empty.{0} C)
/--
An arbitrary choice of initial object, if one exists.
You can use the notation `⊥_ C`.
This object is characterized by having a unique morphism to any object.
-/
abbreviation initial [has_initial C] : C := colimit (functor.empty.{0} C)

notation `⊤_ ` C:20 := terminal C
notation `⊥_ ` C:20 := initial C

section
variables {C}

/-- We can more explicitly show that a category has a terminal object by specifying the object,
and showing there is a unique morphism to it from any other object. -/
lemma has_terminal_of_unique (X : C) [h : Π Y : C, unique (Y ⟶ X)] : has_terminal C :=
{ has_limit := λ F, has_limit.mk ⟨_, (is_terminal_equiv_unique F X).inv_fun h⟩ }

/-- We can more explicitly show that a category has an initial object by specifying the object,
and showing there is a unique morphism from it to any other object. -/
lemma has_initial_of_unique (X : C) [h : Π Y : C, unique (X ⟶ Y)] : has_initial C :=
{ has_colimit := λ F, has_colimit.mk ⟨_, (is_initial_equiv_unique F X).inv_fun h⟩ }

/-- The map from an object to the terminal object. -/
abbreviation terminal.from [has_terminal C] (P : C) : P ⟶ ⊤_ C :=
limit.lift (functor.empty C) (as_empty_cone P)
/-- The map to an object from the initial object. -/
abbreviation initial.to [has_initial C] (P : C) : ⊥_ C ⟶ P :=
colimit.desc (functor.empty C) (as_empty_cocone P)

/-- A terminal object is terminal. -/
def terminal_is_terminal [has_terminal C] : is_terminal (⊤_ C) :=
{ lift := λ s, terminal.from _ }

/-- An initial object is initial. -/
def initial_is_initial [has_initial C] : is_initial (⊥_ C) :=
{ desc := λ s, initial.to _ }

instance unique_to_terminal [has_terminal C] (P : C) : unique (P ⟶ ⊤_ C) :=
is_terminal_equiv_unique _ (⊤_ C) terminal_is_terminal P

instance unique_from_initial [has_initial C] (P : C) : unique (⊥_ C ⟶ P) :=
is_initial_equiv_unique _ (⊥_ C) initial_is_initial P

@[simp] lemma terminal.comp_from [has_terminal C] {P Q : C} (f : P ⟶ Q) :
  f ≫ terminal.from Q = terminal.from P :=
by tidy
@[simp] lemma initial.to_comp [has_initial C] {P Q : C} (f : P ⟶ Q) :
  initial.to P ≫ f = initial.to Q :=
by tidy

/-- The (unique) isomorphism between the chosen initial object and any other initial object. -/
@[simp] def initial_iso_is_initial [has_initial C] {P : C} (t : is_initial P) : ⊥_ C ≅ P :=
initial_is_initial.unique_up_to_iso t

/-- The (unique) isomorphism between the chosen terminal object and any other terminal object. -/
@[simp] def terminal_iso_is_terminal [has_terminal C] {P : C}  (t : is_terminal P) : ⊤_ C ≅ P :=
terminal_is_terminal.unique_up_to_iso t

/-- Any morphism from a terminal object is split mono. -/
instance terminal.split_mono_from {Y : C} [has_terminal C] (f : ⊤_ C ⟶ Y) : split_mono f :=
is_terminal.split_mono_from terminal_is_terminal _

/-- Any morphism to an initial object is split epi. -/
instance initial.split_epi_to {Y : C} [has_initial C] (f : Y ⟶ ⊥_ C) : split_epi f :=
is_initial.split_epi_to initial_is_initial _

/-- An initial object is terminal in the opposite category. -/
def terminal_op_of_initial {X : C} (t : is_initial X) : is_terminal (opposite.op X) :=
{ lift := λ s, (t.to s.X.unop).op,
  uniq' := λ s m w, quiver.hom.unop_inj (t.hom_ext _ _) }

/-- An initial object in the opposite category is terminal in the original category. -/
def terminal_unop_of_initial {X : Cᵒᵖ} (t : is_initial X) : is_terminal X.unop :=
{ lift := λ s, (t.to (opposite.op s.X)).unop,
  uniq' := λ s m w, quiver.hom.op_inj (t.hom_ext _ _) }

/-- A terminal object is initial in the opposite category. -/
def initial_op_of_terminal {X : C} (t : is_terminal X) : is_initial (opposite.op X) :=
{ desc := λ s, (t.from s.X.unop).op,
  uniq' := λ s m w, quiver.hom.unop_inj (t.hom_ext _ _) }

/-- A terminal object in the opposite category is initial in the original category. -/
def initial_unop_of_terminal {X : Cᵒᵖ} (t : is_terminal X) : is_initial X.unop :=
{ desc := λ s, (t.from (opposite.op s.X)).unop,
  uniq' := λ s m w, quiver.hom.op_inj (t.hom_ext _ _) }

instance {J : Type*} [category J] {C : Type*} [category C] [has_terminal C] :
  has_limit ((category_theory.functor.const J).obj (⊤_ C)) :=
has_limit.mk
{ cone :=
  { X := ⊤_ C,
    π := { app := λ _, terminal.from _, }, },
  is_limit :=
  { lift := λ s, terminal.from _, }, }

/-- The limit of the constant `⊤_ C` functor is `⊤_ C`. -/
@[simps hom]
def limit_const_terminal {J : Type*} [category J] {C : Type*} [category C] [has_terminal C] :
  limit ((category_theory.functor.const J).obj (⊤_ C)) ≅ ⊤_ C :=
{ hom := terminal.from _,
  inv := limit.lift ((category_theory.functor.const J).obj (⊤_ C))
    { X := ⊤_ C, π := { app := λ j, terminal.from _, }}, }

@[simp, reassoc] lemma limit_const_terminal_inv_π
  {J : Type*} [category J] {C : Type*} [category C] [has_terminal C] {j : J} :
  limit_const_terminal.inv ≫ limit.π ((category_theory.functor.const J).obj (⊤_ C)) j =
    terminal.from _ :=
by ext ⟨⟨⟩⟩

instance {J : Type*} [category J] {C : Type*} [category C] [has_initial C] :
  has_colimit ((category_theory.functor.const J).obj (⊥_ C)) :=
has_colimit.mk
{ cocone :=
  { X := ⊥_ C,
    ι := { app := λ _, initial.to _, }, },
  is_colimit :=
  { desc := λ s, initial.to _, }, }

/-- The colimit of the constant `⊥_ C` functor is `⊥_ C`. -/
@[simps inv]
def colimit_const_initial {J : Type*} [category J] {C : Type*} [category C] [has_initial C] :
  colimit ((category_theory.functor.const J).obj (⊥_ C)) ≅ ⊥_ C :=
{ hom := colimit.desc ((category_theory.functor.const J).obj (⊥_ C))
    { X := ⊥_ C, ι := { app := λ j, initial.to _, }, },
  inv := initial.to _, }

@[simp, reassoc] lemma ι_colimit_const_initial_hom
  {J : Type*} [category J] {C : Type*} [category C] [has_initial C] {j : J} :
  colimit.ι ((category_theory.functor.const J).obj (⊥_ C)) j ≫ colimit_const_initial.hom =
    initial.to _ :=
by ext ⟨⟨⟩⟩

/-- A category is a `initial_mono_class` if the canonical morphism of an initial object is a
monomorphism.  In practice, this is most useful when given an arbitrary morphism out of the chosen
initial object, see `initial.mono_from`.
Given a terminal object, this is equivalent to the assumption that the unique morphism from initial
to terminal is a monomorphism, which is the second of Freyd's axioms for an AT category.

TODO: This is a condition satisfied by categories with zero objects and morphisms.
-/
class initial_mono_class (C : Type u₁) [category.{v₁} C] : Prop :=
(is_initial_mono_from : ∀ {I} (X : C) (hI : is_initial I), mono (hI.to X))

lemma is_initial.mono_from [initial_mono_class C] {I} {X : C} (hI : is_initial I) (f : I ⟶ X) :
  mono f :=
begin
  rw hI.hom_ext f (hI.to X),
  apply initial_mono_class.is_initial_mono_from,
end

@[priority 100]
instance initial.mono_from [has_initial C] [initial_mono_class C] (X : C) (f : ⊥_ C ⟶ X) :
  mono f :=
initial_is_initial.mono_from f

/-- To show a category is a `initial_mono_class` it suffices to give an initial object such that
every morphism out of it is a monomorphism. -/
lemma initial_mono_class.of_is_initial {I : C} (hI : is_initial I) (h : ∀ X, mono (hI.to X)) :
  initial_mono_class C :=
{ is_initial_mono_from := λ I' X hI',
  begin
    rw hI'.hom_ext (hI'.to X) ((hI'.unique_up_to_iso hI).hom ≫ hI.to X),
    apply mono_comp,
  end }

/-- To show a category is a `initial_mono_class` it suffices to show every morphism out of the
initial object is a monomorphism. -/
lemma initial_mono_class.of_initial [has_initial C] (h : ∀ X : C, mono (initial.to X)) :
  initial_mono_class C :=
initial_mono_class.of_is_initial initial_is_initial h

/-- To show a category is a `initial_mono_class` it suffices to show the unique morphism from an
initial object to a terminal object is a monomorphism. -/
lemma initial_mono_class.of_is_terminal {I T : C} (hI : is_initial I) (hT : is_terminal T)
  (f : mono (hI.to T)) :
  initial_mono_class C :=
initial_mono_class.of_is_initial hI (λ X, mono_of_mono_fac (hI.hom_ext (_ ≫ hT.from X) (hI.to T)))

/-- To show a category is a `initial_mono_class` it suffices to show the unique morphism from the
initial object to a terminal object is a monomorphism. -/
lemma initial_mono_class.of_terminal [has_initial C] [has_terminal C]
  (h : mono (initial.to (⊤_ C))) :
  initial_mono_class C :=
initial_mono_class.of_is_terminal initial_is_initial terminal_is_terminal h

section comparison
variables {D : Type u₂} [category.{v₂} D] (G : C ⥤ D)

/--
The comparison morphism from the image of a terminal object to the terminal object in the target
category.
This is an isomorphism iff `G` preserves terminal objects, see
`category_theory.limits.preserves_terminal.of_iso_comparison`.
-/
def terminal_comparison [has_terminal C] [has_terminal D] :
  G.obj (⊤_ C) ⟶ ⊤_ D :=
terminal.from _

/--
The comparison morphism from the initial object in the target category to the image of the initial
object.
-/
-- TODO: Show this is an isomorphism if and only if `G` preserves initial objects.
def initial_comparison [has_initial C] [has_initial D] :
  ⊥_ D ⟶ G.obj (⊥_ C) :=
initial.to _

end comparison

variables {J : Type u} [category.{v} J]

/-- From a functor `F : J ⥤ C`, given an initial object of `J`, construct a cone for `J`.
In `limit_of_diagram_initial` we show it is a limit cone. -/
@[simps]
def cone_of_diagram_initial
  {X : J} (tX : is_initial X) (F : J ⥤ C) : cone F :=
{ X := F.obj X,
  π :=
  { app := λ j, F.map (tX.to j),
    naturality' := λ j j' k,
    begin
      dsimp,
      rw [← F.map_comp, category.id_comp, tX.hom_ext (tX.to j ≫ k) (tX.to j')],
    end } }

/-- From a functor `F : J ⥤ C`, given an initial object of `J`, show the cone
`cone_of_diagram_initial` is a limit. -/
def limit_of_diagram_initial
  {X : J} (tX : is_initial X) (F : J ⥤ C) :
is_limit (cone_of_diagram_initial tX F) :=
{ lift := λ s, s.π.app X,
  uniq' := λ s m w,
    begin
      rw [← w X, cone_of_diagram_initial_π_app, tX.hom_ext (tX.to X) (𝟙 _)],
      dsimp, simp -- See note [dsimp, simp]
    end}

-- This is reducible to allow usage of lemmas about `cone_point_unique_up_to_iso`.
/-- For a functor `F : J ⥤ C`, if `J` has an initial object then the image of it is isomorphic
to the limit of `F`. -/
@[reducible]
def limit_of_initial (F : J ⥤ C)
  [has_initial J] [has_limit F] :
limit F ≅ F.obj (⊥_ J) :=
is_limit.cone_point_unique_up_to_iso
  (limit.is_limit _)
  (limit_of_diagram_initial initial_is_initial F)

/-- From a functor `F : J ⥤ C`, given a terminal object of `J`, construct a cone for `J`,
provided that the morphisms in the diagram are isomorphisms.
In `limit_of_diagram_terminal` we show it is a limit cone. -/
@[simps]
def cone_of_diagram_terminal {X : J} (hX : is_terminal X)
  (F : J ⥤ C) [∀ (i j : J) (f : i ⟶ j), is_iso (F.map f)] : cone F :=
{ X := F.obj X,
  π :=
  { app := λ i, inv (F.map (hX.from _)),
    naturality' := begin
      intros i j f,
      dsimp,
      simp only [is_iso.eq_inv_comp, is_iso.comp_inv_eq, category.id_comp,
        ← F.map_comp, hX.hom_ext (hX.from i) (f ≫ hX.from j)],
    end } }

/-- From a functor `F : J ⥤ C`, given a terminal object of `J` and that the morphisms in the
diagram are isomorphisms, show the cone `cone_of_diagram_terminal` is a limit. -/
def limit_of_diagram_terminal {X : J} (hX : is_terminal X)
  (F : J ⥤ C) [∀ (i j : J) (f : i ⟶ j), is_iso (F.map f)] :
  is_limit (cone_of_diagram_terminal hX F) :=
{ lift := λ S, S.π.app _ }

-- This is reducible to allow usage of lemmas about `cone_point_unique_up_to_iso`.
/-- For a functor `F : J ⥤ C`, if `J` has a terminal object and all the morphisms in the diagram
are isomorphisms, then the image of the terminal object is isomorphic to the limit of `F`. -/
@[reducible]
def limit_of_terminal (F : J ⥤ C)
  [has_terminal J] [has_limit F] [∀ (i j : J) (f : i ⟶ j), is_iso (F.map f)] :
limit F ≅ F.obj (⊤_ J) :=
is_limit.cone_point_unique_up_to_iso
  (limit.is_limit _)
  (limit_of_diagram_terminal terminal_is_terminal F)

/-- From a functor `F : J ⥤ C`, given a terminal object of `J`, construct a cocone for `J`.
In `colimit_of_diagram_terminal` we show it is a colimit cocone. -/
@[simps]
def cocone_of_diagram_terminal
  {X : J} (tX : is_terminal X) (F : J ⥤ C) : cocone F :=
{ X := F.obj X,
  ι :=
  { app := λ j, F.map (tX.from j),
    naturality' := λ j j' k,
    begin
      dsimp,
      rw [← F.map_comp, category.comp_id, tX.hom_ext (k ≫ tX.from j') (tX.from j)],
    end } }

/-- From a functor `F : J ⥤ C`, given a terminal object of `J`, show the cocone
`cocone_of_diagram_terminal` is a colimit. -/
def colimit_of_diagram_terminal
  {X : J} (tX : is_terminal X) (F : J ⥤ C) :
is_colimit (cocone_of_diagram_terminal tX F) :=
{ desc := λ s, s.ι.app X,
  uniq' := λ s m w,
    by { rw [← w X, cocone_of_diagram_terminal_ι_app, tX.hom_ext (tX.from X) (𝟙 _)], simp } }

-- This is reducible to allow usage of lemmas about `cocone_point_unique_up_to_iso`.
/-- For a functor `F : J ⥤ C`, if `J` has a terminal object then the image of it is isomorphic
to the colimit of `F`. -/
@[reducible]
def colimit_of_terminal (F : J ⥤ C)
  [has_terminal J] [has_colimit F] :
colimit F ≅ F.obj (⊤_ J) :=
is_colimit.cocone_point_unique_up_to_iso
  (colimit.is_colimit _)
  (colimit_of_diagram_terminal terminal_is_terminal F)

/-- From a functor `F : J ⥤ C`, given an initial object of `J`, construct a cocone for `J`,
provided that the morphisms in the diagram are isomorphisms.
In `colimit_of_diagram_initial` we show it is a colimit cocone. -/
@[simps]
def cocone_of_diagram_initial {X : J} (hX : is_initial X) (F : J ⥤ C)
  [∀ (i j : J) (f : i ⟶ j), is_iso (F.map f)] : cocone F :=
{ X := F.obj X,
  ι :=
  { app := λ i, inv (F.map (hX.to _)),
    naturality' := begin
      intros i j f,
      dsimp,
      simp only [is_iso.eq_inv_comp, is_iso.comp_inv_eq, category.comp_id,
        ← F.map_comp, hX.hom_ext (hX.to i ≫ f) (hX.to j)],
    end } }

/-- From a functor `F : J ⥤ C`, given an initial object of `J` and that the morphisms in the
diagram are isomorphisms, show the cone `cocone_of_diagram_initial` is a colimit. -/
def colimit_of_diagram_initial {X : J} (hX : is_initial X) (F : J ⥤ C)
  [∀ (i j : J) (f : i ⟶ j), is_iso (F.map f)] : is_colimit (cocone_of_diagram_initial hX F) :=
{ desc := λ S, S.ι.app _ }

-- This is reducible to allow usage of lemmas about `cocone_point_unique_up_to_iso`.
/-- For a functor `F : J ⥤ C`, if `J` has an initial object and all the morphisms in the diagram
are isomorphisms, then the image of the initial object is isomorphic to the colimit of `F`. -/
@[reducible]
def colimit_of_initial (F : J ⥤ C)
  [has_initial J] [has_colimit F] [∀ (i j : J) (f : i ⟶ j), is_iso (F.map f)] :
colimit F ≅ F.obj (⊥_ J) :=
is_colimit.cocone_point_unique_up_to_iso
  (colimit.is_colimit _)
  (colimit_of_diagram_initial initial_is_initial _)

/--
If `j` is initial in the index category, then the map `limit.π F j` is an isomorphism.
-/
lemma is_iso_π_of_is_initial {j : J} (I : is_initial j) (F : J ⥤ C) [has_limit F] :
  is_iso (limit.π F j) :=
⟨⟨limit.lift _ (cone_of_diagram_initial I F), ⟨by { ext, simp }, by simp⟩⟩⟩

instance is_iso_π_initial [has_initial J] (F : J ⥤ C) [has_limit F] :
  is_iso (limit.π F (⊥_ J)) :=
is_iso_π_of_is_initial (initial_is_initial) F

lemma is_iso_π_of_is_terminal {j : J} (I : is_terminal j) (F : J ⥤ C)
  [has_limit F] [∀ (i j : J) (f : i ⟶ j), is_iso (F.map f)] : is_iso (limit.π F j) :=
⟨⟨limit.lift _ (cone_of_diagram_terminal I F), by { ext, simp }, by simp ⟩⟩

instance is_iso_π_terminal [has_terminal J] (F : J ⥤ C) [has_limit F]
  [∀ (i j : J) (f : i ⟶ j), is_iso (F.map f)] : is_iso (limit.π F (⊤_ J)) :=
is_iso_π_of_is_terminal terminal_is_terminal F

/--
If `j` is terminal in the index category, then the map `colimit.ι F j` is an isomorphism.
-/
lemma is_iso_ι_of_is_terminal {j : J} (I : is_terminal j) (F : J ⥤ C) [has_colimit F] :
  is_iso (colimit.ι F j) :=
⟨⟨colimit.desc _ (cocone_of_diagram_terminal I F), ⟨by simp, by { ext, simp }⟩⟩⟩

instance is_iso_ι_terminal [has_terminal J] (F : J ⥤ C) [has_colimit F] :
  is_iso (colimit.ι F (⊤_ J)) :=
is_iso_ι_of_is_terminal (terminal_is_terminal) F

lemma is_iso_ι_of_is_initial {j : J} (I : is_initial j) (F : J ⥤ C)
  [has_colimit F] [∀ (i j : J) (f : i ⟶ j), is_iso (F.map f)] : is_iso (colimit.ι F j) :=
⟨⟨colimit.desc _ (cocone_of_diagram_initial I F), ⟨by tidy, by { ext, simp }⟩⟩⟩

instance is_iso_ι_initial [has_initial J] (F : J ⥤ C) [has_colimit F]
  [∀ (i j : J) (f : i ⟶ j), is_iso (F.map f)] : is_iso (colimit.ι F (⊥_ J)) :=
is_iso_ι_of_is_initial initial_is_initial F

end

end category_theory.limits


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Patrick Massot

! This file was ported from Lean 3 source module algebra.group.pi
! leanprover-community/mathlib commit b3f25363ae62cb169e72cd6b8b1ac97bacf21ca7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Logic.Pairwise
import Mathlib.Algebra.Hom.GroupInstances
import Mathlib.Data.Pi.Algebra
import Mathlib.Data.Set.Function

/-!
# Pi instances for groups and monoids

This file defines instances for group, monoid, semigroup and related structures on Pi types.
-/

/-
  Porting notes:

  See this Zulip discussion: [https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/not.20porting.20pi_instance]

  * This file now includes the pi instances for `AddMonoidWithOne` and `AddGroupWithOne`
  * This file relied on the `pi_instance` tactic, which was not available at the time of porting.
    The comment `--pi_instance` is inserted before all fields which were previously derived by
    `pi_instance`.
  * This file previously gave data fields explicitly. Now previously-defined instances are sourced
    via `with` as much as possible.
-/

universe u v w

variable {ι α : Type _}

variable {I : Type u}

-- The indexing type
variable {f : I → Type v}

-- The family of types already equipped with instances
variable (x y : ∀ i, f i) (i : I)

@[to_additive]
theorem Set.preimage_one {α β : Type _} [One β] (s : Set β) [Decidable ((1 : β) ∈ s)] :
    (1 : α → β) ⁻¹' s = if (1 : β) ∈ s then Set.univ else ∅ :=
  Set.preimage_const 1 s
#align set.preimage_one Set.preimage_one
#align set.preimage_zero Set.preimage_zero

namespace Pi

@[to_additive]
instance semigroup [∀ i, Semigroup <| f i] : Semigroup (∀ i : I, f i) :=
  { mul := (· * ·)
    --pi_instance
    mul_assoc := by intros; ext; exact mul_assoc _ _ _ }
#align pi.semigroup Pi.semigroup
#align pi.add_semigroup Pi.addSemigroup

@[to_additive]
instance commSemigroup [∀ i, CommSemigroup <| f i] : CommSemigroup (∀ i : I, f i) :=
  { semigroup with
    --pi_instance
    mul_comm := by intros; ext; exact mul_comm _ _
  }
#align pi.comm_semigroup Pi.commSemigroup
#align pi.add_comm_semigroup Pi.addCommSemigroup

@[to_additive]
instance mulOneClass [∀ i, MulOneClass <| f i] : MulOneClass (∀ i : I, f i) :=
  { one := (1 : ∀ i, f i)
    mul := (· * ·)
    --pi_instance
    one_mul := by intros; ext; exact one_mul _
    mul_one := by intros; ext; exact mul_one _
  }
#align pi.mul_one_class Pi.mulOneClass
#align pi.add_zero_class Pi.addZeroClass

@[to_additive]
instance monoid [∀ i, Monoid <| f i] : Monoid (∀ i : I, f i) :=
  { semigroup, mulOneClass with
    npow := fun n x i => x i ^ n
    --pi_instance
    npow_zero := by intros; ext; exact Monoid.npow_zero _
    npow_succ := by intros; ext; exact Monoid.npow_succ _ _
  }
#align pi.monoid Pi.monoid
#align pi.add_monoid Pi.addMonoid

instance addMonoidWithOne [∀ i, AddMonoidWithOne <| f i] : AddMonoidWithOne (∀ i : I, f i) :=
  { addMonoid with
    natCast := fun n _ => n
    natCast_zero := funext fun _ => AddMonoidWithOne.natCast_zero
    natCast_succ := fun n => funext fun _ => AddMonoidWithOne.natCast_succ n
  }

@[to_additive]
instance commMonoid [∀ i, CommMonoid <| f i] : CommMonoid (∀ i : I, f i) :=
  { monoid, commSemigroup with }
#align pi.comm_monoid Pi.commMonoid
#align pi.add_comm_monoid Pi.addCommMonoid

@[to_additive Pi.subNegMonoid]
instance divInvMonoid [∀ i, DivInvMonoid <| f i] : DivInvMonoid (∀ i : I, f i) :=
  { monoid with
    inv := Inv.inv
    div := Div.div
    zpow := fun z x i => x i ^ z
    --pi_instance
    div_eq_mul_inv := by intros; ext; exact div_eq_mul_inv _ _
    zpow_zero' := by intros; ext; exact DivInvMonoid.zpow_zero' _
    zpow_succ' := by intros; ext; exact DivInvMonoid.zpow_succ' _ _
    zpow_neg' := by intros; ext; exact DivInvMonoid.zpow_neg' _ _
  }

@[to_additive]
instance involutiveInv [∀ i, InvolutiveInv <| f i] : InvolutiveInv (∀ i, f i) :=
  { inv := Inv.inv
    --pi_instance
    inv_inv := by intros; ext; exact inv_inv _
  }

@[to_additive Pi.subtractionMonoid]
instance divisionMonoid [∀ i, DivisionMonoid <| f i] : DivisionMonoid (∀ i, f i) :=
  { divInvMonoid, involutiveInv with
    --pi_instance
    mul_inv_rev := by intros; ext; exact mul_inv_rev _ _
    inv_eq_of_mul := by
      intros _ _ h; ext; exact DivisionMonoid.inv_eq_of_mul _ _ (congrFun h _)
  }

@[to_additive Pi.subtractionCommMonoid]
instance [∀ i, DivisionCommMonoid <| f i] : DivisionCommMonoid (∀ i, f i) :=
  { divisionMonoid, commSemigroup with }

@[to_additive]
instance group [∀ i, Group <| f i] : Group (∀ i : I, f i) :=
  { divInvMonoid with
    --pi_instance
    mul_left_inv := by intros; ext; exact mul_left_inv _
    }
#align pi.group Pi.group
#align pi.add_group Pi.addGroup

instance addGroupWithOne [∀ i, AddGroupWithOne <| f i] : AddGroupWithOne (∀ i : I, f i) :=
  { addGroup, addMonoidWithOne with
    intCast := fun z _ => z
    intCast_ofNat := fun n => funext fun _ => AddGroupWithOne.intCast_ofNat n
    intCast_negSucc := fun n => funext fun _ => AddGroupWithOne.intCast_negSucc n
  }

@[to_additive]
instance commGroup [∀ i, CommGroup <| f i] : CommGroup (∀ i : I, f i) :=
  { group, commMonoid with }
#align pi.comm_group Pi.commGroup
#align pi.add_comm_group Pi.addCommGroup

@[to_additive]
instance leftCancelSemigroup [∀ i, LeftCancelSemigroup <| f i] :
    LeftCancelSemigroup (∀ i : I, f i) :=
  { semigroup with
    --pi_instance
    mul_left_cancel := by
      intros _ _ _ h; ext; exact LeftCancelSemigroup.mul_left_cancel _ _ _ (congr_fun h _);
  }
#align pi.left_cancel_semigroup Pi.leftCancelSemigroup
#align pi.add_left_cancel_semigroup Pi.addLeftCancelSemigroup

@[to_additive]
instance rightCancelSemigroup [∀ i, RightCancelSemigroup <| f i] :
    RightCancelSemigroup (∀ i : I, f i) :=
  { semigroup with
    --pi_instance
    mul_right_cancel := by
      intros _ _ _ h; ext; exact RightCancelSemigroup.mul_right_cancel _ _ _ (congr_fun h _)
  }
#align pi.right_cancel_semigroup Pi.rightCancelSemigroup
#align pi.add_right_cancel_semigroup Pi.addRightCancelSemigroup

@[to_additive]
instance leftCancelMonoid [∀ i, LeftCancelMonoid <| f i] : LeftCancelMonoid (∀ i : I, f i) :=
  { leftCancelSemigroup, monoid with }
#align pi.left_cancel_monoid Pi.leftCancelMonoid
#align pi.add_left_cancel_monoid Pi.addLeftCancelMonoid

@[to_additive]
instance rightCancelMonoid [∀ i, RightCancelMonoid <| f i] : RightCancelMonoid (∀ i : I, f i) :=
  { rightCancelSemigroup, monoid with }
#align pi.right_cancel_monoid Pi.rightCancelMonoid
#align pi.add_right_cancel_monoid Pi.addRightCancelMonoid

@[to_additive]
instance cancelMonoid [∀ i, CancelMonoid <| f i] : CancelMonoid (∀ i : I, f i) :=
  { leftCancelMonoid, rightCancelMonoid with }
#align pi.cancel_monoid Pi.cancelMonoid
#align pi.add_cancel_monoid Pi.addCancelMonoid

@[to_additive]
instance cancelCommMonoid [∀ i, CancelCommMonoid <| f i] : CancelCommMonoid (∀ i : I, f i) :=
  { leftCancelMonoid, commMonoid with }
#align pi.cancel_comm_monoid Pi.cancelCommMonoid
#align pi.add_cancel_comm_monoid Pi.addCancelCommMonoid

instance mulZeroClass [∀ i, MulZeroClass <| f i] : MulZeroClass (∀ i : I, f i) :=
  { zero := (0 : ∀ i, f i)
    mul := (· * ·)
    --pi_instance
    zero_mul := by intros; ext; exact zero_mul _
    mul_zero := by intros; ext; exact mul_zero _
}
#align pi.mul_zero_class Pi.mulZeroClass

instance mulZeroOneClass [∀ i, MulZeroOneClass <| f i] : MulZeroOneClass (∀ i : I, f i) :=
  { mulZeroClass, mulOneClass with }
#align pi.mul_zero_one_class Pi.mulZeroOneClass

instance monoidWithZero [∀ i, MonoidWithZero <| f i] : MonoidWithZero (∀ i : I, f i) :=
  { monoid, mulZeroClass with }
#align pi.monoid_with_zero Pi.monoidWithZero

instance commMonoidWithZero [∀ i, CommMonoidWithZero <| f i] : CommMonoidWithZero (∀ i : I, f i) :=
  { monoidWithZero, commMonoid with }
#align pi.comm_monoid_with_zero Pi.commMonoidWithZero

instance semigroupWithZero [∀ i, SemigroupWithZero <| f i] : SemigroupWithZero (∀ i : I, f i) :=
  { semigroup, mulZeroClass with }
#align pi.semigroup_with_zero Pi.semigroupWithZero

end Pi

namespace MulHom

@[to_additive]
theorem coe_mul {M N} {_ : Mul M} {_ : CommSemigroup N} (f g : M →ₙ* N) : (f * g : M → N) =
  fun x => f x * g x := rfl
#align mul_hom.coe_mul MulHom.coe_mul
#align add_hom.coe_add AddHom.coe_add

end MulHom

section MulHom

/-- A family of MulHom's `f a : γ →ₙ* β a` defines a MulHom `Pi.mulHom f : γ →ₙ* Π a, β a`
given by `Pi.mulHom f x b = f b x`. -/
@[to_additive (attr := simps)
  "A family of AddHom's `f a : γ → β a` defines an AddHom `Pi.addHom f : γ → Π a, β a` given by
  `Pi.addHom f x b = f b x`."]
def Pi.mulHom {γ : Type w} [∀ i, Mul (f i)] [Mul γ] (g : ∀ i, γ →ₙ* f i) : γ →ₙ* ∀ i, f i where
  toFun x i := g i x
  map_mul' x y := funext fun i => (g i).map_mul x y
#align pi.mul_hom Pi.mulHom
#align pi.add_hom Pi.addHom
#align pi.mul_hom_apply Pi.mulHom_apply
#align pi.add_hom_apply Pi.addHom_apply

@[to_additive]
theorem Pi.mulHom_injective {γ : Type w} [Nonempty I] [∀ i, Mul (f i)] [Mul γ] (g : ∀ i, γ →ₙ* f i)
    (hg : ∀ i, Function.Injective (g i)) : Function.Injective (Pi.mulHom g) := fun x y h =>
  let ⟨i⟩ := ‹Nonempty I›
  hg i ((Function.funext_iff.mp h : _) i)
#align pi.mul_hom_injective Pi.mulHom_injective
#align pi.add_hom_injective Pi.addHom_injective

/-- A family of monoid homomorphisms `f a : γ →* β a` defines a monoid homomorphism
`Pi.monoidHom f : γ →* Π a, β a` given by `Pi.monoidHom f x b = f b x`. -/
@[to_additive (attr := simps)
  "A family of additive monoid homomorphisms `f a : γ →+ β a` defines a monoid homomorphism
  `Pi.addMonoidHom f : γ →+ Π a, β a` given by `Pi.addMonoidHom f x b = f b x`."]
def Pi.monoidHom {γ : Type w} [∀ i, MulOneClass (f i)] [MulOneClass γ] (g : ∀ i, γ →* f i) :
    γ →* ∀ i, f i :=
  { Pi.mulHom fun i => (g i).toMulHom with
    toFun := fun x i => g i x
    map_one' := funext fun i => (g i).map_one }
#align pi.monoid_hom Pi.monoidHom
#align pi.add_monoid_hom Pi.addMonoidHom
#align pi.monoid_hom_apply Pi.monoidHom_apply
#align pi.add_monoid_hom_apply Pi.addMonoidHom_apply

@[to_additive]
theorem Pi.monoidHom_injective {γ : Type w} [Nonempty I] [∀ i, MulOneClass (f i)] [MulOneClass γ]
    (g : ∀ i, γ →* f i) (hg : ∀ i, Function.Injective (g i)) :
    Function.Injective (Pi.monoidHom g) :=
  Pi.mulHom_injective (fun i => (g i).toMulHom) hg
#align pi.monoid_hom_injective Pi.monoidHom_injective
#align pi.add_monoid_hom_injective Pi.addMonoidHom_injective

variable (f) [(i : I) → Mul (f i)]

/-- Evaluation of functions into an indexed collection of semigroups at a point is a semigroup
homomorphism.
This is `Function.eval i` as a `MulHom`. -/
@[to_additive (attr := simps)
  "Evaluation of functions into an indexed collection of additive semigroups at a point is an
  additive semigroup homomorphism. This is `Function.eval i` as an `AddHom`."]
def Pi.evalMulHom (i : I) : (∀ i, f i) →ₙ* f i where
  toFun g := g i
  map_mul' _ _ := Pi.mul_apply _ _ i
#align pi.eval_mul_hom Pi.evalMulHom
#align pi.eval_add_hom Pi.evalAddHom
#align pi.eval_mul_hom_apply Pi.evalMulHom_apply
#align pi.eval_add_hom_apply Pi.evalAddHom_apply

/-- `Function.const` as a `MulHom`. -/
@[to_additive (attr := simps) "`Function.const` as an `AddHom`."]
def Pi.constMulHom (α β : Type _) [Mul β] :
    β →ₙ* α → β where
  toFun := Function.const α
  map_mul' _ _ := rfl
#align pi.const_mul_hom Pi.constMulHom
#align pi.const_add_hom Pi.constAddHom
#align pi.const_mul_hom_apply Pi.constMulHom_apply
#align pi.const_add_hom_apply Pi.constAddHom_apply

/-- Coercion of a `MulHom` into a function is itself a `MulHom`.

See also `MulHom.eval`. -/
@[to_additive (attr := simps) "Coercion of an `AddHom` into a function is itself an `AddHom`.

See also `AddHom.eval`."]
def MulHom.coeFn (α β : Type _) [Mul α] [CommSemigroup β] :
    (α →ₙ* β) →ₙ* α → β where
  toFun g := g
  map_mul' _ _ := rfl
#align mul_hom.coe_fn MulHom.coeFn
#align add_hom.coe_fn AddHom.coeFn
#align mul_hom.coe_fn_apply MulHom.coeFn_apply
#align add_hom.coe_fn_apply AddHom.coeFn_apply

/-- Semigroup homomorphism between the function spaces `I → α` and `I → β`, induced by a semigroup
homomorphism `f` between `α` and `β`. -/
@[to_additive (attr := simps) "Additive semigroup homomorphism between the function spaces `I → α`
and `I → β`, induced by an additive semigroup homomorphism `f` between `α` and `β`"]
protected def MulHom.compLeft {α β : Type _} [Mul α] [Mul β] (f : α →ₙ* β) (I : Type _) :
    (I → α) →ₙ* I → β where
  toFun h := f ∘ h
  map_mul' _ _ := by ext; simp
#align mul_hom.comp_left MulHom.compLeft
#align add_hom.comp_left AddHom.compLeft
#align mul_hom.comp_left_apply MulHom.compLeft_apply
#align add_hom.comp_left_apply AddHom.compLeft_apply

end MulHom

section MonoidHom

variable (f) [(i : I) → MulOneClass (f i)]

/-- Evaluation of functions into an indexed collection of monoids at a point is a monoid
homomorphism.
This is `Function.eval i` as a `MonoidHom`. -/
@[to_additive (attr := simps) "Evaluation of functions into an indexed collection of additive
monoids at a point is an additive monoid homomorphism. This is `Function.eval i` as an
`AddMonoidHom`."]
def Pi.evalMonoidHom (i : I) : (∀ i, f i) →* f i where
  toFun g := g i
  map_one' := Pi.one_apply i
  map_mul' _ _ := Pi.mul_apply _ _ i
#align pi.eval_monoid_hom Pi.evalMonoidHom
#align pi.eval_add_monoid_hom Pi.evalAddMonoidHom
#align pi.eval_monoid_hom_apply Pi.evalMonoidHom_apply
#align pi.eval_add_monoid_hom_apply Pi.evalAddMonoidHom_apply

/-- `Function.const` as a `MonoidHom`. -/
@[to_additive (attr := simps) "`Function.const` as an `AddMonoidHom`."]
def Pi.constMonoidHom (α β : Type _) [MulOneClass β] : β →* α → β where
  toFun := Function.const α
  map_one' := rfl
  map_mul' _ _ := rfl
#align pi.const_monoid_hom Pi.constMonoidHom
#align pi.const_add_monoid_hom Pi.constAddMonoidHom
#align pi.const_monoid_hom_apply Pi.constMonoidHom_apply
#align pi.const_add_monoid_hom_apply Pi.constAddMonoidHom_apply

/-- Coercion of a `MonoidHom` into a function is itself a `MonoidHom`.

See also `MonoidHom.eval`. -/
@[to_additive (attr := simps) "Coercion of an `AddMonoidHom` into a function is itself
a `AddMonoidHom`.

See also `AddMonoidHom.eval`."]
def MonoidHom.coeFn (α β : Type _) [MulOneClass α] [CommMonoid β] : (α →* β) →* α → β where
  toFun g := g
  map_one' := rfl
  map_mul' _ _ := rfl
#align monoid_hom.coe_fn MonoidHom.coeFn
#align add_monoid_hom.coe_fn AddMonoidHom.coeFn
#align monoid_hom.coe_fn_apply MonoidHom.coeFn_apply
#align add_monoid_hom.coe_fn_apply AddMonoidHom.coeFn_apply

/-- Monoid homomorphism between the function spaces `I → α` and `I → β`, induced by a monoid
homomorphism `f` between `α` and `β`. -/
@[to_additive (attr := simps)
  "Additive monoid homomorphism between the function spaces `I → α` and `I → β`, induced by an
  additive monoid homomorphism `f` between `α` and `β`"]
protected def MonoidHom.compLeft {α β : Type _} [MulOneClass α] [MulOneClass β] (f : α →* β)
    (I : Type _) : (I → α) →* I → β where
  toFun h := f ∘ h
  map_one' := by ext; dsimp; simp
  map_mul' _ _ := by ext; simp
#align monoid_hom.comp_left MonoidHom.compLeft
#align add_monoid_hom.comp_left AddMonoidHom.compLeft
#align monoid_hom.comp_left_apply MonoidHom.compLeft_apply
#align add_monoid_hom.comp_left_apply AddMonoidHom.compLeft_apply

end MonoidHom

section Single

variable [DecidableEq I]

open Pi

variable (f)

/-- The one-preserving homomorphism including a single value
into a dependent family of values, as functions supported at a point.

This is the `OneHom` version of `Pi.mulSingle`. -/
@[to_additive
      "The zero-preserving homomorphism including a single value into a dependent family of values,
      as functions supported at a point.

      This is the `ZeroHom` version of `Pi.single`."]
def OneHom.single [∀ i, One <| f i] (i : I) : OneHom (f i) (∀ i, f i) where
  toFun := mulSingle i
  map_one' := mulSingle_one i
#align one_hom.single OneHom.single
#align zero_hom.single ZeroHom.single

@[to_additive (attr := simp)]
theorem OneHom.single_apply [∀ i, One <| f i] (i : I) (x : f i) :
    OneHom.single f i x = mulSingle i x :=
  rfl
#align one_hom.single_apply OneHom.single_apply
#align zero_hom.single_apply ZeroHom.single_apply

/-- The monoid homomorphism including a single monoid into a dependent family of additive monoids,
as functions supported at a point.

This is the `MonoidHom` version of `Pi.mulSingle`. -/
@[to_additive
      "The additive monoid homomorphism including a single additive monoid into a dependent family
      of additive monoids, as functions supported at a point.

      This is the `AddMonoidHom` version of `Pi.single`."]
def MonoidHom.single [∀ i, MulOneClass <| f i] (i : I) : f i →* ∀ i, f i :=
  { OneHom.single f i with map_mul' := mulSingle_op₂ (fun _ => (· * ·)) (fun _ => one_mul _) _ }
#align monoid_hom.single MonoidHom.single
#align add_monoid_hom.single AddMonoidHom.single

@[to_additive (attr := simp)]
theorem MonoidHom.single_apply [∀ i, MulOneClass <| f i] (i : I) (x : f i) :
    MonoidHom.single f i x = mulSingle i x :=
  rfl
#align monoid_hom.single_apply MonoidHom.single_apply
#align add_monoid_hom.single_apply AddMonoidHom.single_apply

/-- The multiplicative homomorphism including a single `MulZeroClass`
into a dependent family of `MulZeroClass`es, as functions supported at a point.

This is the `MulHom` version of `Pi.single`. -/
@[simps]
def MulHom.single [∀ i, MulZeroClass <| f i] (i : I) : f i →ₙ* ∀ i, f i where
  toFun := Pi.single i
  map_mul' := Pi.single_op₂ (fun _ => (· * ·)) (fun _ => zero_mul _) _
#align mul_hom.single MulHom.single
#align mul_hom.single_apply MulHom.single_apply

variable {f}

@[to_additive]
theorem Pi.mulSingle_mul [∀ i, MulOneClass <| f i] (i : I) (x y : f i) :
    mulSingle i (x * y) = mulSingle i x * mulSingle i y :=
  (MonoidHom.single f i).map_mul x y
#align pi.mul_single_mul Pi.mulSingle_mul
#align pi.single_add Pi.single_add

@[to_additive]
theorem Pi.mulSingle_inv [∀ i, Group <| f i] (i : I) (x : f i) :
    mulSingle i x⁻¹ = (mulSingle i x)⁻¹ :=
  (MonoidHom.single f i).map_inv x
#align pi.mul_single_inv Pi.mulSingle_inv
#align pi.single_neg Pi.single_neg

@[to_additive]
theorem Pi.single_div [∀ i, Group <| f i] (i : I) (x y : f i) :
    mulSingle i (x / y) = mulSingle i x / mulSingle i y :=
  (MonoidHom.single f i).map_div x y
#align pi.single_div Pi.single_div
#align pi.single_sub Pi.single_sub

theorem Pi.single_mul [∀ i, MulZeroClass <| f i] (i : I) (x y : f i) :
    single i (x * y) = single i x * single i y :=
  (MulHom.single f i).map_mul x y
#align pi.single_mul Pi.single_mul

/-- The injection into a pi group at different indices commutes.

For injections of commuting elements at the same index, see `Commute.map` -/
@[to_additive
      "The injection into an additive pi group at different indices commutes.

      For injections of commuting elements at the same index, see `AddCommute.map`"]
theorem Pi.mulSingle_commute [∀ i, MulOneClass <| f i] :
    Pairwise fun i j => ∀ (x : f i) (y : f j), Commute (mulSingle i x) (mulSingle j y) := by
  intro i j hij x y; ext k
  by_cases h1 : i = k;
  · subst h1
    simp [hij]
  by_cases h2 : j = k;
  · subst h2
    simp [hij]
  simp [h1, h2]
#align pi.mul_single_commute Pi.mulSingle_commute
#align pi.single_commute Pi.single_commute

/-- The injection into a pi group with the same values commutes. -/
@[to_additive "The injection into an additive pi group with the same values commutes."]
theorem Pi.mulSingle_apply_commute [∀ i, MulOneClass <| f i] (x : ∀ i, f i) (i j : I) :
    Commute (mulSingle i (x i)) (mulSingle j (x j)) := by
  obtain rfl | hij := Decidable.eq_or_ne i j
  · rfl
  · exact Pi.mulSingle_commute hij _ _
#align pi.mul_single_apply_commute Pi.mulSingle_apply_commute
#align pi.single_apply_commute Pi.single_apply_commute

@[to_additive]
theorem Pi.update_eq_div_mul_mulSingle [∀ i, Group <| f i] (g : ∀ i : I, f i) (x : f i) :
    Function.update g i x = g / mulSingle i (g i) * mulSingle i x := by
  ext j
  rcases eq_or_ne i j with (rfl | h)
  · simp
  · simp [Function.update_noteq h.symm, h]
#align pi.update_eq_div_mul_single Pi.update_eq_div_mul_mulSingle
#align pi.update_eq_sub_add_single Pi.update_eq_div_mul_mulSingle

@[to_additive]
theorem Pi.mulSingle_mul_mulSingle_eq_mulSingle_mul_mulSingle {M : Type _} [CommMonoid M]
    {k l m n : I} {u v : M} (hu : u ≠ 1) (hv : v ≠ 1) :
    (mulSingle k u : I → M) * mulSingle l v = mulSingle m u * mulSingle n v ↔
      k = m ∧ l = n ∨ u = v ∧ k = n ∧ l = m ∨ u * v = 1 ∧ k = l ∧ m = n := by
  refine' ⟨fun h => _, _⟩
  · have hk := congr_fun h k
    have hl := congr_fun h l
    have hm := (congr_fun h m).symm
    have hn := (congr_fun h n).symm
    simp only [mul_apply, mulSingle_apply, if_pos rfl] at hk hl hm hn
    rcases eq_or_ne k m with (rfl | hkm)
    · refine' Or.inl ⟨rfl, not_ne_iff.mp fun hln => (hv _).elim⟩
      rcases eq_or_ne k l with (rfl | hkl)
      · rwa [if_neg hln.symm, if_neg hln.symm, one_mul, one_mul] at hn
      · rwa [if_neg hkl.symm, if_neg hln, one_mul, one_mul] at hl
    · rcases eq_or_ne m n with (rfl | hmn)
      · rcases eq_or_ne k l with (rfl | hkl)
        · rw [if_neg hkm.symm, if_neg hkm.symm, one_mul, if_pos rfl] at hm
          exact Or.inr (Or.inr ⟨hm, rfl, rfl⟩)
        · simp only [if_neg hkm, if_neg hkl, mul_one] at hk
          dsimp at hk
          contradiction
      · rw [if_neg hkm.symm, if_neg hmn, one_mul, mul_one] at hm
        obtain rfl := (ite_ne_right_iff.mp (ne_of_eq_of_ne hm.symm hu)).1
        rw [if_neg hkm, if_neg hkm, one_mul, mul_one] at hk
        obtain rfl := (ite_ne_right_iff.mp (ne_of_eq_of_ne hk.symm hu)).1
        exact Or.inr (Or.inl ⟨hk.trans (if_pos rfl), rfl, rfl⟩)
  · rintro (⟨rfl, rfl⟩ | ⟨rfl, rfl, rfl⟩ | ⟨h, rfl, rfl⟩)
    · rfl
    · apply mul_comm
    · simp_rw [← Pi.mulSingle_mul, h, mulSingle_one]
#align pi.mul_single_mul_mul_single_eq_mul_single_mul_mul_single Pi.mulSingle_mul_mulSingle_eq_mulSingle_mul_mulSingle
#align pi.single_add_single_eq_single_add_single Pi.single_add_single_eq_single_add_single

end Single

namespace Function

@[to_additive (attr := simp)]
theorem update_one [∀ i, One (f i)] [DecidableEq I] (i : I) : update (1 : ∀ i, f i) i 1 = 1 :=
  update_eq_self i (1 : (a : I) → f a)
#align function.update_one Function.update_one
#align function.update_zero Function.update_zero

@[to_additive]
theorem update_mul [∀ i, Mul (f i)] [DecidableEq I] (f₁ f₂ : ∀ i, f i) (i : I) (x₁ : f i)
    (x₂ : f i) : update (f₁ * f₂) i (x₁ * x₂) = update f₁ i x₁ * update f₂ i x₂ :=
  funext fun j => (apply_update₂ (fun _ => (· * ·)) f₁ f₂ i x₁ x₂ j).symm
#align function.update_mul Function.update_mul
#align function.update_add Function.update_add

@[to_additive]
theorem update_inv [∀ i, Inv (f i)] [DecidableEq I] (f₁ : ∀ i, f i) (i : I) (x₁ : f i) :
    update f₁⁻¹ i x₁⁻¹ = (update f₁ i x₁)⁻¹ :=
  funext fun j => (apply_update (fun _ => Inv.inv) f₁ i x₁ j).symm
#align function.update_inv Function.update_inv
#align function.update_neg Function.update_neg

@[to_additive]
theorem update_div [∀ i, Div (f i)] [DecidableEq I] (f₁ f₂ : ∀ i, f i) (i : I) (x₁ : f i)
    (x₂ : f i) : update (f₁ / f₂) i (x₁ / x₂) = update f₁ i x₁ / update f₂ i x₂ :=
  funext fun j => (apply_update₂ (fun _ => (· / ·)) f₁ f₂ i x₁ x₂ j).symm
#align function.update_div Function.update_div
#align function.update_sub Function.update_sub

variable [One α] [Nonempty ι] {a : α}

@[to_additive (attr := simp)]
theorem const_eq_one : const ι a = 1 ↔ a = 1 :=
  @const_inj _ _ _ _ 1
#align function.const_eq_one Function.const_eq_one
#align function.const_eq_zero Function.const_eq_zero

@[to_additive]
theorem const_ne_one : const ι a ≠ 1 ↔ a ≠ 1 :=
  Iff.not const_eq_one
#align function.const_ne_one Function.const_ne_one
#align function.const_ne_zero Function.const_ne_zero

end Function

section Piecewise

@[to_additive]
theorem Set.piecewise_mul [∀ i, Mul (f i)] (s : Set I) [∀ i, Decidable (i ∈ s)]
    (f₁ f₂ g₁ g₂ : ∀ i, f i) :
    s.piecewise (f₁ * f₂) (g₁ * g₂) = s.piecewise f₁ g₁ * s.piecewise f₂ g₂ :=
  s.piecewise_op₂ f₁ _ _ _ fun _ => (· * ·)
#align set.piecewise_mul Set.piecewise_mul
#align set.piecewise_add Set.piecewise_add

@[to_additive]
theorem Set.piecewise_inv [∀ i, Inv (f i)] (s : Set I) [∀ i, Decidable (i ∈ s)] (f₁ g₁ : ∀ i, f i) :
    s.piecewise f₁⁻¹ g₁⁻¹ = (s.piecewise f₁ g₁)⁻¹ :=
  s.piecewise_op f₁ g₁ fun _ x => x⁻¹
#align set.piecewise_inv Set.piecewise_inv
#align set.piecewise_neg Set.piecewise_neg

@[to_additive]
theorem Set.piecewise_div [∀ i, Div (f i)] (s : Set I) [∀ i, Decidable (i ∈ s)]
    (f₁ f₂ g₁ g₂ : ∀ i, f i) :
    s.piecewise (f₁ / f₂) (g₁ / g₂) = s.piecewise f₁ g₁ / s.piecewise f₂ g₂ :=
  s.piecewise_op₂ f₁ _ _ _ fun _ => (· / ·)
#align set.piecewise_div Set.piecewise_div
#align set.piecewise_sub Set.piecewise_sub

end Piecewise

section Extend

variable {η : Type v} (R : Type w) (s : ι → η)

/-- `Function.extend s f 1` as a bundled hom. -/
@[to_additive (attr := simps) Function.ExtendByZero.hom "`Function.extend s f 0` as a bundled hom."]
noncomputable def Function.ExtendByOne.hom [MulOneClass R] :
    (ι → R) →* η → R where
  toFun f := Function.extend s f 1
  map_one' := Function.extend_one s
  map_mul' f g := by simpa using Function.extend_mul s f g 1 1
#align function.extend_by_one.hom Function.ExtendByOne.hom
#align function.extend_by_zero.hom Function.ExtendByZero.hom
#align function.extend_by_one.hom_apply Function.ExtendByOne.hom_apply
#align function.extend_by_zero.hom_apply Function.ExtendByZero.hom_apply

end Extend


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

! This file was ported from Lean 3 source module ring_theory.algebraic_independent
! leanprover-community/mathlib commit b95b8c7a484a298228805c72c142f6b062eb0d70
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.Adjoin.Basic
import Mathbin.LinearAlgebra.LinearIndependent
import Mathbin.RingTheory.MvPolynomial.Basic
import Mathbin.Data.MvPolynomial.Supported
import Mathbin.RingTheory.Algebraic
import Mathbin.Data.MvPolynomial.Equiv

/-!
# Algebraic Independence

This file defines algebraic independence of a family of element of an `R` algebra

## Main definitions

* `algebraic_independent` - `algebraic_independent R x` states the family of elements `x`
  is algebraically independent over `R`, meaning that the canonical map out of the multivariable
  polynomial ring is injective.

* `algebraic_independent.repr` - The canonical map from the subalgebra generated by an
  algebraic independent family into the polynomial ring.

## References

* [Stacks: Transcendence](https://stacks.math.columbia.edu/tag/030D)

## TODO
Prove that a ring is an algebraic extension of the subalgebra generated by a transcendence basis.

## Tags
transcendence basis, transcendence degree, transcendence

-/

noncomputable section

open Function Set Subalgebra MvPolynomial Algebra

open Classical BigOperators

universe x u v w

variable {ι : Type _} {ι' : Type _} (R : Type _) {K : Type _}

variable {A : Type _} {A' A'' : Type _} {V : Type u} {V' : Type _}

variable (x : ι → A)

variable [CommRing R] [CommRing A] [CommRing A'] [CommRing A'']

variable [Algebra R A] [Algebra R A'] [Algebra R A'']

variable {a b : R}

/-- `algebraic_independent R x` states the family of elements `x`
  is algebraically independent over `R`, meaning that the canonical
  map out of the multivariable polynomial ring is injective. -/
def AlgebraicIndependent : Prop :=
  Injective (MvPolynomial.aeval x : MvPolynomial ι R →ₐ[R] A)
#align algebraic_independent AlgebraicIndependent

variable {R} {x}

theorem algebraicIndependent_iff_ker_eq_bot :
    AlgebraicIndependent R x ↔
      (MvPolynomial.aeval x : MvPolynomial ι R →ₐ[R] A).toRingHom.ker = ⊥ :=
  RingHom.injective_iff_ker_eq_bot _
#align algebraic_independent_iff_ker_eq_bot algebraicIndependent_iff_ker_eq_bot

theorem algebraicIndependent_iff :
    AlgebraicIndependent R x ↔
      ∀ p : MvPolynomial ι R, MvPolynomial.aeval (x : ι → A) p = 0 → p = 0 :=
  injective_iff_map_eq_zero _
#align algebraic_independent_iff algebraicIndependent_iff

theorem AlgebraicIndependent.eq_zero_of_aeval_eq_zero (h : AlgebraicIndependent R x) :
    ∀ p : MvPolynomial ι R, MvPolynomial.aeval (x : ι → A) p = 0 → p = 0 :=
  algebraicIndependent_iff.1 h
#align algebraic_independent.eq_zero_of_aeval_eq_zero AlgebraicIndependent.eq_zero_of_aeval_eq_zero

theorem algebraicIndependent_iff_injective_aeval :
    AlgebraicIndependent R x ↔ Injective (MvPolynomial.aeval x : MvPolynomial ι R →ₐ[R] A) :=
  Iff.rfl
#align algebraic_independent_iff_injective_aeval algebraicIndependent_iff_injective_aeval

@[simp]
theorem algebraicIndependent_empty_type_iff [IsEmpty ι] :
    AlgebraicIndependent R x ↔ Injective (algebraMap R A) :=
  by
  have : aeval x = (Algebra.ofId R A).comp (@isEmptyAlgEquiv R ι _ _).toAlgHom :=
    by
    ext i
    exact IsEmpty.elim' ‹IsEmpty ι› i
  rw [AlgebraicIndependent, this, ←
    injective.of_comp_iff' _ (@is_empty_alg_equiv R ι _ _).Bijective]
  rfl
#align algebraic_independent_empty_type_iff algebraicIndependent_empty_type_iff

namespace AlgebraicIndependent

variable (hx : AlgebraicIndependent R x)

include hx

theorem algebraMap_injective : Injective (algebraMap R A) := by
  simpa [← MvPolynomial.algebraMap_eq, Function.comp] using
    (injective.of_comp_iff (algebraicIndependent_iff_injective_aeval.1 hx) MvPolynomial.C).2
      (MvPolynomial.C_injective _ _)
#align algebraic_independent.algebra_map_injective AlgebraicIndependent.algebraMap_injective

theorem linearIndependent : LinearIndependent R x :=
  by
  rw [linearIndependent_iff_injective_total]
  have : Finsupp.total ι A R x = (MvPolynomial.aeval x).toLinearMap.comp (Finsupp.total ι _ R X) :=
    by
    ext
    simp
  rw [this]
  refine' hx.comp _
  rw [← linearIndependent_iff_injective_total]
  exact linear_independent_X _ _
#align algebraic_independent.linear_independent AlgebraicIndependent.linearIndependent

protected theorem injective [Nontrivial R] : Injective x :=
  hx.LinearIndependent.Injective
#align algebraic_independent.injective AlgebraicIndependent.injective

theorem ne_zero [Nontrivial R] (i : ι) : x i ≠ 0 :=
  hx.LinearIndependent.NeZero i
#align algebraic_independent.ne_zero AlgebraicIndependent.ne_zero

theorem comp (f : ι' → ι) (hf : Function.Injective f) : AlgebraicIndependent R (x ∘ f) := fun p q =>
  by simpa [aeval_rename, (rename_injective f hf).eq_iff] using @hx (rename f p) (rename f q)
#align algebraic_independent.comp AlgebraicIndependent.comp

theorem coe_range : AlgebraicIndependent R (coe : range x → A) := by
  simpa using hx.comp _ (range_splitting_injective x)
#align algebraic_independent.coe_range AlgebraicIndependent.coe_range

theorem map {f : A →ₐ[R] A'} (hf_inj : Set.InjOn f (adjoin R (range x))) :
    AlgebraicIndependent R (f ∘ x) :=
  by
  have : aeval (f ∘ x) = f.comp (aeval x) := by ext <;> simp
  have h : ∀ p : MvPolynomial ι R, aeval x p ∈ (@aeval R _ _ _ _ _ (coe : range x → A)).range :=
    by
    intro p
    rw [AlgHom.mem_range]
    refine' ⟨MvPolynomial.rename (cod_restrict x (range x) mem_range_self) p, _⟩
    simp [Function.comp, aeval_rename]
  intro x y hxy
  rw [this] at hxy
  rw [adjoin_eq_range] at hf_inj
  exact hx (hf_inj (h x) (h y) hxy)
#align algebraic_independent.map AlgebraicIndependent.map

theorem map' {f : A →ₐ[R] A'} (hf_inj : Injective f) : AlgebraicIndependent R (f ∘ x) :=
  hx.map (injOn_of_injective hf_inj _)
#align algebraic_independent.map' AlgebraicIndependent.map'

omit hx

theorem of_comp (f : A →ₐ[R] A') (hfv : AlgebraicIndependent R (f ∘ x)) :
    AlgebraicIndependent R x :=
  by
  have : aeval (f ∘ x) = f.comp (aeval x) := by ext <;> simp
  rw [AlgebraicIndependent, this] at hfv <;> exact hfv.of_comp
#align algebraic_independent.of_comp AlgebraicIndependent.of_comp

end AlgebraicIndependent

open AlgebraicIndependent

theorem AlgHom.algebraicIndependent_iff (f : A →ₐ[R] A') (hf : Injective f) :
    AlgebraicIndependent R (f ∘ x) ↔ AlgebraicIndependent R x :=
  ⟨fun h => h.of_comp f, fun h => h.map (injOn_of_injective hf _)⟩
#align alg_hom.algebraic_independent_iff AlgHom.algebraicIndependent_iff

@[nontriviality]
theorem algebraicIndependent_of_subsingleton [Subsingleton R] : AlgebraicIndependent R x :=
  algebraicIndependent_iff.2 fun l hl => Subsingleton.elim _ _
#align algebraic_independent_of_subsingleton algebraicIndependent_of_subsingleton

theorem algebraicIndependent_equiv (e : ι ≃ ι') {f : ι' → A} :
    AlgebraicIndependent R (f ∘ e) ↔ AlgebraicIndependent R f :=
  ⟨fun h => Function.comp.right_id f ▸ e.self_comp_symm ▸ h.comp _ e.symm.Injective, fun h =>
    h.comp _ e.Injective⟩
#align algebraic_independent_equiv algebraicIndependent_equiv

theorem algebraicIndependent_equiv' (e : ι ≃ ι') {f : ι' → A} {g : ι → A} (h : f ∘ e = g) :
    AlgebraicIndependent R g ↔ AlgebraicIndependent R f :=
  h ▸ algebraicIndependent_equiv e
#align algebraic_independent_equiv' algebraicIndependent_equiv'

theorem algebraicIndependent_subtype_range {ι} {f : ι → A} (hf : Injective f) :
    AlgebraicIndependent R (coe : range f → A) ↔ AlgebraicIndependent R f :=
  Iff.symm <| algebraicIndependent_equiv' (Equiv.ofInjective f hf) rfl
#align algebraic_independent_subtype_range algebraicIndependent_subtype_range

alias algebraicIndependent_subtype_range ↔ AlgebraicIndependent.of_subtype_range _
#align algebraic_independent.of_subtype_range AlgebraicIndependent.of_subtype_range

theorem algebraicIndependent_image {ι} {s : Set ι} {f : ι → A} (hf : Set.InjOn f s) :
    (AlgebraicIndependent R fun x : s => f x) ↔ AlgebraicIndependent R fun x : f '' s => (x : A) :=
  algebraicIndependent_equiv' (Equiv.Set.imageOfInjOn _ _ hf) rfl
#align algebraic_independent_image algebraicIndependent_image

theorem algebraicIndependent_adjoin (hs : AlgebraicIndependent R x) :
    @AlgebraicIndependent ι R (adjoin R (range x))
      (fun i : ι => ⟨x i, subset_adjoin (mem_range_self i)⟩) _ _ _ :=
  AlgebraicIndependent.of_comp (adjoin R (range x)).val hs
#align algebraic_independent_adjoin algebraicIndependent_adjoin

/-- A set of algebraically independent elements in an algebra `A` over a ring `K` is also
algebraically independent over a subring `R` of `K`. -/
theorem AlgebraicIndependent.restrict_scalars {K : Type _} [CommRing K] [Algebra R K] [Algebra K A]
    [IsScalarTower R K A] (hinj : Function.Injective (algebraMap R K))
    (ai : AlgebraicIndependent K x) : AlgebraicIndependent R x :=
  by
  have :
    (aeval x : MvPolynomial ι K →ₐ[K] A).toRingHom.comp (MvPolynomial.map (algebraMap R K)) =
      (aeval x : MvPolynomial ι R →ₐ[R] A).toRingHom :=
    by ext <;> simp [algebra_map_eq_smul_one]
  show injective (aeval x).toRingHom
  rw [← this]
  exact injective.comp ai (MvPolynomial.map_injective _ hinj)
#align algebraic_independent.restrict_scalars AlgebraicIndependent.restrict_scalars

/-- Every finite subset of an algebraically independent set is algebraically independent. -/
theorem algebraicIndependent_finset_map_embedding_subtype (s : Set A)
    (li : AlgebraicIndependent R (coe : s → A)) (t : Finset s) :
    AlgebraicIndependent R (coe : Finset.map (Embedding.subtype s) t → A) :=
  by
  let f : t.map (embedding.subtype s) → s := fun x =>
    ⟨x.1, by
      obtain ⟨x, h⟩ := x
      rw [Finset.mem_map] at h
      obtain ⟨a, ha, rfl⟩ := h
      simp only [Subtype.coe_prop, embedding.coe_subtype]⟩
  convert AlgebraicIndependent.comp li f _
  rintro ⟨x, hx⟩ ⟨y, hy⟩
  rw [Finset.mem_map] at hx hy
  obtain ⟨a, ha, rfl⟩ := hx
  obtain ⟨b, hb, rfl⟩ := hy
  simp only [imp_self, Subtype.mk_eq_mk]
#align algebraic_independent_finset_map_embedding_subtype algebraicIndependent_finset_map_embedding_subtype

/-- If every finite set of algebraically independent element has cardinality at most `n`,
then the same is true for arbitrary sets of algebraically independent elements.
-/
theorem algebraicIndependent_bounded_of_finset_algebraicIndependent_bounded {n : ℕ}
    (H : ∀ s : Finset A, (AlgebraicIndependent R fun i : s => (i : A)) → s.card ≤ n) :
    ∀ s : Set A, AlgebraicIndependent R (coe : s → A) → Cardinal.mk s ≤ n :=
  by
  intro s li
  apply Cardinal.card_le_of
  intro t
  rw [← Finset.card_map (embedding.subtype s)]
  apply H
  apply algebraicIndependent_finset_map_embedding_subtype _ li
#align algebraic_independent_bounded_of_finset_algebraic_independent_bounded algebraicIndependent_bounded_of_finset_algebraicIndependent_bounded

section Subtype

theorem AlgebraicIndependent.restrict_of_comp_subtype {s : Set ι}
    (hs : AlgebraicIndependent R (x ∘ coe : s → A)) : AlgebraicIndependent R (s.restrict x) :=
  hs
#align algebraic_independent.restrict_of_comp_subtype AlgebraicIndependent.restrict_of_comp_subtype

variable (R A)

theorem algebraicIndependent_empty_iff :
    AlgebraicIndependent R (fun x => x : (∅ : Set A) → A) ↔ Injective (algebraMap R A) := by simp
#align algebraic_independent_empty_iff algebraicIndependent_empty_iff

variable {R A}

theorem AlgebraicIndependent.mono {t s : Set A} (h : t ⊆ s)
    (hx : AlgebraicIndependent R (fun x => x : s → A)) :
    AlgebraicIndependent R (fun x => x : t → A) := by
  simpa [Function.comp] using hx.comp (inclusion h) (inclusion_injective h)
#align algebraic_independent.mono AlgebraicIndependent.mono

end Subtype

theorem AlgebraicIndependent.to_subtype_range {ι} {f : ι → A} (hf : AlgebraicIndependent R f) :
    AlgebraicIndependent R (coe : range f → A) :=
  by
  nontriviality R
  · rwa [algebraicIndependent_subtype_range hf.injective]
#align algebraic_independent.to_subtype_range AlgebraicIndependent.to_subtype_range

theorem AlgebraicIndependent.to_subtype_range' {ι} {f : ι → A} (hf : AlgebraicIndependent R f) {t}
    (ht : range f = t) : AlgebraicIndependent R (coe : t → A) :=
  ht ▸ hf.to_subtype_range
#align algebraic_independent.to_subtype_range' AlgebraicIndependent.to_subtype_range'

theorem algebraicIndependent_comp_subtype {s : Set ι} :
    AlgebraicIndependent R (x ∘ coe : s → A) ↔
      ∀ p ∈ MvPolynomial.supported R s, aeval x p = 0 → p = 0 :=
  by
  have : (aeval (x ∘ coe : s → A) : _ →ₐ[R] _) = (aeval x).comp (rename coe) := by ext <;> simp
  have : ∀ p : MvPolynomial s R, rename (coe : s → ι) p = 0 ↔ p = 0 :=
    (injective_iff_map_eq_zero' (rename (coe : s → ι) : MvPolynomial s R →ₐ[R] _).toRingHom).1
      (rename_injective _ Subtype.val_injective)
  simp [algebraicIndependent_iff, supported_eq_range_rename, *]
#align algebraic_independent_comp_subtype algebraicIndependent_comp_subtype

theorem algebraicIndependent_subtype {s : Set A} :
    AlgebraicIndependent R (fun x => x : s → A) ↔
      ∀ p : MvPolynomial A R, p ∈ MvPolynomial.supported R s → aeval id p = 0 → p = 0 :=
  by apply @algebraicIndependent_comp_subtype _ _ _ id
#align algebraic_independent_subtype algebraicIndependent_subtype

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (t «expr ⊆ » s) -/
theorem algebraicIndependent_of_finite (s : Set A)
    (H : ∀ (t) (_ : t ⊆ s), t.Finite → AlgebraicIndependent R (fun x => x : t → A)) :
    AlgebraicIndependent R (fun x => x : s → A) :=
  algebraicIndependent_subtype.2 fun p hp =>
    algebraicIndependent_subtype.1 (H _ (mem_supported.1 hp) (Finset.finite_toSet _)) _ (by simp)
#align algebraic_independent_of_finite algebraicIndependent_of_finite

theorem AlgebraicIndependent.image_of_comp {ι ι'} (s : Set ι) (f : ι → ι') (g : ι' → A)
    (hs : AlgebraicIndependent R fun x : s => g (f x)) :
    AlgebraicIndependent R fun x : f '' s => g x :=
  by
  nontriviality R
  have : inj_on f s := inj_on_iff_injective.2 hs.injective.of_comp
  exact (algebraicIndependent_equiv' (Equiv.Set.imageOfInjOn f s this) rfl).1 hs
#align algebraic_independent.image_of_comp AlgebraicIndependent.image_of_comp

theorem AlgebraicIndependent.image {ι} {s : Set ι} {f : ι → A}
    (hs : AlgebraicIndependent R fun x : s => f x) :
    AlgebraicIndependent R fun x : f '' s => (x : A) := by
  convert AlgebraicIndependent.image_of_comp s f id hs
#align algebraic_independent.image AlgebraicIndependent.image

theorem algebraicIndependent_unionᵢ_of_directed {η : Type _} [Nonempty η] {s : η → Set A}
    (hs : Directed (· ⊆ ·) s) (h : ∀ i, AlgebraicIndependent R (fun x => x : s i → A)) :
    AlgebraicIndependent R (fun x => x : (⋃ i, s i) → A) :=
  by
  refine' algebraicIndependent_of_finite (⋃ i, s i) fun t ht ft => _
  rcases finite_subset_Union ft ht with ⟨I, fi, hI⟩
  rcases hs.finset_le fi.to_finset with ⟨i, hi⟩
  exact (h i).mono (subset.trans hI <| Union₂_subset fun j hj => hi j (fi.mem_to_finset.2 hj))
#align algebraic_independent_Union_of_directed algebraicIndependent_unionᵢ_of_directed

theorem algebraicIndependent_unionₛ_of_directed {s : Set (Set A)} (hsn : s.Nonempty)
    (hs : DirectedOn (· ⊆ ·) s)
    (h : ∀ a ∈ s, AlgebraicIndependent R (fun x => x : (a : Set A) → A)) :
    AlgebraicIndependent R (fun x => x : ⋃₀ s → A) := by
  letI : Nonempty s := nonempty.to_subtype hsn <;> rw [sUnion_eq_Union] <;>
    exact algebraicIndependent_unionᵢ_of_directed hs.directed_coe (by simpa using h)
#align algebraic_independent_sUnion_of_directed algebraicIndependent_unionₛ_of_directed

theorem exists_maximal_algebraicIndependent (s t : Set A) (hst : s ⊆ t)
    (hs : AlgebraicIndependent R (coe : s → A)) :
    ∃ u : Set A,
      AlgebraicIndependent R (coe : u → A) ∧
        s ⊆ u ∧ u ⊆ t ∧ ∀ x : Set A, AlgebraicIndependent R (coe : x → A) → u ⊆ x → x ⊆ t → x = u :=
  by
  rcases zorn_subset_nonempty { u : Set A | AlgebraicIndependent R (coe : u → A) ∧ s ⊆ u ∧ u ⊆ t }
      (fun c hc chainc hcn =>
        ⟨⋃₀ c,
          by
          refine'
            ⟨⟨algebraicIndependent_unionₛ_of_directed hcn chainc.directed_on fun a ha => (hc ha).1,
                _, _⟩,
              _⟩
          · cases' hcn with x hx
            exact subset_sUnion_of_subset _ x (hc hx).2.1 hx
          · exact sUnion_subset fun x hx => (hc hx).2.2
          · intro s
            exact subset_sUnion_of_mem⟩)
      s ⟨hs, Set.Subset.refl s, hst⟩ with
    ⟨u, ⟨huai, hsu, hut⟩, hsu, hx⟩
  use u, huai, hsu, hut
  intro x hxai huv hxt
  exact hx _ ⟨hxai, trans hsu huv, hxt⟩ huv
#align exists_maximal_algebraic_independent exists_maximal_algebraicIndependent

section repr

variable (hx : AlgebraicIndependent R x)

/-- Canonical isomorphism between polynomials and the subalgebra generated by
  algebraically independent elements. -/
@[simps]
def AlgebraicIndependent.aevalEquiv (hx : AlgebraicIndependent R x) :
    MvPolynomial ι R ≃ₐ[R] Algebra.adjoin R (range x) :=
  by
  apply
    AlgEquiv.ofBijective (AlgHom.codRestrict (@aeval R A ι _ _ _ x) (Algebra.adjoin R (range x)) _)
  swap
  · intro x
    rw [adjoin_range_eq_range_aeval]
    exact AlgHom.mem_range_self _ _
  · constructor
    · exact (AlgHom.injective_codRestrict _ _ _).2 hx
    · rintro ⟨x, hx⟩
      rw [adjoin_range_eq_range_aeval] at hx
      rcases hx with ⟨y, rfl⟩
      use y
      ext
      simp
#align algebraic_independent.aeval_equiv AlgebraicIndependent.aevalEquiv

@[simp]
theorem AlgebraicIndependent.algebraMap_aevalEquiv (hx : AlgebraicIndependent R x)
    (p : MvPolynomial ι R) :
    algebraMap (Algebra.adjoin R (range x)) A (hx.aevalEquiv p) = aeval x p :=
  rfl
#align algebraic_independent.algebra_map_aeval_equiv AlgebraicIndependent.algebraMap_aevalEquiv

/-- The canonical map from the subalgebra generated by an algebraic independent family
  into the polynomial ring.  -/
def AlgebraicIndependent.repr (hx : AlgebraicIndependent R x) :
    Algebra.adjoin R (range x) →ₐ[R] MvPolynomial ι R :=
  hx.aevalEquiv.symm
#align algebraic_independent.repr AlgebraicIndependent.repr

@[simp]
theorem AlgebraicIndependent.aeval_repr (p) : aeval x (hx.repr p) = p :=
  Subtype.ext_iff.1 (AlgEquiv.apply_symm_apply hx.aevalEquiv p)
#align algebraic_independent.aeval_repr AlgebraicIndependent.aeval_repr

theorem AlgebraicIndependent.aeval_comp_repr : (aeval x).comp hx.repr = Subalgebra.val _ :=
  AlgHom.ext <| hx.aeval_repr
#align algebraic_independent.aeval_comp_repr AlgebraicIndependent.aeval_comp_repr

theorem AlgebraicIndependent.repr_ker :
    (hx.repr : adjoin R (range x) →+* MvPolynomial ι R).ker = ⊥ :=
  (RingHom.injective_iff_ker_eq_bot _).1 (AlgEquiv.injective _)
#align algebraic_independent.repr_ker AlgebraicIndependent.repr_ker

end repr

-- TODO - make this an `alg_equiv`
/-- The isomorphism between `mv_polynomial (option ι) R` and the polynomial ring over
the algebra generated by an algebraically independent family.  -/
def AlgebraicIndependent.mvPolynomialOptionEquivPolynomialAdjoin (hx : AlgebraicIndependent R x) :
    MvPolynomial (Option ι) R ≃+* Polynomial (adjoin R (Set.range x)) :=
  (MvPolynomial.optionEquivLeft _ _).toRingEquiv.trans
    (Polynomial.mapEquiv hx.aevalEquiv.toRingEquiv)
#align algebraic_independent.mv_polynomial_option_equiv_polynomial_adjoin AlgebraicIndependent.mvPolynomialOptionEquivPolynomialAdjoin

@[simp]
theorem AlgebraicIndependent.mvPolynomialOptionEquivPolynomialAdjoin_apply
    (hx : AlgebraicIndependent R x) (y) :
    hx.mvPolynomialOptionEquivPolynomialAdjoin y =
      Polynomial.map (hx.aevalEquiv : MvPolynomial ι R →+* adjoin R (range x))
        (aeval (fun o : Option ι => o.elim Polynomial.X fun s : ι => Polynomial.C (X s)) y) :=
  rfl
#align algebraic_independent.mv_polynomial_option_equiv_polynomial_adjoin_apply AlgebraicIndependent.mvPolynomialOptionEquivPolynomialAdjoin_apply

@[simp]
theorem AlgebraicIndependent.mvPolynomialOptionEquivPolynomialAdjoin_c
    (hx : AlgebraicIndependent R x) (r) :
    hx.mvPolynomialOptionEquivPolynomialAdjoin (C r) = Polynomial.C (algebraMap _ _ r) :=
  by
  -- TODO: this instance is slow to infer
  have h : IsScalarTower R (MvPolynomial ι R) (Polynomial (MvPolynomial ι R)) :=
    @Polynomial.isScalarTower (MvPolynomial ι R) _ R _ _ _ _ _ _ _
  rw [AlgebraicIndependent.mvPolynomialOptionEquivPolynomialAdjoin_apply, aeval_C,
    @IsScalarTower.algebraMap_apply _ _ _ _ _ _ _ _ _ h, ← Polynomial.C_eq_algebraMap,
    Polynomial.map_C, RingHom.coe_coe, AlgEquiv.commutes]
#align algebraic_independent.mv_polynomial_option_equiv_polynomial_adjoin_C AlgebraicIndependent.mvPolynomialOptionEquivPolynomialAdjoin_c

@[simp]
theorem AlgebraicIndependent.mvPolynomialOptionEquivPolynomialAdjoin_x_none
    (hx : AlgebraicIndependent R x) :
    hx.mvPolynomialOptionEquivPolynomialAdjoin (X none) = Polynomial.X := by
  rw [AlgebraicIndependent.mvPolynomialOptionEquivPolynomialAdjoin_apply, aeval_X, Option.elim',
    Polynomial.map_X]
#align algebraic_independent.mv_polynomial_option_equiv_polynomial_adjoin_X_none AlgebraicIndependent.mvPolynomialOptionEquivPolynomialAdjoin_x_none

@[simp]
theorem AlgebraicIndependent.mvPolynomialOptionEquivPolynomialAdjoin_x_some
    (hx : AlgebraicIndependent R x) (i) :
    hx.mvPolynomialOptionEquivPolynomialAdjoin (X (some i)) = Polynomial.C (hx.aevalEquiv (X i)) :=
  by
  rw [AlgebraicIndependent.mvPolynomialOptionEquivPolynomialAdjoin_apply, aeval_X, Option.elim',
    Polynomial.map_C, RingHom.coe_coe]
#align algebraic_independent.mv_polynomial_option_equiv_polynomial_adjoin_X_some AlgebraicIndependent.mvPolynomialOptionEquivPolynomialAdjoin_x_some

theorem AlgebraicIndependent.aeval_comp_mvPolynomialOptionEquivPolynomialAdjoin
    (hx : AlgebraicIndependent R x) (a : A) :
    RingHom.comp
        (↑(Polynomial.aeval a : Polynomial (adjoin R (Set.range x)) →ₐ[_] A) :
          Polynomial (adjoin R (Set.range x)) →+* A)
        hx.mvPolynomialOptionEquivPolynomialAdjoin.toRingHom =
      ↑(MvPolynomial.aeval fun o : Option ι => o.elim a x : MvPolynomial (Option ι) R →ₐ[R] A) :=
  by
  refine' MvPolynomial.ringHom_ext _ _ <;>
    simp only [RingHom.comp_apply, RingEquiv.toRingHom_eq_coe, RingEquiv.coe_toRingHom,
      AlgHom.coe_toRingHom, AlgHom.coe_toRingHom]
  · intro r
    rw [hx.mv_polynomial_option_equiv_polynomial_adjoin_C, aeval_C, Polynomial.aeval_C,
      IsScalarTower.algebraMap_apply R (adjoin R (range x)) A]
  · rintro (⟨⟩ | ⟨i⟩)
    ·
      rw [hx.mv_polynomial_option_equiv_polynomial_adjoin_X_none, aeval_X, Polynomial.aeval_X,
        Option.elim']
    ·
      rw [hx.mv_polynomial_option_equiv_polynomial_adjoin_X_some, Polynomial.aeval_C,
        hx.algebra_map_aeval_equiv, aeval_X, aeval_X, Option.elim']
#align algebraic_independent.aeval_comp_mv_polynomial_option_equiv_polynomial_adjoin AlgebraicIndependent.aeval_comp_mvPolynomialOptionEquivPolynomialAdjoin

theorem AlgebraicIndependent.option_iff (hx : AlgebraicIndependent R x) (a : A) :
    (AlgebraicIndependent R fun o : Option ι => o.elim a x) ↔
      ¬IsAlgebraic (adjoin R (Set.range x)) a :=
  by
  erw [algebraicIndependent_iff_injective_aeval, isAlgebraic_iff_not_injective, Classical.not_not, ←
    AlgHom.coe_toRingHom, ← hx.aeval_comp_mv_polynomial_option_equiv_polynomial_adjoin,
    RingHom.coe_comp, injective.of_comp_iff' _ (RingEquiv.bijective _), AlgHom.coe_toRingHom]
#align algebraic_independent.option_iff AlgebraicIndependent.option_iff

variable (R)

/-- A family is a transcendence basis if it is a maximal algebraically independent subset.
-/
def IsTranscendenceBasis (x : ι → A) : Prop :=
  AlgebraicIndependent R x ∧
    ∀ (s : Set A) (i' : AlgebraicIndependent R (coe : s → A)) (h : range x ≤ s), range x = s
#align is_transcendence_basis IsTranscendenceBasis

theorem exists_isTranscendenceBasis (h : Injective (algebraMap R A)) :
    ∃ s : Set A, IsTranscendenceBasis R (coe : s → A) :=
  by
  cases'
    exists_maximal_algebraicIndependent (∅ : Set A) Set.univ (Set.subset_univ _)
      ((algebraicIndependent_empty_iff R A).2 h) with
    s hs
  use s, hs.1
  intro t ht hr
  simp only [Subtype.range_coe_subtype, set_of_mem_eq] at *
  exact Eq.symm (hs.2.2.2 t ht hr (Set.subset_univ _))
#align exists_is_transcendence_basis exists_isTranscendenceBasis

variable {R}

theorem AlgebraicIndependent.isTranscendenceBasis_iff {ι : Type w} {R : Type u} [CommRing R]
    [Nontrivial R] {A : Type v} [CommRing A] [Algebra R A] {x : ι → A}
    (i : AlgebraicIndependent R x) :
    IsTranscendenceBasis R x ↔
      ∀ (κ : Type v) (w : κ → A) (i' : AlgebraicIndependent R w) (j : ι → κ) (h : w ∘ j = x),
        Surjective j :=
  by
  fconstructor
  · rintro p κ w i' j rfl
    have p := p.2 (range w) i'.coe_range (range_comp_subset_range _ _)
    rw [range_comp, ← @image_univ _ _ w] at p
    exact range_iff_surjective.mp (image_injective.mpr i'.injective p)
  · intro p
    use i
    intro w i' h
    specialize
      p w (coe : w → A) i' (fun i => ⟨x i, range_subset_iff.mp h i⟩)
        (by
          ext
          simp)
    have q := congr_arg (fun s => (coe : w → A) '' s) p.range_eq
    dsimp at q
    rw [← image_univ, image_image] at q
    simpa using q
#align algebraic_independent.is_transcendence_basis_iff AlgebraicIndependent.isTranscendenceBasis_iff

theorem IsTranscendenceBasis.isAlgebraic [Nontrivial R] (hx : IsTranscendenceBasis R x) :
    IsAlgebraic (adjoin R (range x)) A := by
  intro a
  rw [← not_iff_comm.1 (hx.1.option_iff _).symm]
  intro ai
  have h₁ : range x ⊆ range fun o : Option ι => o.elim a x :=
    by
    rintro x ⟨y, rfl⟩
    exact ⟨some y, rfl⟩
  have h₂ : range x ≠ range fun o : Option ι => o.elim a x :=
    by
    intro h
    have : a ∈ range x := by
      rw [h]
      exact ⟨none, rfl⟩
    rcases this with ⟨b, rfl⟩
    have : some b = none := ai.injective rfl
    simpa
  exact
    h₂
      (hx.2 (Set.range fun o : Option ι => o.elim a x)
        ((algebraicIndependent_subtype_range ai.injective).2 ai) h₁)
#align is_transcendence_basis.is_algebraic IsTranscendenceBasis.isAlgebraic

section Field

variable [Field K] [Algebra K A]

@[simp]
theorem algebraicIndependent_empty_type [IsEmpty ι] [Nontrivial A] : AlgebraicIndependent K x :=
  by
  rw [algebraicIndependent_empty_type_iff]
  exact RingHom.injective _
#align algebraic_independent_empty_type algebraicIndependent_empty_type

theorem algebraicIndependent_empty [Nontrivial A] :
    AlgebraicIndependent K (coe : (∅ : Set A) → A) :=
  algebraicIndependent_empty_type
#align algebraic_independent_empty algebraicIndependent_empty

end Field