/-
Copyright (c) 2020 Alexander Bentkamp. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alexander Bentkamp
-/

import linear_algebra.charpoly.basic
import linear_algebra.finsupp
import linear_algebra.matrix.to_lin
import algebra.algebra.spectrum
import order.hom.basic

/-!
# Eigenvectors and eigenvalues

This file defines eigenspaces, eigenvalues, and eigenvalues, as well as their generalized
counterparts. We follow Axler's approach [axler2015] because it allows us to derive many properties
without choosing a basis and without using matrices.

An eigenspace of a linear map `f` for a scalar `μ` is the kernel of the map `(f - μ • id)`. The
nonzero elements of an eigenspace are eigenvectors `x`. They have the property `f x = μ • x`. If
there are eigenvectors for a scalar `μ`, the scalar `μ` is called an eigenvalue.

There is no consensus in the literature whether `0` is an eigenvector. Our definition of
`has_eigenvector` permits only nonzero vectors. For an eigenvector `x` that may also be `0`, we
write `x ∈ f.eigenspace μ`.

A generalized eigenspace of a linear map `f` for a natural number `k` and a scalar `μ` is the kernel
of the map `(f - μ • id) ^ k`. The nonzero elements of a generalized eigenspace are generalized
eigenvectors `x`. If there are generalized eigenvectors for a natural number `k` and a scalar `μ`,
the scalar `μ` is called a generalized eigenvalue.

## References

* [Sheldon Axler, *Linear Algebra Done Right*][axler2015]
* https://en.wikipedia.org/wiki/Eigenvalues_and_eigenvectors

## Tags

eigenspace, eigenvector, eigenvalue, eigen
-/

universes u v w

namespace module
namespace End

open module principal_ideal_ring polynomial finite_dimensional

variables {K R : Type v} {V M : Type w}
  [comm_ring R] [add_comm_group M] [module R M] [field K] [add_comm_group V] [module K V]

/-- The submodule `eigenspace f μ` for a linear map `f` and a scalar `μ` consists of all vectors `x`
    such that `f x = μ • x`. (Def 5.36 of [axler2015])-/
def eigenspace (f : End R M) (μ : R) : submodule R M :=
(f - algebra_map R (End R M) μ).ker

/-- A nonzero element of an eigenspace is an eigenvector. (Def 5.7 of [axler2015]) -/
def has_eigenvector (f : End R M) (μ : R) (x : M) : Prop :=
x ∈ eigenspace f μ ∧ x ≠ 0

/-- A scalar `μ` is an eigenvalue for a linear map `f` if there are nonzero vectors `x`
    such that `f x = μ • x`. (Def 5.5 of [axler2015]) -/
def has_eigenvalue (f : End R M) (a : R) : Prop :=
eigenspace f a ≠ ⊥

/-- The eigenvalues of the endomorphism `f`, as a subtype of `R`. -/
def eigenvalues (f : End R M) : Type* := {μ : R // f.has_eigenvalue μ}

instance (f : End R M) : has_coe f.eigenvalues R := coe_subtype

lemma has_eigenvalue_of_has_eigenvector {f : End R M} {μ : R} {x : M} (h : has_eigenvector f μ x) :
  has_eigenvalue f μ :=
begin
  rw [has_eigenvalue, submodule.ne_bot_iff],
  use x, exact h,
end

lemma mem_eigenspace_iff {f : End R M} {μ : R} {x : M} : x ∈ eigenspace f μ ↔ f x = μ • x :=
by rw [eigenspace, linear_map.mem_ker, linear_map.sub_apply, algebra_map_End_apply,
  sub_eq_zero]

lemma has_eigenvector.apply_eq_smul {f : End R M} {μ : R} {x : M} (hx : f.has_eigenvector μ x) :
  f x = μ • x :=
mem_eigenspace_iff.mp hx.1

lemma has_eigenvalue.exists_has_eigenvector {f : End R M} {μ : R} (hμ : f.has_eigenvalue μ) :
  ∃ v, f.has_eigenvector μ v :=
submodule.exists_mem_ne_zero_of_ne_bot hμ

lemma mem_spectrum_of_has_eigenvalue {f : End R M} {μ : R} (hμ : has_eigenvalue f μ) :
  μ ∈ spectrum R f :=
begin
  refine spectrum.mem_iff.mpr (λ h_unit, _),
  set f' := linear_map.general_linear_group.to_linear_equiv h_unit.unit,
  rcases hμ.exists_has_eigenvector with ⟨v, hv⟩,
  refine hv.2 ((linear_map.ker_eq_bot'.mp f'.ker) v (_ : μ • v - f v = 0)),
  rw [hv.apply_eq_smul, sub_self]
end

lemma has_eigenvalue_iff_mem_spectrum [finite_dimensional K V] {f : End K V} {μ : K} :
  f.has_eigenvalue μ ↔ μ ∈ spectrum K f :=
iff.intro mem_spectrum_of_has_eigenvalue
  (λ h, by rwa [spectrum.mem_iff, is_unit.sub_iff, linear_map.is_unit_iff_ker_eq_bot] at h)

lemma eigenspace_div (f : End K V) (a b : K) (hb : b ≠ 0) :
  eigenspace f (a / b) = (b • f - algebra_map K (End K V) a).ker :=
calc
  eigenspace f (a / b) = eigenspace f (b⁻¹ * a) : by { rw [div_eq_mul_inv, mul_comm] }
  ... = (f - (b⁻¹ * a) • linear_map.id).ker : rfl
  ... = (f - b⁻¹ • a • linear_map.id).ker : by rw smul_smul
  ... = (f - b⁻¹ • algebra_map K (End K V) a).ker : rfl
  ... = (b • (f - b⁻¹ • algebra_map K (End K V) a)).ker : by rw linear_map.ker_smul _ b hb
  ... = (b • f - algebra_map K (End K V) a).ker : by rw [smul_sub, smul_inv_smul₀ hb]

lemma eigenspace_aeval_polynomial_degree_1
  (f : End K V) (q : polynomial K) (hq : degree q = 1) :
  eigenspace f (- q.coeff 0 / q.leading_coeff) = (aeval f q).ker :=
calc
  eigenspace f (- q.coeff 0 / q.leading_coeff)
      = (q.leading_coeff • f - algebra_map K (End K V) (- q.coeff 0)).ker
    : by { rw eigenspace_div, intro h, rw leading_coeff_eq_zero_iff_deg_eq_bot.1 h at hq, cases hq }
  ... = (aeval f (C q.leading_coeff * X + C (q.coeff 0))).ker
    : by { rw [C_mul', aeval_def], simp [algebra_map, algebra.to_ring_hom], }
  ... = (aeval f q).ker
     : by { congr, apply (eq_X_add_C_of_degree_eq_one hq).symm }

lemma ker_aeval_ring_hom'_unit_polynomial
  (f : End K V) (c : (polynomial K)ˣ) :
  (aeval f (c : polynomial K)).ker = ⊥ :=
begin
  rw polynomial.eq_C_of_degree_eq_zero (degree_coe_units c),
  simp only [aeval_def, eval₂_C],
  apply ker_algebra_map_End,
  apply coeff_coe_units_zero_ne_zero c
end

theorem aeval_apply_of_has_eigenvector {f : End K V}
  {p : polynomial K} {μ : K} {x : V} (h : f.has_eigenvector μ x) :
  aeval f p x = (p.eval μ) • x :=
begin
  apply p.induction_on,
  { intro a, simp [module.algebra_map_End_apply] },
  { intros p q hp hq, simp [hp, hq, add_smul] },
  { intros n a hna,
    rw [mul_comm, pow_succ, mul_assoc, alg_hom.map_mul, linear_map.mul_apply, mul_comm, hna],
    simp [algebra_map_End_apply, mem_eigenspace_iff.1 h.1, smul_smul, mul_comm] }
end

section minpoly

theorem is_root_of_has_eigenvalue {f : End K V} {μ : K} (h : f.has_eigenvalue μ) :
  (minpoly K f).is_root μ :=
begin
  rcases (submodule.ne_bot_iff _).1 h with ⟨w, ⟨H, ne0⟩⟩,
  refine or.resolve_right (smul_eq_zero.1 _) ne0,
  simp [← aeval_apply_of_has_eigenvector ⟨H, ne0⟩, minpoly.aeval K f],
end

variables [finite_dimensional K V] (f : End K V)

variables {f} {μ : K}

theorem has_eigenvalue_of_is_root (h : (minpoly K f).is_root μ) :
  f.has_eigenvalue μ :=
begin
  cases dvd_iff_is_root.2 h with p hp,
  rw [has_eigenvalue, eigenspace],
  intro con,
  cases (linear_map.is_unit_iff_ker_eq_bot _).2 con with u hu,
  have p_ne_0 : p ≠ 0,
  { intro con,
    apply minpoly.ne_zero f.is_integral,
    rw [hp, con, mul_zero] },
  have h_deg := minpoly.degree_le_of_ne_zero K f p_ne_0 _,
  { rw [hp, degree_mul, degree_X_sub_C, polynomial.degree_eq_nat_degree p_ne_0] at h_deg,
    norm_cast at h_deg,
    linarith, },
  { have h_aeval := minpoly.aeval K f,
    revert h_aeval,
    simp [hp, ← hu] },
end

theorem has_eigenvalue_iff_is_root :
  f.has_eigenvalue μ ↔ (minpoly K f).is_root μ :=
⟨is_root_of_has_eigenvalue, has_eigenvalue_of_is_root⟩

/-- An endomorphism of a finite-dimensional vector space has finitely many eigenvalues. -/
noncomputable instance (f : End K V) : fintype f.eigenvalues :=
set.finite.fintype
begin
  have h : minpoly K f ≠ 0 := minpoly.ne_zero f.is_integral,
  convert (minpoly K f).root_set_finite K,
  ext μ,
  have : (μ ∈ {μ : K | f.eigenspace μ = ⊥ → false}) ↔ ¬f.eigenspace μ = ⊥ := by tauto,
  convert rfl.mpr this,
  simp [polynomial.root_set_def, polynomial.mem_roots h, ← has_eigenvalue_iff_is_root,
    has_eigenvalue]
end

end minpoly

/-- Every linear operator on a vector space over an algebraically closed field has
    an eigenvalue. -/
-- This is Lemma 5.21 of [axler2015], although we are no longer following that proof.
lemma exists_eigenvalue [is_alg_closed K] [finite_dimensional K V] [nontrivial V] (f : End K V) :
  ∃ (c : K), f.has_eigenvalue c :=
by { simp_rw has_eigenvalue_iff_mem_spectrum,
     exact spectrum.nonempty_of_is_alg_closed_of_finite_dimensional K f }

noncomputable instance [is_alg_closed K] [finite_dimensional K V] [nontrivial V] (f : End K V) :
  inhabited f.eigenvalues :=
⟨⟨f.exists_eigenvalue.some, f.exists_eigenvalue.some_spec⟩⟩

/-- The eigenspaces of a linear operator form an independent family of subspaces of `V`.  That is,
any eigenspace has trivial intersection with the span of all the other eigenspaces. -/
lemma eigenspaces_independent (f : End K V) : complete_lattice.independent f.eigenspace :=
begin
  classical,
  -- Define an operation from `Π₀ μ : K, f.eigenspace μ`, the vector space of of finitely-supported
  -- choices of an eigenvector from each eigenspace, to `V`, by sending a collection to its sum.
  let S : @linear_map K K _ _ (ring_hom.id K) (Π₀ μ : K, f.eigenspace μ) V
    (@dfinsupp.add_comm_monoid K (λ μ, f.eigenspace μ) _) _
    (@dfinsupp.module K _ (λ μ, f.eigenspace μ) _ _ _) _ :=
    @dfinsupp.lsum K K ℕ _ V _ _ _ _ _ _ _ _ _
    (λ μ, (f.eigenspace μ).subtype),
  -- We need to show that if a finitely-supported collection `l` of representatives of the
  -- eigenspaces has sum `0`, then it itself is zero.
  suffices : ∀ l : Π₀ μ, f.eigenspace μ, S l = 0 → l = 0,
  { rw complete_lattice.independent_iff_dfinsupp_lsum_injective,
    change function.injective S,
    rw ← @linear_map.ker_eq_bot K K (Π₀ μ, (f.eigenspace μ)) V _ _
      (@dfinsupp.add_comm_group K (λ μ, f.eigenspace μ) _),
    rw eq_bot_iff,
    exact this },
  intros l hl,
  -- We apply induction on the finite set of eigenvalues from which `l` selects a nonzero
  -- eigenvector, i.e. on the support of `l`.
  induction h_l_support : l.support using finset.induction with μ₀ l_support' hμ₀ ih generalizing l,
  -- If the support is empty, all coefficients are zero and we are done.
  { exact dfinsupp.support_eq_empty.1 h_l_support },
  -- Now assume that the support of `l` contains at least one eigenvalue `μ₀`. We define a new
  -- collection of representatives `l'` to apply the induction hypothesis on later. The collection
  -- of representatives `l'` is derived from `l` by multiplying the coefficient of the eigenvector
  -- with eigenvalue `μ` by `μ - μ₀`.
  { let l' := dfinsupp.map_range.linear_map
      (λ μ, (μ - μ₀) • @linear_map.id K (f.eigenspace μ) _ _ _) l,
    -- The support of `l'` is the support of `l` without `μ₀`.
    have h_l_support' : l'.support = l_support',
    { have : l_support' = finset.erase l.support μ₀,
      { rw [h_l_support, finset.erase_insert hμ₀] },
      rw this,
      ext a,
      have : ¬(a = μ₀ ∨ l a = 0) ↔ ¬a = μ₀ ∧ ¬l a = 0 := by tauto,
      simp only [l', dfinsupp.map_range.linear_map_apply, dfinsupp.map_range_apply,
        dfinsupp.mem_support_iff, finset.mem_erase, id.def, linear_map.id_coe,
        linear_map.smul_apply, ne.def, smul_eq_zero, sub_eq_zero, this] },
    -- The entries of `l'` add up to `0`.
    have total_l' : S l' = 0,
    { let g := f - algebra_map K (End K V) μ₀,
      let a : Π₀ μ : K, V := dfinsupp.map_range.linear_map (λ μ, (f.eigenspace μ).subtype) l,
      calc S l'
          = dfinsupp.lsum ℕ (λ μ, (f.eigenspace μ).subtype.comp ((μ - μ₀) • linear_map.id)) l : _
      ... = dfinsupp.lsum ℕ (λ μ, g.comp (f.eigenspace μ).subtype) l : _
      ... = dfinsupp.lsum ℕ (λ μ, g) a : _
      ... = g (dfinsupp.lsum ℕ (λ μ, (linear_map.id : V →ₗ[K] V)) a) : _
      ... = g (S l) : _
      ... = 0 : by rw [hl, g.map_zero],
      { rw dfinsupp.sum_map_range_index.linear_map },
      { congr,
        ext μ v,
        simp only [g, eq_self_iff_true, function.comp_app, id.def, linear_map.coe_comp,
          linear_map.id_coe, linear_map.smul_apply, linear_map.sub_apply,
          module.algebra_map_End_apply, sub_left_inj, sub_smul, submodule.coe_smul_of_tower,
          submodule.coe_sub, submodule.subtype_apply, mem_eigenspace_iff.1 v.prop], },
      { rw dfinsupp.sum_map_range_index.linear_map },
      { simp only [dfinsupp.sum_add_hom_apply, linear_map.id_coe, linear_map.map_dfinsupp_sum,
          id.def, linear_map.to_add_monoid_hom_coe, dfinsupp.lsum_apply_apply], },
      { congr,
        simp only [S, a, dfinsupp.sum_map_range_index.linear_map, linear_map.id_comp] } },
    -- Therefore, by the induction hypothesis, all entries of `l'` are zero.
    have l'_eq_0 := ih l' total_l' h_l_support',
    -- By the definition of `l'`, this means that `(μ - μ₀) • l μ = 0` for all `μ`.
    have h_smul_eq_0 : ∀ μ, (μ - μ₀) • l μ = 0,
    { intro μ,
      calc (μ - μ₀) • l μ = l' μ : by simp only [l', linear_map.id_coe, id.def,
        linear_map.smul_apply, dfinsupp.map_range_apply, dfinsupp.map_range.linear_map_apply]
      ... = 0 : by { rw [l'_eq_0], refl } },
    -- Thus, the eigenspace-representatives in `l` for all `μ ≠ μ₀` are `0`.
    have h_lμ_eq_0 : ∀ μ : K, μ ≠ μ₀ → l μ = 0,
    { intros μ hμ,
      apply or_iff_not_imp_left.1 (smul_eq_zero.1 (h_smul_eq_0 μ)),
      rwa [sub_eq_zero] },
    -- So if we sum over all these representatives, we obtain `0`.
    have h_sum_l_support'_eq_0 : finset.sum l_support' (λ μ, (l μ : V)) = 0,
    { rw ←finset.sum_const_zero,
      apply finset.sum_congr rfl,
      intros μ hμ,
      norm_cast,
      rw h_lμ_eq_0,
      intro h,
      rw h at hμ,
      contradiction },
    -- The only potentially nonzero eigenspace-representative in `l` is the one corresponding to
    -- `μ₀`. But since the overall sum is `0` by assumption, this representative must also be `0`.
    have : l μ₀ = 0,
    { simp only [S, dfinsupp.lsum_apply_apply, dfinsupp.sum_add_hom_apply,
        linear_map.to_add_monoid_hom_coe, dfinsupp.sum, h_l_support, submodule.subtype_apply,
        submodule.coe_eq_zero, finset.sum_insert hμ₀, h_sum_l_support'_eq_0, add_zero] at hl,
      exact_mod_cast hl },
    -- Thus, all coefficients in `l` are `0`.
    show l = 0,
    { ext μ,
      by_cases h_cases : μ = μ₀,
      { rw h_cases,
        exact_mod_cast this },
      exact congr_arg (coe : _ → V) (h_lμ_eq_0 μ h_cases) }}
end

/-- Eigenvectors corresponding to distinct eigenvalues of a linear operator are linearly
    independent. (Lemma 5.10 of [axler2015])

    We use the eigenvalues as indexing set to ensure that there is only one eigenvector for each
    eigenvalue in the image of `xs`. -/
lemma eigenvectors_linear_independent (f : End K V) (μs : set K) (xs : μs → V)
  (h_eigenvec : ∀ μ : μs, f.has_eigenvector μ (xs μ)) :
  linear_independent K xs :=
complete_lattice.independent.linear_independent _
  (f.eigenspaces_independent.comp (coe : μs → K) subtype.coe_injective)
  (λ μ, (h_eigenvec μ).1) (λ μ, (h_eigenvec μ).2)

/-- The generalized eigenspace for a linear map `f`, a scalar `μ`, and an exponent `k ∈ ℕ` is the
kernel of `(f - μ • id) ^ k`. (Def 8.10 of [axler2015]). Furthermore, a generalized eigenspace for
some exponent `k` is contained in the generalized eigenspace for exponents larger than `k`. -/
def generalized_eigenspace (f : End R M) (μ : R) : ℕ →o submodule R M :=
{ to_fun    := λ k, ((f - algebra_map R (End R M) μ) ^ k).ker,
  monotone' := λ k m hm,
  begin
    simp only [← pow_sub_mul_pow _ hm],
    exact linear_map.ker_le_ker_comp
      ((f - algebra_map R (End R M) μ) ^ k) ((f - algebra_map R (End R M) μ) ^ (m - k)),
  end }

@[simp] lemma mem_generalized_eigenspace (f : End R M) (μ : R) (k : ℕ) (m : M) :
  m ∈ f.generalized_eigenspace μ k ↔ ((f - μ • 1)^k) m = 0 :=
iff.rfl

/-- A nonzero element of a generalized eigenspace is a generalized eigenvector.
    (Def 8.9 of [axler2015])-/
def has_generalized_eigenvector (f : End R M) (μ : R) (k : ℕ) (x : M) : Prop :=
x ≠ 0 ∧ x ∈ generalized_eigenspace f μ k

/-- A scalar `μ` is a generalized eigenvalue for a linear map `f` and an exponent `k ∈ ℕ` if there
    are generalized eigenvectors for `f`, `k`, and `μ`. -/
def has_generalized_eigenvalue (f : End R M) (μ : R) (k : ℕ) : Prop :=
generalized_eigenspace f μ k ≠ ⊥

/-- The generalized eigenrange for a linear map `f`, a scalar `μ`, and an exponent `k ∈ ℕ` is the
    range of `(f - μ • id) ^ k`. -/
def generalized_eigenrange (f : End R M) (μ : R) (k : ℕ) : submodule R M :=
((f - algebra_map R (End R M) μ) ^ k).range

/-- The exponent of a generalized eigenvalue is never 0. -/
lemma exp_ne_zero_of_has_generalized_eigenvalue {f : End R M} {μ : R} {k : ℕ}
  (h : f.has_generalized_eigenvalue μ k) : k ≠ 0 :=
begin
  rintro rfl,
  exact h linear_map.ker_id
end

/-- The union of the kernels of `(f - μ • id) ^ k` over all `k`. -/
def maximal_generalized_eigenspace (f : End R M) (μ : R) : submodule R M :=
⨆ k, f.generalized_eigenspace μ k

lemma generalized_eigenspace_le_maximal (f : End R M) (μ : R) (k : ℕ) :
  f.generalized_eigenspace μ k ≤ f.maximal_generalized_eigenspace μ :=
le_supr _ _

@[simp] lemma mem_maximal_generalized_eigenspace (f : End R M) (μ : R) (m : M) :
  m ∈ f.maximal_generalized_eigenspace μ ↔ ∃ (k : ℕ), ((f - μ • 1)^k) m = 0 :=
by simp only [maximal_generalized_eigenspace, ← mem_generalized_eigenspace,
  submodule.mem_supr_of_chain]

/-- If there exists a natural number `k` such that the kernel of `(f - μ • id) ^ k` is the
maximal generalized eigenspace, then this value is the least such `k`. If not, this value is not
meaningful. -/
noncomputable def maximal_generalized_eigenspace_index (f : End R M) (μ : R) :=
monotonic_sequence_limit_index (f.generalized_eigenspace μ)

/-- For an endomorphism of a Noetherian module, the maximal eigenspace is always of the form kernel
`(f - μ • id) ^ k` for some `k`. -/
lemma maximal_generalized_eigenspace_eq [h : is_noetherian R M] (f : End R M) (μ : R) :
  maximal_generalized_eigenspace f μ =
  f.generalized_eigenspace μ (maximal_generalized_eigenspace_index f μ) :=
begin
  rw is_noetherian_iff_well_founded at h,
  exact (well_founded.supr_eq_monotonic_sequence_limit h (f.generalized_eigenspace μ) : _),
end

/-- A generalized eigenvalue for some exponent `k` is also
    a generalized eigenvalue for exponents larger than `k`. -/
lemma has_generalized_eigenvalue_of_has_generalized_eigenvalue_of_le
  {f : End R M} {μ : R} {k : ℕ} {m : ℕ} (hm : k ≤ m) (hk : f.has_generalized_eigenvalue μ k) :
  f.has_generalized_eigenvalue μ m :=
begin
  unfold has_generalized_eigenvalue at *,
  contrapose! hk,
  rw [←le_bot_iff, ←hk],
  exact (f.generalized_eigenspace μ).monotone hm,
end

/-- The eigenspace is a subspace of the generalized eigenspace. -/
lemma eigenspace_le_generalized_eigenspace {f : End R M} {μ : R} {k : ℕ} (hk : 0 < k) :
  f.eigenspace μ ≤ f.generalized_eigenspace μ k :=
(f.generalized_eigenspace μ).monotone (nat.succ_le_of_lt hk)

/-- All eigenvalues are generalized eigenvalues. -/
lemma has_generalized_eigenvalue_of_has_eigenvalue
  {f : End R M} {μ : R} {k : ℕ} (hk : 0 < k) (hμ : f.has_eigenvalue μ) :
  f.has_generalized_eigenvalue μ k :=
begin
  apply has_generalized_eigenvalue_of_has_generalized_eigenvalue_of_le hk,
  rw [has_generalized_eigenvalue, generalized_eigenspace, order_hom.coe_fun_mk, pow_one],
  exact hμ,
end

/-- All generalized eigenvalues are eigenvalues. -/
lemma has_eigenvalue_of_has_generalized_eigenvalue
  {f : End R M} {μ : R} {k : ℕ} (hμ : f.has_generalized_eigenvalue μ k) :
  f.has_eigenvalue μ :=
begin
  intros contra, apply hμ,
  erw linear_map.ker_eq_bot at ⊢ contra, rw linear_map.coe_pow,
  exact function.injective.iterate contra k,
end

/-- Generalized eigenvalues are actually just eigenvalues. -/
@[simp] lemma has_generalized_eigenvalue_iff_has_eigenvalue
  {f : End R M} {μ : R} {k : ℕ} (hk : 0 < k) :
  f.has_generalized_eigenvalue μ k ↔ f.has_eigenvalue μ :=
⟨has_eigenvalue_of_has_generalized_eigenvalue, has_generalized_eigenvalue_of_has_eigenvalue hk⟩

/-- Every generalized eigenvector is a generalized eigenvector for exponent `finrank K V`.
    (Lemma 8.11 of [axler2015]) -/
lemma generalized_eigenspace_le_generalized_eigenspace_finrank
  [finite_dimensional K V] (f : End K V) (μ : K) (k : ℕ) :
  f.generalized_eigenspace μ k ≤ f.generalized_eigenspace μ (finrank K V) :=
ker_pow_le_ker_pow_finrank _ _

/-- Generalized eigenspaces for exponents at least `finrank K V` are equal to each other. -/
lemma generalized_eigenspace_eq_generalized_eigenspace_finrank_of_le [finite_dimensional K V]
  (f : End K V) (μ : K) {k : ℕ} (hk : finrank K V ≤ k) :
  f.generalized_eigenspace μ k = f.generalized_eigenspace μ (finrank K V) :=
ker_pow_eq_ker_pow_finrank_of_le hk

/-- If `f` maps a subspace `p` into itself, then the generalized eigenspace of the restriction
    of `f` to `p` is the part of the generalized eigenspace of `f` that lies in `p`. -/
lemma generalized_eigenspace_restrict
  (f : End R M) (p : submodule R M) (k : ℕ) (μ : R) (hfp : ∀ (x : M), x ∈ p → f x ∈ p) :
  generalized_eigenspace (linear_map.restrict f hfp) μ k =
    submodule.comap p.subtype (f.generalized_eigenspace μ k) :=
begin
  simp only [generalized_eigenspace, order_hom.coe_fun_mk, ← linear_map.ker_comp],
  induction k with k ih,
  { rw [pow_zero, pow_zero, linear_map.one_eq_id],
    apply (submodule.ker_subtype _).symm },
  { erw [pow_succ', pow_succ', linear_map.ker_comp, linear_map.ker_comp, ih,
      ← linear_map.ker_comp, linear_map.comp_assoc] },
end

/-- If `p` is an invariant submodule of an endomorphism `f`, then the `μ`-eigenspace of the
restriction of `f` to `p` is a submodule of the `μ`-eigenspace of `f`. -/
lemma eigenspace_restrict_le_eigenspace (f : End R M) {p : submodule R M}
  (hfp : ∀ x ∈ p, f x ∈ p) (μ : R) :
  (eigenspace (f.restrict hfp) μ).map p.subtype ≤ f.eigenspace μ :=
begin
  rintros a ⟨x, hx, rfl⟩,
  simp only [set_like.mem_coe, mem_eigenspace_iff, linear_map.restrict_apply] at hx ⊢,
  exact congr_arg coe hx
end

/-- Generalized eigenrange and generalized eigenspace for exponent `finrank K V` are disjoint. -/
lemma generalized_eigenvec_disjoint_range_ker [finite_dimensional K V] (f : End K V) (μ : K) :
  disjoint (f.generalized_eigenrange μ (finrank K V)) (f.generalized_eigenspace μ (finrank K V))  :=
begin
  have h := calc
    submodule.comap ((f - algebra_map _ _ μ) ^ finrank K V)
        (f.generalized_eigenspace μ (finrank K V))
      = ((f - algebra_map _ _ μ) ^ finrank K V *
          (f - algebra_map K (End K V) μ) ^ finrank K V).ker :
        by { simpa only [generalized_eigenspace, order_hom.coe_fun_mk, ← linear_map.ker_comp] }
  ... = f.generalized_eigenspace μ (finrank K V + finrank K V) :
        by { rw ←pow_add, refl }
  ... = f.generalized_eigenspace μ (finrank K V) :
        by { rw generalized_eigenspace_eq_generalized_eigenspace_finrank_of_le, linarith },
  rw [disjoint, generalized_eigenrange, linear_map.range_eq_map, submodule.map_inf_eq_map_inf_comap,
    top_inf_eq, h],
  apply submodule.map_comap_le
end

/-- If an invariant subspace `p` of an endomorphism `f` is disjoint from the `μ`-eigenspace of `f`,
then the restriction of `f` to `p` has trivial `μ`-eigenspace. -/
lemma eigenspace_restrict_eq_bot {f : End R M} {p : submodule R M}
  (hfp : ∀ x ∈ p, f x ∈ p) {μ : R} (hμp : disjoint (f.eigenspace μ) p) :
  eigenspace (f.restrict hfp) μ = ⊥ :=
begin
  rw eq_bot_iff,
  intros x hx,
  simpa using hμp ⟨eigenspace_restrict_le_eigenspace f hfp μ ⟨x, hx, rfl⟩, x.prop⟩,
end

/-- The generalized eigenspace of an eigenvalue has positive dimension for positive exponents. -/
lemma pos_finrank_generalized_eigenspace_of_has_eigenvalue [finite_dimensional K V]
  {f : End K V} {k : ℕ} {μ : K} (hx : f.has_eigenvalue μ) (hk : 0 < k):
  0 < finrank K (f.generalized_eigenspace μ k) :=
calc
    0 = finrank K (⊥ : submodule K V) : by rw finrank_bot
  ... < finrank K (f.eigenspace μ) : submodule.finrank_lt_finrank_of_lt (bot_lt_iff_ne_bot.2 hx)
  ... ≤ finrank K (f.generalized_eigenspace μ k) :
    submodule.finrank_mono ((f.generalized_eigenspace μ).monotone (nat.succ_le_of_lt hk))

/-- A linear map maps a generalized eigenrange into itself. -/
lemma map_generalized_eigenrange_le {f : End K V} {μ : K} {n : ℕ} :
  submodule.map f (f.generalized_eigenrange μ n) ≤ f.generalized_eigenrange μ n :=
calc submodule.map f (f.generalized_eigenrange μ n)
       = (f * ((f - algebra_map _ _ μ) ^ n)).range : (linear_map.range_comp _ _).symm
   ... = (((f - algebra_map _ _ μ) ^ n) * f).range : by rw algebra.mul_sub_algebra_map_pow_commutes
   ... = submodule.map ((f - algebra_map _ _ μ) ^ n) f.range : linear_map.range_comp _ _
   ... ≤ f.generalized_eigenrange μ n : linear_map.map_le_range

/-- The generalized eigenvectors span the entire vector space (Lemma 8.21 of [axler2015]). -/
lemma supr_generalized_eigenspace_eq_top [is_alg_closed K] [finite_dimensional K V] (f : End K V) :
  (⨆ (μ : K) (k : ℕ), f.generalized_eigenspace μ k) = ⊤ :=
begin
  -- We prove the claim by strong induction on the dimension of the vector space.
  unfreezingI { induction h_dim : finrank K V using nat.strong_induction_on
  with n ih generalizing V },
  cases n,
  -- If the vector space is 0-dimensional, the result is trivial.
  { rw ←top_le_iff,
    simp only [finrank_eq_zero.1 (eq.trans finrank_top h_dim), bot_le] },
  -- Otherwise the vector space is nontrivial.
  { haveI : nontrivial V := finrank_pos_iff.1 (by { rw h_dim, apply nat.zero_lt_succ }),
    -- Hence, `f` has an eigenvalue `μ₀`.
    obtain ⟨μ₀, hμ₀⟩ : ∃ μ₀, f.has_eigenvalue μ₀ := exists_eigenvalue f,
    -- We define `ES` to be the generalized eigenspace
    let ES := f.generalized_eigenspace μ₀ (finrank K V),
    -- and `ER` to be the generalized eigenrange.
    let ER := f.generalized_eigenrange μ₀ (finrank K V),
    -- `f` maps `ER` into itself.
    have h_f_ER : ∀ (x : V), x ∈ ER → f x ∈ ER,
      from λ x hx, map_generalized_eigenrange_le (submodule.mem_map_of_mem hx),
    -- Therefore, we can define the restriction `f'` of `f` to `ER`.
    let f' : End K ER := f.restrict h_f_ER,
    -- The dimension of `ES` is positive
    have h_dim_ES_pos : 0 < finrank K ES,
    { dsimp only [ES],
      rw h_dim,
      apply pos_finrank_generalized_eigenspace_of_has_eigenvalue hμ₀ (nat.zero_lt_succ n) },
    -- and the dimensions of `ES` and `ER` add up to `finrank K V`.
    have h_dim_add : finrank K ER + finrank K ES = finrank K V,
    { apply linear_map.finrank_range_add_finrank_ker },
    -- Therefore the dimension `ER` mus be smaller than `finrank K V`.
    have h_dim_ER : finrank K ER < n.succ, by linarith,
    -- This allows us to apply the induction hypothesis on `ER`:
    have ih_ER : (⨆ (μ : K) (k : ℕ), f'.generalized_eigenspace μ k) = ⊤,
      from ih (finrank K ER) h_dim_ER f' rfl,
    -- The induction hypothesis gives us a statement about subspaces of `ER`. We can transfer this
    -- to a statement about subspaces of `V` via `submodule.subtype`:
    have ih_ER' : (⨆ (μ : K) (k : ℕ), (f'.generalized_eigenspace μ k).map ER.subtype) = ER,
      by simp only [(submodule.map_supr _ _).symm, ih_ER, submodule.map_subtype_top ER],
    -- Moreover, every generalized eigenspace of `f'` is contained in the corresponding generalized
    -- eigenspace of `f`.
    have hff' : ∀ μ k,
        (f'.generalized_eigenspace μ k).map ER.subtype ≤ f.generalized_eigenspace μ k,
    { intros,
      rw generalized_eigenspace_restrict,
      apply submodule.map_comap_le },
    -- It follows that `ER` is contained in the span of all generalized eigenvectors.
    have hER : ER ≤ ⨆ (μ : K) (k : ℕ), f.generalized_eigenspace μ k,
    { rw ← ih_ER',
      apply supr_le_supr _,
      exact λ μ, supr_le_supr (λ k, hff' μ k), },
    -- `ES` is contained in this span by definition.
    have hES : ES ≤ ⨆ (μ : K) (k : ℕ), f.generalized_eigenspace μ k,
      from le_trans
        (le_supr (λ k, f.generalized_eigenspace μ₀ k) (finrank K V))
        (le_supr (λ (μ : K), ⨆ (k : ℕ), f.generalized_eigenspace μ k) μ₀),
    -- Moreover, we know that `ER` and `ES` are disjoint.
    have h_disjoint : disjoint ER ES,
      from generalized_eigenvec_disjoint_range_ker f μ₀,
    -- Since the dimensions of `ER` and `ES` add up to the dimension of `V`, it follows that the
    -- span of all generalized eigenvectors is all of `V`.
    show (⨆ (μ : K) (k : ℕ), f.generalized_eigenspace μ k) = ⊤,
    { rw [←top_le_iff, ←submodule.eq_top_of_disjoint ER ES h_dim_add h_disjoint],
      apply sup_le hER hES } }
end

end End
end module


/-
Copyright (c) 2022 Jujian Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andrew Yang, Jujian Zhang
-/

import group_theory.monoid_localization
import ring_theory.localization.basic
import algebra.algebra.restrict_scalars

/-!
# Localized Module

Given a commutative ring `R`, a multiplicative subset `S ⊆ R` and an `R`-module `M`, we can localize
`M` by `S`. This gives us a `localization S`-module.

## Main definitions

* `localized_module.r` : the equivalence relation defining this localization, namely
  `(m, s) ≈ (m', s')` if and only if if there is some `u : S` such that `u • s' • m = u • s • m'`.
* `localized_module M S` : the localized module by `S`.
* `localized_module.mk`  : the canonical map sending `(m, s) : M × S ↦ m/s : localized_module M S`
* `localized_module.lift_on` : any well defined function `f : M × S → α` respecting `r` descents to
  a function `localized_module M S → α`
* `localized_module.lift_on₂` : any well defined function `f : M × S → M × S → α` respecting `r`
  descents to a function `localized_module M S → localized_module M S`
* `localized_module.mk_add_mk` : in the localized module
  `mk m s + mk m' s' = mk (s' • m + s • m') (s * s')`
* `localized_module.mk_smul_mk` : in the localized module, for any `r : R`, `s t : S`, `m : M`,
  we have `mk r s • mk m t = mk (r • m) (s * t)` where `mk r s : localization S` is localized ring
  by `S`.
* `localized_module.is_module` : `localized_module M S` is a `localization S`-module.

## Future work

 * Redefine `localization` for monoids and rings to coincide with `localized_module`.
-/

namespace localized_module

universes u v

variables {R : Type u} [comm_semiring R] (S : submonoid R)
variables (M : Type v) [add_comm_monoid M] [module R M]

/--The equivalence relation on `M × S` where `(m1, s1) ≈ (m2, s2)` if and only if
for some (u : S), u * (s2 • m1 - s1 • m2) = 0-/
def r (a b : M × S) : Prop :=
∃ (u : S), u • b.2 • a.1 = u • a.2 • b.1

lemma r.is_equiv : is_equiv _ (r S M) :=
{ refl := λ ⟨m, s⟩, ⟨1, by rw [one_smul]⟩,
  trans := λ ⟨m1, s1⟩ ⟨m2, s2⟩ ⟨m3, s3⟩ ⟨u1, hu1⟩ ⟨u2, hu2⟩, begin
    use u1 * u2 * s2,
    -- Put everything in the same shape, sorting the terms using `simp`
    have hu1' := congr_arg ((•) (u2 * s3)) hu1.symm,
    have hu2' := congr_arg ((•) (u1 * s1)) hu2.symm,
    simp only [← mul_smul, smul_assoc, mul_assoc, mul_comm, mul_left_comm] at ⊢ hu1' hu2',
    rw [hu2', hu1']
  end,
  symm := λ ⟨m1, s1⟩ ⟨m2, s2⟩ ⟨u, hu⟩, ⟨u, hu.symm⟩ }

instance r.setoid : setoid (M × S) :=
{ r := r S M,
  iseqv := ⟨(r.is_equiv S M).refl, (r.is_equiv S M).symm, (r.is_equiv S M).trans⟩ }

-- TODO: change `localization` to use `r'` instead of `r` so that the two types are also defeq,
-- `localization S = localized_module S R`.
example {R} [comm_semiring R] (S : submonoid R) : ⇑(localization.r' S) = localized_module.r S R :=
rfl

/--
If `S` is a multiplicative subset of a ring `R` and `M` an `R`-module, then
we can localize `M` by `S`.
-/
@[nolint has_nonempty_instance]
def _root_.localized_module : Type (max u v) := quotient (r.setoid S M)

section
variables {M S}

/--The canonical map sending `(m, s) ↦ m/s`-/
def mk (m : M) (s : S) : localized_module S M :=
quotient.mk ⟨m, s⟩

lemma mk_eq {m m' : M} {s s' : S} : mk m s = mk m' s' ↔ ∃ (u : S), u • s' • m = u • s • m' :=
quotient.eq

@[elab_as_eliminator]
lemma induction_on {β : localized_module S M → Prop} (h : ∀ (m : M) (s : S), β (mk m s)) :
  ∀ (x : localized_module S M), β x :=
by { rintro ⟨⟨m, s⟩⟩, exact h m s }

@[elab_as_eliminator]
lemma induction_on₂ {β : localized_module S M → localized_module S M → Prop}
  (h : ∀ (m m' : M) (s s' : S), β (mk m s) (mk m' s')) : ∀ x y, β x y :=
by { rintro ⟨⟨m, s⟩⟩ ⟨⟨m', s'⟩⟩, exact h m m' s s' }

/--If `f : M × S → α` respects the equivalence relation `localized_module.r`, then
`f` descents to a map `localized_module M S → α`.
-/
def lift_on {α : Type*} (x : localized_module S M) (f : M × S → α)
  (wd : ∀ (p p' : M × S) (h1 : p ≈ p'), f p = f p') : α :=
quotient.lift_on x f wd

lemma lift_on_mk {α : Type*} {f : M × S → α}
  (wd : ∀ (p p' : M × S) (h1 : p ≈ p'), f p = f p')
  (m : M) (s : S) :
  lift_on (mk m s) f wd = f ⟨m, s⟩ :=
by convert quotient.lift_on_mk f wd ⟨m, s⟩

/--If `f : M × S → M × S → α` respects the equivalence relation `localized_module.r`, then
`f` descents to a map `localized_module M S → localized_module M S → α`.
-/
def lift_on₂ {α : Type*} (x y : localized_module S M) (f : (M × S) → (M × S) → α)
  (wd : ∀ (p q p' q' : M × S) (h1 : p ≈ p') (h2 : q ≈ q'), f p q = f p' q') : α :=
quotient.lift_on₂ x y f wd

lemma lift_on₂_mk {α : Type*} (f : (M × S) → (M × S) → α)
  (wd : ∀ (p q p' q' : M × S) (h1 : p ≈ p') (h2 : q ≈ q'), f p q = f p' q')
  (m m' : M) (s s' : S) :
  lift_on₂ (mk m s) (mk m' s') f wd = f ⟨m, s⟩ ⟨m', s'⟩ :=
by convert quotient.lift_on₂_mk f wd _ _

instance : has_zero (localized_module S M) := ⟨mk 0 1⟩
@[simp] lemma zero_mk (s : S) : mk (0 : M) s = 0 :=
mk_eq.mpr ⟨1, by rw [one_smul, smul_zero, smul_zero, one_smul]⟩

instance : has_add (localized_module S M) :=
{ add := λ p1 p2, lift_on₂ p1 p2 (λ x y, mk (y.2 • x.1 + x.2 • y.1) (x.2 * y.2)) $
    λ ⟨m1, s1⟩ ⟨m2, s2⟩ ⟨m1', s1'⟩ ⟨m2', s2'⟩ ⟨u1, hu1⟩ ⟨u2, hu2⟩, mk_eq.mpr ⟨u1 * u2, begin
      -- Put everything in the same shape, sorting the terms using `simp`
      have hu1' := congr_arg ((•) (u2 * s2 * s2')) hu1,
      have hu2' := congr_arg ((•) (u1 * s1 * s1')) hu2,
      simp only [smul_add, ← mul_smul, smul_assoc, mul_assoc, mul_comm, mul_left_comm]
        at ⊢ hu1' hu2',
      rw [hu1', hu2']
    end⟩ }

lemma mk_add_mk {m1 m2 : M} {s1 s2 : S} :
  mk m1 s1 + mk m2 s2 = mk (s2 • m1 + s1 • m2) (s1 * s2) :=
mk_eq.mpr $ ⟨1, by dsimp only; rw [one_smul]⟩

private lemma add_assoc' (x y z : localized_module S M) :
  x + y + z = x + (y + z) :=
begin
  induction x using localized_module.induction_on with mx sx,
  induction y using localized_module.induction_on with my sy,
  induction z using localized_module.induction_on with mz sz,
  simp only [mk_add_mk, smul_add],
  refine mk_eq.mpr ⟨1, _⟩,
  rw [one_smul, one_smul],
  congr' 1,
  { rw [mul_assoc] },
  { rw [eq_comm, mul_comm, add_assoc, mul_smul, mul_smul, ←mul_smul sx sz, mul_comm, mul_smul], },
end

private lemma add_comm' (x y : localized_module S M) :
  x + y = y + x :=
localized_module.induction_on₂ (λ m m' s s', by rw [mk_add_mk, mk_add_mk, add_comm, mul_comm]) x y

private lemma zero_add' (x : localized_module S M) : 0 + x = x :=
induction_on (λ m s, by rw [← zero_mk s, mk_add_mk, smul_zero, zero_add, mk_eq];
  exact ⟨1, by rw [one_smul, mul_smul, one_smul]⟩) x

private lemma add_zero' (x : localized_module S M) : x + 0 = x :=
induction_on (λ m s, by rw [← zero_mk s, mk_add_mk, smul_zero, add_zero, mk_eq];
  exact ⟨1, by rw [one_smul, mul_smul, one_smul]⟩) x

instance has_nat_smul : has_smul ℕ (localized_module S M) :=
{ smul := λ n, nsmul_rec n }

private lemma nsmul_zero' (x : localized_module S M) : (0 : ℕ) • x = 0 :=
localized_module.induction_on (λ _ _, rfl) x
private lemma nsmul_succ' (n : ℕ) (x : localized_module S M) :
  n.succ • x = x + n • x :=
localized_module.induction_on (λ _ _, rfl) x

instance : add_comm_monoid (localized_module S M) :=
{ add := (+),
  add_assoc := add_assoc',
  zero := 0,
  zero_add := zero_add',
  add_zero := add_zero',
  nsmul := (•),
  nsmul_zero' := nsmul_zero',
  nsmul_succ' := nsmul_succ',
  add_comm := add_comm' }

instance {M : Type*} [add_comm_group M] [module R M] :
  add_comm_group (localized_module S M) :=
{ neg := λ p, lift_on p (λ x, localized_module.mk (-x.1) x.2)
    (λ ⟨m1, s1⟩ ⟨m2, s2⟩ ⟨u, hu⟩, by { rw mk_eq, exact ⟨u, by simpa⟩ }),
  add_left_neg := λ p, begin
    obtain ⟨⟨m, s⟩, rfl : mk m s = p⟩ := quotient.exists_rep p,
    change (mk m s).lift_on (λ x, mk (-x.1) x.2)
      (λ ⟨m1, s1⟩ ⟨m2, s2⟩ ⟨u, hu⟩, by { rw mk_eq, exact ⟨u, by simpa⟩ }) + mk m s = 0,
    rw [lift_on_mk, mk_add_mk],
    simp
  end,
  ..(show add_comm_monoid (localized_module S M), by apply_instance) }

lemma mk_neg {M : Type*} [add_comm_group M] [module R M] {m : M} {s : S} :
  mk (-m) s = - mk m s := rfl

instance {A : Type*} [semiring A] [algebra R A] {S : submonoid R} :
  semiring (localized_module S A) :=
{ mul := λ m₁ m₂, lift_on₂ m₁ m₂ (λ x₁ x₂, localized_module.mk (x₁.1 * x₂.1) (x₁.2 * x₂.2))
    (begin
      rintros ⟨a₁, s₁⟩ ⟨a₂, s₂⟩ ⟨b₁, t₁⟩ ⟨b₂, t₂⟩ ⟨u₁, e₁⟩ ⟨u₂, e₂⟩,
      rw mk_eq,
      use u₁ * u₂,
      dsimp only at ⊢ e₁ e₂,
      rw eq_comm,
      transitivity (u₁ • t₁ • a₁) • u₂ • t₂ • a₂,
      rw [e₁, e₂], swap, rw eq_comm,
      all_goals { rw [smul_smul, mul_mul_mul_comm, ← smul_eq_mul, ← smul_eq_mul A,
        smul_smul_smul_comm, mul_smul, mul_smul] }
    end),
  left_distrib := begin
    intros x₁ x₂ x₃,
    obtain ⟨⟨a₁, s₁⟩, rfl : mk a₁ s₁ = x₁⟩ := quotient.exists_rep x₁,
    obtain ⟨⟨a₂, s₂⟩, rfl : mk a₂ s₂ = x₂⟩ := quotient.exists_rep x₂,
    obtain ⟨⟨a₃, s₃⟩, rfl : mk a₃ s₃ = x₃⟩ := quotient.exists_rep x₃,
    apply mk_eq.mpr _,
    use 1,
    simp only [one_mul, smul_add, mul_add, mul_smul_comm, smul_smul, ← mul_assoc, mul_right_comm]
  end,
  right_distrib := begin
    intros x₁ x₂ x₃,
    obtain ⟨⟨a₁, s₁⟩, rfl : mk a₁ s₁ = x₁⟩ := quotient.exists_rep x₁,
    obtain ⟨⟨a₂, s₂⟩, rfl : mk a₂ s₂ = x₂⟩ := quotient.exists_rep x₂,
    obtain ⟨⟨a₃, s₃⟩, rfl : mk a₃ s₃ = x₃⟩ := quotient.exists_rep x₃,
    apply mk_eq.mpr _,
    use 1,
    simp only [one_mul, smul_add, add_mul, smul_smul, ← mul_assoc, smul_mul_assoc, mul_right_comm],
  end,
  zero_mul := begin
    intros x,
    obtain ⟨⟨a, s⟩, rfl : mk a s = x⟩ := quotient.exists_rep x,
    exact mk_eq.mpr ⟨1, by simp only [zero_mul, smul_zero]⟩,
  end,
  mul_zero := begin
    intros x,
    obtain ⟨⟨a, s⟩, rfl : mk a s = x⟩ := quotient.exists_rep x,
    exact mk_eq.mpr ⟨1, by simp only [mul_zero, smul_zero]⟩,
  end,
  mul_assoc := begin
    intros x₁ x₂ x₃,
    obtain ⟨⟨a₁, s₁⟩, rfl : mk a₁ s₁ = x₁⟩ := quotient.exists_rep x₁,
    obtain ⟨⟨a₂, s₂⟩, rfl : mk a₂ s₂ = x₂⟩ := quotient.exists_rep x₂,
    obtain ⟨⟨a₃, s₃⟩, rfl : mk a₃ s₃ = x₃⟩ := quotient.exists_rep x₃,
    apply mk_eq.mpr _,
    use 1,
    simp only [one_mul, smul_smul, ← mul_assoc, mul_right_comm],
  end,
  one := mk 1 (1 : S),
  one_mul := begin
    intros x,
    obtain ⟨⟨a, s⟩, rfl : mk a s = x⟩ := quotient.exists_rep x,
    exact mk_eq.mpr ⟨1, by simp only [one_mul, one_smul]⟩,
  end,
  mul_one := begin
    intros x,
    obtain ⟨⟨a, s⟩, rfl : mk a s = x⟩ := quotient.exists_rep x,
    exact mk_eq.mpr ⟨1, by simp only [mul_one, one_smul]⟩,
  end,
  ..(show add_comm_monoid (localized_module S A), by apply_instance) }

instance {A : Type*} [comm_semiring A] [algebra R A] {S : submonoid R} :
  comm_semiring (localized_module S A) :=
{ mul_comm := begin
    intros x₁ x₂,
    obtain ⟨⟨a₁, s₁⟩, rfl : mk a₁ s₁ = x₁⟩ := quotient.exists_rep x₁,
    obtain ⟨⟨a₂, s₂⟩, rfl : mk a₂ s₂ = x₂⟩ := quotient.exists_rep x₂,
    exact mk_eq.mpr ⟨1, by simp only [one_smul, mul_comm]⟩
  end,
  ..(show semiring (localized_module S A), by apply_instance) }

instance {A : Type*} [ring A] [algebra R A] {S : submonoid R} :
  ring (localized_module S A) :=
{ ..(show add_comm_group (localized_module S A), by apply_instance),
  ..(show monoid (localized_module S A), by apply_instance),
  ..(show distrib (localized_module S A), by apply_instance) }

instance {A : Type*} [comm_ring A] [algebra R A] {S : submonoid R} :
  comm_ring (localized_module S A) :=
{ mul_comm := begin
    intros x₁ x₂,
    obtain ⟨⟨a₁, s₁⟩, rfl : mk a₁ s₁ = x₁⟩ := quotient.exists_rep x₁,
    obtain ⟨⟨a₂, s₂⟩, rfl : mk a₂ s₂ = x₂⟩ := quotient.exists_rep x₂,
    exact mk_eq.mpr ⟨1, by simp only [one_smul, mul_comm]⟩
  end,
  ..(show ring (localized_module S A), by apply_instance) }

lemma mk_mul_mk {A : Type*} [semiring A] [algebra R A] {a₁ a₂ : A} {s₁ s₂ : S} :
  mk a₁ s₁ * mk a₂ s₂ = mk (a₁ * a₂) (s₁ * s₂) :=
rfl

instance : has_smul (localization S) (localized_module S M) :=
{ smul := λ f x, localization.lift_on f (λ r s, lift_on x (λ p, mk (r • p.1) (s * p.2))
    begin
      rintros ⟨m1, t1⟩ ⟨m2, t2⟩ ⟨u, h⟩,
      refine mk_eq.mpr ⟨u, _⟩,
      have h' := congr_arg ((•) (s • r)) h,
      simp only [← mul_smul, smul_assoc, mul_comm, mul_left_comm, submonoid.smul_def,
        submonoid.coe_mul] at ⊢ h',
      rw h',
    end) begin
      induction x using localized_module.induction_on with m t,
      rintros r r' s s' h,
      simp only [lift_on_mk, lift_on_mk, mk_eq],
      obtain ⟨u, eq1⟩ := localization.r_iff_exists.mp h,
      use u,
      have eq1' := congr_arg (• (t • m)) eq1,
      simp only [← mul_smul, smul_assoc, submonoid.smul_def, submonoid.coe_mul] at ⊢ eq1',
      ring_nf at ⊢ eq1',
      rw eq1'
    end }

lemma mk_smul_mk (r : R) (m : M) (s t : S) :
  localization.mk r s • mk m t = mk (r • m) (s * t) :=
begin
  unfold has_smul.smul,
  rw [localization.lift_on_mk, lift_on_mk],
end

private lemma one_smul' (m : localized_module S M) :
  (1 : localization S) • m = m :=
begin
  induction m using localized_module.induction_on with m s,
  rw [← localization.mk_one, mk_smul_mk, one_smul, one_mul],
end

private lemma mul_smul' (x y : localization S) (m : localized_module S M) :
  (x * y) • m = x • y • m :=
begin
  induction x using localization.induction_on with data,
  induction y using localization.induction_on with data',
  rcases ⟨data, data'⟩ with ⟨⟨r, s⟩, ⟨r', s'⟩⟩,

  induction m using localized_module.induction_on with m t,
  rw [localization.mk_mul, mk_smul_mk, mk_smul_mk, mk_smul_mk, mul_smul, mul_assoc],
end

private lemma smul_add' (x : localization S) (y z : localized_module S M) :
  x • (y + z) = x • y + x • z :=
begin
  induction x using localization.induction_on with data,
  rcases data with ⟨r, u⟩,
  induction y using localized_module.induction_on with m s,
  induction z using localized_module.induction_on with n t,
  rw [mk_smul_mk, mk_smul_mk, mk_add_mk, mk_smul_mk, mk_add_mk, mk_eq],
  use 1,
  simp only [one_smul, smul_add, ← mul_smul, submonoid.smul_def, submonoid.coe_mul],
  ring_nf
end

private lemma smul_zero' (x : localization S) :
  x • (0 : localized_module S M) = 0 :=
begin
  induction x using localization.induction_on with data,
  rcases data with ⟨r, s⟩,
  rw [←zero_mk s, mk_smul_mk, smul_zero, zero_mk, zero_mk],
end

private lemma add_smul' (x y : localization S) (z : localized_module S M) :
  (x + y) • z = x • z + y • z :=
begin
  induction x using localization.induction_on with datax,
  induction y using localization.induction_on with datay,
  induction z using localized_module.induction_on with m t,
  rcases ⟨datax, datay⟩ with ⟨⟨r, s⟩, ⟨r', s'⟩⟩,
  rw [localization.add_mk, mk_smul_mk, mk_smul_mk, mk_smul_mk, mk_add_mk, mk_eq],
  use 1,
  simp only [one_smul, add_smul, smul_add, ← mul_smul, submonoid.smul_def, submonoid.coe_mul,
    submonoid.coe_one],
  rw add_comm, -- Commutativity of addition in the module is not applied by `ring`.
  ring_nf,
end

private lemma zero_smul' (x : localized_module S M) :
  (0 : localization S) • x = 0 :=
begin
  induction x using localized_module.induction_on with m s,
  rw [← localization.mk_zero s, mk_smul_mk, zero_smul, zero_mk],
end

instance is_module : module (localization S) (localized_module S M) :=
{ smul := (•),
  one_smul := one_smul',
  mul_smul := mul_smul',
  smul_add := smul_add',
  smul_zero := smul_zero',
  add_smul := add_smul',
  zero_smul := zero_smul' }

@[simp] lemma mk_cancel_common_left (s' s : S) (m : M) : mk (s' • m) (s' * s) = mk m s :=
mk_eq.mpr ⟨1, by { simp only [mul_smul, one_smul], rw smul_comm }⟩

@[simp] lemma mk_cancel (s : S) (m : M) : mk (s • m) s = mk m 1 :=
mk_eq.mpr ⟨1, by simp⟩

@[simp] lemma mk_cancel_common_right (s s' : S) (m : M) : mk (s' • m) (s * s') = mk m s :=
mk_eq.mpr ⟨1, by simp [mul_smul]⟩

instance is_module' : module R (localized_module S M) :=
{ ..module.comp_hom (localized_module S M) $ (algebra_map R (localization S)) }

lemma smul'_mk (r : R) (s : S) (m : M) : r • mk m s = mk (r • m) s :=
by erw [mk_smul_mk r m 1 s, one_mul]

instance {A : Type*} [semiring A] [algebra R A] :
  algebra (localization S) (localized_module S A) :=
algebra.of_module
begin
  intros r x₁ x₂,
  obtain ⟨y, s, rfl : is_localization.mk' _ y s = r⟩ := is_localization.mk'_surjective S r,
  obtain ⟨⟨a₁, s₁⟩, rfl : mk a₁ s₁ = x₁⟩ := quotient.exists_rep x₁,
  obtain ⟨⟨a₂, s₂⟩, rfl : mk a₂ s₂ = x₂⟩ := quotient.exists_rep x₂,
  rw [mk_mul_mk, ← localization.mk_eq_mk', mk_smul_mk, mk_smul_mk, mk_mul_mk,
    mul_assoc, smul_mul_assoc],
end
begin
  intros r x₁ x₂,
  obtain ⟨y, s, rfl : is_localization.mk' _ y s = r⟩ := is_localization.mk'_surjective S r,
  obtain ⟨⟨a₁, s₁⟩, rfl : mk a₁ s₁ = x₁⟩ := quotient.exists_rep x₁,
  obtain ⟨⟨a₂, s₂⟩, rfl : mk a₂ s₂ = x₂⟩ := quotient.exists_rep x₂,
  rw [mk_mul_mk, ← localization.mk_eq_mk', mk_smul_mk, mk_smul_mk, mk_mul_mk,
    mul_left_comm, mul_smul_comm]
end

lemma algebra_map_mk {A : Type*} [semiring A] [algebra R A] (a : R) (s : S) :
  algebra_map _ _ (localization.mk a s) = mk (algebra_map R A a) s :=
begin
  rw [algebra.algebra_map_eq_smul_one],
  change _ • mk _ _ = _,
  rw [mk_smul_mk, algebra.algebra_map_eq_smul_one, mul_one]
end

instance : is_scalar_tower R (localization S) (localized_module S M) :=
restrict_scalars.is_scalar_tower R (localization S) (localized_module S M)

instance algebra' {A : Type*} [semiring A] [algebra R A] :
  algebra R (localized_module S A) :=
{ commutes' := begin
    intros r x,
    obtain ⟨⟨a, s⟩, rfl : mk a s = x⟩ := quotient.exists_rep x,
    dsimp,
    rw [← localization.mk_one_eq_algebra_map, algebra_map_mk, mk_mul_mk, mk_mul_mk, mul_comm,
      algebra.commutes],
  end,
  smul_def' := begin
    intros r x,
    obtain ⟨⟨a, s⟩, rfl : mk a s = x⟩ := quotient.exists_rep x,
    dsimp,
    rw [← localization.mk_one_eq_algebra_map, algebra_map_mk, mk_mul_mk, smul'_mk,
      algebra.smul_def, one_mul],
  end,
  ..(algebra_map (localization S) (localized_module S A)).comp (algebra_map R $ localization S),
  ..(show module R (localized_module S A), by apply_instance) }
section

variables (S M)

/-- The function `m ↦ m / 1` as an `R`-linear map.
-/
@[simps]
def mk_linear_map : M →ₗ[R] localized_module S M :=
{ to_fun := λ m, mk m 1,
  map_add' := λ x y, by simp [mk_add_mk],
  map_smul' := λ r x, (smul'_mk _ _ _).symm }

end

/--
For any `s : S`, there is an `R`-linear map given by `a/b ↦ a/(b*s)`.
-/
@[simps]
def div_by (s : S) : localized_module S M →ₗ[R] localized_module S M :=
{ to_fun := λ p, p.lift_on (λ p, mk p.1 (s * p.2)) $ λ ⟨a, b⟩ ⟨a', b'⟩ ⟨c, eq1⟩, mk_eq.mpr ⟨c,
  begin
    rw [mul_smul, mul_smul, smul_comm c, eq1, smul_comm s];
    apply_instance,
  end⟩,
  map_add' := λ x y, x.induction_on₂
    (begin
      intros m₁ m₂ t₁ t₂,
      simp only [mk_add_mk, localized_module.lift_on_mk, mul_smul, ←smul_add, mul_assoc,
        mk_cancel_common_left s],
      rw show s * (t₁ * t₂) = t₁ * (s * t₂), by { ext, simp only [submonoid.coe_mul], ring },
    end) y,
  map_smul' := λ r x, x.induction_on $ by { intros, simp [localized_module.lift_on_mk, smul'_mk] } }

lemma div_by_mul_by (s : S) (p : localized_module S M) :
  div_by s (algebra_map R (module.End R (localized_module S M)) s p) = p :=
p.induction_on
begin
  intros m t,
  simp only [localized_module.lift_on_mk, module.algebra_map_End_apply, smul'_mk, div_by_apply],
  erw mk_cancel_common_left s t,
end

lemma mul_by_div_by (s : S) (p : localized_module S M) :
  algebra_map R (module.End R (localized_module S M)) s (div_by s p) = p :=
p.induction_on
begin
  intros m t,
  simp only [localized_module.lift_on_mk, div_by_apply, module.algebra_map_End_apply, smul'_mk],
  erw mk_cancel_common_left s t,
end

end

end localized_module

section is_localized_module

universes u v

variables {R : Type*} [comm_ring R] (S : submonoid R)
variables {M M' M'' : Type*} [add_comm_monoid M] [add_comm_monoid M'] [add_comm_monoid M'']
variables [module R M] [module R M'] [module R M''] (f : M →ₗ[R] M') (g : M →ₗ[R] M'')

/--
The characteristic predicate for localized module.
`is_localized_module S f` describes that `f : M ⟶ M'` is the localization map identifying `M'` as
`localized_module S M`.
-/
class is_localized_module : Prop :=
(map_units [] : ∀ (x : S), is_unit (algebra_map R (module.End R M') x))
(surj [] : ∀ y : M', ∃ (x : M × S), x.2 • y = f x.1)
(eq_iff_exists [] : ∀ {x₁ x₂}, f x₁ = f x₂ ↔ ∃ c : S, c • x₂ = c • x₁)

namespace localized_module

/--
If `g` is a linear map `M → M''` such that all scalar multiplication by `s : S` is invertible, then
there is a linear map `localized_module S M → M''`.
-/
noncomputable def lift' (g : M →ₗ[R] M'')
  (h : ∀ (x : S), is_unit ((algebra_map R (module.End R M'')) x)) :
  (localized_module S M) → M'' :=
λ m, m.lift_on (λ p, (h $ p.2).unit⁻¹ $ g p.1) $ λ ⟨m, s⟩ ⟨m', s'⟩ ⟨c, eq1⟩,
begin
  generalize_proofs h1 h2,
  erw [module.End_algebra_map_is_unit_inv_apply_eq_iff, ←h2.unit⁻¹.1.map_smul], symmetry,
  erw [module.End_algebra_map_is_unit_inv_apply_eq_iff], dsimp,
  have : c • s • g m' = c • s' • g m,
  { erw [←g.map_smul, ←g.map_smul, ←g.map_smul, ←g.map_smul, eq1], refl, },
  have : function.injective (h c).unit.inv,
  { rw function.injective_iff_has_left_inverse, refine ⟨(h c).unit, _⟩,
    intros x,
    change ((h c).unit.1 * (h c).unit.inv) x = x,
    simp only [units.inv_eq_coe_inv, is_unit.mul_coe_inv, linear_map.one_apply], },
  apply_fun (h c).unit.inv,
  erw [units.inv_eq_coe_inv, module.End_algebra_map_is_unit_inv_apply_eq_iff,
    ←(h c).unit⁻¹.1.map_smul], symmetry,
  erw [module.End_algebra_map_is_unit_inv_apply_eq_iff,
    ←g.map_smul, ←g.map_smul, ←g.map_smul, ←g.map_smul, eq1], refl,
end

lemma lift'_mk (g : M →ₗ[R] M'')
  (h : ∀ (x : S), is_unit ((algebra_map R (module.End R M'')) x)) (m : M) (s : S) :
  localized_module.lift' S g h (localized_module.mk m s) =
  (h s).unit⁻¹.1 (g m) := rfl

lemma lift'_add (g : M →ₗ[R] M'')
  (h : ∀ (x : S), is_unit ((algebra_map R (module.End R M'')) x)) (x y) :
  localized_module.lift' S g h (x + y) =
  localized_module.lift' S g h x + localized_module.lift' S g h y :=
localized_module.induction_on₂ begin
  intros a a' b b',
  erw [localized_module.lift'_mk, localized_module.lift'_mk, localized_module.lift'_mk],
  dsimp, generalize_proofs h1 h2 h3,
  erw [map_add, module.End_algebra_map_is_unit_inv_apply_eq_iff,
    smul_add, ←h2.unit⁻¹.1.map_smul, ←h3.unit⁻¹.1.map_smul],
  congr' 1; symmetry,
  erw [module.End_algebra_map_is_unit_inv_apply_eq_iff, mul_smul, ←map_smul], refl,
  erw [module.End_algebra_map_is_unit_inv_apply_eq_iff, mul_comm, mul_smul, ←map_smul], refl,
end x y

lemma lift'_smul (g : M →ₗ[R] M'')
  (h : ∀ (x : S), is_unit ((algebra_map R (module.End R M'')) x))
  (r : R) (m) :
  r • localized_module.lift' S g h m = localized_module.lift' S g h (r • m) :=
m.induction_on begin
  intros a b,
  rw [localized_module.lift'_mk, localized_module.smul'_mk, localized_module.lift'_mk],
    generalize_proofs h1 h2,
    erw [←h1.unit⁻¹.1.map_smul, ←g.map_smul],
end

/--
If `g` is a linear map `M → M''` such that all scalar multiplication by `s : S` is invertible, then
there is a linear map `localized_module S M → M''`.
-/
noncomputable def lift (g : M →ₗ[R] M'')
  (h : ∀ (x : S), is_unit ((algebra_map R (module.End R M'')) x)) :
  (localized_module S M) →ₗ[R] M'' :=
{ to_fun := localized_module.lift' S g h,
  map_add' := localized_module.lift'_add S g h,
  map_smul' := λ r x, by rw [localized_module.lift'_smul, ring_hom.id_apply] }

/--
If `g` is a linear map `M → M''` such that all scalar multiplication by `s : S` is invertible, then
`lift g m s = s⁻¹ • g m`.
-/
lemma lift_mk (g : M →ₗ[R] M'')
  (h : ∀ (x : S), is_unit ((algebra_map R (module.End R M'')) x))
  (m : M) (s : S) :
  localized_module.lift S g h (localized_module.mk m s) = (h s).unit⁻¹.1 (g m) := rfl

/--
If `g` is a linear map `M → M''` such that all scalar multiplication by `s : S` is invertible, then
there is a linear map `lift g ∘ mk_linear_map = g`.
-/
lemma lift_comp (g : M →ₗ[R] M'')
  (h : ∀ (x : S), is_unit ((algebra_map R (module.End R M'')) x)) :
  (lift S g h).comp (mk_linear_map S M) = g :=
begin
  ext x, dsimp, rw localized_module.lift_mk,
  erw [module.End_algebra_map_is_unit_inv_apply_eq_iff, one_smul],
end

/--
If `g` is a linear map `M → M''` such that all scalar multiplication by `s : S` is invertible and
`l` is another linear map `localized_module S M ⟶ M''` such that `l ∘ mk_linear_map = g` then
`l = lift g`
-/
lemma lift_unique (g : M →ₗ[R] M'')
  (h : ∀ (x : S), is_unit ((algebra_map R (module.End R M'')) x))
  (l : localized_module S M →ₗ[R] M'')
  (hl : l.comp (localized_module.mk_linear_map S M) = g) :
  localized_module.lift S g h = l :=
begin
  ext x, induction x using localized_module.induction_on with m s,
  rw [localized_module.lift_mk],
  erw [module.End_algebra_map_is_unit_inv_apply_eq_iff, ←hl, linear_map.coe_comp, function.comp_app,
    localized_module.mk_linear_map_apply, ←l.map_smul, localized_module.smul'_mk],
  congr' 1, rw localized_module.mk_eq,
  refine ⟨1, _⟩, simp only [one_smul], refl,
end

end localized_module

instance localized_module_is_localized_module :
  is_localized_module S (localized_module.mk_linear_map S M) :=
{ map_units := λ s, ⟨⟨algebra_map R (module.End R (localized_module S M)) s,
    localized_module.div_by s,
    fun_like.ext _ _ $ localized_module.mul_by_div_by s,
    fun_like.ext _ _ $ localized_module.div_by_mul_by s⟩,
    fun_like.ext _ _ $ λ p, p.induction_on $ by { intros, refl }⟩,
  surj := λ p, p.induction_on
    begin
      intros m t,
      refine ⟨⟨m, t⟩, _⟩,
      erw [localized_module.smul'_mk, localized_module.mk_linear_map_apply, submonoid.coe_subtype,
        localized_module.mk_cancel t ],
    end,
  eq_iff_exists := λ m1 m2,
  { mp := λ eq1, by simpa only [eq_comm, one_smul] using localized_module.mk_eq.mp eq1,
    mpr := λ ⟨c, eq1⟩,
      localized_module.mk_eq.mpr ⟨c, by simpa only [eq_comm, one_smul] using eq1⟩ } }

namespace is_localized_module

variable [is_localized_module S f]

/--
If `(M', f : M ⟶ M')` satisfies universal property of localized module, there is a canonical map
`localized_module S M ⟶ M'`.
-/
noncomputable def from_localized_module' : localized_module S M → M' :=
λ p, p.lift_on (λ x, (is_localized_module.map_units f x.2).unit⁻¹ (f x.1))
begin
  rintros ⟨a, b⟩ ⟨a', b'⟩ ⟨c, eq1⟩,
  dsimp,
  generalize_proofs h1 h2,
  erw [module.End_algebra_map_is_unit_inv_apply_eq_iff, ←h2.unit⁻¹.1.map_smul,
    module.End_algebra_map_is_unit_inv_apply_eq_iff', ←linear_map.map_smul, ←linear_map.map_smul],
  exact (is_localized_module.eq_iff_exists S f).mpr ⟨c, eq1⟩,
end

@[simp] lemma from_localized_module'_mk (m : M) (s : S) :
  from_localized_module' S f (localized_module.mk m s) =
  (is_localized_module.map_units f s).unit⁻¹ (f m) :=
rfl

lemma from_localized_module'_add (x y : localized_module S M) :
  from_localized_module' S f (x + y) =
  from_localized_module' S f x + from_localized_module' S f y :=
localized_module.induction_on₂ begin
  intros a a' b b',
  simp only [localized_module.mk_add_mk, from_localized_module'_mk],
  generalize_proofs h1 h2 h3,
  erw [module.End_algebra_map_is_unit_inv_apply_eq_iff, smul_add, ←h2.unit⁻¹.1.map_smul,
    ←h3.unit⁻¹.1.map_smul, map_add],
  congr' 1,
  all_goals { erw [module.End_algebra_map_is_unit_inv_apply_eq_iff'] },
  { dsimp, erw [mul_smul, f.map_smul], refl, },
  { dsimp, erw [mul_comm, f.map_smul, mul_smul], refl, },
end x y

lemma from_localized_module'_smul (r : R) (x : localized_module S M) :
  r • from_localized_module' S f x = from_localized_module' S f (r • x) :=
localized_module.induction_on begin
  intros a b,
  rw [from_localized_module'_mk, localized_module.smul'_mk, from_localized_module'_mk],
  generalize_proofs h1, erw [f.map_smul, h1.unit⁻¹.1.map_smul], refl,
end x

/--
If `(M', f : M ⟶ M')` satisfies universal property of localized module, there is a canonical map
`localized_module S M ⟶ M'`.
-/
noncomputable def from_localized_module : localized_module S M →ₗ[R] M' :=
{ to_fun := from_localized_module' S f,
  map_add' := from_localized_module'_add S f,
  map_smul' := λ r x, by rw [from_localized_module'_smul, ring_hom.id_apply] }

lemma from_localized_module_mk (m : M) (s : S) :
  from_localized_module S f (localized_module.mk m s) =
  (is_localized_module.map_units f s).unit⁻¹ (f m) :=
rfl

lemma from_localized_module.inj : function.injective $ from_localized_module S f :=
λ x y eq1,
begin
  induction x using localized_module.induction_on with a b,
  induction y using localized_module.induction_on with a' b',
  simp only [from_localized_module_mk] at eq1,
  generalize_proofs h1 h2 at eq1,
  erw [module.End_algebra_map_is_unit_inv_apply_eq_iff, ←linear_map.map_smul,
    module.End_algebra_map_is_unit_inv_apply_eq_iff'] at eq1,
  erw [localized_module.mk_eq, ←is_localized_module.eq_iff_exists S f, f.map_smul, f.map_smul, eq1],
  refl,
end

lemma from_localized_module.surj : function.surjective $ from_localized_module S f :=
λ x, let ⟨⟨m, s⟩, eq1⟩ := is_localized_module.surj S f x in ⟨localized_module.mk m s,
by { rw [from_localized_module_mk, module.End_algebra_map_is_unit_inv_apply_eq_iff, ←eq1], refl }⟩

lemma from_localized_module.bij : function.bijective $ from_localized_module S f :=
⟨from_localized_module.inj _ _, from_localized_module.surj _ _⟩

/--
If `(M', f : M ⟶ M')` satisfies universal property of localized module, then `M'` is isomorphic to
`localized_module S M` as an `R`-module.
-/
@[simps] noncomputable def iso : localized_module S M ≃ₗ[R] M' :=
{ ..from_localized_module S f,
  ..equiv.of_bijective (from_localized_module S f) $ from_localized_module.bij _ _}

lemma iso_apply_mk (m : M) (s : S) :
  iso S f (localized_module.mk m s) = (is_localized_module.map_units f s).unit⁻¹ (f m) :=
rfl

lemma iso_symm_apply_aux (m : M') :
  (iso S f).symm m = localized_module.mk (is_localized_module.surj S f m).some.1
    (is_localized_module.surj S f m).some.2 :=
begin
  generalize_proofs _ h2,
  apply_fun (iso S f) using linear_equiv.injective _,
  rw [linear_equiv.apply_symm_apply],
  simp only [iso_apply, linear_map.to_fun_eq_coe, from_localized_module_mk],
  erw [module.End_algebra_map_is_unit_inv_apply_eq_iff', h2.some_spec],
end

lemma iso_symm_apply' (m : M') (a : M) (b : S) (eq1 : b • m = f a) :
  (iso S f).symm m = localized_module.mk a b :=
(iso_symm_apply_aux S f m).trans $ localized_module.mk_eq.mpr $
begin
  generalize_proofs h1,
  erw [←is_localized_module.eq_iff_exists S f, f.map_smul, f.map_smul, ←h1.some_spec, ←mul_smul,
    mul_comm, mul_smul, eq1],
end

lemma iso_symm_comp : (iso S f).symm.to_linear_map.comp f = localized_module.mk_linear_map S M :=
begin
  ext m, rw [linear_map.comp_apply, localized_module.mk_linear_map_apply],
  change (iso S f).symm _ = _, rw [iso_symm_apply'], exact one_smul _ _,
end

/--
If `M'` is a localized module and `g` is a linear map `M' → M''` such that all scalar multiplication
by `s : S` is invertible, then there is a linear map `M' → M''`.
-/
noncomputable def lift (g : M →ₗ[R] M'')
  (h : ∀ (x : S), is_unit ((algebra_map R (module.End R M'')) x)) :
  M' →ₗ[R] M'' :=
(localized_module.lift S g h).comp (iso S f).symm.to_linear_map

lemma lift_comp (g : M →ₗ[R] M'')
  (h : ∀ (x : S), is_unit ((algebra_map R (module.End R M'')) x)) :
  (lift S f g h).comp f = g :=
begin
  dunfold is_localized_module.lift,
  rw [linear_map.comp_assoc],
  convert localized_module.lift_comp S g h,
  exact iso_symm_comp _ _,
end

lemma lift_unique (g : M →ₗ[R] M'')
  (h : ∀ (x : S), is_unit ((algebra_map R (module.End R M'')) x))
  (l : M' →ₗ[R] M'') (hl : l.comp f = g) :
  lift S f g h = l :=
begin
  dunfold is_localized_module.lift,
  rw [localized_module.lift_unique S g h (l.comp (iso S f).to_linear_map), linear_map.comp_assoc,
    show (iso S f).to_linear_map.comp (iso S f).symm.to_linear_map = linear_map.id, from _,
    linear_map.comp_id],
  { rw [linear_equiv.comp_to_linear_map_symm_eq, linear_map.id_comp], },
  { rw [linear_map.comp_assoc, ←hl], congr' 1, ext x,
    erw [from_localized_module_mk, module.End_algebra_map_is_unit_inv_apply_eq_iff, one_smul], },
end

/--
Universal property from localized module:
If `(M', f : M ⟶ M')` is a localized module then it satisfies the following universal property:
For every `R`-module `M''` which every `s : S`-scalar multiplication is invertible and for every
`R`-linear map `g : M ⟶ M''`, there is a unique `R`-linear map `l : M' ⟶ M''` such that
`l ∘ f = g`.
```
M -----f----> M'
|           /
|g       /
|     /   l
v   /
M''
```
-/
lemma is_universal :
  ∀ (g : M →ₗ[R] M'') (map_unit : ∀ (x : S), is_unit ((algebra_map R (module.End R M'')) x)),
    ∃! (l : M' →ₗ[R] M''), l.comp f = g :=
λ g h, ⟨lift S f g h, lift_comp S f g h, λ l hl, (lift_unique S f g h l hl).symm⟩

lemma ring_hom_ext (map_unit : ∀ (x : S), is_unit ((algebra_map R (module.End R M'')) x))
  ⦃j k : M' →ₗ[R] M''⦄ (h : j.comp f = k.comp f) : j = k :=
by { rw [←lift_unique S f (k.comp f) map_unit j h, lift_unique], refl }

/--
If `(M', f)` and `(M'', g)` both satisfy universal property of localized module, then `M', M''`
are isomorphic as `R`-module
-/
noncomputable def linear_equiv [is_localized_module S g] : M' ≃ₗ[R] M'' :=
(iso S f).symm.trans (iso S g)

variable {S}

lemma smul_injective (s : S) : function.injective (λ m : M', s • m) :=
((module.End_is_unit_iff _).mp (is_localized_module.map_units f s)).injective

lemma smul_inj (s : S) (m₁ m₂ : M') : s • m₁ = s • m₂ ↔ m₁ = m₂ :=
(smul_injective f s).eq_iff

/-- `mk' f m s` is the fraction `m/s` with respect to the localization map `f`. -/
noncomputable
def mk' (m : M) (s : S) : M' := from_localized_module S f (localized_module.mk m s)

lemma mk'_smul (r : R) (m : M) (s : S) : mk' f (r • m) s = r • mk' f m s :=
by { delta mk', rw [← localized_module.smul'_mk, linear_map.map_smul] }

lemma mk'_add_mk' (m₁ m₂ : M) (s₁ s₂ : S) :
  mk' f m₁ s₁ + mk' f m₂ s₂ = mk' f (s₂ • m₁ + s₁ • m₂) (s₁ * s₂)  :=
by { delta mk', rw [← map_add, localized_module.mk_add_mk] }

@[simp] lemma mk'_zero (s : S) :
  mk' f 0 s = 0 :=
by rw [← zero_smul R (0 : M), mk'_smul, zero_smul]

variable (S)

@[simp] lemma mk'_one (m : M) :
  mk' f m (1 : S) = f m :=
by { delta mk', rw [from_localized_module_mk, module.End_algebra_map_is_unit_inv_apply_eq_iff,
  submonoid.coe_one, one_smul] }

variable {S}

@[simp] lemma mk'_cancel (m : M) (s : S) :
  mk' f (s • m) s = f m :=
by { delta mk', rw [localized_module.mk_cancel, ← mk'_one S f], refl }

@[simp] lemma mk'_cancel' (m : M) (s : S) :
  s • mk' f m s = f m :=
by rw [submonoid.smul_def, ← mk'_smul, ← submonoid.smul_def, mk'_cancel]

@[simp] lemma mk'_cancel_left (m : M) (s₁ s₂ : S) :
  mk' f (s₁ • m) (s₁ * s₂) = mk' f m s₂ :=
by { delta mk', rw localized_module.mk_cancel_common_left }

@[simp] lemma mk'_cancel_right (m : M) (s₁ s₂ : S) :
  mk' f (s₂ • m) (s₁ * s₂) = mk' f m s₁ :=
by { delta mk', rw localized_module.mk_cancel_common_right }

lemma mk'_add (m₁ m₂ : M) (s : S) : mk' f (m₁ + m₂) s = mk' f m₁ s + mk' f m₂ s :=
by { rw [mk'_add_mk', ← smul_add, mk'_cancel_left] }

lemma mk'_eq_mk'_iff (m₁ m₂ : M) (s₁ s₂ : S) :
  mk' f m₁ s₁ = mk' f m₂ s₂ ↔ ∃ s : S, s • s₁ • m₂ = s • s₂ • m₁ :=
begin
  delta mk',
  rw [(from_localized_module.inj S f).eq_iff, localized_module.mk_eq],
  simp_rw eq_comm
end

lemma mk'_neg {M M' : Type*} [add_comm_group M] [add_comm_group M'] [module R M]
  [module R M'] (f : M →ₗ[R] M') [is_localized_module S f] (m : M) (s : S) :
  mk' f (-m) s = - mk' f m s :=
by { delta mk', rw [localized_module.mk_neg, map_neg] }

lemma mk'_sub {M M' : Type*} [add_comm_group M] [add_comm_group M'] [module R M]
  [module R M'] (f : M →ₗ[R] M') [is_localized_module S f] (m₁ m₂ : M) (s : S) :
  mk' f (m₁ - m₂) s = mk' f m₁ s - mk' f m₂ s :=
by rw [sub_eq_add_neg, sub_eq_add_neg, mk'_add, mk'_neg]

lemma mk'_sub_mk' {M M' : Type*} [add_comm_group M] [add_comm_group M'] [module R M]
  [module R M'] (f : M →ₗ[R] M') [is_localized_module S f] (m₁ m₂ : M) (s₁ s₂ : S) :
  mk' f m₁ s₁ - mk' f m₂ s₂ = mk' f (s₂ • m₁ - s₁ • m₂) (s₁ * s₂) :=
by rw [sub_eq_add_neg, ← mk'_neg, mk'_add_mk', smul_neg, ← sub_eq_add_neg]

lemma mk'_mul_mk'_of_map_mul {M M' : Type*} [semiring M] [semiring M'] [module R M]
  [algebra R M'] (f : M →ₗ[R] M') (hf : ∀ m₁ m₂, f (m₁ * m₂) = f m₁ * f m₂)
  [is_localized_module S f] (m₁ m₂ : M) (s₁ s₂ : S) :
  mk' f m₁ s₁ * mk' f m₂ s₂ = mk' f (m₁ * m₂) (s₁ * s₂) :=
begin
  symmetry,
  apply (module.End_algebra_map_is_unit_inv_apply_eq_iff _ _ _).mpr,
  simp_rw [submonoid.coe_mul, ← smul_eq_mul],
  rw [smul_smul_smul_comm, ← mk'_smul, ← mk'_smul],
  simp_rw [← submonoid.smul_def, mk'_cancel, smul_eq_mul, hf],
end

lemma mk'_mul_mk' {M M' : Type*} [semiring M] [semiring M'] [algebra R M]
  [algebra R M'] (f : M →ₐ[R] M')
  [is_localized_module S f.to_linear_map] (m₁ m₂ : M) (s₁ s₂ : S) :
  mk' f.to_linear_map m₁ s₁ * mk' f.to_linear_map m₂ s₂ =
    mk' f.to_linear_map (m₁ * m₂) (s₁ * s₂) :=
mk'_mul_mk'_of_map_mul f.to_linear_map f.map_mul m₁ m₂ s₁ s₂

variables {f}

@[simp] lemma mk'_eq_iff {m : M} {s : S} {m' : M'} :
  mk' f m s = m' ↔ f m = s • m' :=
by rw [← smul_inj f s, submonoid.smul_def, ← mk'_smul, ← submonoid.smul_def, mk'_cancel]

@[simp] lemma mk'_eq_zero {m : M} (s : S) :
  mk' f m s = 0 ↔ f m = 0 :=
by rw [mk'_eq_iff, smul_zero]

variable (f)

lemma mk'_eq_zero' {m : M} (s : S) :
  mk' f m s = 0 ↔ ∃ s' : S, s' • m = 0 :=
by simp_rw [← mk'_zero f (1 : S), mk'_eq_mk'_iff, smul_zero, one_smul, eq_comm]

variable (S)

lemma eq_zero_iff {m : M} :
  f m = 0 ↔ ∃ s' : S, s' • m = 0 :=
(mk'_eq_zero (1 : S)).symm.trans (mk'_eq_zero' f _)

lemma mk'_surjective : function.surjective (function.uncurry $ mk' f : M × S → M') :=
begin
  intro x,
  obtain ⟨⟨m, s⟩, e : s • x = f m⟩ := is_localized_module.surj S f x,
  exact ⟨⟨m, s⟩, mk'_eq_iff.mpr e.symm⟩
end

section algebra

lemma mk_of_algebra {R S S' : Type*} [comm_ring R] [comm_ring S] [comm_ring S']
  [algebra R S] [algebra R S'] (M : submonoid R) (f : S →ₐ[R] S')
  (h₁ : ∀ x ∈ M, is_unit (algebra_map R S' x))
  (h₂ : ∀ y, ∃ (x : S × M), x.2 • y = f x.1)
  (h₃ : ∀ x, f x = 0 → ∃ m : M, m • x = 0) :
  is_localized_module M f.to_linear_map :=
begin
  replace h₃ := λ x, iff.intro (h₃ x) (λ ⟨⟨m, hm⟩, e⟩, (h₁ m hm).mul_left_cancel $
    by { rw ← algebra.smul_def, simpa [submonoid.smul_def] using f.congr_arg e }),
  constructor,
  { intro x,
    rw module.End_is_unit_iff,
    split,
    { rintros a b (e : x • a = x • b), simp_rw [submonoid.smul_def, algebra.smul_def] at e,
      exact (h₁ x x.2).mul_left_cancel e },
    { intro a, refine ⟨((h₁ x x.2).unit⁻¹ : _) * a, _⟩, change (x : R) • (_ * a) = _,
      rw [algebra.smul_def, ← mul_assoc, is_unit.mul_coe_inv, one_mul] } },
  { exact h₂ },
  { intros, dsimp, rw [eq_comm, ← sub_eq_zero, ← map_sub, h₃], simp_rw [smul_sub, sub_eq_zero] },
end

end algebra

end is_localized_module

end is_localized_module


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_80
  (x : ℝ)
  (h₀ : x ≠ -1)
  (h₁ : (x - 9) / (x + 1) = 2) :
  x = -11 :=
begin
  revert x h₀ h₁,
  norm_num,
  intros _ hx,
  simp [hx, two_mul, sub_eq_add_neg],
  intro H,
  rwa [div_eq_iff_mul_eq] at H,
  linarith,
  norm_num,
  intro h,
  exact hx (add_eq_zero_iff_eq_neg.1 h),
end


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

import field_theory.primitive_element
import linear_algebra.determinant
import linear_algebra.finite_dimensional
import linear_algebra.matrix.charpoly.minpoly
import linear_algebra.matrix.to_linear_equiv
import field_theory.is_alg_closed.algebraic_closure
import field_theory.galois

/-!
# Norm for (finite) ring extensions

Suppose we have an `R`-algebra `S` with a finite basis. For each `s : S`,
the determinant of the linear map given by multiplying by `s` gives information
about the roots of the minimal polynomial of `s` over `R`.

## Implementation notes

Typically, the norm is defined specifically for finite field extensions.
The current definition is as general as possible and the assumption that we have
fields or that the extension is finite is added to the lemmas as needed.

We only define the norm for left multiplication (`algebra.left_mul_matrix`,
i.e. `linear_map.mul_left`).
For now, the definitions assume `S` is commutative, so the choice doesn't
matter anyway.

See also `algebra.trace`, which is defined similarly as the trace of
`algebra.left_mul_matrix`.

## References

 * https://en.wikipedia.org/wiki/Field_norm

-/

universes u v w

variables {R S T : Type*} [comm_ring R] [ring S]
variables [algebra R S]
variables {K L F : Type*} [field K] [field L] [field F]
variables [algebra K L] [algebra K F]
variables {ι : Type w}

open finite_dimensional
open linear_map
open matrix polynomial

open_locale big_operators
open_locale matrix

namespace algebra

variables (R)

/-- The norm of an element `s` of an `R`-algebra is the determinant of `(*) s`. -/
noncomputable def norm : S →* R :=
linear_map.det.comp (lmul R S).to_ring_hom.to_monoid_hom

lemma norm_apply (x : S) : norm R x = linear_map.det (lmul R S x) := rfl

lemma norm_eq_one_of_not_exists_basis
  (h : ¬ ∃ (s : finset S), nonempty (basis s R S)) (x : S) : norm R x = 1 :=
by { rw [norm_apply, linear_map.det], split_ifs with h, refl }

variables {R}

-- Can't be a `simp` lemma because it depends on a choice of basis
lemma norm_eq_matrix_det [fintype ι] [decidable_eq ι] (b : basis ι R S) (s : S) :
  norm R s = matrix.det (algebra.left_mul_matrix b s) :=
by { rwa [norm_apply, ← linear_map.det_to_matrix b, ← to_matrix_lmul_eq], refl }

/-- If `x` is in the base ring `K`, then the norm is `x ^ [L : K]`. -/
lemma norm_algebra_map_of_basis [fintype ι] (b : basis ι R S) (x : R) :
  norm R (algebra_map R S x) = x ^ fintype.card ι :=
begin
  haveI := classical.dec_eq ι,
  rw [norm_apply, ← det_to_matrix b, lmul_algebra_map],
  convert @det_diagonal _ _ _ _ _ (λ (i : ι), x),
  { ext i j, rw [to_matrix_lsmul, matrix.diagonal] },
  { rw [finset.prod_const, finset.card_univ] }
end

/-- If `x` is in the base field `K`, then the norm is `x ^ [L : K]`.

(If `L` is not finite-dimensional over `K`, then `norm = 1 = x ^ 0 = x ^ (finrank L K)`.)
-/
@[simp]
protected lemma norm_algebra_map {L : Type*} [ring L] [algebra K L] (x : K) :
  norm K (algebra_map K L x) = x ^ finrank K L :=
begin
  by_cases H : ∃ (s : finset L), nonempty (basis s K L),
  { rw [norm_algebra_map_of_basis H.some_spec.some, finrank_eq_card_basis H.some_spec.some] },
  { rw [norm_eq_one_of_not_exists_basis K H, finrank_eq_zero_of_not_exists_basis, pow_zero],
    rintros ⟨s, ⟨b⟩⟩,
    exact H ⟨s, ⟨b⟩⟩ },
end

section eq_prod_roots

/-- Given `pb : power_basis K S`, then the norm of `pb.gen` is
`(-1) ^ pb.dim * coeff (minpoly K pb.gen) 0`. -/
lemma power_basis.norm_gen_eq_coeff_zero_minpoly (pb : power_basis R S) :
  norm R pb.gen = (-1) ^ pb.dim * coeff (minpoly R pb.gen) 0 :=
by rw [norm_eq_matrix_det pb.basis, det_eq_sign_charpoly_coeff,
       charpoly_left_mul_matrix, fintype.card_fin]

/-- Given `pb : power_basis R S`, then the norm of `pb.gen` is
`((minpoly R pb.gen).map (algebra_map R F)).roots.prod`. -/
lemma power_basis.norm_gen_eq_prod_roots [algebra R F] (pb : power_basis R S)
  (hf : (minpoly R pb.gen).splits (algebra_map R F)) :
  algebra_map R F (norm R pb.gen) =
    ((minpoly R pb.gen).map (algebra_map R F)).roots.prod :=
begin
  haveI := module.nontrivial R F,
  have := minpoly.monic pb.is_integral_gen,
  rw [power_basis.norm_gen_eq_coeff_zero_minpoly, ← pb.nat_degree_minpoly, ring_hom.map_mul,
    ← coeff_map, prod_roots_eq_coeff_zero_of_monic_of_split (this.map _)
      ((splits_id_iff_splits _).2 hf), this.nat_degree_map, map_pow, ← mul_assoc, ← mul_pow],
  { simp only [map_neg, _root_.map_one, neg_mul, neg_neg, one_pow, one_mul] }, apply_instance,
end

end eq_prod_roots

section eq_zero_iff
variables [finite ι]

@[simp] lemma norm_zero [nontrivial S] [module.free R S] [module.finite R S] :
  norm R (0 : S) = 0 :=
begin
  nontriviality,
  rw [norm_apply, coe_lmul_eq_mul, map_zero, linear_map.det_zero' (module.free.choose_basis R S)]
end

@[simp] lemma norm_eq_zero_iff [is_domain R] [is_domain S] [module.free R S] [module.finite R S]
  {x : S} :
  norm R x = 0 ↔ x = 0 :=
begin
  split,
  let b := module.free.choose_basis R S,
  swap, { rintro rfl, exact norm_zero },
  { letI := classical.dec_eq (module.free.choose_basis_index R S),
    rw [norm_eq_matrix_det b,
        ← matrix.exists_mul_vec_eq_zero_iff],
    rintros ⟨v, v_ne, hv⟩,
    rw [← b.equiv_fun.apply_symm_apply v, b.equiv_fun_symm_apply, b.equiv_fun_apply,
        left_mul_matrix_mul_vec_repr] at hv,
    refine (mul_eq_zero.mp (b.ext_elem $ λ i, _)).resolve_right (show ∑ i, v i • b i ≠ 0, from _),
    { simpa only [linear_equiv.map_zero, pi.zero_apply] using congr_fun hv i },
    { contrapose! v_ne with sum_eq,
      apply b.equiv_fun.symm.injective,
      rw [b.equiv_fun_symm_apply, sum_eq, linear_equiv.map_zero] } },
end

lemma norm_ne_zero_iff [is_domain R] [is_domain S] [module.free R S] [module.finite R S]
  {x : S} :
  norm R x ≠ 0 ↔ x ≠ 0 :=
not_iff_not.mpr norm_eq_zero_iff

/-- This is `algebra.norm_eq_zero_iff` composed with `algebra.norm_apply`. -/
@[simp]
lemma norm_eq_zero_iff' [is_domain R] [is_domain S] [module.free R S] [module.finite R S]
  {x : S} :
  linear_map.det (linear_map.mul R S x) = 0 ↔ x = 0 :=
norm_eq_zero_iff

lemma norm_eq_zero_iff_of_basis [is_domain R] [is_domain S] (b : basis ι R S) {x : S} :
  algebra.norm R x = 0 ↔ x = 0 :=
begin
  haveI : module.free R S := module.free.of_basis b,
  haveI : module.finite R S := module.finite.of_basis b,
  exact norm_eq_zero_iff
end

lemma norm_ne_zero_iff_of_basis [is_domain R] [is_domain S] (b : basis ι R S) {x : S} :
  algebra.norm R x ≠ 0 ↔ x ≠ 0 :=
not_iff_not.mpr (norm_eq_zero_iff_of_basis b)

end eq_zero_iff

open intermediate_field

variable (K)

lemma norm_eq_norm_adjoin [finite_dimensional K L] [is_separable K L] (x : L) :
  norm K x = norm K (adjoin_simple.gen K x) ^ finrank K⟮x⟯ L :=
begin
  letI := is_separable_tower_top_of_is_separable K K⟮x⟯ L,
  let pbL := field.power_basis_of_finite_of_separable K⟮x⟯ L,
  let pbx := intermediate_field.adjoin.power_basis (is_separable.is_integral K x),
  rw [← adjoin_simple.algebra_map_gen K x, norm_eq_matrix_det (pbx.basis.smul pbL.basis) _,
    smul_left_mul_matrix_algebra_map, det_block_diagonal, norm_eq_matrix_det pbx.basis],
  simp only [finset.card_fin, finset.prod_const],
  congr,
  rw [← power_basis.finrank, adjoin_simple.algebra_map_gen K x]
end

variable {K}

section intermediate_field

lemma _root_.intermediate_field.adjoin_simple.norm_gen_eq_one {x : L}
  (hx : ¬is_integral K x) : norm K (adjoin_simple.gen K x) = 1 :=
begin
  rw [norm_eq_one_of_not_exists_basis],
  contrapose! hx,
  obtain ⟨s, ⟨b⟩⟩ := hx,
  refine is_integral_of_mem_of_fg (K⟮x⟯).to_subalgebra _ x _,
  { exact (submodule.fg_iff_finite_dimensional _).mpr (of_fintype_basis b) },
  { exact intermediate_field.subset_adjoin K _ (set.mem_singleton x) }
end

lemma _root_.intermediate_field.adjoin_simple.norm_gen_eq_prod_roots (x : L)
  (hf : (minpoly K x).splits (algebra_map K F)) :
  (algebra_map K F) (norm K (adjoin_simple.gen K x)) =
    ((minpoly K x).map (algebra_map K F)).roots.prod :=
begin
  have injKxL := (algebra_map K⟮x⟯ L).injective,
  by_cases hx : is_integral K x, swap,
  { simp [minpoly.eq_zero hx, intermediate_field.adjoin_simple.norm_gen_eq_one hx] },
  have hx' : is_integral K (adjoin_simple.gen K x),
  { rwa [← is_integral_algebra_map_iff injKxL, adjoin_simple.algebra_map_gen],
    apply_instance },
  rw [← adjoin.power_basis_gen hx, power_basis.norm_gen_eq_prod_roots];
    rw [adjoin.power_basis_gen hx, minpoly.eq_of_algebra_map_eq injKxL hx'];
    try { simp only [adjoin_simple.algebra_map_gen _ _] },
  exact hf
end

end intermediate_field

section eq_prod_embeddings

open intermediate_field intermediate_field.adjoin_simple polynomial

variables (F) (E : Type*) [field E] [algebra K E]

lemma norm_eq_prod_embeddings_gen [algebra R F] (pb : power_basis R S)
  (hE : (minpoly R pb.gen).splits (algebra_map R F)) (hfx : (minpoly R pb.gen).separable) :
  algebra_map R F (norm R pb.gen) = (@@finset.univ pb^.alg_hom.fintype).prod (λ σ, σ pb.gen) :=
begin
  letI := classical.dec_eq F,
  rw [pb.norm_gen_eq_prod_roots hE, fintype.prod_equiv pb.lift_equiv',
    finset.prod_mem_multiset, finset.prod_eq_multiset_prod, multiset.to_finset_val,
    multiset.dedup_eq_self.mpr, multiset.map_id],
  { exact nodup_roots hfx.map },
  { intro x, refl },
  { intro σ, rw [pb.lift_equiv'_apply_coe, id.def] }
end

lemma norm_eq_prod_roots [is_separable K L] [finite_dimensional K L]
  {x : L} (hF : (minpoly K x).splits (algebra_map K F)) :
  algebra_map K F (norm K x) = ((minpoly K x).map (algebra_map K F)).roots.prod ^ finrank K⟮x⟯ L :=
by rw [norm_eq_norm_adjoin K x, map_pow,
  intermediate_field.adjoin_simple.norm_gen_eq_prod_roots _ hF]

lemma prod_embeddings_eq_finrank_pow [algebra L F] [is_scalar_tower K L F] [is_alg_closed E]
  [is_separable K F] [finite_dimensional K F] (pb : power_basis K L) :
  ∏ σ : F →ₐ[K] E, σ (algebra_map L F pb.gen) =
  ((@@finset.univ pb^.alg_hom.fintype).prod (λ σ : L →ₐ[K] E, σ pb.gen)) ^ finrank L F :=
begin
  haveI : finite_dimensional L F := finite_dimensional.right K L F,
  haveI : is_separable L F := is_separable_tower_top_of_is_separable K L F,
  letI : fintype (L →ₐ[K] E) := power_basis.alg_hom.fintype pb,
  letI : ∀ (f : L →ₐ[K] E), fintype (@@alg_hom L F E _ _ _ _ f.to_ring_hom.to_algebra) := _,
  rw [fintype.prod_equiv alg_hom_equiv_sigma (λ (σ : F →ₐ[K] E), _) (λ σ, σ.1 pb.gen),
     ← finset.univ_sigma_univ, finset.prod_sigma, ← finset.prod_pow],
  refine finset.prod_congr rfl (λ σ _, _),
  { letI : algebra L E := σ.to_ring_hom.to_algebra,
    simp only [finset.prod_const, finset.card_univ],
    congr,
    rw alg_hom.card L F E },
  { intros σ,
    simp only [alg_hom_equiv_sigma, equiv.coe_fn_mk, alg_hom.restrict_domain, alg_hom.comp_apply,
         is_scalar_tower.coe_to_alg_hom'] }
end

variable (K)

/-- For `L/K` a finite separable extension of fields and `E` an algebraically closed extension
of `K`, the norm (down to `K`) of an element `x` of `L` is equal to the product of the images
of `x` over all the `K`-embeddings `σ`  of `L` into `E`. -/
lemma norm_eq_prod_embeddings [finite_dimensional K L] [is_separable K L] [is_alg_closed E]
  {x : L} : algebra_map K E (norm K x) = ∏ σ : L →ₐ[K] E, σ x :=
begin
  have hx := is_separable.is_integral K x,
  rw [norm_eq_norm_adjoin K x, ring_hom.map_pow, ← adjoin.power_basis_gen hx,
    norm_eq_prod_embeddings_gen E (adjoin.power_basis hx) (is_alg_closed.splits_codomain _)],
  { exact (prod_embeddings_eq_finrank_pow L E (adjoin.power_basis hx)).symm },
  { haveI := is_separable_tower_bot_of_is_separable K K⟮x⟯ L,
    exact is_separable.separable K _ }
end

lemma norm_eq_prod_automorphisms [finite_dimensional K L] [is_galois K L] (x : L) :
  algebra_map K L (norm K x) = ∏ (σ : L ≃ₐ[K] L), σ x :=
begin
  apply no_zero_smul_divisors.algebra_map_injective L (algebraic_closure L),
  rw map_prod (algebra_map L (algebraic_closure L)),
  rw ← fintype.prod_equiv (normal.alg_hom_equiv_aut K (algebraic_closure L) L),
  { rw ← norm_eq_prod_embeddings,
    simp only [algebra_map_eq_smul_one, smul_one_smul] },
  { intro σ,
    simp only [normal.alg_hom_equiv_aut, alg_hom.restrict_normal', equiv.coe_fn_mk,
               alg_equiv.coe_of_bijective, alg_hom.restrict_normal_commutes, id.map_eq_id,
               ring_hom.id_apply] },
end

lemma is_integral_norm [algebra R L] [algebra R K] [is_scalar_tower R K L]
  [is_separable K L] [finite_dimensional K L] {x : L} (hx : is_integral R x) :
  is_integral R (norm K x) :=
begin
  have hx' : is_integral K x := is_integral_of_is_scalar_tower hx,
  rw [← is_integral_algebra_map_iff (algebra_map K (algebraic_closure L)).injective,
      norm_eq_prod_roots],
  { refine (is_integral.multiset_prod (λ y hy, _)).pow _,
    rw mem_roots_map (minpoly.ne_zero hx') at hy,
    use [minpoly R x, minpoly.monic hx],
    rw ← aeval_def at ⊢ hy,
    exact minpoly.aeval_of_is_scalar_tower R x y hy },
  { apply is_alg_closed.splits_codomain },
  { apply_instance }
end

end eq_prod_embeddings

end algebra


import algebra.algebra.basic
import data.nat.basic
import data.real.basic
import data.polynomial.basic
import linear_algebra.basis
import number_theory.liouville.liouville_constant
import tactic

open_locale big_operators
open_locale nat polynomial

open nat finset

-- Slow proof
example {f : ℚ → ℚ} (h : ∀ x, ∀ y, f (x + y) = f x + f y) : ∀ x, f x = x * f 1 :=
begin
  have f_zero : f 0 = 0,
  { specialize h 0 0, simpa using h, },
  have f_nat_mul : ∀ n : ℕ, ∀ x, f (n * x) = n * f x,
  { intros n x,
    induction n with k hk,
    { simp only [nat.cast_zero, zero_mul, f_zero], },
    { simp only [nat.succ_eq_add_one, nat.cast_add_one, add_mul, one_mul, h, hk], },
  },
  have f_nat : ∀ n : ℕ, f n = n * f 1,
  { intro n, rw [← f_nat_mul n 1, mul_one], },
  have f_neg : ∀ x, f (-x) = -(f x),
  { intro x, rw [eq_neg_iff_add_eq_zero, ← h, neg_add_self, f_zero], },
  have f_int_mul : ∀ n : ℤ, ∀ x, f (n * x) = n * f x,
  { intros n x,
    cases n,
    { rw [int.of_nat_eq_coe, ← coe_coe, f_nat_mul], },
    { simp only [int.neg_succ_of_nat_eq, int.cast_neg, neg_mul, f_neg, neg_mul, neg_inj,
                 int.cast_add, ← coe_coe, int.cast_one, add_mul, one_mul, h, f_nat_mul], },
  },
  have f_one_div : ∀ n : ℕ, n ≠ 0 → f ((1 : ℚ) / n) = (f 1) / n,
  { intros n hn,
    rw [eq_div_iff, mul_comm, ← f_nat_mul _ _, mul_one_div_cancel],
    repeat { rwa nat.cast_ne_zero, } },

  intro q,
  rw ← rat.num_div_denom q,
  rcases q with ⟨m, n⟩,
  dsimp,
  rw [div_eq_mul_inv, f_int_mul, inv_eq_one_div, f_one_div, div_eq_mul_one_div],
  ring,
  linarith,
end

-- Quicker proof
example {f : ℚ → ℚ} (h : ∀ x, ∀ y, f (x + y) = f x + f y) : ∀ x, f x = x * f 1 :=
begin
  -- Setup f as linear_map from ℚ to ℚ
  let f_lin : ℚ →+ ℚ := add_monoid_hom.mk' f h,
  let f_hom : ℚ →ₗ[ℚ] ℚ := add_monoid_hom.to_rat_linear_map f_lin,

  -- The rest is straightforward
  intro x,
  simpa using f_hom.map_smul' x 1,
end

---------------------------------------------------------------------------------------------

example : ∃ f : ℝ → ℝ, (∀ x y, f (x + y) = f x + f y) ∧ (∃ x : ℝ, f x ≠ x * f 1) :=
begin
  let real_basis := basis.of_vector_space ℚ ℝ,
  let real_index_set : set ℝ := basis.of_vector_space_index ℚ ℝ,

  -- we prove that the set is nonempty
  have real_index_set_nonempty : real_index_set.nonempty,
  { rw ← set.nonempty_coe_sort, exact real_basis.index_nonempty, },
  let real_basis_vec₁ := set.nonempty.some real_index_set_nonempty,

  -- we prove that the set is infinite
  have real_index_set_infinite : real_index_set.infinite,
  { sorry, },

  -- then we can choose some basis vectors
  let real_index_nat_embedding := set.infinite.nat_embedding real_index_set real_index_set_infinite,
  let real_basis_vec₀ := real_index_nat_embedding 0,
  let real_basis_vec₁ := real_index_nat_embedding 1,

  -- they are not equal
  have real_basis_vec₀_ne_real_basis_vec₁: real_basis_vec₀ ≠ real_basis_vec₁,
  {
    by_contradiction,
    linarith [real_index_nat_embedding.injective h],
  },

  let f_map : real_index_set → ℝ := λ index,
  if index = real_basis_vec₀
  then
    real_basis real_basis_vec₁
  else
    real_basis real_basis_vec₀,

  let f : ℝ → ℝ := real_basis.constr ℝ f_map,

  -- now we verify that the two basis vectors map to different values
  let x₀ : ℝ := real_basis real_basis_vec₀,
  let x₁ : ℝ := real_basis real_basis_vec₁,
  have : f x₀ ≠ f x₁,
  {
    simp only [f, x₀, x₁],
    dsimp [basis.constr],
    -- simp only [f, basis.constr, x₀, x₁],
    simp only [basis.repr_self, finsupp.map_domain_single, finsupp.total_single, one_smul, id,
               f_map],
    simp [set_coe.ext_iff],
  },
end

---------------------------------

namespace polynomial

example : true :=
begin
  -- We construct a transcendental (over Q) number x
  let x : ℝ := liouville.liouville_number 3,

  -- Then construct the set {1, x, x^2, ...}
  let ι := ℕ,
  let v : ι → ℝ := λ n, x ^ n,

  -- Then prove it is linearly independent over Q
  have : linear_independent ℚ v,
  {
    let h := liouville.is_transcendental (show 2 ≤ 3, by omega),
    simp only [transcendental, is_algebraic] at h,
    push_neg at h,
    rw linear_independent_iff,
    intro l,
    simp [finsupp.total, v],
    have h' : ∀ (p : ℚ[X]), p ≠ 0 → (polynomial.aeval (liouville.liouville_number ↑3)) p ≠ 0,
    {
      intros p hp,
      simp [polynomial.aeval, polynomial.eval₂_ring_hom', polynomial.eval₂, polynomial.sum] at h,
      simp [polynomial.aeval, polynomial.eval₂_ring_hom', polynomial.eval₂, polynomial.sum],
      -- Somehow "clear the denominators"
      -- Look at `data.polynomial.denoms_clearable`
    }
  }
end

lemma nice_lemma {q : ℚ} {n : ℤ} (h : n ≠ 0) : (q * n).denom = 1 ↔ ↑q.denom ∣ n :=
begin
  replace hn : (n : ℚ) ≠ 0, by rwa [ne.def, ← int.cast_zero, rat.coe_int_inj],
  split; intros h,
  { rw [← rat.num_div_denom q, div_eq_mul_inv, mul_assoc, mul_comm _ ↑n, ← mul_assoc,
        ← div_eq_mul_inv, ← int.cast_mul, show (q.denom : ℚ) = ↑(q.denom : ℤ), by exact rfl,
        rat.denom_div_cast_eq_one_iff] at h,
    { exact int.dvd_of_dvd_mul_right_of_gcd_one h (coprime.symm q.cop), },
    { norm_cast, exact rat.denom_ne_zero q, }, },
  { rw [← rat.num_div_denom q, div_eq_mul_inv, mul_assoc, mul_comm _ ↑n, ← mul_assoc,
        ← div_eq_mul_inv, ← int.cast_mul, show (q.denom : ℚ) = ↑(q.denom : ℤ), by exact rfl,
        rat.denom_div_cast_eq_one_iff],
    { apply dvd_mul_of_dvd_right h, },
    { norm_cast, exact rat.denom_ne_zero q, }, },
end

lemma nice_lemma' {q : ℚ} {n : ℕ} (h : n ≠ 0) : (q * n).denom = 1 ↔ q.denom ∣ n :=
by exact_mod_cast (@nice_lemma _ n $ by exact_mod_cast h)

lemma denoms_clear (l : list ℚ) : ∃ N : ℕ, N ≠ 0 ∧ ∀ q ∈ l, (q * (N : ℚ)).denom = 1 :=
begin
  induction l with l hl l_ih,
  { use 1, simp, },
  { rcases l_ih with ⟨N, ⟨hN, h⟩⟩,
    { use (N.lcm l.denom),
      split,
      { apply lcm_ne_zero hN (rat.denom_ne_zero l), },
      { intros q h',
        rw list.mem_cons_eq at h',
        change (q * ↑((N : ℕ).lcm l.denom)).denom = 1,
        cases h',
        { rw [h', nice_lemma'],
          { exact nat.dvd_lcm_right _ _, },
          { apply lcm_ne_zero hN (rat.denom_ne_zero l), }, },
        { specialize h q h',
          rw nice_lemma' at *,
          { exact dvd_trans h (nat.dvd_lcm_left _ _), },
          { apply lcm_ne_zero hN (rat.denom_ne_zero l), },
          { exact hN, }, }, }, }, }
end

example : 3 / 2 * X ^ 2 + 7 / 9 * X + 5 = C (3 / 2 : ℚ) * X ^ 2 + C (7 / 9) * X + C 5 :=
begin
  -- If you swap orders, it will overwrite 9 = bit1 (bit0 (bit0 (bit1))) -> bit1 (bit0 (C2 * 1))
  rw (show (9 : ℚ[X]) = C 9 * 1, by simp),
  rw (show (7 : ℚ[X]) = C 7, by simp),
  rw (show (5 : ℚ[X]) = C 5 * 1, by simp),
  rw (show (3 : ℚ[X]) = C 3, by simp),
  rw (show (2 : ℚ[X]) = C 2 * 1, by simp),
  simp only [div_C_mul, euclidean_domain.div_one, div_eq_mul_inv, ring_hom.map_mul],
  simp only [mul_comm, one_mul],
end

example {p : ℚ[X]} (h : p = C (3 / 2) * X ^ 2 + C 1) : p.support = {0, 2} :=
begin
  rw [finset.ext_iff, h],
  intro a,
  rw polynomial.mem_support_iff,
  by_cases h' : a ∈ ({0, 2} : finset ℕ),
  { fin_cases h',
    { simp [C_mul_X_pow_eq_monomial, coeff_monomial], },
    { rw [coeff_add, C_mul_X_pow_eq_monomial, ← monomial_zero_left, coeff_monomial,
          coeff_monomial],
      norm_num, }, },
  { rw [coeff_add, coeff_C, C_mul_X_pow_eq_monomial, coeff_monomial],
    apply iff.symm (iff.trans (iff.trans not_not.symm (not_iff_not_of_iff _)) not_not),
    push_neg,
    rw [iff_true_intro h', true_iff],
    simp [show a ≠ 0, { by_contradiction h'', apply h', simp [h''], },
          (show a ≠ 2, { by_contradiction h'', apply h', simp [h''], }).symm], },
end

example : false :=
begin
  let p : ℚ[X] := (3 / 2) * X + 1,
  let s := p.support,
  let s' := p.to_finsupp.support,
  -- construct 3 * X + 2
  let new_coeff_hom : ℕ →₀ ℚ := {
    support := p.support,
    to_fun := λ n, 2 * p.coeff n,
    mem_support_to_fun := by simp,
  },
  let new_p : ℚ[X] := polynomial.of_finsupp new_coeff_hom,
end

example {x : ℝ} {p : ℚ[X]} (h : polynomial.aeval x p ≠ 0) :
∃ (p' : ℤ[X]), polynomial.aeval x p' ≠ 0 :=
begin
  -- get N
end

theorem a : 0 = 0 :=
begin
  simp,
end

end polynomial


/-
Copyright (c) 2019 Seul Baek. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Seul Baek

! This file was ported from Lean 3 source module tactic.omega.lin_comb
! leanprover-community/mathlib commit 58581d0fe523063f5651df0619be2bf65012a94a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.Omega.Clause

/-
Linear combination of constraints.
-/
namespace Omega

/-- Linear combination of constraints. The second
    argument is the list of constraints, and the first
    argument is the list of conefficients by which the
    constraints are multiplied -/
@[simp]
def linComb : List Nat → List Term → Term
  | [], [] => ⟨0, []⟩
  | [], _ :: _ => ⟨0, []⟩
  | _ :: _, [] => ⟨0, []⟩
  | n :: ns, t :: ts => Term.add (t.mul ↑n) (lin_comb ns ts)
#align omega.lin_comb Omega.linComb

theorem linComb_holds {v : Nat → Int} :
    ∀ {ts} (ns), (∀ t ∈ ts, 0 ≤ Term.val v t) → 0 ≤ (linComb ns ts).val v
  | [], [], h => by simp only [add_zero, term.val, lin_comb, coeffs.val_nil]
  | [], _ :: _, h => by simp only [add_zero, term.val, lin_comb, coeffs.val_nil]
  | _ :: _, [], h => by simp only [add_zero, term.val, lin_comb, coeffs.val_nil]
  | t :: ts, n :: ns, h =>
    by
    have : 0 ≤ ↑n * term.val v t + term.val v (lin_comb ns ts) :=
      by
      apply add_nonneg
      · apply mul_nonneg
        apply Int.coe_nat_nonneg
        apply h _ (Or.inl rfl)
      · apply lin_comb_holds
        apply List.forall_mem_of_forall_mem_cons h
    simpa only [lin_comb, term.val_mul, term.val_add]
#align omega.lin_comb_holds Omega.linComb_holds

/-- `unsat_lin_comb ns ts` asserts that the linear combination
    `lin_comb ns ts` is unsatisfiable  -/
def UnsatLinComb (ns : List Nat) (ts : List Term) : Prop :=
  (linComb ns ts).fst < 0 ∧ ∀ x ∈ (linComb ns ts).snd, x = (0 : Int)
#align omega.unsat_lin_comb Omega.UnsatLinComb

theorem unsatLinComb_of (ns : List Nat) (ts : List Term) :
    (linComb ns ts).fst < 0 → (∀ x ∈ (linComb ns ts).snd, x = (0 : Int)) → UnsatLinComb ns ts :=
  by
  intro h1 h2
  exact ⟨h1, h2⟩
#align omega.unsat_lin_comb_of Omega.unsatLinComb_of

theorem unsat_of_unsatLinComb (ns : List Nat) (ts : List Term) :
    UnsatLinComb ns ts → Clause.Unsat ([], ts) :=
  by
  intro h1 h2; cases' h2 with v h2
  have h3 := lin_comb_holds ns h2.right
  cases' h1 with hl hr
  cases' lin_comb ns ts with b as
  unfold term.val at h3
  rw [coeffs.val_eq_zero hr, add_zero, ← not_lt] at h3
  apply h3 hl
#align omega.unsat_of_unsat_lin_comb Omega.unsat_of_unsatLinComb

end Omega