import analysis.special_functions.pow

open real

lemma rpow_ne_zero
{x y : ℝ} (hx : 0 < x) (hy : 0 < y)
: x^y ≠ 0 :=
begin
  have hy2 : y ≠ 0 := by linarith,
  apply ne_of_gt,
  rw [← zero_rpow hy2, rpow_lt_rpow_iff],
  iterate 4 {linarith},
end

lemma zero_lt_rpow
{x y : ℝ} (hx : 0 < x) (hy : 0 < y)
: 0 < x^y :=
begin
  have hy2 : y ≠ 0 := by linarith,
  rw [← zero_rpow hy2, rpow_lt_rpow_iff],
  iterate 4 {linarith},
end


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

import ring_theory.non_zero_divisors
import data.polynomial.algebra_map

/-!
# Scaling the roots of a polynomial

This file defines `scale_roots p s` for a polynomial `p` in one variable and a ring element `s` to
be the polynomial with root `r * s` for each root `r` of `p` and proves some basic results about it.
-/

section scale_roots

variables {A K R S : Type*} [comm_ring A] [is_domain A] [field K] [comm_ring R] [comm_ring S]
variables {M : submonoid A}

open polynomial
open_locale big_operators polynomial

/-- `scale_roots p s` is a polynomial with root `r * s` for each root `r` of `p`. -/
noncomputable def scale_roots (p : R[X]) (s : R) : R[X] :=
∑ i in p.support, monomial i (p.coeff i * s ^ (p.nat_degree - i))

@[simp] lemma coeff_scale_roots (p : R[X]) (s : R) (i : ℕ) :
  (scale_roots p s).coeff i = coeff p i * s ^ (p.nat_degree - i) :=
by simp [scale_roots, coeff_monomial] {contextual := tt}

@[simp] lemma zero_scale_roots (s : R) : scale_roots 0 s = 0 := by { ext, simp }

lemma scale_roots_ne_zero {p : R[X]} (hp : p ≠ 0) (s : R) :
  scale_roots p s ≠ 0 :=
begin
  intro h,
  have : p.coeff p.nat_degree ≠ 0 := mt leading_coeff_eq_zero.mp hp,
  have : (scale_roots p s).coeff p.nat_degree = 0 :=
    congr_fun (congr_arg (coeff : R[X] → ℕ → R) h) p.nat_degree,
  rw [coeff_scale_roots_nat_degree] at this,
  contradiction
end

lemma support_scale_roots_le (p : R[X]) (s : R) :
  (scale_roots p s).support ≤ p.support :=
by { intro, simpa using left_ne_zero_of_mul }

lemma support_scale_roots_eq (p : R[X]) {s : R} (hs : s ∈ non_zero_divisors R) :
  (scale_roots p s).support = p.support :=
le_antisymm (support_scale_roots_le p s)
  begin
    intro i,
    simp only [coeff_scale_roots, polynomial.mem_support_iff],
    intros p_ne_zero ps_zero,
    have := pow_mem hs (p.nat_degree - i) _ ps_zero,
    contradiction
  end

@[simp] lemma degree_scale_roots (p : R[X]) {s : R} :
  degree (scale_roots p s) = degree p :=
begin
  haveI := classical.prop_decidable,
  by_cases hp : p = 0,
  { rw [hp, zero_scale_roots] },
  have := scale_roots_ne_zero hp s,
  refine le_antisymm (finset.sup_mono (support_scale_roots_le p s)) (degree_le_degree _),
  rw coeff_scale_roots_nat_degree,
  intro h,
  have := leading_coeff_eq_zero.mp h,
  contradiction,
end

@[simp] lemma nat_degree_scale_roots (p : R[X]) (s : R) :
  nat_degree (scale_roots p s) = nat_degree p :=
by simp only [nat_degree, degree_scale_roots]

lemma monic_scale_roots_iff {p : R[X]} (s : R) :
  monic (scale_roots p s) ↔ monic p :=
by simp only [monic, leading_coeff, nat_degree_scale_roots, coeff_scale_roots_nat_degree]

lemma scale_roots_eval₂_eq_zero {p : S[X]} (f : S →+* R)
  {r : R} {s : S} (hr : eval₂ f r p = 0) :
  eval₂ f (f s * r) (scale_roots p s) = 0 :=
calc eval₂ f (f s * r) (scale_roots p s) =
  (scale_roots p s).support.sum (λ i, f (coeff p i * s ^ (p.nat_degree - i)) * (f s * r) ^ i) :
  by simp [eval₂_eq_sum, sum_def]
... = p.support.sum (λ i, f (coeff p i * s ^ (p.nat_degree - i)) * (f s * r) ^ i) :
  finset.sum_subset (support_scale_roots_le p s)
  (λ i hi hi', let this : coeff p i * s ^ (p.nat_degree - i) = 0 :=
  by simpa using hi' in by simp [this])
... = p.support.sum (λ (i : ℕ), f (p.coeff i) * f s ^ (p.nat_degree - i + i) * r ^ i) :
  finset.sum_congr rfl
  (λ i hi, by simp_rw [f.map_mul, f.map_pow, pow_add, mul_pow, mul_assoc])
... = p.support.sum (λ (i : ℕ), f s ^ p.nat_degree * (f (p.coeff i) * r ^ i)) :
  finset.sum_congr rfl
  (λ i hi, by { rw [mul_assoc, mul_left_comm, tsub_add_cancel_of_le],
                exact le_nat_degree_of_ne_zero (polynomial.mem_support_iff.mp hi) })
... = f s ^ p.nat_degree * p.support.sum (λ (i : ℕ), (f (p.coeff i) * r ^ i)) : finset.mul_sum.symm
... = f s ^ p.nat_degree * eval₂ f r p : by { simp [eval₂_eq_sum, sum_def] }
... = 0 : by rw [hr, _root_.mul_zero]

lemma scale_roots_aeval_eq_zero [algebra S R] {p : S[X]}
  {r : R} {s : S} (hr : aeval r p = 0) :
  aeval (algebra_map S R s * r) (scale_roots p s) = 0 :=
scale_roots_eval₂_eq_zero (algebra_map S R) hr

lemma scale_roots_eval₂_eq_zero_of_eval₂_div_eq_zero
  {p : A[X]} {f : A →+* K} (hf : function.injective f)
  {r s : A} (hr : eval₂ f (f r / f s) p = 0) (hs : s ∈ non_zero_divisors A) :
  eval₂ f (f r) (scale_roots p s) = 0 :=
begin
  convert scale_roots_eval₂_eq_zero f hr,
  rw [←mul_div_assoc, mul_comm, mul_div_cancel],
  exact map_ne_zero_of_mem_non_zero_divisors _ hf hs
end

lemma scale_roots_aeval_eq_zero_of_aeval_div_eq_zero [algebra A K]
  (inj : function.injective (algebra_map A K)) {p : A[X]} {r s : A}
  (hr : aeval (algebra_map A K r / algebra_map A K s) p = 0) (hs : s ∈ non_zero_divisors A) :
  aeval (algebra_map A K r) (scale_roots p s) = 0 :=
scale_roots_eval₂_eq_zero_of_eval₂_div_eq_zero inj hr hs

end scale_roots


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Patrick Massot, Casper Putz, Anne Baanen, Antoine Labelle
-/
import linear_algebra.matrix.to_lin
import linear_algebra.matrix.trace
import linear_algebra.contraction
import linear_algebra.tensor_product_basis
import linear_algebra.free_module.strong_rank_condition
import linear_algebra.free_module.finite.rank
import linear_algebra.projection

/-!
# Trace of a linear map

This file defines the trace of a linear map.

See also `linear_algebra/matrix/trace.lean` for the trace of a matrix.

## Tags

linear_map, trace, diagonal

-/

noncomputable theory

universes u v w

namespace linear_map

open_locale big_operators
open_locale matrix
open finite_dimensional

open_locale tensor_product

section
variables (R : Type u) [comm_semiring R] {M : Type v} [add_comm_monoid M] [module R M]
variables {ι : Type w} [decidable_eq ι] [fintype ι]
variables {κ : Type*} [decidable_eq κ] [fintype κ]
variables (b : basis ι R M) (c : basis κ R M)

/-- The trace of an endomorphism given a basis. -/
def trace_aux :
  (M →ₗ[R] M) →ₗ[R] R :=
(matrix.trace_linear_map ι R R) ∘ₗ ↑(linear_map.to_matrix b b)

-- Can't be `simp` because it would cause a loop.
lemma trace_aux_def (b : basis ι R M) (f : M →ₗ[R] M) :
  trace_aux R b f = matrix.trace (linear_map.to_matrix b b f) :=
rfl

theorem trace_aux_eq : trace_aux R b = trace_aux R c :=
linear_map.ext $ λ f,
calc  matrix.trace (linear_map.to_matrix b b f)
    = matrix.trace (linear_map.to_matrix b b ((linear_map.id.comp f).comp linear_map.id)) :
  by rw [linear_map.id_comp, linear_map.comp_id]
... = matrix.trace (linear_map.to_matrix c b linear_map.id ⬝
        linear_map.to_matrix c c f ⬝
        linear_map.to_matrix b c linear_map.id) :
  by rw [linear_map.to_matrix_comp _ c, linear_map.to_matrix_comp _ c]
... = matrix.trace (linear_map.to_matrix c c f ⬝
        linear_map.to_matrix b c linear_map.id ⬝
        linear_map.to_matrix c b linear_map.id) :
  by rw [matrix.mul_assoc, matrix.trace_mul_comm]
... = matrix.trace (linear_map.to_matrix c c ((f.comp linear_map.id).comp linear_map.id)) :
  by rw [linear_map.to_matrix_comp _ b, linear_map.to_matrix_comp _ c]
... = matrix.trace (linear_map.to_matrix c c f) :
  by rw [linear_map.comp_id, linear_map.comp_id]

open_locale classical

variables (R) (M)

/-- Trace of an endomorphism independent of basis. -/
def trace : (M →ₗ[R] M) →ₗ[R] R :=
if H : ∃ (s : finset M), nonempty (basis s R M)
then trace_aux R H.some_spec.some
else 0

variables (R) {M}

/-- Auxiliary lemma for `trace_eq_matrix_trace`. -/
theorem trace_eq_matrix_trace_of_finset {s : finset M} (b : basis s R M)
  (f : M →ₗ[R] M) :
  trace R M f = matrix.trace (linear_map.to_matrix b b f) :=
have ∃ (s : finset M), nonempty (basis s R M),
from ⟨s, ⟨b⟩⟩,
by { rw [trace, dif_pos this, ← trace_aux_def], congr' 1, apply trace_aux_eq }

theorem trace_eq_matrix_trace (f : M →ₗ[R] M) :
  trace R M f = matrix.trace (linear_map.to_matrix b b f) :=
by rw [trace_eq_matrix_trace_of_finset R b.reindex_finset_range,
    ← trace_aux_def, ← trace_aux_def, trace_aux_eq R b]

theorem trace_mul_comm (f g : M →ₗ[R] M) :
  trace R M (f * g) = trace R M (g * f) :=
if H : ∃ (s : finset M), nonempty (basis s R M) then let ⟨s, ⟨b⟩⟩ := H in
by { simp_rw [trace_eq_matrix_trace R b, linear_map.to_matrix_mul], apply matrix.trace_mul_comm }
else by rw [trace, dif_neg H, linear_map.zero_apply, linear_map.zero_apply]

/-- The trace of an endomorphism is invariant under conjugation -/
@[simp]
theorem trace_conj (g : M →ₗ[R] M) (f : (M →ₗ[R] M)ˣ) :
  trace R M (↑f * g * ↑f⁻¹) = trace R M g :=
by { rw trace_mul_comm, simp }

end

section

variables {R : Type*} [comm_ring R] {M : Type*} [add_comm_group M] [module R M]
variables (N : Type*) [add_comm_group N] [module R N]
variables {ι : Type*}

/-- The trace of a linear map correspond to the contraction pairing under the isomorphism
 `End(M) ≃ M* ⊗ M`-/

/-- The trace of a linear map correspond to the contraction pairing under the isomorphism
 `End(M) ≃ M* ⊗ M`-/
lemma trace_eq_contract_of_basis' [fintype ι] [decidable_eq ι] (b : basis ι R M) :
  (linear_map.trace R M) =
  (contract_left R M) ∘ₗ (dual_tensor_hom_equiv_of_basis b).symm.to_linear_map :=
by simp [linear_equiv.eq_comp_to_linear_map_symm, trace_eq_contract_of_basis b]

variables (R M N)
variables [module.free R M] [module.finite R M] [module.free R N] [module.finite R N] [nontrivial R]

/-- When `M` is finite free, the trace of a linear map correspond to the contraction pairing under
the isomorphism `End(M) ≃ M* ⊗ M`-/
@[simp] theorem trace_eq_contract :
  (linear_map.trace R M) ∘ₗ (dual_tensor_hom R M M) = contract_left R M :=
trace_eq_contract_of_basis (module.free.choose_basis R M)

@[simp] theorem trace_eq_contract_apply (x : module.dual R M ⊗[R] M) :
  (linear_map.trace R M) ((dual_tensor_hom R M M) x) = contract_left R M x :=
by rw [←comp_apply, trace_eq_contract]

open_locale classical

/-- When `M` is finite free, the trace of a linear map correspond to the contraction pairing under
the isomorphism `End(M) ≃ M* ⊗ M`-/
theorem trace_eq_contract' :
  (linear_map.trace R M) =
  (contract_left R M) ∘ₗ (dual_tensor_hom_equiv R M M).symm.to_linear_map :=
trace_eq_contract_of_basis' (module.free.choose_basis R M)

/-- The trace of the identity endomorphism is the dimension of the free module -/
@[simp] theorem trace_one : trace R M 1 = (finrank R M : R) :=
begin
  have b := module.free.choose_basis R M,
  rw [trace_eq_matrix_trace R b, to_matrix_one, module.free.finrank_eq_card_choose_basis_index],
  simp,
end

/-- The trace of the identity endomorphism is the dimension of the free module -/
@[simp] theorem trace_id : trace R M id = (finrank R M : R) :=
by rw [←one_eq_id, trace_one]

@[simp] theorem trace_transpose : trace R (module.dual R M) ∘ₗ module.dual.transpose = trace R M :=
begin
  let e := dual_tensor_hom_equiv R M M,
  have h : function.surjective e.to_linear_map := e.surjective,
  refine (cancel_right h).1 _,
  ext f m, simp [e],
end

theorem trace_prod_map :
  trace R (M × N) ∘ₗ prod_map_linear R M N M N R =
  (coprod id id : R × R →ₗ[R] R) ∘ₗ prod_map (trace R M) (trace R N) :=
begin
  let e := ((dual_tensor_hom_equiv R M M).prod (dual_tensor_hom_equiv R N N)),
  have h : function.surjective e.to_linear_map := e.surjective,
  refine (cancel_right h).1 _,
  ext,
  { simp only [dual_tensor_hom_equiv, tensor_product.algebra_tensor_module.curry_apply,
  to_fun_eq_coe, tensor_product.curry_apply, coe_restrict_scalars_eq_coe, coe_comp,
  linear_equiv.coe_to_linear_map, coe_inl, function.comp_app, linear_equiv.prod_apply,
  dual_tensor_hom_equiv_of_basis_apply, map_zero, prod_map_apply, coprod_apply, id_coe, id.def,
  add_zero, prod_map_linear_apply, dual_tensor_hom_prod_map_zero, trace_eq_contract_apply,
  contract_left_apply, fst_apply] },
  { simp only [dual_tensor_hom_equiv, tensor_product.algebra_tensor_module.curry_apply,
  to_fun_eq_coe, tensor_product.curry_apply, coe_restrict_scalars_eq_coe, coe_comp,
  linear_equiv.coe_to_linear_map, coe_inr, function.comp_app, linear_equiv.prod_apply,
  dual_tensor_hom_equiv_of_basis_apply, map_zero, prod_map_apply, coprod_apply, id_coe, id.def,
  zero_add, prod_map_linear_apply, zero_prod_map_dual_tensor_hom, trace_eq_contract_apply,
  contract_left_apply, snd_apply], },
end

variables {R M N}

theorem trace_prod_map' (f : M →ₗ[R] M) (g : N →ₗ[R] N) :
  trace R (M × N) (prod_map f g) = trace R M f + trace R N g :=
begin
  have h := ext_iff.1 (trace_prod_map R M N) (f, g),
  simp only [coe_comp, function.comp_app, prod_map_apply, coprod_apply, id_coe, id.def,
  prod_map_linear_apply] at h, exact h,
end

variables (R M N)

open tensor_product function

theorem trace_tensor_product :
  compr₂ (map_bilinear R M N M N) (trace R (M ⊗ N)) =
  compl₁₂ (lsmul R R : R →ₗ[R] R →ₗ[R] R) (trace R M) (trace R N) :=
begin
  apply (compl₁₂_inj
    (show surjective (dual_tensor_hom R M M), from (dual_tensor_hom_equiv R M M).surjective)
    (show surjective (dual_tensor_hom R N N), from (dual_tensor_hom_equiv R N N).surjective)).1,
  ext f m g n,
  simp only [algebra_tensor_module.curry_apply, to_fun_eq_coe, tensor_product.curry_apply,
  coe_restrict_scalars_eq_coe, compl₁₂_apply, compr₂_apply, map_bilinear_apply,
  trace_eq_contract_apply, contract_left_apply, lsmul_apply, algebra.id.smul_eq_mul,
  map_dual_tensor_hom, dual_distrib_apply],
end

theorem trace_comp_comm :
  compr₂ (llcomp R M N M) (trace R M) = compr₂ (llcomp R N M N).flip (trace R N) :=
begin
  apply (compl₁₂_inj
    (show surjective (dual_tensor_hom R N M), from (dual_tensor_hom_equiv R N M).surjective)
    (show surjective (dual_tensor_hom R M N), from (dual_tensor_hom_equiv R M N).surjective)).1,
  ext g m f n,
  simp only [tensor_product.algebra_tensor_module.curry_apply, to_fun_eq_coe,
      linear_equiv.coe_to_linear_map, tensor_product.curry_apply, coe_restrict_scalars_eq_coe,
      compl₁₂_apply, compr₂_apply, flip_apply, llcomp_apply', comp_dual_tensor_hom, map_smul,
      trace_eq_contract_apply, contract_left_apply, smul_eq_mul, mul_comm],
end

variables {R M N}

@[simp]
theorem trace_transpose' (f : M →ₗ[R] M) : trace R _ (module.dual.transpose f) = trace R M f :=
by { rw [←comp_apply, trace_transpose] }

theorem trace_tensor_product' (f : M →ₗ[R] M) (g : N →ₗ[R] N) :
  trace R (M ⊗ N) (map f g) = trace R M f * trace R N g :=
begin
  have h := ext_iff.1 (ext_iff.1 (trace_tensor_product R M N) f) g,
  simp only [compr₂_apply, map_bilinear_apply, compl₁₂_apply, lsmul_apply,
    algebra.id.smul_eq_mul] at h, exact h,
end

theorem trace_comp_comm' (f : M →ₗ[R] N) (g : N →ₗ[R] M) :
  trace R M (g ∘ₗ f) = trace R N (f ∘ₗ g) :=
begin
  have h := ext_iff.1 (ext_iff.1 (trace_comp_comm R M N) g) f,
  simp only [llcomp_apply', compr₂_apply, flip_apply] at h,
  exact h,
end

@[simp] theorem trace_conj' (f : M →ₗ[R] M) (e : M ≃ₗ[R] N) : trace R N (e.conj f) = trace R M f :=
by rw [e.conj_apply, trace_comp_comm', ←comp_assoc, linear_equiv.comp_coe,
  linear_equiv.self_trans_symm, linear_equiv.refl_to_linear_map, id_comp]

theorem is_proj.trace {p : submodule R M} {f : M →ₗ[R] M} (h : is_proj p f)
  [module.free R p] [module.finite R p] [module.free R f.ker] [module.finite R f.ker] :
  trace R M f = (finrank R p : R) :=
by rw [h.eq_conj_prod_map, trace_conj', trace_prod_map', trace_id, map_zero, add_zero]

end

end linear_map


import data.polynomial

class algebra (R : out_param $ Type*) [comm_ring R] (A : Type*) extends ring A :=
(f : R → A) [hom : is_ring_hom f]
(commutes : ∀ r s, s * f r = f r * s)

attribute [instance] algebra.hom

namespace algebra

variables (R : Type*) (A : Type*)
variables [comm_ring R] [algebra R A]

@[simp] lemma f_add (r s : R) : f A (r + s) = f A r + f A s :=
is_ring_hom.map_add _

@[simp] lemma f_zero : f A (0 : R) = 0 :=
is_ring_hom.map_zero _

@[simp] lemma f_neg (r : R) : f A (-r) = -f A r :=
is_ring_hom.map_neg _

@[simp] lemma f_sub (r s : R) : f A (r - s) = f A r - f A s :=
is_ring_hom.map_sub _

@[simp] lemma f_mul (r s : R) : f A (r * s) = f A r * f A s :=
is_ring_hom.map_mul _

@[simp] lemma f_one : f A (1 : R) = 1 :=
is_ring_hom.map_one _

instance to_module : module R A :=
{ smul := λ r x, f A r * x,
  smul_add := by intros; simp [mul_add],
  add_smul := by intros; simp [add_mul],
  mul_smul := by intros; simp [mul_assoc],
  one_smul := by intros; simp }

theorem smul_def {r : R} {x : A} : r • x = f A r * x :=
rfl

@[simp] lemma mul_smul (s : R) (x y : A) :
  x * (s • y) = s • (x * y) :=
by rw [smul_def, smul_def, ← mul_assoc, commutes, mul_assoc]

@[simp] lemma smul_mul (r : R) (x y : A) :
  (r • x) * y = r • (x * y) :=
mul_assoc _ _ _

end algebra

class is_alg_hom (R : Type*) {A : Type*} {B : Type*}
  [comm_ring R] [algebra R A] [algebra R B] (φ : A → B)
  extends is_ring_hom φ : Prop :=
(commutes : ∀ r : R, φ (r • 1) = r • 1)

namespace is_alg_hom

variables (R : Type*) (A : Type*) (B : Type*)
variables [comm_ring R] [algebra R A] [algebra R B]
variables (φ : A → B) [is_alg_hom R φ]

theorem is_alg_hom.smul (r : R) (x : A) : φ (r • x) = r • φ x :=
calc  φ (r • x)
    = φ (r • 1 * x) : by simp
... = φ (r • 1) * φ x : is_ring_hom.map_mul φ
... = r • φ x : by simp [is_alg_hom.commutes φ r]

end is_alg_hom

namespace polynomial

variables (R : Type*) (A : Type*)
variables [comm_ring R] [algebra R A]
variables [decidable_eq R] (x : A)

instance : algebra R (polynomial R) :=
{ f := C,
  commutes := λ _ _, mul_comm _ _ }

def eval' : polynomial R → A :=
λ p, p.sum (λ n c, c • x^n)

@[simp] lemma eval'_add (f g : polynomial R) :
  eval' R A x (f + g) =
  eval' R A x f + eval' R A x g :=
begin
  unfold eval',
  apply finsupp.sum_add_index,
  { intros, simp },
  intros n r s,
  simp [add_smul]
end

@[simp] lemma eval'_C_mul_X (r : R) (n : ℕ) :
  eval' R A x (C r * X ^ n) = r • x^n :=
begin
  unfold eval',
  rw ← single_eq_C_mul_X,
  rw finsupp.sum_single_index; simp
end

@[simp] lemma eval'_C (r : R) :
  eval' R A x (C r) = r • (1 : A) :=
by simpa using eval'_C_mul_X R A x r 0

@[simp] lemma eval'_X_pow (n : ℕ) :
  eval' R A x (X ^ n) = x^n :=
by simpa using eval'_C_mul_X R A x 1 n

@[simp] lemma eval'_X :
  eval' R A x (X) = x :=
by simpa using eval'_X_pow R A x 1

@[simp] lemma eval'_C_mul_X_mul (r : R) (n : ℕ) (p : polynomial R) :
  eval' R A x (C r * X ^ n * p) = (r • x^n) * eval' R A x p :=
begin
  apply polynomial.induction_on p,
  { intro s,
    rw [mul_right_comm, ← C_mul],
    rw [eval'_C_mul_X, eval'_C],
    simp [mul_smul] },
  { intros f g ih1 ih2,
    simp [mul_add, ih1, ih2] },
  intros m s ih,
  rw [← mul_assoc, mul_right_comm (C r)],
  rw [← C_mul, mul_assoc, ← pow_add],
  rw [eval'_C_mul_X, eval'_C_mul_X],
  simp [pow_add, mul_smul]
end

@[simp] lemma eval'_C_mul (r : R) (p : polynomial R) :
  eval' R A x (C r * p) = r • eval' R A x p :=
by simpa using eval'_C_mul_X_mul R A x r 0 p

instance is_alg_hom : is_alg_hom R (eval' R A x) :=
{ map_add := eval'_add R A x,
  map_mul := λ f g, by apply polynomial.induction_on f; intros; simp [add_mul,*],
  map_one := by simpa using eval'_X_pow R A x 0,
  commutes := λ r, (eval'_C_mul R A x r 1).trans $
    congr_arg _ $ by simpa using eval'_X_pow R A x 0 }

variables (p q : polynomial R)

@[simp] lemma eval'_zero : eval' R A x 0 = 0 :=
is_ring_hom.map_zero _

@[simp] lemma eval'_neg : eval' R A x (-p) = -eval' R A x p :=
is_ring_hom.map_neg _

@[simp] lemma eval'_sub : eval' R A x (p - q) = eval' R A x p - eval' R A x q :=
is_ring_hom.map_sub _

@[simp] lemma eval'_mul : eval' R A x (p * q) = eval' R A x p * eval' R A x q :=
is_ring_hom.map_mul _

@[simp] lemma eval'_one : eval' R A x 1 = 1 :=
is_ring_hom.map_one _

theorem eval'_unique (φ : polynomial R → A) [is_alg_hom R φ] (p) :
  φ p = eval' R A (φ X) p :=
begin
  apply polynomial.induction_on p,
  { intro r,
    suffices : φ (C r * 1) = r • 1,
    { simpa using this },
    exact is_alg_hom.commutes φ r },
  { intros f g ih1 ih2,
    simp [is_ring_hom.map_add φ, ih1, ih2] },
  { intros n r ih,
    rw [pow_succ, mul_left_comm, is_ring_hom.map_mul φ, ih],
    simp }
end

end polynomial

variables (R : Type*) [ring R]

def ring.to_ℤ_algebra : algebra ℤ R :=
{ f := coe,
  hom := by constructor; intros; simp,
  commutes := λ n r, int.induction_on n (by simp)
    (λ i ih, by simp [mul_add, add_mul, ih])
    (λ i ih, by simp [mul_add, add_mul, ih]), }

def is_ring_hom.to_is_ℤ_alg_hom
  (R : Type*) [algebra ℤ R] (S : Type*) [algebra ℤ S]
  (f : R → S) [is_ring_hom f] : is_alg_hom ℤ f :=
{ commutes := λ i, show f (i • 1) = i • 1, from
    int.induction_on i (by simpa using is_ring_hom.map_zero f)
      (λ i ih, by rw [add_smul, add_smul, one_smul, one_smul];
        rw [is_ring_hom.map_add f, is_ring_hom.map_one f, ih])
      (λ i ih, by rw [sub_smul, sub_smul, one_smul, one_smul];
        rw [is_ring_hom.map_sub f, is_ring_hom.map_one f, ih]) }

local attribute [instance] ring.to_ℤ_algebra
local attribute [instance] is_ring_hom.to_is_ℤ_alg_hom

instance : ring (polynomial ℤ) :=
comm_ring.to_ring _

example : {f : polynomial ℤ → R // is_ring_hom f} ≃ R :=
{ to_fun := λ f, f.1 polynomial.X,
  inv_fun := λ r, ⟨polynomial.eval' ℤ R r,
    @is_alg_hom.to_is_ring_hom ℤ _ _ _ (polynomial.algebra ℤ) _ _
      (polynomial.is_alg_hom _ _ r)⟩,
  left_inv := λ ⟨f, hf⟩, subtype.eq $ funext $ λ p,
    eq.symm $ @polynomial.eval'_unique ℤ _ _ _ _ f
      (@is_ring_hom.to_is_ℤ_alg_hom _ (polynomial.algebra ℤ) _ _ f hf) _,
  right_inv := λ r, by simp }


import category_theory.functor_category -- this transitively imports
import algebra.category.CommRing.basic
import algebra.ring
import category_theory.natural_transformation
import category_theory.types
open CommRing
open is_ring_hom
open nat
universes v u  -- the order matters (see below)
/--
## Category of Commutative Ring : Functor of nilpotent.
## Define a functor. We first define two functions :
## 1. obj'
## 2. map'
##  construction !

#print "hello"
def φ  :   nil3 ⟶  A := {
    app := λ R,Nat_tu(R)
    -- naturality' := begin
    --     intros R R' f,
    --     sorry,
    --     end
}
#print φ
-/
lemma power_commute_with_morph  (A B : CommRing)(f : A ⟶ B)(n : ℕ) : ∀ x : A, f( x^n ) = (f x)^n := λ x,
            nat.rec_on n (show  f(x^0) = (f x)^0, {rw [pow_zero x,pow_zero (f x)], exact map_one f,})
                         (assume n, assume rec_hyp : f(x^n) = (f(x))^n,
                                 show f(x^(n+1)) = (f(x))^(n+1),{rw [pow_succ x n,pow_succ (f(x)) n,← rec_hyp],exact map_mul (f)})

def nil_obj'(n : ℕ)  (R : CommRing) : Type v := { η  : R | η^n = 0 }
def nil_map'(n : ℕ)  (X Y : CommRing)( f : ring_hom X Y) : nil_obj'(n) X → nil_obj'(n) Y  := begin
  intros x,
  cases x with η certificat,
  have t : η^n = 0,
    exact certificat,
    have H : ( f η  ) ^n = 0,
        rw ←  power_commute_with_morph,
        rw t,
        exact map_zero f,
        use (f η), assumption,
  end

def Nil(n: ℕ) : CommRing ⥤ Type v :=
{ obj := nil_obj'(n),
  map := nil_map'(n),
}
def nil3 := Nil(3)
#check Nil
def A_obj' (R : CommRing) : Type v := (R : Type v)
def A_map'  (X Y : CommRing)( f : ring_hom X Y) :A_obj' X → A_obj' Y  :=
begin
  intros x,
  use  f x,
  end
def A : CommRing ⥤ Type v :=
{ obj := A_obj'
  map := A_map'
}
#check A
#print 14
lemma Nat_tu   (R : CommRing) :  nil3.obj(R) ⟶ A.obj(R) :=
    begin
        rw category_theory.types_hom,
        intro x,
        cases x with e certificat,
        use e,
    end
#print 16


/-
Copyright (c) 2021 Christopher Hoskin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Christopher Hoskin
-/
import algebra.lie.of_associative

/-!
# Jordan rings

Let `A` be a non-unital, non-associative ring. Then `A` is said to be a (commutative, linear) Jordan
ring if the multiplication is commutative and satisfies a weak associativity law known as the
Jordan Identity: for all `a` and `b` in `A`,
```
(a * b) * a^2 = a * (b * a^2)
```
i.e. the operators of multiplication by `a` and `a^2` commute.

A more general concept of a (non-commutative) Jordan ring can also be defined, as a
(non-commutative, non-associative) ring `A` where, for each `a` in `A`, the operators of left and
right multiplication by `a` and `a^2` commute.

Every associative algebra can be equipped with a symmetrized multiplication (characterized by
`sym_alg.sym_mul_sym`) making it into a commutative Jordan algebra (`sym_alg.is_comm_jordan`).
Jordan algebras arising this way are said to be special.

A real Jordan algebra `A` can be introduced by
```lean
variables {A : Type*} [non_unital_non_assoc_ring A] [module ℝ A] [smul_comm_class ℝ A A]
  [is_scalar_tower ℝ A A] [is_comm_jordan A]
```

## Main results

- `two_nsmul_lie_lmul_lmul_add_add_eq_zero` : Linearisation of the commutative Jordan axiom

## Implementation notes

We shall primarily be interested in linear Jordan algebras (i.e. over rings of characteristic not
two) leaving quadratic algebras to those better versed in that theory.

The conventional way to linearise the Jordan axiom is to equate coefficients (more formally, assume
that the axiom holds in all field extensions). For simplicity we use brute force algebraic expansion
and substitution instead.

## Motivation

Every Jordan algebra `A` has a triple product defined, for `a` `b` and `c` in `A` by
$$
{a\,b\,c} = (a * b) * c - (a * c) * b + a * (b * c).
$$
Via this triple product Jordan algebras are related to a number of other mathematical structures:
Jordan triples, partial Jordan triples, Jordan pairs and quadratic Jordan algebras. In addition to
their considerable algebraic interest ([mccrimmon2004]) these structures have been shown to have
deep connections to mathematical physics, functional analysis and differential geometry. For more
information about these connections the interested reader is referred to [alfsenshultz2003],
[chu2012], [friedmanscarr2005], [iordanescu2003] and [upmeier1987].

There are also exceptional Jordan algebras which can be shown not to be the symmetrization of any
associative algebra. The 3x3 matrices of octonions is the canonical example.

Non-commutative Jordan algebras have connections to the Vidav-Palmer theorem
[cabreragarciarodriguezpalacios2014].

## References

* [Cabrera García and Rodríguez Palacios, Non-associative normed algebras. Volume 1]
  [cabreragarciarodriguezpalacios2014]
* [Hanche-Olsen and Størmer, Jordan Operator Algebras][hancheolsenstormer1984]
* [McCrimmon, A taste of Jordan algebras][mccrimmon2004]

-/

variables (A : Type*)

/-- A (non-commutative) Jordan multiplication. -/
class is_jordan [has_mul A] :=
(lmul_comm_rmul : ∀ a b : A, (a * b) * a = a * (b * a))
(lmul_lmul_comm_lmul : ∀ a b : A, (a * a) * (a * b) = a * ((a * a) * b))
(lmul_lmul_comm_rmul : ∀ a b : A, (a * a) * (b * a) = ((a * a) * b) * a)
(lmul_comm_rmul_rmul : ∀ a b : A, (a * b) * (a * a) = a * (b * (a * a)))
(rmul_comm_rmul_rmul : ∀ a b : A, (b * a) * (a * a) = (b * (a * a)) * a)

/-- A commutative Jordan multipication -/
class is_comm_jordan [has_mul A] :=
(mul_comm : ∀ a b : A, a * b = b * a)
(lmul_comm_rmul_rmul : ∀ a b : A, (a * b) * (a * a) = a * (b * (a * a)))

/-- A (commutative) Jordan multiplication is also a Jordan multipication -/
@[priority 100] -- see Note [lower instance priority]
instance is_comm_jordan.to_is_jordan [has_mul A] [is_comm_jordan A] : is_jordan A :=
{ lmul_comm_rmul := λ a b, by rw [is_comm_jordan.mul_comm, is_comm_jordan.mul_comm a b],
  lmul_lmul_comm_lmul := λ a b, by rw [is_comm_jordan.mul_comm (a * a) (a * b),
    is_comm_jordan.lmul_comm_rmul_rmul, is_comm_jordan.mul_comm b (a * a)],
  lmul_comm_rmul_rmul := is_comm_jordan.lmul_comm_rmul_rmul,
  lmul_lmul_comm_rmul := λ a b, by rw [is_comm_jordan.mul_comm (a * a) (b * a),
    is_comm_jordan.mul_comm b a, is_comm_jordan.lmul_comm_rmul_rmul, is_comm_jordan.mul_comm,
    is_comm_jordan.mul_comm b (a * a)],
  rmul_comm_rmul_rmul := λ a b, by rw [is_comm_jordan.mul_comm b a,
    is_comm_jordan.lmul_comm_rmul_rmul, is_comm_jordan.mul_comm], }

/-- Semigroup multiplication satisfies the (non-commutative) Jordan axioms-/
@[priority 100] -- see Note [lower instance priority]
instance semigroup.is_jordan [semigroup A] : is_jordan A :=
{ lmul_comm_rmul := λ a b, by rw mul_assoc,
  lmul_lmul_comm_lmul := λ a b, by rw [mul_assoc, mul_assoc],
  lmul_comm_rmul_rmul := λ a b, by rw [mul_assoc],
  lmul_lmul_comm_rmul := λ a b, by rw [←mul_assoc],
  rmul_comm_rmul_rmul := λ a b, by rw [← mul_assoc, ← mul_assoc], }

@[priority 100] -- see Note [lower instance priority]
instance comm_semigroup.is_comm_jordan [comm_semigroup A] : is_comm_jordan A :=
{ mul_comm := mul_comm,
  lmul_comm_rmul_rmul := λ a b, mul_assoc _ _ _, }

local notation `L` := add_monoid.End.mul_left
local notation `R` := add_monoid.End.mul_right

/-!
The Jordan axioms can be expressed in terms of commuting multiplication operators.
-/
section commute
variables {A} [non_unital_non_assoc_ring A] [is_jordan A]

@[simp] lemma commute_lmul_rmul (a : A) : commute (L a) (R a) :=
add_monoid_hom.ext $ λ b, (is_jordan.lmul_comm_rmul _ _).symm

@[simp] lemma commute_lmul_lmul_sq (a : A) : commute (L a) (L (a * a)) :=
add_monoid_hom.ext $ λ b, (is_jordan.lmul_lmul_comm_lmul _ _).symm

@[simp] lemma commute_lmul_rmul_sq (a : A) : commute (L a) (R (a * a)) :=
add_monoid_hom.ext $ λ b, (is_jordan.lmul_comm_rmul_rmul _ _).symm

@[simp] lemma commute_lmul_sq_rmul (a : A) : commute (L (a * a)) (R a) :=
add_monoid_hom.ext $ λ b, (is_jordan.lmul_lmul_comm_rmul _ _)

@[simp] lemma commute_rmul_rmul_sq (a : A) : commute (R a) (R (a * a)) :=
add_monoid_hom.ext $ λ b, (is_jordan.rmul_comm_rmul_rmul _ _).symm

end commute

variables {A} [non_unital_non_assoc_ring A] [is_comm_jordan A]

/-!
The endomorphisms on an additive monoid `add_monoid.End` form a `ring`, and this may be equipped
with a Lie Bracket via `ring.has_bracket`.
-/

lemma two_nsmul_lie_lmul_lmul_add_eq_lie_lmul_lmul_add (a b : A) :
  2•(⁅L a, L (a * b)⁆ + ⁅L b, L (b * a)⁆) = ⁅L (a * a), L b⁆ + ⁅L (b * b), L a⁆ :=
begin
  suffices : 2 • ⁅L a, L (a * b)⁆ + 2 • ⁅L b, L (b * a)⁆ + ⁅L b, L (a * a)⁆ + ⁅L a, L (b * b)⁆ = 0,
  { rwa [← sub_eq_zero, ← sub_sub, sub_eq_add_neg, sub_eq_add_neg, lie_skew, lie_skew, nsmul_add] },
  convert (commute_lmul_lmul_sq (a + b)).lie_eq,
  simp only [add_mul, mul_add, map_add, lie_add, add_lie, is_comm_jordan.mul_comm b a,
    (commute_lmul_lmul_sq a).lie_eq, (commute_lmul_lmul_sq b).lie_eq],
  abel,
end

lemma two_nsmul_lie_lmul_lmul_add_add_eq_zero (a b c : A) :
  2•(⁅L a, L (b * c)⁆ + ⁅L b, L (c * a)⁆ + ⁅L c, L (a * b)⁆) = 0 :=
begin
  symmetry,
  calc 0 = ⁅L (a + b + c), L ((a + b + c) * (a + b + c))⁆ :
    by rw (commute_lmul_lmul_sq (a + b + c)).lie_eq
  ... = ⁅L a + L b + L c,
    L (a * a) + L (a * b) + L (a * c) + (L (b * a) + L (b * b) + L (b * c))
      + (L (c * a) + L (c * b) + L (c * c))⁆ :
    by rw [add_mul, add_mul, mul_add, mul_add, mul_add, mul_add, mul_add, mul_add,
      map_add, map_add, map_add, map_add, map_add, map_add, map_add, map_add, map_add, map_add]
  ... = ⁅L a + L b + L c,
    L (a * a) + L (a * b) + L (c * a) + (L (a * b) + L (b * b) + L (b * c))
      + (L (c * a) + L (b * c) + L (c * c))⁆ :
    by rw [is_comm_jordan.mul_comm b a, is_comm_jordan.mul_comm c a, is_comm_jordan.mul_comm c b]
  ... = ⁅L a + L b + L c, L (a * a) + L (b * b) + L (c * c) + 2•L (a * b) + 2•L (c * a)
    + 2•L (b * c) ⁆ :
    by {rw [two_smul, two_smul, two_smul],
      simp only [lie_add, add_lie, commute_lmul_lmul_sq, zero_add, add_zero], abel}
  ... = ⁅L a, L (a * a)⁆ + ⁅L a, L (b * b)⁆ + ⁅L a, L (c * c)⁆ + ⁅L a, 2•L (a * b)⁆
        + ⁅L a, 2•L(c * a)⁆ + ⁅L a, 2•L (b * c)⁆
        + (⁅L b, L (a * a)⁆ + ⁅L b, L (b * b)⁆ + ⁅L b, L (c * c)⁆ + ⁅L b, 2•L (a * b)⁆
          + ⁅L b, 2•L (c * a)⁆ + ⁅L b, 2•L (b * c)⁆)
        + (⁅L c, L (a * a)⁆ + ⁅L c, L (b * b)⁆ + ⁅L c, L (c * c)⁆ + ⁅L c, 2•L (a * b)⁆
          + ⁅L c, 2•L (c * a)⁆ + ⁅L c, 2•L (b * c)⁆) :
    by rw [add_lie, add_lie, lie_add, lie_add, lie_add, lie_add, lie_add, lie_add, lie_add, lie_add,
     lie_add, lie_add, lie_add, lie_add, lie_add, lie_add, lie_add]
  ... = ⁅L a, L (b * b)⁆ + ⁅L a, L (c * c)⁆ + ⁅L a, 2•L (a * b)⁆ + ⁅L a, 2•L (c * a)⁆
          + ⁅L a, 2•L (b * c)⁆
        + (⁅L b, L (a * a)⁆ + ⁅L b, L (c * c)⁆ + ⁅L b, 2•L (a * b)⁆ + ⁅L b, 2•L (c * a)⁆
          + ⁅L b, 2•L (b * c)⁆)
        + (⁅L c, L (a * a)⁆ + ⁅L c, L (b * b)⁆ + ⁅L c, 2•L (a * b)⁆ + ⁅L c, 2•L (c * a)⁆
          + ⁅L c, 2•L (b * c)⁆) :
    by rw [(commute_lmul_lmul_sq a).lie_eq, (commute_lmul_lmul_sq b).lie_eq,
      (commute_lmul_lmul_sq c).lie_eq, zero_add, add_zero, add_zero]
  ... = ⁅L a, L (b * b)⁆ + ⁅L a, L (c * c)⁆ + 2•⁅L a, L (a * b)⁆ + 2•⁅L a, L (c * a)⁆
          + 2•⁅L a, L (b * c)⁆
        + (⁅L b, L (a * a)⁆ + ⁅L b, L (c * c)⁆ + 2•⁅L b, L (a * b)⁆ + 2•⁅L b, L (c * a)⁆
          + 2•⁅L b, L (b * c)⁆)
        + (⁅L c, L (a * a)⁆ + ⁅L c, L (b * b)⁆ + 2•⁅L c, L (a * b)⁆ + 2•⁅L c, L (c * a)⁆
          + 2•⁅L c, L (b * c)⁆) :
    by simp only [lie_nsmul]
  ... = (⁅L a, L (b * b)⁆+ ⁅L b, L (a * a)⁆ + 2•(⁅L a, L (a * b)⁆ + ⁅L b, L (a * b)⁆))
        + (⁅L a, L (c * c)⁆ + ⁅L c, L (a * a)⁆ + 2•(⁅L a, L (c * a)⁆ + ⁅L c, L (c * a)⁆))
        + (⁅L b, L (c * c)⁆ + ⁅L c, L (b * b)⁆ + 2•(⁅L b, L (b * c)⁆ + ⁅L c, L (b * c)⁆))
        + (2•⁅L a, L (b * c)⁆ + 2•⁅L b, L (c * a)⁆ + 2•⁅L c, L (a * b)⁆) : by abel
  ... = 2•⁅L a, L (b * c)⁆ + 2•⁅L b, L (c * a)⁆ + 2•⁅L c, L (a * b)⁆ :
    by begin
      rw add_left_eq_self,
      nth_rewrite 1 is_comm_jordan.mul_comm a b,
      nth_rewrite 0 is_comm_jordan.mul_comm c a,
      nth_rewrite 1 is_comm_jordan.mul_comm b c,
      rw [two_nsmul_lie_lmul_lmul_add_eq_lie_lmul_lmul_add,
        two_nsmul_lie_lmul_lmul_add_eq_lie_lmul_lmul_add,
        two_nsmul_lie_lmul_lmul_add_eq_lie_lmul_lmul_add,
        ← lie_skew (L (a * a)), ← lie_skew (L (b * b)), ← lie_skew (L (c * c)),
        ← lie_skew (L (a * a)), ← lie_skew (L (b * b)), ← lie_skew (L (c * c))],
      abel,
    end
  ... = 2•(⁅L a, L (b * c)⁆ + ⁅L b, L (c * a)⁆ + ⁅L c, L (a * b)⁆) : by rw [nsmul_add, nsmul_add]
end


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.direct_limit
import Mathlib.field_theory.splitting_field
import Mathlib.analysis.complex.polynomial
import Mathlib.PostPort

universes u l u_1 u_2 v

namespace Mathlib

/-!
# Algebraic Closure

In this file we define the typeclass for algebraically closed fields and algebraic closures.
We also construct an algebraic closure for any field.

## Main Definitions

- `is_alg_closed k` is the typeclass saying `k` is an algebraically closed field, i.e. every
polynomial in `k` splits.

- `is_alg_closure k K` is the typeclass saying `K` is an algebraic closure of `k`.

- `algebraic_closure k` is an algebraic closure of `k` (in the same universe).
  It is constructed by taking the polynomial ring generated by indeterminates `x_f`
  corresponding to monic irreducible polynomials `f` with coefficients in `k`, and quotienting
  out by a maximal ideal containing every `f(x_f)`, and then repeating this step countably
  many times. See Exercise 1.13 in Atiyah--Macdonald.

## TODO

Show that any algebraic extension embeds into any algebraically closed extension (via Zorn's lemma).

## Tags

algebraic closure, algebraically closed

-/

/-- Typeclass for algebraically closed fields. -/
class is_alg_closed (k : Type u) [field k]
where
  splits : ∀ (p : polynomial k), polynomial.splits (ring_hom.id k) p

theorem polynomial.splits' {k : Type u_1} {K : Type u_2} [field k] [is_alg_closed k] [field K] {f : k →+* K} (p : polynomial k) : polynomial.splits f p :=
  polynomial.splits_of_splits_id f (is_alg_closed.splits p)

namespace is_alg_closed

theorem of_exists_root (k : Type u) [field k] (H : ∀ (p : polynomial k), polynomial.monic p → irreducible p → ∃ (x : k), polynomial.eval x p = 0) : is_alg_closed k := sorry

theorem degree_eq_one_of_irreducible (k : Type u) [field k] [is_alg_closed k] {p : polynomial k} (h_nz : p ≠ 0) (hp : irreducible p) : polynomial.degree p = 1 :=
  polynomial.degree_eq_one_of_irreducible_of_splits h_nz hp (polynomial.splits' p)

theorem algebra_map_surjective_of_is_integral {k : Type u_1} {K : Type u_2} [field k] [domain K] [hk : is_alg_closed k] [algebra k K] (hf : algebra.is_integral k K) : function.surjective ⇑(algebra_map k K) := sorry

theorem algebra_map_surjective_of_is_integral' {k : Type u_1} {K : Type u_2} [field k] [integral_domain K] [hk : is_alg_closed k] (f : k →+* K) (hf : ring_hom.is_integral f) : function.surjective ⇑f :=
  algebra_map_surjective_of_is_integral hf

theorem algebra_map_surjective_of_is_algebraic {k : Type u_1} {K : Type u_2} [field k] [domain K] [hk : is_alg_closed k] [algebra k K] (hf : algebra.is_algebraic k K) : function.surjective ⇑(algebra_map k K) :=
  algebra_map_surjective_of_is_integral (iff.mp (is_algebraic_iff_is_integral' k) hf)

end is_alg_closed

protected instance complex.is_alg_closed : is_alg_closed ℂ :=
  is_alg_closed.of_exists_root ℂ
    fun (p : polynomial ℂ) (_x : polynomial.monic p) (hp : irreducible p) =>
      complex.exists_root (polynomial.degree_pos_of_irreducible hp)

/-- Typeclass for an extension being an algebraic closure. -/
def is_alg_closure (k : Type u) [field k] (K : Type v) [field K] [algebra k K] :=
  is_alg_closed K ∧ algebra.is_algebraic k K

namespace algebraic_closure

/-- The subtype of monic irreducible polynomials -/
def monic_irreducible (k : Type u) [field k] :=
  Subtype fun (f : polynomial k) => polynomial.monic f ∧ irreducible f

/-- Sends a monic irreducible polynomial `f` to `f(x_f)` where `x_f` is a formal indeterminate. -/
def eval_X_self (k : Type u) [field k] (f : monic_irreducible k) : mv_polynomial (monic_irreducible k) k :=
  polynomial.eval₂ mv_polynomial.C (mv_polynomial.X f) ↑f

/-- The span of `f(x_f)` across monic irreducible polynomials `f` where `x_f` is an indeterminate. -/
def span_eval (k : Type u) [field k] : ideal (mv_polynomial (monic_irreducible k) k) :=
  ideal.span (set.range (eval_X_self k))

/-- Given a finset of monic irreducible polynomials, construct an algebra homomorphism to the
splitting field of the product of the polynomials sending each indeterminate `x_f` represented by
the polynomial `f` in the finset to a root of `f`. -/
def to_splitting_field (k : Type u) [field k] (s : finset (monic_irreducible k)) : alg_hom k (mv_polynomial (monic_irreducible k) k)
  (polynomial.splitting_field (finset.prod s fun (x : monic_irreducible k) => ↑x)) :=
  mv_polynomial.aeval
    fun (f : monic_irreducible k) =>
      dite (f ∈ s)
        (fun (hf : f ∈ s) =>
          polynomial.root_of_splits
            (algebra_map k (polynomial.splitting_field (finset.prod s fun (x : monic_irreducible k) => ↑x))) sorry sorry)
        fun (hf : ¬f ∈ s) => bit1 (bit0 (bit1 (bit0 (bit0 1))))

theorem to_splitting_field_eval_X_self (k : Type u) [field k] {s : finset (monic_irreducible k)} {f : monic_irreducible k} (hf : f ∈ s) : coe_fn (to_splitting_field k s) (eval_X_self k f) = 0 := sorry

theorem span_eval_ne_top (k : Type u) [field k] : span_eval k ≠ ⊤ := sorry

/-- A random maximal ideal that contains `span_eval k` -/
def max_ideal (k : Type u) [field k] : ideal (mv_polynomial (monic_irreducible k) k) :=
  classical.some sorry

protected instance max_ideal.is_maximal (k : Type u) [field k] : ideal.is_maximal (max_ideal k) :=
  and.left (classical.some_spec (ideal.exists_le_maximal (span_eval k) (span_eval_ne_top k)))

theorem le_max_ideal (k : Type u) [field k] : span_eval k ≤ max_ideal k :=
  and.right (classical.some_spec (ideal.exists_le_maximal (span_eval k) (span_eval_ne_top k)))

/-- The first step of constructing `algebraic_closure`: adjoin a root of all monic polynomials -/
def adjoin_monic (k : Type u) [field k] :=
  ideal.quotient (max_ideal k)

protected instance adjoin_monic.field (k : Type u) [field k] : field (adjoin_monic k) :=
  ideal.quotient.field (max_ideal k)

protected instance adjoin_monic.inhabited (k : Type u) [field k] : Inhabited (adjoin_monic k) :=
  { default := bit1 (bit0 (bit1 (bit0 (bit0 1)))) }

/-- The canonical ring homomorphism to `adjoin_monic k`. -/
def to_adjoin_monic (k : Type u) [field k] : k →+* adjoin_monic k :=
  ring_hom.comp (ideal.quotient.mk (max_ideal k)) mv_polynomial.C

protected instance adjoin_monic.algebra (k : Type u) [field k] : algebra k (adjoin_monic k) :=
  ring_hom.to_algebra (to_adjoin_monic k)

theorem adjoin_monic.algebra_map (k : Type u) [field k] : algebra_map k (adjoin_monic k) = ring_hom.comp (ideal.quotient.mk (max_ideal k)) mv_polynomial.C :=
  rfl

theorem adjoin_monic.is_integral (k : Type u) [field k] (z : adjoin_monic k) : is_integral k z := sorry

theorem adjoin_monic.exists_root (k : Type u) [field k] {f : polynomial k} (hfm : polynomial.monic f) (hfi : irreducible f) : ∃ (x : adjoin_monic k), polynomial.eval₂ (to_adjoin_monic k) x f = 0 := sorry

/-- The `n`th step of constructing `algebraic_closure`, together with its `field` instance. -/
def step_aux (k : Type u) [field k] (n : ℕ) : sigma fun (α : Type u) => field α :=
  nat.rec_on n (sigma.mk k infer_instance)
    fun (n : ℕ) (ih : sigma fun (α : Type u) => field α) =>
      sigma.mk (adjoin_monic (sigma.fst ih)) (adjoin_monic.field (sigma.fst ih))

/-- The `n`th step of constructing `algebraic_closure`. -/
def step (k : Type u) [field k] (n : ℕ) :=
  sigma.fst (step_aux k n)

protected instance step.field (k : Type u) [field k] (n : ℕ) : field (step k n) :=
  sigma.snd (step_aux k n)

protected instance step.inhabited (k : Type u) [field k] (n : ℕ) : Inhabited (step k n) :=
  { default := bit1 (bit0 (bit1 (bit0 (bit0 1)))) }

/-- The canonical inclusion to the `0`th step. -/
def to_step_zero (k : Type u) [field k] : k →+* step k 0 :=
  ring_hom.id k

/-- The canonical ring homomorphism to the next step. -/
def to_step_succ (k : Type u) [field k] (n : ℕ) : step k n →+* step k (n + 1) :=
  to_adjoin_monic (step k n)

protected instance step.algebra_succ (k : Type u) [field k] (n : ℕ) : algebra (step k n) (step k (n + 1)) :=
  ring_hom.to_algebra (to_step_succ k n)

theorem to_step_succ.exists_root (k : Type u) [field k] {n : ℕ} {f : polynomial (step k n)} (hfm : polynomial.monic f) (hfi : irreducible f) : ∃ (x : step k (n + 1)), polynomial.eval₂ (to_step_succ k n) x f = 0 :=
  adjoin_monic.exists_root (step k n) hfm hfi

/-- The canonical ring homomorphism to a step with a greater index. -/
def to_step_of_le (k : Type u) [field k] (m : ℕ) (n : ℕ) (h : m ≤ n) : step k m →+* step k n :=
  ring_hom.mk (nat.le_rec_on h fun (n : ℕ) => ⇑(to_step_succ k n)) sorry sorry sorry sorry

@[simp] theorem coe_to_step_of_le (k : Type u) [field k] (m : ℕ) (n : ℕ) (h : m ≤ n) : ⇑(to_step_of_le k m n h) = nat.le_rec_on h fun (n : ℕ) => ⇑(to_step_succ k n) :=
  rfl

protected instance step.algebra (k : Type u) [field k] (n : ℕ) : algebra k (step k n) :=
  ring_hom.to_algebra (to_step_of_le k 0 n (nat.zero_le n))

protected instance step.scalar_tower (k : Type u) [field k] (n : ℕ) : is_scalar_tower k (step k n) (step k (n + 1)) :=
  is_scalar_tower.of_algebra_map_eq fun (z : k) => nat.le_rec_on_succ (nat.zero_le n) z

theorem step.is_integral (k : Type u) [field k] (n : ℕ) (z : step k n) : is_integral k z :=
  nat.rec_on n (fun (z : step k 0) => is_integral_algebra_map)
    fun (n : ℕ) (ih : ∀ (z : step k n), is_integral k z) (z : step k (Nat.succ n)) =>
      is_integral_trans ih z (adjoin_monic.is_integral (step k n) z)

protected instance to_step_of_le.directed_system (k : Type u) [field k] : directed_system (step k) fun (i j : ℕ) (h : i ≤ j) => ⇑(to_step_of_le k i j h) :=
  directed_system.mk (fun (i : ℕ) (x : step k i) (h : i ≤ i) => nat.le_rec_on_self x)
    fun (i₁ i₂ i₃ : ℕ) (h₁₂ : i₁ ≤ i₂) (h₂₃ : i₂ ≤ i₃) (x : step k i₁) => Eq.symm (nat.le_rec_on_trans h₁₂ h₂₃ x)

end algebraic_closure

/-- The canonical algebraic closure of a field, the direct limit of adding roots to the field for each polynomial over the field. -/
def algebraic_closure (k : Type u) [field k] :=
  ring.direct_limit sorry fun (i j : ℕ) (h : i ≤ j) => ⇑sorry

namespace algebraic_closure

protected instance field (k : Type u) [field k] : field (algebraic_closure k) :=
  field.direct_limit.field (step k) fun (i j : ℕ) (h : i ≤ j) => to_step_of_le k i j h

protected instance inhabited (k : Type u) [field k] : Inhabited (algebraic_closure k) :=
  { default := bit1 (bit0 (bit1 (bit0 (bit0 1)))) }

/-- The canonical ring embedding from the `n`th step to the algebraic closure. -/
def of_step (k : Type u) [field k] (n : ℕ) : step k n →+* algebraic_closure k :=
  ring_hom.of ⇑(ring.direct_limit.of (step k) (fun (i j : ℕ) (h : i ≤ j) => ⇑(to_step_of_le k i j h)) n)

protected instance algebra_of_step (k : Type u) [field k] (n : ℕ) : algebra (step k n) (algebraic_closure k) :=
  ring_hom.to_algebra (of_step k n)

theorem of_step_succ (k : Type u) [field k] (n : ℕ) : ring_hom.comp (of_step k (n + 1)) (to_step_succ k n) = of_step k n := sorry

theorem exists_of_step (k : Type u) [field k] (z : algebraic_closure k) : ∃ (n : ℕ), ∃ (x : step k n), coe_fn (of_step k n) x = z :=
  ring.direct_limit.exists_of z

-- slow

theorem exists_root (k : Type u) [field k] {f : polynomial (algebraic_closure k)} (hfm : polynomial.monic f) (hfi : irreducible f) : ∃ (x : algebraic_closure k), polynomial.eval x f = 0 := sorry

protected instance is_alg_closed (k : Type u) [field k] : is_alg_closed (algebraic_closure k) :=
  is_alg_closed.of_exists_root (algebraic_closure k) fun (f : polynomial (algebraic_closure k)) => exists_root k

protected instance algebra (k : Type u) [field k] : algebra k (algebraic_closure k) :=
  ring_hom.to_algebra (of_step k 0)

/-- Canonical algebra embedding from the `n`th step to the algebraic closure. -/
def of_step_hom (k : Type u) [field k] (n : ℕ) : alg_hom k (step k n) (algebraic_closure k) :=
  alg_hom.mk (ring_hom.to_fun (of_step k n)) sorry sorry sorry sorry sorry

theorem is_algebraic (k : Type u) [field k] : algebra.is_algebraic k (algebraic_closure k) := sorry

protected instance is_alg_closure (k : Type u) [field k] : is_alg_closure k (algebraic_closure k) :=
  { left := algebraic_closure.is_alg_closed k, right := is_algebraic k }


/-
Copyright (c) 2020 Simon Hudon All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Simon Hudon
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.control.functor.multivariate
import Mathlib.data.qpf.multivariate.basic
import Mathlib.PostPort

universes u u_1 u_2

namespace Mathlib

/-!
# Constant functors are QPFs

Constant functors map every type vectors to the same target type. This
is a useful device for constructing data types from more basic types
that are not actually functorial. For instance `const n nat` makes
`nat` into a functor that can be used in a functor-based data type
specification.
-/

namespace mvqpf

/-- Constant multivariate functor -/
def const (n : ℕ) (A : Type u_1) (v : typevec n) := A

protected instance const.inhabited (n : ℕ) {A : Type u_1} {α : typevec n} [Inhabited A] :
    Inhabited (const n A α) :=
  { default := Inhabited.default }

namespace const

/-- Constructor for constant functor -/
protected def mk {n : ℕ} {A : Type u} {α : typevec n} (x : A) : const n A α := x

/-- Destructor for constant functor -/
protected def get {n : ℕ} {A : Type u} {α : typevec n} (x : const n A α) : A := x

@[simp] protected theorem mk_get {n : ℕ} {A : Type u} {α : typevec n} (x : const n A α) :
    const.mk (const.get x) = x :=
  rfl

@[simp] protected theorem get_mk {n : ℕ} {A : Type u} {α : typevec n} (x : A) :
    const.get (const.mk x) = x :=
  rfl

/-- `map` for constant functor -/
protected def map {n : ℕ} {A : Type u} {α : typevec n} {β : typevec n} :
    const n A α → const n A β :=
  fun (x : const n A α) => x

protected instance mvfunctor {n : ℕ} {A : Type u} : mvfunctor (const n A) :=
  mvfunctor.mk fun (α β : typevec n) (f : typevec.arrow α β) => const.map

theorem map_mk {n : ℕ} {A : Type u} {α : typevec n} {β : typevec n} (f : typevec.arrow α β)
    (x : A) : mvfunctor.map f (const.mk x) = const.mk x :=
  rfl

theorem get_map {n : ℕ} {A : Type u} {α : typevec n} {β : typevec n} (f : typevec.arrow α β)
    (x : const n A α) : const.get (mvfunctor.map f x) = const.get x :=
  rfl

protected instance mvqpf {n : ℕ} {A : Type u} : mvqpf (const n A) :=
  mk (mvpfunctor.const n A)
    (fun (α : typevec n) (x : mvpfunctor.obj (mvpfunctor.const n A) α) => mvpfunctor.const.get x)
    (fun (α : typevec n) (x : const n A α) => mvpfunctor.const.mk n x) sorry sorry

end Mathlib


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import linear_algebra.exterior_algebra.basic
import ring_theory.graded_algebra.basic

/-!
# Results about the grading structure of the exterior algebra

Many of these results are copied with minimal modification from the tensor algebra.

The main result is `exterior_algebra.graded_algebra`, which says that the exterior algebra is a
ℕ-graded algebra.
-/

namespace exterior_algebra
variables {R M : Type*} [comm_ring R] [add_comm_group M] [module R M]
variables (R M)

open_locale direct_sum

/-- A version of `exterior_algebra.ι` that maps directly into the graded structure. This is
primarily an auxiliary construction used to provide `exterior_algebra.graded_algebra`. -/
def graded_algebra.ι : M →ₗ[R] ⨁ i : ℕ, ↥((ι R : M →ₗ[_] _).range ^ i) :=
direct_sum.lof R ℕ (λ i, ↥((ι R : M →ₗ[_] _).range ^ i)) 1
  ∘ₗ (ι R).cod_restrict _ (λ m, by simpa only [pow_one] using linear_map.mem_range_self _ m)

lemma graded_algebra.ι_apply (m : M) :
  graded_algebra.ι R M m =
    direct_sum.of (λ i, ↥((ι R : M →ₗ[_] _).range ^ i)) 1
      (⟨ι R m, by simpa only [pow_one] using linear_map.mem_range_self _ m⟩) := rfl

lemma graded_algebra.ι_sq_zero (m : M) : graded_algebra.ι R M m * graded_algebra.ι R M m = 0 :=
begin
  rw [graded_algebra.ι_apply, direct_sum.of_mul_of],
  refine dfinsupp.single_eq_zero.mpr (subtype.ext $ ι_sq_zero _),
end

/-- `exterior_algebra.graded_algebra.ι` lifted to exterior algebra. This is
primarily an auxiliary construction used to provide `exterior_algebra.graded_algebra`. -/
def graded_algebra.lift_ι : exterior_algebra R M →ₐ[R]
  ⨁ (i : ℕ), ↥((ι R).range ^ i : submodule R (exterior_algebra R M)) :=
lift R ⟨by apply graded_algebra.ι R M, graded_algebra.ι_sq_zero R M⟩

variables (R M)

lemma graded_algebra.lift_ι_eq (i : ℕ)
  (x : ((ι R : M →ₗ[R] exterior_algebra R M).range ^ i : submodule R (exterior_algebra R M))) :
  graded_algebra.lift_ι R M x =
    direct_sum.of (λ i, ↥((ι R).range ^ i : submodule R (exterior_algebra R M))) i x :=
begin
  cases x with x hx,
  dsimp only [subtype.coe_mk, direct_sum.lof_eq_of],
  refine submodule.pow_induction_on_left' _
    (λ r, _) (λ x y i hx hy ihx ihy, _) (λ m hm i x hx ih, _) hx,
  { rw [alg_hom.commutes, direct_sum.algebra_map_apply], refl },
  { rw [alg_hom.map_add, ihx, ihy, ←map_add], refl },
  { obtain ⟨_, rfl⟩ := hm,
    rw [alg_hom.map_mul, ih, graded_algebra.lift_ι, lift_ι_apply,
      graded_algebra.ι_apply R M, direct_sum.of_mul_of],
    exact direct_sum.of_eq_of_graded_monoid_eq (sigma.subtype_ext (add_comm _ _) rfl) },
end

/-- The exterior algebra is graded by the powers of the submodule `(exterior_algebra.ι R).range`. -/
instance graded_algebra :
  graded_algebra ((^) (ι R : M →ₗ[R] exterior_algebra R M).range : ℕ → submodule R _) :=
graded_algebra.of_alg_hom _
  -- while not necessary, the `by apply` makes this elaborate faster
  (by apply graded_algebra.lift_ι R M)
  -- the proof from here onward is identical to the `tensor_algebra` case
  (begin
    ext m,
    dsimp only [linear_map.comp_apply, alg_hom.to_linear_map_apply, alg_hom.comp_apply,
      alg_hom.id_apply, graded_algebra.lift_ι],
    rw [lift_ι_apply, graded_algebra.ι_apply R M, direct_sum.coe_alg_hom_of, subtype.coe_mk],
  end)
  (by apply graded_algebra.lift_ι_eq R M)

end exterior_algebra


/-
Copyright (c) 2020 Kexing Ying and Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kexing Ying, Kevin Buzzard, Yury Kudryashov
-/
import algebra.big_operators.order
import algebra.indicator_function
import data.set.pairwise

/-!
# Finite products and sums over types and sets

We define products and sums over types and subsets of types, with no finiteness hypotheses.
All infinite products and sums are defined to be junk values (i.e. one or zero).
This approach is sometimes easier to use than `finset.sum`,
when issues arise with `finset` and `fintype` being data.

## Main definitions

We use the following variables:

* `α`, `β` - types with no structure;
* `s`, `t` - sets
* `M`, `N` - additive or multiplicative commutative monoids
* `f`, `g` - functions

Definitions in this file:

* `finsum f : M` : the sum of `f x` as `x` ranges over the support of `f`, if it's finite.
   Zero otherwise.

* `finprod f : M` : the product of `f x` as `x` ranges over the multiplicative support of `f`, if
   it's finite. One otherwise.

## Notation

* `∑ᶠ i, f i` and `∑ᶠ i : α, f i` for `finsum f`

* `∏ᶠ i, f i` and `∏ᶠ i : α, f i` for `finprod f`

This notation works for functions `f : p → M`, where `p : Prop`, so the following works:

* `∑ᶠ i ∈ s, f i`, where `f : α → M`, `s : set α` : sum over the set `s`;
* `∑ᶠ n < 5, f n`, where `f : ℕ → M` : same as `f 0 + f 1 + f 2 + f 3 + f 4`;
* `∏ᶠ (n >= -2) (hn : n < 3), f n`, where `f : ℤ → M` : same as `f (-2) * f (-1) * f 0 * f 1 * f 2`.

## Implementation notes

`finsum` and `finprod` is "yet another way of doing finite sums and products in Lean". However
experiments in the wild (e.g. with matroids) indicate that it is a helpful approach in settings
where the user is not interested in computability and wants to do reasoning without running into
typeclass diamonds caused by the constructive finiteness used in definitions such as `finset` and
`fintype`. By sticking solely to `set.finite` we avoid these problems. We are aware that there are
other solutions but for beginner mathematicians this approach is easier in practice.

Another application is the construction of a partition of unity from a collection of “bump”
function. In this case the finite set depends on the point and it's convenient to have a definition
that does not mention the set explicitly.

The first arguments in all definitions and lemmas is the codomain of the function of the big
operator. This is necessary for the heuristic in `@[to_additive]`.
See the documentation of `to_additive.attr` for more information.

We did not add `is_finite (X : Type) : Prop`, because it is simply `nonempty (fintype X)`.

## Tags

finsum, finprod, finite sum, finite product
-/

open function set

/-!
### Definition and relation to `finset.sum` and `finset.prod`
-/

section sort
variables {M N : Type*} {α β ι : Sort*} [comm_monoid M] [comm_monoid N]

open_locale big_operators

section

/- Note: we use classical logic only for these definitions, to ensure that we do not write lemmas
with `classical.dec` in their statement. -/
open_locale classical

/-- Sum of `f x` as `x` ranges over the elements of the support of `f`, if it's finite. Zero
otherwise. -/
@[irreducible] noncomputable def finsum {M α} [add_comm_monoid M] (f : α → M) : M :=
if h : finite (support (f ∘ plift.down)) then ∑ i in h.to_finset, f i.down else 0

/-- Product of `f x` as `x` ranges over the elements of the multiplicative support of `f`, if it's
finite. One otherwise. -/
@[irreducible, to_additive]
noncomputable def finprod (f : α → M) : M :=
if h : finite (mul_support (f ∘ plift.down)) then ∏ i in h.to_finset, f i.down else 1

end

localized "notation `∑ᶠ` binders `, ` r:(scoped:67 f, finsum f) := r" in big_operators

localized "notation `∏ᶠ` binders `, ` r:(scoped:67 f, finprod f) := r" in big_operators

@[to_additive] lemma finprod_eq_prod_plift_of_mul_support_to_finset_subset
  {f : α → M} (hf : finite (mul_support (f ∘ plift.down))) {s : finset (plift α)}
  (hs : hf.to_finset ⊆ s) :
  ∏ᶠ i, f i = ∏ i in s, f i.down :=
begin
  rw [finprod, dif_pos],
  refine finset.prod_subset hs (λ x hx hxf, _),
  rwa [hf.mem_to_finset, nmem_mul_support] at hxf
end

@[to_additive] lemma finprod_eq_prod_plift_of_mul_support_subset
  {f : α → M} {s : finset (plift α)} (hs : mul_support (f ∘ plift.down) ⊆ s) :
  ∏ᶠ i, f i = ∏ i in s, f i.down :=
finprod_eq_prod_plift_of_mul_support_to_finset_subset
  (s.finite_to_set.subset hs) $ λ x hx, by { rw finite.mem_to_finset at hx, exact hs hx }

@[simp, to_additive] lemma finprod_one : ∏ᶠ i : α, (1 : M) = 1 :=
begin
  have : mul_support (λ x : plift α, (λ _, 1 : α → M) x.down) ⊆ (∅ : finset (plift α)),
    from λ x h, h rfl,
  rw [finprod_eq_prod_plift_of_mul_support_subset this, finset.prod_empty]
end

@[to_additive] lemma finprod_of_is_empty [is_empty α] (f : α → M) : ∏ᶠ i, f i = 1 :=
by { rw ← finprod_one, congr }

@[simp, to_additive] lemma finprod_false (f : false → M) : ∏ᶠ i, f i = 1 :=
finprod_of_is_empty _

@[to_additive] lemma finprod_eq_single (f : α → M) (a : α) (ha : ∀ x ≠ a, f x = 1) :
  ∏ᶠ x, f x = f a :=
begin
  have : mul_support (f ∘ plift.down) ⊆ ({plift.up a} : finset (plift α)),
  { intro x, contrapose,
    simpa [plift.eq_up_iff_down_eq] using ha x.down },
  rw [finprod_eq_prod_plift_of_mul_support_subset this, finset.prod_singleton],
end

@[to_additive] lemma finprod_unique [unique α] (f : α → M) : ∏ᶠ i, f i = f (default α) :=
finprod_eq_single f (default α) $ λ x hx, (hx $ unique.eq_default _).elim

@[simp, to_additive] lemma finprod_true (f : true → M) : ∏ᶠ i, f i = f trivial :=
@finprod_unique M true _ ⟨⟨trivial⟩, λ _, rfl⟩ f

@[to_additive] lemma finprod_eq_dif {p : Prop} [decidable p] (f : p → M) :
  ∏ᶠ i, f i = if h : p then f h else 1 :=
begin
  split_ifs,
  { haveI : unique p := ⟨⟨h⟩, λ _, rfl⟩, exact finprod_unique f },
  { haveI : is_empty p := ⟨h⟩, exact finprod_of_is_empty f }
end

@[to_additive] lemma finprod_eq_if {p : Prop} [decidable p] {x : M} :
  ∏ᶠ i : p, x = if p then x else 1 :=
finprod_eq_dif (λ _, x)

@[to_additive] lemma finprod_congr {f g : α → M} (h : ∀ x, f x = g x) :
  finprod f = finprod g :=
congr_arg _ $ funext h

@[congr, to_additive] lemma finprod_congr_Prop {p q : Prop} {f : p → M} {g : q → M} (hpq : p = q)
  (hfg : ∀ h : q, f (hpq.mpr h) = g h) :
  finprod f = finprod g :=
by { subst q, exact finprod_congr hfg }

attribute [congr] finsum_congr_Prop

/-- To prove a property of a finite product, it suffices to prove that the property is
multiplicative and holds on multipliers. -/
@[to_additive] lemma finprod_induction {f : α → M} (p : M → Prop) (hp₀ : p 1)
  (hp₁ : ∀ x y, p x → p y → p (x * y)) (hp₂ : ∀ i, p (f i)) :
  p (∏ᶠ i, f i) :=
begin
  rw finprod,
  split_ifs,
  exacts [finset.prod_induction _ _ hp₁ hp₀ (λ i hi, hp₂ _), hp₀]
end

/-- To prove a property of a finite sum, it suffices to prove that the property is
additive and holds on summands. -/
add_decl_doc finsum_induction

lemma finprod_nonneg {R : Type*} [ordered_comm_semiring R] {f : α → R} (hf : ∀ x, 0 ≤ f x) :
  0 ≤ ∏ᶠ x, f x :=
finprod_induction (λ x, 0 ≤ x) zero_le_one (λ x y, mul_nonneg) hf

@[to_additive finsum_nonneg]
lemma one_le_finprod' {M : Type*} [ordered_comm_monoid M] {f : α → M} (hf : ∀ i, 1 ≤ f i) :
  1 ≤ ∏ᶠ i, f i :=
finprod_induction _ le_rfl (λ _ _, one_le_mul) hf

@[to_additive] lemma monoid_hom.map_finprod_plift (f : M →* N) (g : α → M)
  (h : finite (mul_support $ g ∘ plift.down)) :
  f (∏ᶠ x, g x) = ∏ᶠ x, f (g x) :=
begin
  rw [finprod_eq_prod_plift_of_mul_support_subset h.coe_to_finset.ge,
    finprod_eq_prod_plift_of_mul_support_subset, f.map_prod],
  rw [h.coe_to_finset],
  exact mul_support_comp_subset f.map_one (g ∘ plift.down)
end

@[to_additive] lemma monoid_hom.map_finprod_Prop {p : Prop} (f : M →* N) (g : p → M) :
  f (∏ᶠ x, g x) = ∏ᶠ x, f (g x) :=
f.map_finprod_plift g (finite.of_fintype _)

@[to_additive] lemma monoid_hom.map_finprod_of_preimage_one (f : M →* N)
  (hf : ∀ x, f x = 1 → x = 1) (g : α → M) :
  f (∏ᶠ i, g i) = ∏ᶠ i, f (g i) :=
begin
  by_cases hg : (mul_support $ g ∘ plift.down).finite, { exact f.map_finprod_plift g hg },
  rw [finprod, dif_neg, f.map_one, finprod, dif_neg],
  exacts [infinite.mono (λ x hx, mt (hf (g x.down)) hx) hg, hg]
end

@[to_additive] lemma monoid_hom.map_finprod_of_injective (g : M →* N) (hg : injective g)
  (f : α → M) :
  g (∏ᶠ i, f i) = ∏ᶠ i, g (f i) :=
g.map_finprod_of_preimage_one (λ x, (hg.eq_iff' g.map_one).mp) f

@[to_additive] lemma mul_equiv.map_finprod (g : M ≃* N) (f : α → M) :
  g (∏ᶠ i, f i) = ∏ᶠ i, g (f i) :=
g.to_monoid_hom.map_finprod_of_injective g.injective f

lemma finsum_smul {R M : Type*} [ring R] [add_comm_group M] [module R M]
  [no_zero_smul_divisors R M] (f : ι → R) (x : M) :
  (∑ᶠ i, f i) • x = (∑ᶠ i, (f i) • x) :=
begin
  rcases eq_or_ne x 0 with rfl|hx, { simp },
  exact ((smul_add_hom R M).flip x).map_finsum_of_injective (smul_left_injective R hx) _
end

lemma smul_finsum {R M : Type*} [ring R] [add_comm_group M] [module R M]
  [no_zero_smul_divisors R M] (c : R) (f : ι → M) :
  c • (∑ᶠ i, f i) = (∑ᶠ i, c • f i) :=
begin
  rcases eq_or_ne c 0 with rfl|hc, { simp },
  exact (smul_add_hom R M c).map_finsum_of_injective (smul_right_injective M hc) _
end

@[to_additive] lemma finprod_inv_distrib {G : Type*} [comm_group G] (f : α → G) :
  ∏ᶠ x, (f x)⁻¹ = (∏ᶠ x, f x)⁻¹ :=
((mul_equiv.inv G).map_finprod f).symm

end sort

section type

variables {α β ι M N : Type*} [comm_monoid M] [comm_monoid N]

open_locale big_operators

@[to_additive] lemma finprod_eq_mul_indicator_apply (s : set α)
  (f : α → M) (a : α) :
  ∏ᶠ (h : a ∈ s), f a = mul_indicator s f a :=
by convert finprod_eq_if

@[simp, to_additive] lemma finprod_mem_mul_support (f : α → M) (a : α) :
  ∏ᶠ (h : f a ≠ 1), f a = f a :=
by rw [← mem_mul_support, finprod_eq_mul_indicator_apply, mul_indicator_mul_support]

@[to_additive] lemma finprod_mem_def (s : set α) (f : α → M) :
  ∏ᶠ a ∈ s, f a = ∏ᶠ a, mul_indicator s f a :=
finprod_congr $ finprod_eq_mul_indicator_apply s f

@[to_additive] lemma finprod_eq_prod_of_mul_support_subset (f : α → M) {s : finset α}
  (h : mul_support f ⊆ s) :
  ∏ᶠ i, f i = ∏ i in s, f i :=
begin
  have A : mul_support (f ∘ plift.down) = equiv.plift.symm '' mul_support f,
  { rw mul_support_comp_eq_preimage,
    exact (equiv.plift.symm.image_eq_preimage _).symm },
  have : mul_support (f ∘ plift.down) ⊆ s.map equiv.plift.symm.to_embedding,
  { rw [A, finset.coe_map], exact image_subset _ h },
  rw [finprod_eq_prod_plift_of_mul_support_subset this],
  simp
end

@[to_additive] lemma finprod_eq_prod_of_mul_support_to_finset_subset (f : α → M)
  (hf : finite (mul_support f)) {s : finset α} (h : hf.to_finset ⊆ s) :
  ∏ᶠ i, f i = ∏ i in s, f i :=
finprod_eq_prod_of_mul_support_subset _ $ λ x hx, h $ hf.mem_to_finset.2 hx

@[to_additive] lemma finprod_def (f : α → M) [decidable (mul_support f).finite] :
  ∏ᶠ i : α, f i = if h : (mul_support f).finite then ∏ i in h.to_finset, f i else 1 :=
begin
  split_ifs,
  { exact finprod_eq_prod_of_mul_support_to_finset_subset _ h (finset.subset.refl _) },
  { rw [finprod, dif_neg],
    rw [mul_support_comp_eq_preimage],
    exact mt (λ hf, hf.of_preimage equiv.plift.surjective) h}
end

@[to_additive] lemma finprod_of_infinite_mul_support {f : α → M} (hf : (mul_support f).infinite) :
  ∏ᶠ i, f i = 1 :=
by { classical, rw [finprod_def, dif_neg hf] }

@[to_additive] lemma finprod_eq_prod (f : α → M) (hf : (mul_support f).finite) :
  ∏ᶠ i : α, f i = ∏ i in hf.to_finset, f i :=
by { classical, rw [finprod_def, dif_pos hf] }

@[to_additive] lemma finprod_eq_prod_of_fintype [fintype α] (f : α → M) :
  ∏ᶠ i : α, f i = ∏ i, f i :=
finprod_eq_prod_of_mul_support_to_finset_subset _ (finite.of_fintype _) $ finset.subset_univ _

@[to_additive] lemma finprod_cond_eq_prod_of_cond_iff (f : α → M) {p : α → Prop} {t : finset α}
  (h : ∀ {x}, f x ≠ 1 → (p x ↔ x ∈ t)) :
  ∏ᶠ i (hi : p i), f i = ∏ i in t, f i :=
begin
  set s := {x | p x},
  have : mul_support (s.mul_indicator f) ⊆ t,
  { rw [set.mul_support_mul_indicator], intros x hx, exact (h hx.2).1 hx.1 },
  erw [finprod_mem_def, finprod_eq_prod_of_mul_support_subset _ this],
  refine finset.prod_congr rfl (λ x hx, mul_indicator_apply_eq_self.2 $ λ hxs, _),
  contrapose! hxs,
  exact (h hxs).2 hx
end

@[to_additive] lemma finprod_mem_eq_prod_of_inter_mul_support_eq (f : α → M) {s : set α}
  {t : finset α} (h : s ∩ mul_support f = t ∩ mul_support f) :
  ∏ᶠ i ∈ s, f i = ∏ i in t, f i :=
finprod_cond_eq_prod_of_cond_iff _ $ by simpa [set.ext_iff] using h

@[to_additive] lemma finprod_mem_eq_prod_of_subset (f : α → M) {s : set α} {t : finset α}
  (h₁ : s ∩ mul_support f ⊆ t) (h₂ : ↑t ⊆ s) :
  ∏ᶠ i ∈ s, f i = ∏ i in t, f i :=
finprod_cond_eq_prod_of_cond_iff _ $ λ x hx, ⟨λ h, h₁ ⟨h, hx⟩, λ h, h₂ h⟩

@[to_additive] lemma finprod_mem_eq_prod (f : α → M) {s : set α}
  (hf : (s ∩ mul_support f).finite) :
  ∏ᶠ i ∈ s, f i = ∏ i in hf.to_finset, f i :=
finprod_mem_eq_prod_of_inter_mul_support_eq _ $ by simp [inter_assoc]

@[to_additive] lemma finprod_mem_eq_prod_filter (f : α → M) (s : set α) [decidable_pred (∈ s)]
  (hf : (mul_support f).finite) :
  ∏ᶠ i ∈ s, f i = ∏ i in finset.filter (∈ s) hf.to_finset, f i :=
finprod_mem_eq_prod_of_inter_mul_support_eq _ $ by simp [inter_comm, inter_left_comm]

@[to_additive] lemma finprod_mem_eq_to_finset_prod (f : α → M) (s : set α) [fintype s] :
  ∏ᶠ i ∈ s, f i = ∏ i in s.to_finset, f i :=
finprod_mem_eq_prod_of_inter_mul_support_eq _ $ by rw [coe_to_finset]

@[to_additive] lemma finprod_mem_eq_finite_to_finset_prod (f : α → M) {s : set α} (hs : s.finite) :
  ∏ᶠ i ∈ s, f i = ∏ i in hs.to_finset, f i :=
finprod_mem_eq_prod_of_inter_mul_support_eq _ $ by rw [hs.coe_to_finset]

@[to_additive] lemma finprod_mem_finset_eq_prod (f : α → M) (s : finset α) :
  ∏ᶠ i ∈ s, f i = ∏ i in s, f i :=
finprod_mem_eq_prod_of_inter_mul_support_eq _ rfl

@[to_additive] lemma finprod_mem_coe_finset (f : α → M) (s : finset α) :
  ∏ᶠ i ∈ (s : set α), f i = ∏ i in s, f i :=
finprod_mem_eq_prod_of_inter_mul_support_eq _ rfl

@[to_additive] lemma finprod_mem_eq_one_of_infinite {f : α → M} {s : set α}
  (hs : (s ∩ mul_support f).infinite) : ∏ᶠ i ∈ s, f i = 1 :=
begin
  rw finprod_mem_def,
  apply finprod_of_infinite_mul_support,
  rwa [← mul_support_mul_indicator] at hs
end

@[to_additive] lemma finprod_mem_inter_mul_support (f : α → M) (s : set α) :
  ∏ᶠ i ∈ (s ∩ mul_support f), f i = ∏ᶠ i ∈ s, f i :=
by rw [finprod_mem_def, finprod_mem_def, mul_indicator_inter_mul_support]

@[to_additive] lemma finprod_mem_inter_mul_support_eq (f : α → M) (s t : set α)
  (h : s ∩ mul_support f = t ∩ mul_support f) :
  ∏ᶠ i ∈ s, f i = ∏ᶠ i ∈ t, f i :=
by rw [← finprod_mem_inter_mul_support, h, finprod_mem_inter_mul_support]

@[to_additive] lemma finprod_mem_inter_mul_support_eq' (f : α → M) (s t : set α)
  (h : ∀ x ∈ mul_support f, x ∈ s ↔ x ∈ t) :
  ∏ᶠ i ∈ s, f i = ∏ᶠ i ∈ t, f i :=
begin
  apply finprod_mem_inter_mul_support_eq,
  ext x,
  exact and_congr_left (h x)
end

@[to_additive] lemma finprod_mem_univ (f : α → M) : ∏ᶠ i ∈ @set.univ α, f i = ∏ᶠ i : α, f i :=
finprod_congr $ λ i, finprod_true _

variables {f g : α → M} {a b : α} {s t : set α}

@[to_additive] lemma finprod_mem_congr (h₀ : s = t) (h₁ : ∀ x ∈ t, f x = g x) :
  ∏ᶠ i ∈ s, f i = ∏ᶠ i ∈ t, g i :=
h₀.symm ▸ (finprod_congr $ λ i, finprod_congr_Prop rfl (h₁ i))

/-!
### Distributivity w.r.t. addition, subtraction, and (scalar) multiplication
-/

/-- If the multiplicative supports of `f` and `g` are finite, then the product of `f i * g i` equals
the product of `f i` multiplied by the product over `g i`. -/
@[to_additive] lemma finprod_mul_distrib (hf : (mul_support f).finite)
  (hg : (mul_support g).finite) :
  ∏ᶠ i, (f i * g i) = (∏ᶠ i, f i) * ∏ᶠ i, g i :=
begin
  classical,
  rw [finprod_eq_prod_of_mul_support_to_finset_subset _ hf (finset.subset_union_left _ _),
    finprod_eq_prod_of_mul_support_to_finset_subset _ hg (finset.subset_union_right _ _),
    ← finset.prod_mul_distrib],
  refine finprod_eq_prod_of_mul_support_subset _ _,
  simp [mul_support_mul]
end

/-- If the multiplicative supports of `f` and `g` are finite, then the product of `f i / g i`
equals the product of `f i` divided by the product over `g i`. -/
@[to_additive] lemma finprod_div_distrib {M' : Type*} [comm_group M'] {f g : α → M'}
  (hf : (mul_support f).finite) (hg : (mul_support g).finite) :
  ∏ᶠ i, f i / g i = (∏ᶠ i, f i) / ∏ᶠ i, g i :=
by simp only [div_eq_mul_inv, finprod_mul_distrib hf ((mul_support_inv g).symm.rec hg),
              finprod_inv_distrib]

/-- A more general version of `finprod_mem_mul_distrib` that requires `s ∩ mul_support f` and
`s ∩ mul_support g` instead of `s` to be finite. -/
@[to_additive] lemma finprod_mem_mul_distrib' (hf : (s ∩ mul_support f).finite)
  (hg : (s ∩ mul_support g).finite) :
  ∏ᶠ i ∈ s, (f i * g i) = (∏ᶠ i ∈ s, f i) * ∏ᶠ i ∈ s, g i :=
begin
  rw [← mul_support_mul_indicator] at hf hg,
  simp only [finprod_mem_def, mul_indicator_mul, finprod_mul_distrib hf hg]
end

/-- The product of constant one over any set equals one. -/
@[to_additive] lemma finprod_mem_one (s : set α) : ∏ᶠ i ∈ s, (1 : M) = 1 := by simp

/-- If a function `f` equals one on a set `s`, then the product of `f i` over `i ∈ s` equals one. -/
@[to_additive] lemma finprod_mem_of_eq_on_one (hf : eq_on f 1 s) : ∏ᶠ i ∈ s, f i = 1 :=
by { rw ← finprod_mem_one s, exact finprod_mem_congr rfl hf }

/-- If the product of `f i` over `i ∈ s` is not equal to one, then there is some `x ∈ s`
such that `f x ≠ 1`. -/
@[to_additive] lemma exists_ne_one_of_finprod_mem_ne_one (h : ∏ᶠ i ∈ s, f i ≠ 1) :
  ∃ x ∈ s, f x ≠ 1 :=
begin
  by_contra h', push_neg at h',
  exact h (finprod_mem_of_eq_on_one h')
end

/-- Given a finite set `s`, the product of `f i * g i` over `i ∈ s` equals the product of `f i`
over `i ∈ s` times the product of `g i` over `i ∈ s`. -/
@[to_additive] lemma finprod_mem_mul_distrib (hs : s.finite) :
  ∏ᶠ i ∈ s, (f i * g i) = (∏ᶠ i ∈ s, f i) * ∏ᶠ i ∈ s, g i :=
finprod_mem_mul_distrib' (hs.inter_of_left _) (hs.inter_of_left _)

@[to_additive] lemma monoid_hom.map_finprod {f : α → M} (g : M →* N) (hf : (mul_support f).finite) :
  g (∏ᶠ i, f i) = ∏ᶠ i, g (f i) :=
g.map_finprod_plift f $ hf.preimage $ equiv.plift.injective.inj_on _

/-- A more general version of `monoid_hom.map_finprod_mem` that requires `s ∩ mul_support f` and
  instead of `s` to be finite. -/
@[to_additive] lemma monoid_hom.map_finprod_mem' {f : α → M} (g : M →* N)
  (h₀ : (s ∩ mul_support f).finite) :
  g (∏ᶠ j ∈ s, f j) = ∏ᶠ i ∈ s, (g (f i)) :=
begin
  rw [g.map_finprod],
  { simp only [g.map_finprod_Prop] },
  { simpa only [finprod_eq_mul_indicator_apply, mul_support_mul_indicator] }
end

/-- Given a monoid homomorphism `g : M →* N`, and a function `f : α → M`, the value of `g` at the
product of `f i` over `i ∈ s` equals the product of `(g ∘ f) i` over `s`. -/
@[to_additive] lemma monoid_hom.map_finprod_mem (f : α → M) (g : M →* N) (hs : s.finite) :
  g (∏ᶠ j ∈ s, f j) = ∏ᶠ i ∈ s, g (f i) :=
g.map_finprod_mem' (hs.inter_of_left _)

@[to_additive] lemma mul_equiv.map_finprod_mem (g : M ≃* N) (f : α → M) {s : set α}
  (hs : s.finite) : g (∏ᶠ i ∈ s, f i) = ∏ᶠ i ∈ s, g (f i) :=
g.to_monoid_hom.map_finprod_mem f hs

@[to_additive] lemma finprod_mem_inv_distrib {G : Type*} [comm_group G] (f : α → G)
  (hs : s.finite) : ∏ᶠ x ∈ s, (f x)⁻¹ = (∏ᶠ x ∈ s, f x)⁻¹ :=
((mul_equiv.inv G).map_finprod_mem f hs).symm

/-- Given a finite set `s`, the product of `f i / g i` over `i ∈ s` equals the product of `f i`
over `i ∈ s` divided by the product of `g i` over `i ∈ s`. -/
@[to_additive] lemma finprod_mem_div_distrib {M' : Type*} [comm_group M'] (f g : α → M')
  (hs : s.finite) : ∏ᶠ i ∈ s, f i / g i = (∏ᶠ i ∈ s, f i) / ∏ᶠ i ∈ s, g i :=
by simp only [div_eq_mul_inv, finprod_mem_mul_distrib hs, finprod_mem_inv_distrib g hs]

/-!
### `∏ᶠ x ∈ s, f x` and set operations
-/

/-- The product of any function over an empty set is one. -/
@[to_additive] lemma finprod_mem_empty : ∏ᶠ i ∈ (∅ : set α), f i = 1 := by simp

/-- A set `s` is not empty if the product of some function over `s` is not equal to one. -/
@[to_additive] lemma nonempty_of_finprod_mem_ne_one (h : ∏ᶠ i ∈ s, f i ≠ 1) : s.nonempty :=
ne_empty_iff_nonempty.1 $ λ h', h $ h'.symm ▸ finprod_mem_empty

/-- Given finite sets `s` and `t`, the product of `f i` over `i ∈ s ∪ t` times the product of
`f i` over `i ∈ s ∩ t` equals the product of `f i` over `i ∈ s` times the product of `f i`
over `i ∈ t`. -/
@[to_additive] lemma finprod_mem_union_inter (hs : s.finite) (ht : t.finite) :
  (∏ᶠ i ∈ s ∪ t, f i) * ∏ᶠ i ∈ s ∩ t, f i = (∏ᶠ i ∈ s, f i) * ∏ᶠ i ∈ t, f i :=
begin
  lift s to finset α using hs, lift t to finset α using ht,
  classical,
  rw [← finset.coe_union, ← finset.coe_inter],
  simp only [finprod_mem_coe_finset, finset.prod_union_inter]
end

/-- A more general version of `finprod_mem_union_inter` that requires `s ∩ mul_support f` and
`t ∩ mul_support f` instead of `s` and `t` to be finite. -/
@[to_additive] lemma finprod_mem_union_inter'
  (hs : (s ∩ mul_support f).finite) (ht : (t ∩ mul_support f).finite) :
  (∏ᶠ i ∈ s ∪ t, f i) * ∏ᶠ i ∈ s ∩ t, f i = (∏ᶠ i ∈ s, f i) * ∏ᶠ i ∈ t, f i :=
begin
  rw [← finprod_mem_inter_mul_support f s, ← finprod_mem_inter_mul_support f t,
    ← finprod_mem_union_inter hs ht, ← union_inter_distrib_right, finprod_mem_inter_mul_support,
    ← finprod_mem_inter_mul_support f (s ∩ t)],
  congr' 2,
  rw [inter_left_comm, inter_assoc, inter_assoc, inter_self, inter_left_comm]
end

/-- A more general version of `finprod_mem_union` that requires `s ∩ mul_support f` and
`t ∩ mul_support f` instead of `s` and `t` to be finite. -/
@[to_additive] lemma finprod_mem_union' (hst : disjoint s t) (hs : (s ∩ mul_support f).finite)
  (ht : (t ∩ mul_support f).finite) :
  ∏ᶠ i ∈ s ∪ t, f i = (∏ᶠ i ∈ s, f i) * ∏ᶠ i ∈ t, f i :=
by rw [← finprod_mem_union_inter' hs ht, disjoint_iff_inter_eq_empty.1 hst, finprod_mem_empty,
  mul_one]

/-- Given two finite disjoint sets `s` and `t`, the product of `f i` over `i ∈ s ∪ t` equals the
product of `f i` over `i ∈ s` times the product of `f i` over `i ∈ t`. -/
@[to_additive] lemma finprod_mem_union (hst : disjoint s t) (hs : s.finite) (ht : t.finite) :
  ∏ᶠ i ∈ s ∪ t, f i = (∏ᶠ i ∈ s, f i) * ∏ᶠ i ∈ t, f i :=
finprod_mem_union' hst (hs.inter_of_left _) (ht.inter_of_left _)

/-- A more general version of `finprod_mem_union'` that requires `s ∩ mul_support f` and
`t ∩ mul_support f` instead of `s` and `t` to be disjoint -/
@[to_additive] lemma finprod_mem_union'' (hst : disjoint (s ∩ mul_support f) (t ∩ mul_support f))
  (hs : (s ∩ mul_support f).finite) (ht : (t ∩ mul_support f).finite) :
  ∏ᶠ i ∈ s ∪ t, f i = (∏ᶠ i ∈ s, f i) * ∏ᶠ i ∈ t, f i :=
by rw [← finprod_mem_inter_mul_support f s, ← finprod_mem_inter_mul_support f t,
  ← finprod_mem_union hst hs ht, ← union_inter_distrib_right, finprod_mem_inter_mul_support]

/-- The product of `f i` over `i ∈ {a}` equals `f a`. -/
@[to_additive] lemma finprod_mem_singleton : ∏ᶠ i ∈ ({a} : set α), f i = f a :=
by rw [← finset.coe_singleton, finprod_mem_coe_finset, finset.prod_singleton]

@[simp, to_additive] lemma finprod_cond_eq_left : ∏ᶠ i = a, f i = f a :=
finprod_mem_singleton

@[simp, to_additive] lemma finprod_cond_eq_right : ∏ᶠ i (hi : a = i), f i = f a :=
by simp [@eq_comm _ a]

/-- A more general version of `finprod_mem_insert` that requires `s ∩ mul_support f` instead of
`s` to be finite. -/
@[to_additive] lemma finprod_mem_insert' (f : α → M) (h : a ∉ s)
  (hs : (s ∩ mul_support f).finite) :
  ∏ᶠ i ∈ insert a s, f i = f a * ∏ᶠ i ∈ s, f i :=
begin
  rw [insert_eq, finprod_mem_union' _ _ hs, finprod_mem_singleton],
  { rwa disjoint_singleton_left },
  { exact (finite_singleton a).inter_of_left _ }
end

/-- Given a finite set `s` and an element `a ∉ s`, the product of `f i` over `i ∈ insert a s` equals
`f a` times the product of `f i` over `i ∈ s`. -/
@[to_additive] lemma finprod_mem_insert (f : α → M) (h : a ∉ s) (hs : s.finite) :
  ∏ᶠ i ∈ insert a s, f i = f a * ∏ᶠ i ∈ s, f i :=
finprod_mem_insert' f h $ hs.inter_of_left _

/-- If `f a = 1` for all `a ∉ s`, then the product of `f i` over `i ∈ insert a s` equals the
product of `f i` over `i ∈ s`. -/
@[to_additive] lemma finprod_mem_insert_of_eq_one_if_not_mem (h : a ∉ s → f a = 1) :
  ∏ᶠ i ∈ (insert a s), f i = ∏ᶠ i ∈ s, f i :=
begin
  refine finprod_mem_inter_mul_support_eq' _ _ _ (λ x hx, ⟨_, or.inr⟩),
  rintro (rfl|hxs),
  exacts [not_imp_comm.1 h hx, hxs]
end

/-- If `f a = 1`, then the product of `f i` over `i ∈ insert a s` equals the product of `f i` over
`i ∈ s`. -/
@[to_additive] lemma finprod_mem_insert_one (h : f a = 1) :
  ∏ᶠ i ∈ (insert a s), f i = ∏ᶠ i ∈ s, f i :=
finprod_mem_insert_of_eq_one_if_not_mem (λ _, h)

/-- If the multiplicative support of `f` is finite, then for every `x` in the domain of `f`,
`f x` divides `finprod f`.  -/
lemma finprod_mem_dvd {f : α → N} (a : α) (hf : finite (mul_support f)) :
  f a ∣ finprod f :=
begin
  by_cases ha : a ∈ mul_support f,
  { rw finprod_eq_prod_of_mul_support_to_finset_subset f hf (set.subset.refl _),
    exact finset.dvd_prod_of_mem f ((finite.mem_to_finset hf).mpr ha) },
  { rw nmem_mul_support.mp ha,
    exact one_dvd (finprod f) }
end

/-- The product of `f i` over `i ∈ {a, b}`, `a ≠ b`, is equal to `f a * f b`. -/
@[to_additive] lemma finprod_mem_pair (h : a ≠ b) : ∏ᶠ i ∈ ({a, b} : set α), f i = f a * f b :=
by { rw [finprod_mem_insert, finprod_mem_singleton], exacts [h, finite_singleton b] }

/-- The product of `f y` over `y ∈ g '' s` equals the product of `f (g i)` over `s`
provided that `g` is injective on `s ∩ mul_support (f ∘ g)`. -/
@[to_additive] lemma finprod_mem_image' {s : set β} {g : β → α}
  (hg : set.inj_on g (s ∩ mul_support (f ∘ g))) :
  ∏ᶠ i ∈ (g '' s), f i = ∏ᶠ j ∈ s, f (g j) :=
begin
  classical,
  by_cases hs : finite (s ∩ mul_support (f ∘ g)),
  { have hg : ∀ (x ∈ hs.to_finset) (y ∈ hs.to_finset), g x = g y → x = y,
      by simpa only [hs.mem_to_finset],
    rw [finprod_mem_eq_prod _ hs, ← finset.prod_image hg],
    refine finprod_mem_eq_prod_of_inter_mul_support_eq f _,
    rw [finset.coe_image, hs.coe_to_finset, ← image_inter_mul_support_eq, inter_assoc,
      inter_self] },
  { rw [finprod_mem_eq_one_of_infinite hs, finprod_mem_eq_one_of_infinite],
    rwa [image_inter_mul_support_eq, infinite_image_iff hg] }
end

/-- The product of `f y` over `y ∈ g '' s` equals the product of `f (g i)` over `s`
provided that `g` is injective on `s`. -/
@[to_additive] lemma finprod_mem_image {β} {s : set β} {g : β → α} (hg : set.inj_on g s) :
  ∏ᶠ i ∈ (g '' s), f i = ∏ᶠ j ∈ s, f (g j) :=
finprod_mem_image' $ hg.mono $ inter_subset_left _ _

/-- The product of `f y` over `y ∈ set.range g` equals the product of `f (g i)` over all `i`
provided that `g` is injective on `mul_support (f ∘ g)`. -/
@[to_additive] lemma finprod_mem_range' {g : β → α} (hg : set.inj_on g (mul_support (f ∘ g))) :
  ∏ᶠ i ∈ range g, f i = ∏ᶠ j, f (g j) :=
begin
  rw [← image_univ, finprod_mem_image', finprod_mem_univ],
  rwa univ_inter
end

/-- The product of `f y` over `y ∈ set.range g` equals the product of `f (g i)` over all `i`
provided that `g` is injective. -/
@[to_additive] lemma finprod_mem_range {g : β → α} (hg : injective g) :
  ∏ᶠ i ∈ range g, f i = ∏ᶠ j, f (g j) :=
finprod_mem_range' (hg.inj_on _)

/-- The product of `f i` over `s : set α` is equal to the product of `g j` over `t : set β`
if there exists a function `e : α → β` such that `e` is bijective from `s` to `t` and for all
`x` in `s` we have `f x = g (e x)`.
See also `finset.prod_bij`. -/
@[to_additive] lemma finprod_mem_eq_of_bij_on {s : set α} {t : set β} {f : α → M} {g : β → M}
  (e : α → β) (he₀ : set.bij_on e s t) (he₁ : ∀ x ∈ s, f x = g (e x)) :
  ∏ᶠ i ∈ s, f i = ∏ᶠ j ∈ t, g j :=
begin
  rw [← set.bij_on.image_eq he₀, finprod_mem_image he₀.2.1],
  exact finprod_mem_congr rfl he₁
end

/-- The product of `f i` is equal to the product of `g j` if there exists a bijective function
`e : α → β` such that for all `x` we have `f x = g (e x)`.
See `finprod_comp`, `fintype.prod_bijective` and `finset.prod_bij` -/
@[to_additive] lemma finprod_eq_of_bijective {f : α → M} {g : β → M}
  (e : α → β) (he₀ : function.bijective e) (he₁ : ∀ x, f x = g (e x)) :
  ∏ᶠ i, f i = ∏ᶠ j, g j :=
begin
  rw [← finprod_mem_univ f, ← finprod_mem_univ g],
  exact finprod_mem_eq_of_bij_on _ (bijective_iff_bij_on_univ.mp he₀) (λ x _, he₁ x),
end

/-- Given a bijective function `e` the product of `g i` is equal to the product of `g (e i)`.
See also `finprod_eq_of_bijective`, `fintype.prod_bijective` and `finset.prod_bij` -/
@[to_additive] lemma finprod_comp {g : β → M} (e : α → β) (he₀ : function.bijective e) :
  ∏ᶠ i, g (e i) = ∏ᶠ j, g j := finprod_eq_of_bijective e he₀ (λ x, rfl)

@[to_additive] lemma finprod_set_coe_eq_finprod_mem (s : set α) : ∏ᶠ j : s, f j = ∏ᶠ i ∈ s, f i :=
begin
  rw [← finprod_mem_range, subtype.range_coe],
  exact subtype.coe_injective
end

@[to_additive] lemma finprod_subtype_eq_finprod_cond (p : α → Prop) :
  ∏ᶠ j : subtype p, f j = ∏ᶠ i (hi : p i), f i :=
finprod_set_coe_eq_finprod_mem {i | p i}

@[to_additive] lemma finprod_mem_inter_mul_diff' (t : set α) (h : (s ∩ mul_support f).finite) :
  (∏ᶠ i ∈ s ∩ t, f i) * ∏ᶠ i ∈ s \ t, f i = ∏ᶠ i ∈ s, f i :=
begin
  rw [← finprod_mem_union', inter_union_diff],
  exacts [λ x hx, hx.2.2 hx.1.2, h.subset (λ x hx, ⟨hx.1.1, hx.2⟩),
    h.subset (λ x hx, ⟨hx.1.1, hx.2⟩)],
end

@[to_additive] lemma finprod_mem_inter_mul_diff (t : set α) (h : s.finite) :
  (∏ᶠ i ∈ s ∩ t, f i) * ∏ᶠ i ∈ s \ t, f i = ∏ᶠ i ∈ s, f i :=
finprod_mem_inter_mul_diff' _ $ h.inter_of_left _

/-- A more general version of `finprod_mem_mul_diff` that requires `t ∩ mul_support f` instead of
  `t` to be finite. -/
@[to_additive] lemma finprod_mem_mul_diff' (hst : s ⊆ t) (ht : (t ∩ mul_support f).finite) :
  (∏ᶠ i ∈ s, f i) * ∏ᶠ i ∈ t \ s, f i = ∏ᶠ i ∈ t, f i :=
by rw [← finprod_mem_inter_mul_diff' _ ht, inter_eq_self_of_subset_right hst]

/-- Given a finite set `t` and a subset `s` of `t`, the product of `f i` over `i ∈ s`
times the product of `f i` over `t \ s` equals the product of `f i` over `i ∈ t`. -/
@[to_additive] lemma finprod_mem_mul_diff (hst : s ⊆ t) (ht : t.finite) :
  (∏ᶠ i ∈ s, f i) * ∏ᶠ i ∈ t \ s, f i = ∏ᶠ i ∈ t, f i :=
finprod_mem_mul_diff' hst (ht.inter_of_left _)

/-- Given a family of pairwise disjoint finite sets `t i` indexed by a finite type,
the product of `f a` over the union `⋃ i, t i` is equal to the product over all indexes `i`
of the products of `f a` over `a ∈ t i`. -/
@[to_additive] lemma finprod_mem_Union [fintype ι] {t : ι → set α}
  (h : pairwise (disjoint on t)) (ht : ∀ i, (t i).finite) :
  ∏ᶠ a ∈ (⋃ i : ι, t i), f a = ∏ᶠ i, (∏ᶠ a ∈ t i, f a) :=
begin
  lift t to ι → finset α using ht,
  classical,
  rw [← bUnion_univ, ← finset.coe_univ, ← finset.coe_bUnion,
    finprod_mem_coe_finset, finset.prod_bUnion],
  { simp only [finprod_mem_coe_finset, finprod_eq_prod_of_fintype] },
  { exact λ x _ y _ hxy, finset.disjoint_iff_disjoint_coe.2 (h x y hxy) }
end

/-- Given a family of sets `t : ι → set α`, a finite set `I` in the index type such that all
sets `t i`, `i ∈ I`, are finite, if all `t i`, `i ∈ I`, are pairwise disjoint, then
the product of `f a` over `a ∈ ⋃ i ∈ I, t i` is equal to the product over `i ∈ I`
of the products of `f a` over `a ∈ t i`. -/
@[to_additive] lemma finprod_mem_bUnion {I : set ι} {t : ι → set α}
  (h : I.pairwise (disjoint on t)) (hI : I.finite) (ht : ∀ i ∈ I, (t i).finite) :
  ∏ᶠ a ∈ ⋃ x ∈ I, t x, f a = ∏ᶠ i ∈ I, ∏ᶠ j ∈ t i, f j :=
begin
  haveI := hI.fintype,
  rw [bUnion_eq_Union, finprod_mem_Union, ← finprod_set_coe_eq_finprod_mem],
  exacts [λ x y hxy, h x x.2 y y.2 (subtype.coe_injective.ne hxy), λ b, ht b b.2]
end

/-- If `t` is a finite set of pairwise disjoint finite sets, then the product of `f a`
over `a ∈ ⋃₀ t` is the product over `s ∈ t` of the products of `f a` over `a ∈ s`. -/
@[to_additive] lemma finprod_mem_sUnion {t : set (set α)} (h : t.pairwise disjoint)
  (ht₀ : t.finite) (ht₁ : ∀ x ∈ t, set.finite x):
  ∏ᶠ a ∈ ⋃₀ t, f a = ∏ᶠ s ∈ t, ∏ᶠ a ∈ s, f a :=
by rw [set.sUnion_eq_bUnion, finprod_mem_bUnion h ht₀ ht₁]

/-- If `s : set α` and `t : set β` are finite sets, then the product over `s` commutes
with the product over `t`. -/
@[to_additive] lemma finprod_mem_comm {s : set α} {t : set β}
  (f : α → β → M) (hs : s.finite) (ht : t.finite) :
  ∏ᶠ i ∈ s, ∏ᶠ j ∈ t, f i j = ∏ᶠ j ∈ t, ∏ᶠ i ∈ s, f i j :=
begin
  lift s to finset α using hs, lift t to finset β using ht,
  simp only [finprod_mem_coe_finset],
  exact finset.prod_comm
end

/-- To prove a property of a finite product, it suffices to prove that the property is
multiplicative and holds on multipliers. -/
@[to_additive] lemma finprod_mem_induction (p : M → Prop) (hp₀ : p 1)
  (hp₁ : ∀ x y, p x → p y → p (x * y)) (hp₂ : ∀ x ∈ s, p $ f x) :
  p (∏ᶠ i ∈ s, f i) :=
finprod_induction _ hp₀ hp₁ $ λ x, finprod_induction _ hp₀ hp₁ $ hp₂ x

lemma finprod_cond_nonneg {R : Type*} [ordered_comm_semiring R] {p : α → Prop} {f : α → R}
  (hf : ∀ x, p x → 0 ≤ f x) :
  0 ≤ ∏ᶠ x (h : p x), f x :=
finprod_nonneg $ λ x, finprod_nonneg $ hf x

@[to_additive]
lemma single_le_finprod {M : Type*} [ordered_comm_monoid M] (i : α) {f : α → M}
  (hf : finite (mul_support f)) (h : ∀ j, 1 ≤ f j) :
  f i ≤ ∏ᶠ j, f j :=
by classical;
calc f i ≤ ∏ j in insert i hf.to_finset, f j :
  finset.single_le_prod' (λ j hj, h j) (finset.mem_insert_self _ _)
     ... = ∏ᶠ j, f j                :
  (finprod_eq_prod_of_mul_support_to_finset_subset _ hf (finset.subset_insert _ _)).symm

lemma finprod_eq_zero {M₀ : Type*} [comm_monoid_with_zero M₀] (f : α → M₀) (x : α)
  (hx : f x = 0) (hf : finite (mul_support f)) :
  ∏ᶠ x, f x = 0 :=
begin
  nontriviality,
  rw [finprod_eq_prod f hf],
  refine finset.prod_eq_zero (hf.mem_to_finset.2 _) hx,
  simp [hx]
end

@[to_additive] lemma finprod_prod_comm (s : finset β) (f : α → β → M)
  (h : ∀ b ∈ s, (mul_support (λ a, f a b)).finite) :
  ∏ᶠ a : α, ∏ b in s, f a b = ∏ b in s, ∏ᶠ a : α, f a b :=
begin
  have hU : mul_support (λ a, ∏ b in s, f a b) ⊆
    (s.finite_to_set.bUnion (λ b hb, h b (finset.mem_coe.1 hb))).to_finset,
  { rw finite.coe_to_finset,
    intros x hx,
    simp only [exists_prop, mem_Union, ne.def, mem_mul_support, finset.mem_coe],
    contrapose! hx,
    rw [mem_mul_support, not_not, finset.prod_congr rfl hx, finset.prod_const_one] },
  rw [finprod_eq_prod_of_mul_support_subset _ hU, finset.prod_comm],
  refine finset.prod_congr rfl (λ b hb, (finprod_eq_prod_of_mul_support_subset _ _).symm),
  intros a ha,
  simp only [finite.coe_to_finset, mem_Union],
  exact ⟨b, hb, ha⟩
end

@[to_additive] lemma prod_finprod_comm (s : finset α) (f : α → β → M)
  (h : ∀ a ∈ s, (mul_support (f a)).finite) :
  ∏ a in s, ∏ᶠ b : β, f a b = ∏ᶠ b : β, ∏ a in s, f a b :=
(finprod_prod_comm s (λ b a, f a b) h).symm

lemma mul_finsum {R : Type*} [semiring R] (f : α → R) (r : R)
  (h : (function.support f).finite) :
  r * ∑ᶠ a : α, f a = ∑ᶠ a : α, r * f a :=
(add_monoid_hom.mul_left r).map_finsum h

lemma finsum_mul {R : Type*} [semiring R] (f : α → R) (r : R)
  (h : (function.support f).finite) :
  (∑ᶠ a : α, f a) * r = ∑ᶠ a : α, f a * r :=
(add_monoid_hom.mul_right r).map_finsum h

@[to_additive] lemma finset.mul_support_of_fiberwise_prod_subset_image [decidable_eq β]
  (s : finset α) (f : α → M) (g : α → β) :
  mul_support (λ b, (s.filter (λ a, g a = b)).prod f) ⊆ s.image g :=
begin
  simp only [finset.coe_image, set.mem_image, finset.mem_coe, function.support_subset_iff],
  intros b h,
  suffices : (s.filter (λ (a : α), g a = b)).nonempty,
  { simpa only [s.fiber_nonempty_iff_mem_image g b, finset.mem_image, exists_prop], },
  exact finset.nonempty_of_prod_ne_one h,
end

/-- Note that `b ∈ (s.filter (λ ab, prod.fst ab = a)).image prod.snd` iff `(a, b) ∈ s` so we can
simplify the right hand side of this lemma. However the form stated here is more useful for
iterating this lemma, e.g., if we have `f : α × β × γ → M`. -/
@[to_additive] lemma finprod_mem_finset_product' [decidable_eq α] [decidable_eq β]
  (s : finset (α × β)) (f : α × β → M) :
  ∏ᶠ ab (h : ab ∈ s), f ab =
  ∏ᶠ a b (h : b ∈ (s.filter (λ ab, prod.fst ab = a)).image prod.snd), f (a, b) :=
begin
  have : ∀ a, ∏ (i : β) in (s.filter (λ ab, prod.fst ab = a)).image prod.snd, f (a, i) =
    (finset.filter (λ ab, prod.fst ab = a) s).prod f,
  { intros a, apply finset.prod_bij (λ b _, (a, b)); finish, },
  rw finprod_mem_finset_eq_prod,
  simp_rw [finprod_mem_finset_eq_prod, this],
  rw [finprod_eq_prod_of_mul_support_subset _
    (s.mul_support_of_fiberwise_prod_subset_image f prod.fst),
    ← finset.prod_fiberwise_of_maps_to _ f],
  finish,
end

/-- See also `finprod_mem_finset_product'`. -/
@[to_additive] lemma finprod_mem_finset_product (s : finset (α × β)) (f : α × β → M) :
  ∏ᶠ ab (h : ab ∈ s), f ab = ∏ᶠ a b (h : (a, b) ∈ s), f (a, b) :=
by { classical, rw finprod_mem_finset_product', simp, }

@[to_additive] lemma finprod_mem_finset_product₃ {γ : Type*}
  (s : finset (α × β × γ)) (f : α × β × γ → M) :
  ∏ᶠ abc (h : abc ∈ s), f abc = ∏ᶠ a b c (h : (a, b, c) ∈ s), f (a, b, c) :=
by { classical, rw finprod_mem_finset_product', simp_rw finprod_mem_finset_product', simp, }

@[to_additive] lemma finprod_curry (f : α × β → M) (hf : (mul_support f).finite) :
  ∏ᶠ ab, f ab = ∏ᶠ a b, f (a, b) :=
begin
  have h₁ : ∀ a, ∏ᶠ (h : a ∈ hf.to_finset), f a = f a, { simp, },
  have h₂ : ∏ᶠ a, f a = ∏ᶠ a (h : a ∈ hf.to_finset), f a, { simp, },
  simp_rw [h₂, finprod_mem_finset_product, h₁],
end

@[to_additive] lemma finprod_curry₃ {γ : Type*} (f : α × β × γ → M) (h : (mul_support f).finite) :
  ∏ᶠ abc, f abc = ∏ᶠ a b c, f (a, b, c) :=
by { rw finprod_curry f h, congr, ext a, rw finprod_curry, simp [h], }

@[to_additive]
lemma finprod_dmem {s : set α} [decidable_pred (∈ s)] (f : (Π (a : α), a ∈ s → M)) :
  ∏ᶠ (a : α) (h : a ∈ s), f a h = ∏ᶠ (a : α) (h : a ∈ s), if h' : a ∈ s then f a h' else 1 :=
finprod_congr (λ a, finprod_congr (λ ha, (dif_pos ha).symm))

@[to_additive]
lemma finprod_emb_domain' {f : α → β} (hf : function.injective f)
  [decidable_pred (∈ set.range f)] (g : α → M) :
  ∏ᶠ (b : β), (if h : b ∈ set.range f then g (classical.some h) else 1) = ∏ᶠ (a : α), g a :=
begin
  simp_rw [← finprod_eq_dif],
  rw [finprod_dmem, finprod_mem_range hf, finprod_congr (λ a, _)],
  rw [dif_pos (set.mem_range_self a), hf (classical.some_spec (set.mem_range_self a))]
end

@[to_additive]
lemma finprod_emb_domain (f : α ↪ β) [decidable_pred (∈ set.range f)] (g : α → M) :
  ∏ᶠ (b : β), (if h : b ∈ set.range f then g (classical.some h) else 1) = ∏ᶠ (a : α), g a :=
finprod_emb_domain' f.injective g

end type


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

! This file was ported from Lean 3 source module topology.spectral.hom
! leanprover-community/mathlib commit 4c19a16e4b705bf135cf9a80ac18fcc99c438514
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Topology.ContinuousFunction.Basic

/-!
# Spectral maps

This file defines spectral maps. A map is spectral when it's continuous and the preimage of a
compact open set is compact open.

## Main declarations

* `IsSpectralMap`: Predicate for a map to be spectral.
* `SpectralMap`: Bundled spectral maps.
* `SpectralMapClass`: Typeclass for a type to be a type of spectral maps.

## TODO

Once we have `SpectralSpace`, `IsSpectralMap` should move to `topology.spectral.basic`.
-/

open Function OrderDual

variable {F α β γ δ : Type _}

section Unbundled

variable [TopologicalSpace α] [TopologicalSpace β] [TopologicalSpace γ] {f : α → β} {s : Set β}

/-- A function between topological spaces is spectral if it is continuous and the preimage of every
compact open set is compact open. -/
structure IsSpectralMap (f : α → β) extends Continuous f : Prop where
  /-- A function between topological spaces is spectral if it is continuous and the preimage of
   every compact open set is compact open. -/
  isCompact_preimage_of_isOpen ⦃s : Set β⦄ : IsOpen s → IsCompact s → IsCompact (f ⁻¹' s)
#align is_spectral_map IsSpectralMap

theorem IsCompact.preimage_of_isOpen (hf : IsSpectralMap f) (h₀ : IsCompact s) (h₁ : IsOpen s) :
    IsCompact (f ⁻¹' s) :=
  hf.isCompact_preimage_of_isOpen h₁ h₀
#align is_compact.preimage_of_is_open IsCompact.preimage_of_isOpen

theorem IsSpectralMap.continuous {f : α → β} (hf : IsSpectralMap f) : Continuous f :=
  hf.toContinuous
#align is_spectral_map.continuous IsSpectralMap.continuous

theorem isSpectralMap_id : IsSpectralMap (@id α) :=
  ⟨continuous_id, fun _s _ => id⟩
#align is_spectral_map_id isSpectralMap_id

theorem IsSpectralMap.comp {f : β → γ} {g : α → β} (hf : IsSpectralMap f) (hg : IsSpectralMap g) :
    IsSpectralMap (f ∘ g) :=
  ⟨hf.continuous.comp hg.continuous, fun _s hs₀ hs₁ =>
    ((hs₁.preimage_of_isOpen hf hs₀).preimage_of_isOpen hg) (hs₀.preimage hf.continuous)⟩
#align is_spectral_map.comp IsSpectralMap.comp

end Unbundled

/-- The type of spectral maps from `α` to `β`. -/
structure SpectralMap (α β : Type _) [TopologicalSpace α] [TopologicalSpace β] where
  /-- function between topological spaces-/
  toFun : α → β
  /-- proof that `toFun` is a spectral map-/
  spectral' : IsSpectralMap toFun
#align spectral_map SpectralMap

section

/-- `SpectralMapClass F α β` states that `F` is a type of spectral maps.

You should extend this class when you extend `SpectralMap`. -/
class SpectralMapClass (F : Type _) (α β : outParam <| Type _) [TopologicalSpace α]
  [TopologicalSpace β] extends FunLike F α fun _ => β where
  /-- statement that `F` is a type of spectal maps-/
  map_spectral (f : F) : IsSpectralMap f
#align spectral_map_class SpectralMapClass

end

export SpectralMapClass (map_spectral)

attribute [simp] map_spectral

-- See note [lower instance priority]
-- porting note: `TopologicalSpace` params marked as implicit to address dangerous instances lint
instance (priority := 100) SpectralMapClass.toContinuousMapClass {_ : TopologicalSpace α}
    {_ : TopologicalSpace β} [SpectralMapClass F α β] : ContinuousMapClass F α β :=
  { ‹SpectralMapClass F α β› with map_continuous := fun f => (map_spectral f).continuous }
#align spectral_map_class.to_continuous_map_class SpectralMapClass.toContinuousMapClass

instance [TopologicalSpace α] [TopologicalSpace β] [SpectralMapClass F α β] :
    CoeTC F (SpectralMap α β) :=
  ⟨fun f => ⟨_, map_spectral f⟩⟩

/-! ### Spectral maps -/

namespace SpectralMap

variable [TopologicalSpace α] [TopologicalSpace β] [TopologicalSpace γ] [TopologicalSpace δ]

/-- Reinterpret a `SpectralMap` as a `ContinuousMap`. -/
def toContinuousMap (f : SpectralMap α β) : ContinuousMap α β :=
  ⟨_, f.spectral'.continuous⟩
#align spectral_map.to_continuous_map SpectralMap.toContinuousMap

instance : SpectralMapClass (SpectralMap α β) α β
    where
  coe := SpectralMap.toFun
  coe_injective' f g h := by cases f; cases g; congr
  map_spectral f := f.spectral'

-- Porting note: These CoeFun instances are not desirable in Lean 4.
--/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
--directly. -/
--instance : CoeFun (SpectralMap α β) fun _ => α → β :=
--  FunLike.hasCoeToFun

@[simp]
theorem toFun_eq_coe {f : SpectralMap α β} : f.toFun = (f : α → β) :=
  rfl
#align spectral_map.to_fun_eq_coe SpectralMap.toFun_eq_coe

@[ext]

/-- Copy of a `SpectralMap` with a new `toFun` equal to the old one. Useful to fix definitional
equalities. -/
protected def copy (f : SpectralMap α β) (f' : α → β) (h : f' = f) : SpectralMap α β :=
  ⟨f', h.symm.subst f.spectral'⟩
#align spectral_map.copy SpectralMap.copy

@[simp]
theorem coe_copy (f : SpectralMap α β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' :=
  rfl
#align spectral_map.coe_copy SpectralMap.coe_copy

theorem copy_eq (f : SpectralMap α β) (f' : α → β) (h : f' = f) : f.copy f' h = f :=
  FunLike.ext' h
#align spectral_map.copy_eq SpectralMap.copy_eq

variable (α)

/-- `id` as a `SpectralMap`. -/
protected def id : SpectralMap α α :=
  ⟨id, isSpectralMap_id⟩
#align spectral_map.id SpectralMap.id

instance : Inhabited (SpectralMap α α) :=
  ⟨SpectralMap.id α⟩

@[simp]
theorem coe_id : ⇑(SpectralMap.id α) = id :=
  rfl
#align spectral_map.coe_id SpectralMap.coe_id

variable {α}

@[simp]
theorem id_apply (a : α) : SpectralMap.id α a = a :=
  rfl
#align spectral_map.id_apply SpectralMap.id_apply

/-- Composition of `SpectralMap`s as a `SpectralMap`. -/
def comp (f : SpectralMap β γ) (g : SpectralMap α β) : SpectralMap α γ :=
  ⟨f.toContinuousMap.comp g.toContinuousMap, f.spectral'.comp g.spectral'⟩
#align spectral_map.comp SpectralMap.comp

@[simp]
theorem coe_comp (f : SpectralMap β γ) (g : SpectralMap α β) : (f.comp g : α → γ) = f ∘ g :=
  rfl
#align spectral_map.coe_comp SpectralMap.coe_comp

@[simp]
theorem comp_apply (f : SpectralMap β γ) (g : SpectralMap α β) (a : α) : (f.comp g) a = f (g a) :=
  rfl
#align spectral_map.comp_apply SpectralMap.comp_apply

@[simp]
theorem coe_comp_continuousMap (f : SpectralMap β γ) (g : SpectralMap α β) :
    (f ∘ g)= (f : ContinuousMap β γ) ∘  (g: ContinuousMap α β) := by
   rfl

-- porting note: removed `simp` from this and added lemma above to address `simpNF` lint
theorem coe_comp_continuousMap' (f : SpectralMap β γ) (g : SpectralMap α β) :
    (f.comp g : ContinuousMap α γ) = (f : ContinuousMap β γ).comp g := by
    simp only [@coe_comp]; rfl
#align spectral_map.coe_comp_continuous_map SpectralMap.coe_comp_continuousMap'

@[simp]
theorem comp_assoc (f : SpectralMap γ δ) (g : SpectralMap β γ) (h : SpectralMap α β) :
    (f.comp g).comp h = f.comp (g.comp h) :=
  rfl
#align spectral_map.comp_assoc SpectralMap.comp_assoc

@[simp]
theorem comp_id (f : SpectralMap α β) : f.comp (SpectralMap.id α) = f :=
  ext fun _a => rfl
#align spectral_map.comp_id SpectralMap.comp_id

@[simp]
theorem id_comp (f : SpectralMap α β) : (SpectralMap.id β).comp f = f :=
  ext fun _a => rfl
#align spectral_map.id_comp SpectralMap.id_comp

theorem cancel_right {g₁ g₂ : SpectralMap β γ} {f : SpectralMap α β} (hf : Surjective f) :
    g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
  ⟨fun h => ext <| hf.forall.2 <| FunLike.ext_iff.1 h,
   fun a => of_eq (congrFun (congrArg comp a) f)⟩
#align spectral_map.cancel_right SpectralMap.cancel_right

theorem cancel_left {g : SpectralMap β γ} {f₁ f₂ : SpectralMap α β} (hg : Injective g) :
    g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
  ⟨fun h => ext fun a => hg <| by rw [← comp_apply, h, comp_apply], congr_arg _⟩
#align spectral_map.cancel_left SpectralMap.cancel_left

end SpectralMap