import data.real.basic

def fn_ub (f : ℝ → ℝ) (a : ℝ) : Prop := ∀ x, f x ≤ a
def fn_lb (f : ℝ → ℝ) (a : ℝ) : Prop := ∀ x, a ≤ f x

def fn_has_ub (f : ℝ → ℝ) := ∃ a, fn_ub f a
def fn_has_lb (f : ℝ → ℝ) := ∃ a, fn_lb f a

theorem fn_ub_add {f g : ℝ → ℝ} {a b : ℝ}
    (hfa : fn_ub f a) (hgb : fn_ub g b) :
  fn_ub (λ x, f x + g x) (a + b) :=
λ x, add_le_add (hfa x) (hgb x)

variables {f g : ℝ → ℝ}

-- BEGIN

example (ubf : fn_has_ub f) (ubg : fn_has_ub g) :
  fn_has_ub (λ x, f x + g x) :=
begin
  rcases ubf with ⟨a, ubfa⟩,
  rcases ubg with ⟨b, ubfb⟩,
  exact ⟨a + b, fn_ub_add ubfa ubfb⟩,
end

/- Alternatively, using the cases tactic -/
example (ubf : fn_has_ub f) (ubg : fn_has_ub g) :
  fn_has_ub (λ x, f x + g x) :=
begin
  cases ubf with a ubfa,
  cases ubg with b ubfb,
  use a + b,
  apply fn_ub_add ubfa ubfb,
end

/- Alternatively, using the intro and cases tactics -/
example : fn_has_ub f → fn_has_ub g →
  fn_has_ub (λ x, f x + g x) :=
begin
  intros ubf ubg,
  cases ubf with a ubfa,
  cases ubg with b ubgb,
  use a + b,
  apply fn_ub_add ubfa ubgb,
end

/- Alternatively, using the rintro tactic -/
example : fn_has_ub f → fn_has_ub g →
  fn_has_ub (λ x, f x + g x) :=
begin
  rintros ⟨a, ubfa⟩ ⟨b, ubfb⟩,
  exact ⟨a + b, fn_ub_add ubfa ubfb⟩,
end

-- END


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

! This file was ported from Lean 3 source module algebra.lie.weights
! leanprover-community/mathlib commit 938fead7abdc0cbbca8eba7a1052865a169dc102
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Lie.Nilpotent
import Mathbin.Algebra.Lie.TensorProduct
import Mathbin.Algebra.Lie.Character
import Mathbin.Algebra.Lie.Engel
import Mathbin.Algebra.Lie.CartanSubalgebra
import Mathbin.LinearAlgebra.Eigenspace
import Mathbin.RingTheory.TensorProduct

/-!
# Weights and roots of Lie modules and Lie algebras

Just as a key tool when studying the behaviour of a linear operator is to decompose the space on
which it acts into a sum of (generalised) eigenspaces, a key tool when studying a representation `M`
of Lie algebra `L` is to decompose `M` into a sum of simultaneous eigenspaces of `x` as `x` ranges
over `L`. These simultaneous generalised eigenspaces are known as the weight spaces of `M`.

When `L` is nilpotent, it follows from the binomial theorem that weight spaces are Lie submodules.
Even when `L` is not nilpotent, it may be useful to study its representations by restricting them
to a nilpotent subalgebra (e.g., a Cartan subalgebra). In the particular case when we view `L` as a
module over itself via the adjoint action, the weight spaces of `L` restricted to a nilpotent
subalgebra are known as root spaces.

Basic definitions and properties of the above ideas are provided in this file.

## Main definitions

  * `lie_module.weight_space`
  * `lie_module.is_weight`
  * `lie_algebra.root_space`
  * `lie_algebra.is_root`
  * `lie_algebra.root_space_weight_space_product`
  * `lie_algebra.root_space_product`
  * `lie_algebra.zero_root_subalgebra_eq_iff_is_cartan`

## References

* [N. Bourbaki, *Lie Groups and Lie Algebras, Chapters 7--9*](bourbaki1975b)

## Tags

lie character, eigenvalue, eigenspace, weight, weight vector, root, root vector
-/

universe u v w w₁ w₂ w₃

variable {R : Type u} {L : Type v} [CommRing R] [LieRing L] [LieAlgebra R L]

variable (H : LieSubalgebra R L) [LieAlgebra.IsNilpotent R H]

variable (M : Type w) [AddCommGroup M] [Module R M] [LieRingModule L M] [LieModule R L M]

namespace LieModule

open LieAlgebra

open TensorProduct

open TensorProduct.LieModule

open BigOperators

open TensorProduct

/-- Given a Lie module `M` over a Lie algebra `L`, the pre-weight space of `M` with respect to a
map `χ : L → R` is the simultaneous generalized eigenspace of the action of all `x : L` on `M`,
with eigenvalues `χ x`.

See also `lie_module.weight_space`. -/
def preWeightSpace (χ : L → R) : Submodule R M :=
  ⨅ x : L, (toEndomorphism R L M x).maximalGeneralizedEigenspace (χ x)
#align lie_module.pre_weight_space LieModule.preWeightSpace

theorem mem_preWeightSpace (χ : L → R) (m : M) :
    m ∈ preWeightSpace M χ ↔ ∀ x, ∃ k : ℕ, ((toEndomorphism R L M x - χ x • 1) ^ k) m = 0 := by
  simp [pre_weight_space, -LinearMap.pow_apply]
#align lie_module.mem_pre_weight_space LieModule.mem_preWeightSpace

variable (R)

theorem exists_preWeightSpace_zero_le_ker_of_isNoetherian [IsNoetherian R M] (x : L) :
    ∃ k : ℕ, preWeightSpace M (0 : L → R) ≤ (toEndomorphism R L M x ^ k).ker :=
  by
  use (to_endomorphism R L M x).maximalGeneralizedEigenspaceIndex 0
  simp only [← Module.End.generalizedEigenspace_zero, pre_weight_space, Pi.zero_apply, infᵢ_le, ←
    (to_endomorphism R L M x).maximalGeneralizedEigenspace_eq]
#align lie_module.exists_pre_weight_space_zero_le_ker_of_is_noetherian LieModule.exists_preWeightSpace_zero_le_ker_of_isNoetherian

variable {R} (L)

/-- See also `bourbaki1975b` Chapter VII §1.1, Proposition 2 (ii). -/
protected theorem weight_vector_multiplication (M₁ : Type w₁) (M₂ : Type w₂) (M₃ : Type w₃)
    [AddCommGroup M₁] [Module R M₁] [LieRingModule L M₁] [LieModule R L M₁] [AddCommGroup M₂]
    [Module R M₂] [LieRingModule L M₂] [LieModule R L M₂] [AddCommGroup M₃] [Module R M₃]
    [LieRingModule L M₃] [LieModule R L M₃] (g : M₁ ⊗[R] M₂ →ₗ⁅R,L⁆ M₃) (χ₁ χ₂ : L → R) :
    ((g : M₁ ⊗[R] M₂ →ₗ[R] M₃).comp (mapIncl (preWeightSpace M₁ χ₁) (preWeightSpace M₂ χ₂))).range ≤
      preWeightSpace M₃ (χ₁ + χ₂) :=
  by
  -- Unpack the statement of the goal.
  intro m₃
  simp only [LieModuleHom.coe_to_linearMap, Pi.add_apply, Function.comp_apply, mem_pre_weight_space,
    LinearMap.coe_comp, TensorProduct.mapIncl, exists_imp, LinearMap.mem_range]
  rintro t rfl x
  -- Set up some notation.
  let F : Module.End R M₃ := to_endomorphism R L M₃ x - (χ₁ x + χ₂ x) • 1
  change ∃ k, (F ^ k) (g _) = 0
  -- The goal is linear in `t` so use induction to reduce to the case that `t` is a pure tensor.
  apply t.induction_on
  · use 0
    simp only [LinearMap.map_zero, LieModuleHom.map_zero]
  swap
  · rintro t₁ t₂ ⟨k₁, hk₁⟩ ⟨k₂, hk₂⟩
    use max k₁ k₂
    simp only [LieModuleHom.map_add, LinearMap.map_add,
      LinearMap.pow_map_zero_of_le (le_max_left k₁ k₂) hk₁,
      LinearMap.pow_map_zero_of_le (le_max_right k₁ k₂) hk₂, add_zero]
  -- Now the main argument: pure tensors.
  rintro ⟨m₁, hm₁⟩ ⟨m₂, hm₂⟩
  change ∃ k, (F ^ k) ((g : M₁ ⊗[R] M₂ →ₗ[R] M₃) (m₁ ⊗ₜ m₂)) = 0
  -- Eliminate `g` from the picture.
  let f₁ : Module.End R (M₁ ⊗[R] M₂) := (to_endomorphism R L M₁ x - χ₁ x • 1).rtensor M₂
  let f₂ : Module.End R (M₁ ⊗[R] M₂) := (to_endomorphism R L M₂ x - χ₂ x • 1).ltensor M₁
  have h_comm_square : F ∘ₗ ↑g = (g : M₁ ⊗[R] M₂ →ₗ[R] M₃).comp (f₁ + f₂) :=
    by
    ext (m₁ m₂)
    simp only [← g.map_lie x (m₁ ⊗ₜ m₂), add_smul, sub_tmul, tmul_sub, smul_tmul, lie_tmul_right,
      tmul_smul, to_endomorphism_apply_apply, LieModuleHom.map_smul, LinearMap.one_apply,
      LieModuleHom.coe_to_linearMap, LinearMap.smul_apply, Function.comp_apply, LinearMap.coe_comp,
      LinearMap.rtensor_tmul, LieModuleHom.map_add, LinearMap.add_apply, LieModuleHom.map_sub,
      LinearMap.sub_apply, LinearMap.ltensor_tmul, algebra_tensor_module.curry_apply, curry_apply,
      LinearMap.toFun_eq_coe, LinearMap.coe_restrictScalars]
    abel
  rsuffices ⟨k, hk⟩ : ∃ k, ((f₁ + f₂) ^ k) (m₁ ⊗ₜ m₂) = 0
  · use k
    rw [← LinearMap.comp_apply, LinearMap.commute_pow_left_of_commute h_comm_square,
      LinearMap.comp_apply, hk, LinearMap.map_zero]
  -- Unpack the information we have about `m₁`, `m₂`.
  simp only [mem_pre_weight_space] at hm₁ hm₂
  obtain ⟨k₁, hk₁⟩ := hm₁ x
  obtain ⟨k₂, hk₂⟩ := hm₂ x
  have hf₁ : (f₁ ^ k₁) (m₁ ⊗ₜ m₂) = 0 := by
    simp only [hk₁, zero_tmul, LinearMap.rtensor_tmul, LinearMap.rtensor_pow]
  have hf₂ : (f₂ ^ k₂) (m₁ ⊗ₜ m₂) = 0 := by
    simp only [hk₂, tmul_zero, LinearMap.ltensor_tmul, LinearMap.ltensor_pow]
  -- It's now just an application of the binomial theorem.
  use k₁ + k₂ - 1
  have hf_comm : Commute f₁ f₂ := by
    ext (m₁ m₂)
    simp only [LinearMap.mul_apply, LinearMap.rtensor_tmul, LinearMap.ltensor_tmul,
      algebra_tensor_module.curry_apply, LinearMap.toFun_eq_coe, LinearMap.ltensor_tmul,
      curry_apply, LinearMap.coe_restrictScalars]
  rw [hf_comm.add_pow']
  simp only [TensorProduct.mapIncl, Submodule.subtype_apply, Finset.sum_apply, Submodule.coe_mk,
    LinearMap.coeFn_sum, TensorProduct.map_tmul, LinearMap.smul_apply]
  -- The required sum is zero because each individual term is zero.
  apply Finset.sum_eq_zero
  rintro ⟨i, j⟩ hij
  -- Eliminate the binomial coefficients from the picture.
  suffices (f₁ ^ i * f₂ ^ j) (m₁ ⊗ₜ m₂) = 0 by
    rw [this]
    apply smul_zero
  -- Finish off with appropriate case analysis.
  cases' Nat.le_or_le_of_add_eq_add_pred (finset.nat.mem_antidiagonal.mp hij) with hi hj
  ·
    rw [(hf_comm.pow_pow i j).Eq, LinearMap.mul_apply, LinearMap.pow_map_zero_of_le hi hf₁,
      LinearMap.map_zero]
  · rw [LinearMap.mul_apply, LinearMap.pow_map_zero_of_le hj hf₂, LinearMap.map_zero]
#align lie_module.weight_vector_multiplication LieModule.weight_vector_multiplication

variable {L M}

theorem lie_mem_preWeightSpace_of_mem_preWeightSpace {χ₁ χ₂ : L → R} {x : L} {m : M}
    (hx : x ∈ preWeightSpace L χ₁) (hm : m ∈ preWeightSpace M χ₂) :
    ⁅x, m⁆ ∈ preWeightSpace M (χ₁ + χ₂) :=
  by
  apply LieModule.weight_vector_multiplication L L M M (to_module_hom R L M) χ₁ χ₂
  simp only [LieModuleHom.coe_to_linearMap, Function.comp_apply, LinearMap.coe_comp,
    TensorProduct.mapIncl, LinearMap.mem_range]
  use ⟨x, hx⟩ ⊗ₜ ⟨m, hm⟩
  simp only [Submodule.subtype_apply, to_module_hom_apply, TensorProduct.map_tmul]
  rfl
#align lie_module.lie_mem_pre_weight_space_of_mem_pre_weight_space LieModule.lie_mem_preWeightSpace_of_mem_preWeightSpace

variable (M)

/-- If a Lie algebra is nilpotent, then pre-weight spaces are Lie submodules. -/
def weightSpace [LieAlgebra.IsNilpotent R L] (χ : L → R) : LieSubmodule R L M :=
  { preWeightSpace M χ with
    lie_mem := fun x m hm => by
      rw [← zero_add χ]
      refine' lie_mem_pre_weight_space_of_mem_pre_weight_space _ hm
      suffices pre_weight_space L (0 : L → R) = ⊤ by simp only [this, Submodule.mem_top]
      exact LieAlgebra.infᵢ_max_gen_zero_eigenspace_eq_top_of_nilpotent R L }
#align lie_module.weight_space LieModule.weightSpace

theorem mem_weightSpace [LieAlgebra.IsNilpotent R L] (χ : L → R) (m : M) :
    m ∈ weightSpace M χ ↔ m ∈ preWeightSpace M χ :=
  Iff.rfl
#align lie_module.mem_weight_space LieModule.mem_weightSpace

/-- See also the more useful form `lie_module.zero_weight_space_eq_top_of_nilpotent`. -/
@[simp]
theorem zero_weightSpace_eq_top_of_nilpotent' [LieAlgebra.IsNilpotent R L] [IsNilpotent R L M] :
    weightSpace M (0 : L → R) = ⊤ :=
  by
  rw [← LieSubmodule.coe_to_submodule_eq_iff, LieSubmodule.top_coeSubmodule]
  exact infi_max_gen_zero_eigenspace_eq_top_of_nilpotent R L M
#align lie_module.zero_weight_space_eq_top_of_nilpotent' LieModule.zero_weightSpace_eq_top_of_nilpotent'

theorem coe_weightSpace_of_top [LieAlgebra.IsNilpotent R L] (χ : L → R) :
    (weightSpace M (χ ∘ (⊤ : LieSubalgebra R L).incl) : Submodule R M) = weightSpace M χ :=
  by
  ext m
  simp only [weight_space, LieSubmodule.coe_to_submodule_mk, LieSubalgebra.coe_bracket_of_module,
    Function.comp_apply, mem_pre_weight_space]
  constructor <;> intro h x
  · obtain ⟨k, hk⟩ := h ⟨x, Set.mem_univ x⟩
    use k
    exact hk
  · obtain ⟨k, hk⟩ := h x
    use k
    exact hk
#align lie_module.coe_weight_space_of_top LieModule.coe_weightSpace_of_top

@[simp]
theorem zero_weightSpace_eq_top_of_nilpotent [LieAlgebra.IsNilpotent R L] [IsNilpotent R L M] :
    weightSpace M (0 : (⊤ : LieSubalgebra R L) → R) = ⊤ :=
  by
  /- We use `coe_weight_space_of_top` as a trick to circumvent the fact that we don't (yet) know
      `is_nilpotent R (⊤ : lie_subalgebra R L) M` is equivalent to `is_nilpotent R L M`. -/
  have h₀ : (0 : L → R) ∘ (⊤ : LieSubalgebra R L).incl = 0 :=
    by
    ext
    rfl
  rw [← LieSubmodule.coe_to_submodule_eq_iff, LieSubmodule.top_coeSubmodule, ← h₀,
    coe_weight_space_of_top, ← infi_max_gen_zero_eigenspace_eq_top_of_nilpotent R L M]
  rfl
#align lie_module.zero_weight_space_eq_top_of_nilpotent LieModule.zero_weightSpace_eq_top_of_nilpotent

/-- Given a Lie module `M` of a Lie algebra `L`, a weight of `M` with respect to a nilpotent
subalgebra `H ⊆ L` is a Lie character whose corresponding weight space is non-empty. -/
def IsWeight (χ : LieCharacter R H) : Prop :=
  weightSpace M χ ≠ ⊥
#align lie_module.is_weight LieModule.IsWeight

/-- For a non-trivial nilpotent Lie module over a nilpotent Lie algebra, the zero character is a
weight with respect to the `⊤` Lie subalgebra. -/
theorem isWeight_zero_of_nilpotent [Nontrivial M] [LieAlgebra.IsNilpotent R L] [IsNilpotent R L M] :
    IsWeight (⊤ : LieSubalgebra R L) M 0 :=
  by
  rw [is_weight, LieHom.coe_zero, zero_weight_space_eq_top_of_nilpotent]
  exact top_ne_bot
#align lie_module.is_weight_zero_of_nilpotent LieModule.isWeight_zero_of_nilpotent

/-- A (nilpotent) Lie algebra acts nilpotently on the zero weight space of a Noetherian Lie
module. -/
theorem isNilpotent_toEndomorphism_weightSpace_zero [LieAlgebra.IsNilpotent R L] [IsNoetherian R M]
    (x : L) : IsNilpotent <| toEndomorphism R L (weightSpace M (0 : L → R)) x :=
  by
  obtain ⟨k, hk⟩ := exists_pre_weight_space_zero_le_ker_of_is_noetherian R M x
  use k
  ext ⟨m, hm⟩
  rw [LinearMap.zero_apply, LieSubmodule.coe_zero, Submodule.coe_eq_zero, ←
    LieSubmodule.toEndomorphism_restrict_eq_toEndomorphism, LinearMap.pow_restrict, ←
    SetLike.coe_eq_coe, LinearMap.restrict_apply, Submodule.coe_mk, Submodule.coe_zero]
  exact hk hm
#align lie_module.is_nilpotent_to_endomorphism_weight_space_zero LieModule.isNilpotent_toEndomorphism_weightSpace_zero

/-- By Engel's theorem, when the Lie algebra is Noetherian, the zero weight space of a Noetherian
Lie module is nilpotent. -/
instance [LieAlgebra.IsNilpotent R L] [IsNoetherian R L] [IsNoetherian R M] :
    IsNilpotent R L (weightSpace M (0 : L → R)) :=
  isNilpotent_iff_forall.mpr <| isNilpotent_toEndomorphism_weightSpace_zero M

end LieModule

namespace LieAlgebra

open TensorProduct

open TensorProduct.LieModule

open LieModule

/-- Given a nilpotent Lie subalgebra `H ⊆ L`, the root space of a map `χ : H → R` is the weight
space of `L` regarded as a module of `H` via the adjoint action. -/
abbrev rootSpace (χ : H → R) : LieSubmodule R H L :=
  weightSpace L χ
#align lie_algebra.root_space LieAlgebra.rootSpace

@[simp]
theorem zero_rootSpace_eq_top_of_nilpotent [h : IsNilpotent R L] :
    rootSpace (⊤ : LieSubalgebra R L) 0 = ⊤ :=
  zero_weightSpace_eq_top_of_nilpotent L
#align lie_algebra.zero_root_space_eq_top_of_nilpotent LieAlgebra.zero_rootSpace_eq_top_of_nilpotent

/-- A root of a Lie algebra `L` with respect to a nilpotent subalgebra `H ⊆ L` is a weight of `L`,
regarded as a module of `H` via the adjoint action. -/
abbrev IsRoot :=
  IsWeight H L
#align lie_algebra.is_root LieAlgebra.IsRoot

@[simp]
theorem rootSpace_comap_eq_weightSpace (χ : H → R) :
    (rootSpace H χ).comap H.incl' = weightSpace H χ :=
  by
  ext x
  let f : H → Module.End R L := fun y => to_endomorphism R H L y - χ y • 1
  let g : H → Module.End R H := fun y => to_endomorphism R H H y - χ y • 1
  suffices
    (∀ y : H, ∃ k : ℕ, (f y ^ k).comp (H.incl : H →ₗ[R] L) x = 0) ↔
      ∀ y : H, ∃ k : ℕ, (H.incl : H →ₗ[R] L).comp (g y ^ k) x = 0
    by
    simp only [LieHom.coe_toLinearMap, LieSubalgebra.coe_incl, Function.comp_apply,
      LinearMap.coe_comp, Submodule.coe_eq_zero] at this
    simp only [mem_weight_space, mem_pre_weight_space, LieSubalgebra.coe_incl',
      LieSubmodule.mem_comap, this]
  have hfg : ∀ y : H, (f y).comp (H.incl : H →ₗ[R] L) = (H.incl : H →ₗ[R] L).comp (g y) :=
    by
    rintro ⟨y, hy⟩
    ext ⟨z, hz⟩
    simp only [Submodule.coe_sub, to_endomorphism_apply_apply, LieHom.coe_toLinearMap,
      LinearMap.one_apply, LieSubalgebra.coe_incl, LieSubalgebra.coe_bracket_of_module,
      LieSubalgebra.coe_bracket, LinearMap.smul_apply, Function.comp_apply,
      Submodule.coe_smul_of_tower, LinearMap.coe_comp, LinearMap.sub_apply]
  simp_rw [LinearMap.commute_pow_left_of_commute (hfg _)]
#align lie_algebra.root_space_comap_eq_weight_space LieAlgebra.rootSpace_comap_eq_weightSpace

variable {H M}

theorem lie_mem_weightSpace_of_mem_weightSpace {χ₁ χ₂ : H → R} {x : L} {m : M}
    (hx : x ∈ rootSpace H χ₁) (hm : m ∈ weightSpace M χ₂) : ⁅x, m⁆ ∈ weightSpace M (χ₁ + χ₂) :=
  by
  apply LieModule.weight_vector_multiplication H L M M ((to_module_hom R L M).restrictLie H) χ₁ χ₂
  simp only [LieModuleHom.coe_to_linearMap, Function.comp_apply, LinearMap.coe_comp,
    TensorProduct.mapIncl, LinearMap.mem_range]
  use ⟨x, hx⟩ ⊗ₜ ⟨m, hm⟩
  simp only [Submodule.subtype_apply, to_module_hom_apply, Submodule.coe_mk,
    LieModuleHom.coe_restrictLie, TensorProduct.map_tmul]
#align lie_algebra.lie_mem_weight_space_of_mem_weight_space LieAlgebra.lie_mem_weightSpace_of_mem_weightSpace

variable (R L H M)

/-- Auxiliary definition for `root_space_weight_space_product`,
which is close to the deterministic timeout limit.
-/
def rootSpaceWeightSpaceProductAux {χ₁ χ₂ χ₃ : H → R} (hχ : χ₁ + χ₂ = χ₃) :
    rootSpace H χ₁ →ₗ[R] weightSpace M χ₂ →ₗ[R] weightSpace M χ₃
    where
  toFun x :=
    { toFun := fun m =>
        ⟨⁅(x : L), (m : M)⁆, hχ ▸ lie_mem_weightSpace_of_mem_weightSpace x.property m.property⟩
      map_add' := fun m n => by
        simp only [LieSubmodule.coe_add, lie_add]
        rfl
      map_smul' := fun t m =>
        by
        conv_lhs =>
          congr
          rw [LieSubmodule.coe_smul, lie_smul]
        rfl }
  map_add' x y := by
    ext m <;>
      rw [LinearMap.add_apply, LinearMap.coe_mk, LinearMap.coe_mk, LinearMap.coe_mk, Subtype.coe_mk,
        LieSubmodule.coe_add, LieSubmodule.coe_add, add_lie, Subtype.coe_mk, Subtype.coe_mk]
  map_smul' t x := by
    simp only [RingHom.id_apply]
    ext m
    rw [LinearMap.smul_apply, LinearMap.coe_mk, LinearMap.coe_mk, Subtype.coe_mk,
      LieSubmodule.coe_smul, smul_lie, LieSubmodule.coe_smul, Subtype.coe_mk]
#align lie_algebra.root_space_weight_space_product_aux LieAlgebra.rootSpaceWeightSpaceProductAux

/-- Given a nilpotent Lie subalgebra `H ⊆ L` together with `χ₁ χ₂ : H → R`, there is a natural
`R`-bilinear product of root vectors and weight vectors, compatible with the actions of `H`. -/
def rootSpaceWeightSpaceProduct (χ₁ χ₂ χ₃ : H → R) (hχ : χ₁ + χ₂ = χ₃) :
    rootSpace H χ₁ ⊗[R] weightSpace M χ₂ →ₗ⁅R,H⁆ weightSpace M χ₃ :=
  liftLie R H (rootSpace H χ₁) (weightSpace M χ₂) (weightSpace M χ₃)
    { toLinearMap := rootSpaceWeightSpaceProductAux R L H M hχ
      map_lie' := fun x y => by
        ext m <;>
          rw [root_space_weight_space_product_aux, LieHom.lie_apply, LieSubmodule.coe_sub,
            LinearMap.coe_mk, LinearMap.coe_mk, Subtype.coe_mk, Subtype.coe_mk,
            LieSubmodule.coe_bracket, LieSubmodule.coe_bracket, Subtype.coe_mk,
            LieSubalgebra.coe_bracket_of_module, LieSubalgebra.coe_bracket_of_module,
            LieSubmodule.coe_bracket, LieSubalgebra.coe_bracket_of_module, lie_lie] }
#align lie_algebra.root_space_weight_space_product LieAlgebra.rootSpaceWeightSpaceProduct

@[simp]
theorem coe_rootSpaceWeightSpaceProduct_tmul (χ₁ χ₂ χ₃ : H → R) (hχ : χ₁ + χ₂ = χ₃)
    (x : rootSpace H χ₁) (m : weightSpace M χ₂) :
    (rootSpaceWeightSpaceProduct R L H M χ₁ χ₂ χ₃ hχ (x ⊗ₜ m) : M) = ⁅(x : L), (m : M)⁆ := by
  simp only [root_space_weight_space_product, root_space_weight_space_product_aux, lift_apply,
    LieModuleHom.coe_to_linearMap, coe_lift_lie_eq_lift_coe, Submodule.coe_mk, LinearMap.coe_mk,
    LieModuleHom.coe_mk]
#align lie_algebra.coe_root_space_weight_space_product_tmul LieAlgebra.coe_rootSpaceWeightSpaceProduct_tmul

/-- Given a nilpotent Lie subalgebra `H ⊆ L` together with `χ₁ χ₂ : H → R`, there is a natural
`R`-bilinear product of root vectors, compatible with the actions of `H`. -/
def rootSpaceProduct (χ₁ χ₂ χ₃ : H → R) (hχ : χ₁ + χ₂ = χ₃) :
    rootSpace H χ₁ ⊗[R] rootSpace H χ₂ →ₗ⁅R,H⁆ rootSpace H χ₃ :=
  rootSpaceWeightSpaceProduct R L H L χ₁ χ₂ χ₃ hχ
#align lie_algebra.root_space_product LieAlgebra.rootSpaceProduct

@[simp]
theorem rootSpaceProduct_def : rootSpaceProduct R L H = rootSpaceWeightSpaceProduct R L H L :=
  rfl
#align lie_algebra.root_space_product_def LieAlgebra.rootSpaceProduct_def

theorem rootSpaceProduct_tmul (χ₁ χ₂ χ₃ : H → R) (hχ : χ₁ + χ₂ = χ₃) (x : rootSpace H χ₁)
    (y : rootSpace H χ₂) : (rootSpaceProduct R L H χ₁ χ₂ χ₃ hχ (x ⊗ₜ y) : L) = ⁅(x : L), (y : L)⁆ :=
  by simp only [root_space_product_def, coe_root_space_weight_space_product_tmul]
#align lie_algebra.root_space_product_tmul LieAlgebra.rootSpaceProduct_tmul

/-- Given a nilpotent Lie subalgebra `H ⊆ L`, the root space of the zero map `0 : H → R` is a Lie
subalgebra of `L`. -/
def zeroRootSubalgebra : LieSubalgebra R L :=
  { (rootSpace H 0 : Submodule R L) with
    lie_mem' := fun x y hx hy =>
      by
      let xy : root_space H 0 ⊗[R] root_space H 0 := ⟨x, hx⟩ ⊗ₜ ⟨y, hy⟩
      suffices (root_space_product R L H 0 0 0 (add_zero 0) xy : L) ∈ root_space H 0 by
        rwa [root_space_product_tmul, Subtype.coe_mk, Subtype.coe_mk] at this
      exact (root_space_product R L H 0 0 0 (add_zero 0) xy).property }
#align lie_algebra.zero_root_subalgebra LieAlgebra.zeroRootSubalgebra

@[simp]
theorem coe_zeroRootSubalgebra : (zeroRootSubalgebra R L H : Submodule R L) = rootSpace H 0 :=
  rfl
#align lie_algebra.coe_zero_root_subalgebra LieAlgebra.coe_zeroRootSubalgebra

theorem mem_zeroRootSubalgebra (x : L) :
    x ∈ zeroRootSubalgebra R L H ↔ ∀ y : H, ∃ k : ℕ, (toEndomorphism R H L y ^ k) x = 0 := by
  simp only [zero_root_subalgebra, mem_weight_space, mem_pre_weight_space, Pi.zero_apply, sub_zero,
    SetLike.mem_coe, zero_smul, LieSubmodule.mem_coeSubmodule, Submodule.mem_carrier,
    LieSubalgebra.mem_mk_iff]
#align lie_algebra.mem_zero_root_subalgebra LieAlgebra.mem_zeroRootSubalgebra

theorem toLieSubmodule_le_rootSpace_zero : H.toLieSubmodule ≤ rootSpace H 0 :=
  by
  intro x hx
  simp only [LieSubalgebra.mem_toLieSubmodule] at hx
  simp only [mem_weight_space, mem_pre_weight_space, Pi.zero_apply, sub_zero, zero_smul]
  intro y
  obtain ⟨k, hk⟩ := (inferInstance : IsNilpotent R H)
  use k
  let f : Module.End R H := to_endomorphism R H H y
  let g : Module.End R L := to_endomorphism R H L y
  have hfg : g.comp (H : Submodule R L).Subtype = (H : Submodule R L).Subtype.comp f :=
    by
    ext z
    simp only [to_endomorphism_apply_apply, Submodule.subtype_apply,
      LieSubalgebra.coe_bracket_of_module, LieSubalgebra.coe_bracket, Function.comp_apply,
      LinearMap.coe_comp]
  change (g ^ k).comp (H : Submodule R L).Subtype ⟨x, hx⟩ = 0
  rw [LinearMap.commute_pow_left_of_commute hfg k]
  have h := iterate_to_endomorphism_mem_lower_central_series R H H y ⟨x, hx⟩ k
  rw [hk, LieSubmodule.mem_bot] at h
  simp only [Submodule.subtype_apply, Function.comp_apply, LinearMap.pow_apply, LinearMap.coe_comp,
    Submodule.coe_eq_zero]
  exact h
#align lie_algebra.to_lie_submodule_le_root_space_zero LieAlgebra.toLieSubmodule_le_rootSpace_zero

theorem le_zeroRootSubalgebra : H ≤ zeroRootSubalgebra R L H :=
  by
  rw [← LieSubalgebra.coe_submodule_le_coe_submodule, ← H.coe_to_lie_submodule,
    coe_zero_root_subalgebra, LieSubmodule.coeSubmodule_le_coeSubmodule]
  exact to_lie_submodule_le_root_space_zero R L H
#align lie_algebra.le_zero_root_subalgebra LieAlgebra.le_zeroRootSubalgebra

@[simp]
theorem zeroRootSubalgebra_normalizer_eq_self :
    (zeroRootSubalgebra R L H).normalizer = zeroRootSubalgebra R L H :=
  by
  refine' le_antisymm _ (LieSubalgebra.le_normalizer _)
  intro x hx
  rw [LieSubalgebra.mem_normalizer_iff] at hx
  rw [mem_zero_root_subalgebra]
  rintro ⟨y, hy⟩
  specialize hx y (le_zero_root_subalgebra R L H hy)
  rw [mem_zero_root_subalgebra] at hx
  obtain ⟨k, hk⟩ := hx ⟨y, hy⟩
  rw [← lie_skew, LinearMap.map_neg, neg_eq_zero] at hk
  use k + 1
  rw [LinearMap.iterate_succ, LinearMap.coe_comp, Function.comp_apply, to_endomorphism_apply_apply,
    LieSubalgebra.coe_bracket_of_module, Submodule.coe_mk, hk]
#align lie_algebra.zero_root_subalgebra_normalizer_eq_self LieAlgebra.zeroRootSubalgebra_normalizer_eq_self

/-- If the zero root subalgebra of a nilpotent Lie subalgebra `H` is just `H` then `H` is a Cartan
subalgebra.

When `L` is Noetherian, it follows from Engel's theorem that the converse holds. See
`lie_algebra.zero_root_subalgebra_eq_iff_is_cartan` -/
theorem is_cartan_of_zeroRootSubalgebra_eq (h : zeroRootSubalgebra R L H = H) :
    H.IsCartanSubalgebra :=
  { nilpotent := inferInstance
    self_normalizing := by
      rw [← h]
      exact zero_root_subalgebra_normalizer_eq_self R L H }
#align lie_algebra.is_cartan_of_zero_root_subalgebra_eq LieAlgebra.is_cartan_of_zeroRootSubalgebra_eq

@[simp]
theorem zeroRootSubalgebra_eq_of_is_cartan (H : LieSubalgebra R L) [H.IsCartanSubalgebra]
    [IsNoetherian R L] : zeroRootSubalgebra R L H = H :=
  by
  refine' le_antisymm _ (le_zero_root_subalgebra R L H)
  suffices root_space H 0 ≤ H.to_lie_submodule by exact fun x hx => this hx
  obtain ⟨k, hk⟩ := (root_space H 0).isNilpotent_iff_exists_self_le_ucs.mp (by infer_instance)
  exact hk.trans (LieSubmodule.ucs_le_of_normalizer_eq_self (by simp) k)
#align lie_algebra.zero_root_subalgebra_eq_of_is_cartan LieAlgebra.zeroRootSubalgebra_eq_of_is_cartan

theorem zeroRootSubalgebra_eq_iff_is_cartan [IsNoetherian R L] :
    zeroRootSubalgebra R L H = H ↔ H.IsCartanSubalgebra :=
  ⟨is_cartan_of_zeroRootSubalgebra_eq R L H, by
    intros
    simp⟩
#align lie_algebra.zero_root_subalgebra_eq_iff_is_cartan LieAlgebra.zeroRootSubalgebra_eq_iff_is_cartan

end LieAlgebra

namespace LieModule

open LieAlgebra

variable {R L H}

/-- A priori, weight spaces are Lie submodules over the Lie subalgebra `H` used to define them.
However they are naturally Lie submodules over the (in general larger) Lie subalgebra
`zero_root_subalgebra R L H`. Even though it is often the case that
`zero_root_subalgebra R L H = H`, it is likely to be useful to have the flexibility not to have
to invoke this equality (as well as to work more generally). -/
def weightSpace' (χ : H → R) : LieSubmodule R (zeroRootSubalgebra R L H) M :=
  { (weightSpace M χ : Submodule R M) with
    lie_mem := fun x m hm =>
      by
      have hx : (x : L) ∈ root_space H 0 :=
        by
        rw [← LieSubmodule.mem_coeSubmodule, ← coe_zero_root_subalgebra]
        exact x.property
      rw [← zero_add χ]
      exact lie_mem_weight_space_of_mem_weight_space hx hm }
#align lie_module.weight_space' LieModule.weightSpace'

@[simp]
theorem coe_weightSpace' (χ : H → R) : (weightSpace' M χ : Submodule R M) = weightSpace M χ :=
  rfl
#align lie_module.coe_weight_space' LieModule.coe_weightSpace'

end LieModule


/-
Copyright (c) 2015 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad

Multiplicity and prime factors. We have:

  mult p n        := the greatest power of p dividing n if p > 1 and n > 0, and 0 otherwise.
  prime_factors n := the finite set of prime factors of n, assuming n > 0

-/
import data.nat data.finset .primes algebra.group_bigops
open eq.ops finset well_founded decidable

namespace nat
-- TODO: this should be proved more generally in ring_bigops
theorem Prod_pos {A : Type} [deceqA : decidable_eq A]
    {s : finset A} {f : A → ℕ} (fpos : ∀ n, n ∈ s → f n > 0) :
  (∏ n ∈ s, f n) > 0 :=
begin
  induction s with a s anins ih,
    {rewrite Prod_empty; exact zero_lt_one},
  rewrite [!Prod_insert_of_not_mem anins],
  exact (mul_pos (fpos a (mem_insert a _)) (ih (forall_of_forall_insert fpos)))
end

/- multiplicity -/

theorem mult_rec_decreasing {p n : ℕ} (Hp : p > 1) (Hn : n > 0) : n / p < n :=
have H' : n < n * p,
 by rewrite [-mul_one n at {1}]; apply mul_lt_mul_of_pos_left Hp Hn,
nat.div_lt_of_lt_mul H'

private definition mult.F (p : ℕ) (n : ℕ) (f: Π {m : ℕ}, m < n → ℕ) : ℕ :=
if H : (p > 1 ∧ n > 0) ∧ p ∣ n then
  succ (f (mult_rec_decreasing (and.left (and.left H)) (and.right (and.left H))))
else 0

definition mult (p n : ℕ) : ℕ := fix (mult.F p) n

theorem mult_rec {p n : ℕ} (pgt1 : p > 1) (ngt0 : n > 0) (pdivn : p ∣ n) :
  mult p n = succ (mult p (n / p)) :=
have (p > 1 ∧ n > 0) ∧ p ∣ n, from and.intro (and.intro pgt1 ngt0) pdivn,
eq.trans (well_founded.fix_eq (mult.F p) n) (dif_pos this)

private theorem mult_base {p n : ℕ} (H : ¬ ((p > 1 ∧ n > 0) ∧ p ∣ n)) :
  mult p n = 0 :=
eq.trans (well_founded.fix_eq (mult.F p) n) (dif_neg H)

theorem mult_zero_right (p : ℕ) : mult p 0 = 0 :=
mult_base (assume H, !lt.irrefl (and.right (and.left H)))

theorem mult_eq_zero_of_not_dvd {p n : ℕ} (H : ¬ p ∣ n) : mult p n = 0 :=
mult_base (assume H', H (and.right H'))

theorem mult_eq_zero_of_le_one {p : ℕ} (n : ℕ) (H : p ≤ 1) : mult p n = 0 :=
mult_base (assume H', not_lt_of_ge H (and.left (and.left H')))

theorem mult_zero_left (n : ℕ) : mult 0 n = 0 :=
mult_eq_zero_of_le_one n !dec_trivial

theorem mult_one_left (n : ℕ) : mult 1 n = 0 :=
mult_eq_zero_of_le_one n !dec_trivial

theorem mult_pos_of_dvd {p n : ℕ} (pgt1 : p > 1) (npos : n > 0) (pdvdn : p ∣ n) : mult p n > 0 :=
by rewrite (mult_rec pgt1 npos pdvdn); apply succ_pos

theorem not_dvd_of_mult_eq_zero {p n : ℕ} (pgt1 : p > 1) (npos : n > 0) (H : mult p n = 0) :
  ¬ p ∣ n :=
suppose p ∣ n,
ne_of_gt (mult_pos_of_dvd pgt1 npos this) H

theorem dvd_of_mult_pos {p n : ℕ} (H : mult p n > 0) : p ∣ n :=
by_contradiction (suppose ¬ p ∣ n, ne_of_gt H (mult_eq_zero_of_not_dvd this))

/- properties of mult -/

theorem mult_eq_zero_of_prime_of_ne {p q : ℕ} (primep : prime p) (primeq : prime q)
    (pneq : p ≠ q) :
  mult p q = 0 :=
mult_eq_zero_of_not_dvd (not_dvd_of_prime_of_coprime primep (coprime_primes primep primeq pneq))

theorem pow_mult_dvd (p n : ℕ) : p^(mult p n) ∣ n :=
begin
  induction n using nat.strong_induction_on with [n, ih],
  cases eq_zero_or_pos n with [nz, npos],
    {rewrite nz, apply dvd_zero},
  cases le_or_gt p 1 with [ple1, pgt1],
    {rewrite [!mult_eq_zero_of_le_one ple1, pow_zero], apply one_dvd},
  cases (or.swap (em (p ∣ n))) with [pndvdn, pdvdn],
    {rewrite [mult_eq_zero_of_not_dvd pndvdn, pow_zero], apply one_dvd},
  show p ^ (mult p n) ∣ n, from dvd.elim pdvdn
    (take n',
      suppose n = p * n',
      have p > 0, from lt.trans zero_lt_one pgt1,
      have n / p = n', from !nat.div_eq_of_eq_mul_right this `n = p * n'`,
      have n' < n,
        by rewrite -this; apply mult_rec_decreasing pgt1 npos,
      begin
        rewrite [mult_rec pgt1 npos pdvdn, `n / p = n'`, pow_succ], subst n,
        apply mul_dvd_mul !dvd.refl,
        apply ih _ this
      end)
end

theorem mult_one_right (p : ℕ) : mult p 1 = 0:=
have H : p^(mult p 1) = 1, from eq_one_of_dvd_one !pow_mult_dvd,
or.elim (le_or_gt p 1)
  (suppose p ≤ 1, by rewrite [!mult_eq_zero_of_le_one this])
  (suppose p > 1,
    by_contradiction
      (suppose mult p 1 ≠ 0,
       have mult p 1 > 0,       from pos_of_ne_zero this,
       have p^(mult p 1) > 1, from pow_gt_one `p > 1` this,
       show false,              by rewrite H at this; apply !lt.irrefl this))

private theorem mult_pow_mul {p n : ℕ} (i : ℕ) (pgt1 : p > 1) (npos : n > 0) :
  mult p (p^i * n) = i + mult p n :=
begin
  induction i with [i, ih],
    {krewrite [pow_zero, one_mul, zero_add]},
  have p > 0, from lt.trans zero_lt_one pgt1,
  have psin_pos : p^(succ i) * n > 0, from mul_pos (!pow_pos_of_pos this) npos,
  have p ∣ p^(succ i) * n, by rewrite [pow_succ, mul.assoc]; apply dvd_mul_right,
  rewrite [mult_rec pgt1 psin_pos this, pow_succ', mul.right_comm, !nat.mul_div_cancel `p > 0`, ih],
  rewrite [add.comm i, add.comm (succ i)]
end

theorem mult_pow_self {p : ℕ} (i : ℕ) (pgt1 : p > 1) : mult p (p^i) = i :=
by rewrite [-(mul_one (p^i)), mult_pow_mul i pgt1 zero_lt_one, mult_one_right]

theorem mult_self {p : ℕ} (pgt1 : p > 1) : mult p p = 1 :=
by rewrite [-pow_one p at {2}]; apply mult_pow_self 1 pgt1

theorem le_mult {p i n : ℕ} (pgt1 : p > 1) (npos : n > 0) (pidvd : p^i ∣ n) : i ≤ mult p n :=
dvd.elim pidvd
  (take m,
    suppose n = p^i * m,
    have m > 0, from pos_of_mul_pos_left (this ▸ npos),
    by subst n; rewrite [mult_pow_mul i pgt1 this]; apply le_add_right)

theorem not_dvd_div_pow_mult {p n : ℕ} (pgt1 : p > 1) (npos : n > 0) : ¬ p ∣ n / p^(mult p n) :=
assume pdvd : p ∣ n / p^(mult p n),
obtain m (H : n / p^(mult p n) = p * m), from exists_eq_mul_right_of_dvd pdvd,
have n = p^(succ (mult p n)) * m, from
  calc
    n     = p^mult p n * (n / p^mult p n) : by rewrite (nat.mul_div_cancel' !pow_mult_dvd)
      ... = p^(succ (mult p n)) * m         : by rewrite [H, pow_succ', mul.assoc],
have p^(succ (mult p n)) ∣ n,    by rewrite this at {2}; apply dvd_mul_right,
have succ (mult p n) ≤ mult p n, from le_mult pgt1 npos this,
show false,                      from !not_succ_le_self this

theorem mult_mul {p m n : ℕ} (primep : prime p) (mpos : m > 0) (npos : n > 0) :
  mult p (m * n) = mult p m + mult p n :=
let m' := m / p^mult p m, n' := n / p^mult p n in
have p > 1, from gt_one_of_prime primep,
have meq : m = p^mult p m * m', by rewrite (nat.mul_div_cancel' !pow_mult_dvd),
have neq : n = p^mult p n * n', by rewrite (nat.mul_div_cancel' !pow_mult_dvd),
have m'pos : m' > 0, from pos_of_mul_pos_left (meq ▸ mpos),
have n'pos : n' > 0, from pos_of_mul_pos_left (neq ▸ npos),
have npdvdm' : ¬ p ∣ m', from !not_dvd_div_pow_mult `p > 1` mpos,
have npdvdn' : ¬ p ∣ n', from !not_dvd_div_pow_mult `p > 1` npos,
have npdvdm'n' : ¬ p ∣ m' * n', from not_dvd_mul_of_prime primep npdvdm' npdvdn',
have m'n'pos : m' * n' > 0, from mul_pos m'pos n'pos,
have multm'n' : mult p (m' * n') = 0, from mult_eq_zero_of_not_dvd npdvdm'n',
calc
  mult p (m * n) = mult p (p^(mult p m + mult p n) * (m' * n')) :
                     by rewrite [pow_add, mul.right_comm, -mul.assoc, -meq, mul.assoc,
                                 mul.comm (n / _), -neq]
             ... = mult p m + mult p n                          :
                     by rewrite [!mult_pow_mul `p > 1` m'n'pos, multm'n']

theorem mult_pow {p m : ℕ} (n : ℕ) (mpos : m > 0) (primep : prime p) :
  mult p (m^n) = n * mult p m :=
begin
  induction n with n ih,
    krewrite [pow_zero, mult_one_right, zero_mul],
  rewrite [pow_succ, mult_mul primep mpos (!pow_pos_of_pos mpos), ih, succ_mul, add.comm]
end

theorem dvd_of_forall_prime_mult_le {m n : ℕ} (mpos : m > 0)
    (H : ∀ {p}, prime p → mult p m ≤ mult p n) :
  m ∣ n :=
begin
  revert H, revert n,
  induction m using nat.strong_induction_on with [m, ih],
  cases (decidable.em (m = 1)) with [meq, mneq],
    {intros, rewrite meq, apply one_dvd},
  have mgt1 : m > 1, from lt_of_le_of_ne (succ_le_of_lt mpos) (ne.symm mneq),
  have mge2 : m ≥ 2, from succ_le_of_lt mgt1,
  have hpd : ∃ p, prime p ∧ p ∣ m, from exists_prime_and_dvd mge2,
  cases hpd with [p, H1],
  cases H1 with [primep, pdvdm],
  intro n,
  cases (eq_zero_or_pos n) with [nz, npos],
    {intros; rewrite nz; apply dvd_zero},
  assume H : ∀ {p : ℕ}, prime p → mult p m ≤ mult p n,
  obtain m' (meq : m = p * m'), from exists_eq_mul_right_of_dvd pdvdm,
  have pgt1 : p > 1, from gt_one_of_prime primep,
  have m'pos : m' > 0, from pos_of_ne_zero
      (assume m'z, by revert mpos; rewrite [meq, m'z, mul_zero]; apply not_lt_zero),
  have m'ltm : m' < m,
    by rewrite [meq, -one_mul m' at {1}]; apply mul_lt_mul_of_lt_of_le m'pos pgt1 !le.refl,
  have multpm : mult p m ≥ 1, from le_mult pgt1 mpos (by rewrite pow_one; apply pdvdm),
  have multpn : mult p n ≥ 1, from le.trans multpm (H primep),
  obtain n' (neq : n = p * n'),
    from exists_eq_mul_right_of_dvd (dvd_of_mult_pos (lt_of_succ_le multpn)),
  have n'pos : n' > 0, from pos_of_ne_zero
      (assume n'z, by revert npos; rewrite [neq, n'z, mul_zero]; apply not_lt_zero),
  have ∀q, prime q → mult q m' ≤ mult q n', from
    (take q,
      assume primeq : prime q,
      have multqm : mult q m = mult q p + mult q m',
        by rewrite [meq, mult_mul primeq (pos_of_prime primep) m'pos],
      have multqn : mult q n = mult q p + mult q n',
        by rewrite [neq, mult_mul primeq (pos_of_prime primep) n'pos],
      show mult q m' ≤ mult q n', from le_of_add_le_add_left (multqm ▸ multqn ▸ H primeq)),
  have m'dvdn' : m' ∣ n', from ih m' m'ltm m'pos n' this,
  show m ∣ n, by rewrite [meq, neq]; apply mul_dvd_mul !dvd.refl m'dvdn'
end

theorem eq_of_forall_prime_mult_eq {m n : ℕ} (mpos : m > 0) (npos : n > 0)
    (H : ∀ p, prime p → mult p m = mult p n) : m = n :=
dvd.antisymm
  (dvd_of_forall_prime_mult_le mpos (take p, assume primep, H _ primep ▸ !le.refl))
  (dvd_of_forall_prime_mult_le npos (take p, assume primep, H _ primep ▸ !le.refl))

/- prime factors -/

definition prime_factors (n : ℕ) : finset ℕ := { p ∈ upto (succ n) | prime p ∧ p ∣ n }

theorem prime_of_mem_prime_factors {p n : ℕ} (H : p ∈ prime_factors n) : prime p :=
and.left (of_mem_sep H)

theorem dvd_of_mem_prime_factors {p n : ℕ} (H : p ∈ prime_factors n) : p ∣ n :=
and.right (of_mem_sep H)

theorem mem_prime_factors {p n : ℕ} (npos : n > 0) (primep : prime p) (pdvdn : p ∣ n) :
  p ∈ prime_factors n :=
have plen : p ≤ n, from le_of_dvd npos pdvdn,
mem_sep_of_mem (mem_upto_of_lt (lt_succ_of_le plen)) (and.intro primep pdvdn)

/- prime factorization -/

theorem mult_pow_eq_zero_of_prime_of_ne {p q : ℕ} (primep : prime p) (primeq : prime q)
  (pneq : p ≠ q) (i : ℕ) : mult p (q^i) = 0 :=
begin
  induction i with i ih,
    {krewrite [pow_zero, mult_one_right]},
  have qpos : q > 0, from pos_of_prime primeq,
  have qipos : q^i > 0, from !pow_pos_of_pos qpos,
  rewrite [pow_succ', mult_mul primep qipos qpos, ih, mult_eq_zero_of_prime_of_ne primep
    primeq pneq]
end

theorem mult_prod_pow_of_not_mem {p : ℕ} (primep : prime p) {s : finset ℕ}
    (sprimes : ∀ p, p ∈ s → prime p) (f : ℕ → ℕ) (pns : p ∉ s) :
  mult p (∏ q ∈ s, q^(f q)) = 0 :=
begin
  induction s with a s anins ih,
    {rewrite [Prod_empty, mult_one_right]},
  have pnea : p ≠ a, from assume peqa, by rewrite peqa at pns; exact pns !mem_insert,
  have primea : prime a, from sprimes a !mem_insert,
  have afapos : a ^ f a > 0, from !pow_pos_of_pos (pos_of_prime primea),
  have prodpos : (∏ q ∈ s, q ^ f q) > 0,
    from Prod_pos (take q, assume qs,
      !pow_pos_of_pos (pos_of_prime (forall_of_forall_insert sprimes q qs))),
  rewrite [!Prod_insert_of_not_mem anins, mult_mul primep afapos prodpos],
  rewrite (mult_pow_eq_zero_of_prime_of_ne primep primea pnea),
  rewrite (ih (forall_of_forall_insert sprimes) (λ H, pns (!mem_insert_of_mem H)))
end

theorem mult_prod_pow_of_mem {p : ℕ} (primep : prime p) {s : finset ℕ}
    (sprimes : ∀ p, p ∈ s → prime p) (f : ℕ → ℕ) (ps : p ∈ s) :
  mult p (∏ q ∈ s, q^(f q)) = f p :=
begin
  induction s with a s anins ih,
    {exact absurd ps !not_mem_empty},
  have primea : prime a, from sprimes a !mem_insert,
  have afapos : a ^ f a > 0, from !pow_pos_of_pos (pos_of_prime primea),
  have prodpos : (∏ q ∈ s, q ^ f q) > 0,
    from Prod_pos (take q, assume qs,
      !pow_pos_of_pos (pos_of_prime (forall_of_forall_insert sprimes q qs))),
  rewrite [!Prod_insert_of_not_mem anins, mult_mul primep afapos prodpos],
  cases eq_or_mem_of_mem_insert ps with peqa pins,
    {rewrite [peqa, !mult_pow_self (gt_one_of_prime primea)],
      rewrite [mult_prod_pow_of_not_mem primea (forall_of_forall_insert sprimes) _ anins]},
  have pnea : p ≠ a, from by intro peqa; rewrite peqa at pins; exact anins pins,
  rewrite [mult_pow_eq_zero_of_prime_of_ne primep primea pnea, zero_add],
  exact (ih (forall_of_forall_insert sprimes) pins)
end

theorem eq_prime_factorization {n : ℕ} (npos : n > 0) :
  n = (∏ p ∈ prime_factors n, p^(mult p n)) :=
let nprod := ∏ p ∈ prime_factors n, p^(mult p n) in
have primefactors : ∀ p, p ∈ prime_factors n → prime p,
  from take p, @prime_of_mem_prime_factors p n,
have prodpos : (∏ q ∈ prime_factors n, q^(mult q n)) > 0,
  from Prod_pos (take q, assume qpf,
    !pow_pos_of_pos (pos_of_prime (prime_of_mem_prime_factors qpf))),
eq_of_forall_prime_mult_eq npos prodpos
  (take p,
    assume primep,
    decidable.by_cases
      (assume pprimefactors : p ∈ prime_factors n,
        eq.symm (mult_prod_pow_of_mem primep primefactors (λ p, mult p n) pprimefactors))
      (assume pnprimefactors : p ∉ prime_factors n,
        have ¬ p ∣ n, from assume H, pnprimefactors (mem_prime_factors npos primep H),
        have mult p n = 0, from mult_eq_zero_of_not_dvd this,
        by rewrite [this, mult_prod_pow_of_not_mem primep primefactors _ pnprimefactors]))
end nat


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

! This file was ported from Lean 3 source module topology.uniform_space.matrix
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.UniformSpace.Pi
import Mathbin.Data.Matrix.Basic

/-!
# Uniform space structure on matrices
-/

open uniformity Topology

variable (m n 𝕜 : Type _) [UniformSpace 𝕜]

namespace Matrix

instance : UniformSpace (Matrix m n 𝕜) :=
  (by infer_instance : UniformSpace (m → n → 𝕜))

theorem uniformity :
    𝓤 (Matrix m n 𝕜) = ⨅ (i : m) (j : n), (𝓤 𝕜).comap fun a => (a.1 i j, a.2 i j) :=
  by
  erw [Pi.uniformity, Pi.uniformity]
  simp_rw [Filter.comap_infᵢ, Filter.comap_comap]
  rfl
#align matrix.uniformity Matrix.uniformity

theorem uniformContinuous {β : Type _} [UniformSpace β] {f : β → Matrix m n 𝕜} :
    UniformContinuous f ↔ ∀ i j, UniformContinuous fun x => f x i j := by
  simp only [UniformContinuous, Matrix.uniformity, Filter.tendsto_infᵢ, Filter.tendsto_comap_iff]
#align matrix.uniform_continuous Matrix.uniformContinuous

instance [CompleteSpace 𝕜] : CompleteSpace (Matrix m n 𝕜) :=
  (by infer_instance : CompleteSpace (m → n → 𝕜))

instance [SeparatedSpace 𝕜] : SeparatedSpace (Matrix m n 𝕜) :=
  (by infer_instance : SeparatedSpace (m → n → 𝕜))

end Matrix


variables x y z : ℤ

example (x y z : ℕ) : x * (y + z) = x * y + x * z := mul_add x y z
example (x y z : ℕ) : (x + y) * z = x * z + y * z := add_mul x y z
example (x y z : ℕ) : x + y + z = x + (y + z) := add_assoc x y z

example (x y : ℕ) :
  (x + y) * (x + y) = x * x + y * x + x * y + y * y :=
  have h1 : (x + y) * (x + y) = (x + y) * x + (x + y) * y,
    from mul_add (x + y) x y,
  have h2 : (x + y) * (x + y) = x * x + y * x + (x * y + y * y),
    from add_mul x y x ▸ add_mul x y y ▸ h1,
  h2.trans (add_assoc (x * x + y * x) (x * y) (y * y)).symm


/-
Copyright (c) 2022 Kyle Miller. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kyle Miller
-/
import data.finite.basic
import data.set.finite

/-!
# Finite instances for `set`

This module provides ways to go between `set.finite` and `finite` and also provides a number
of `finite` instances for basic set constructions such as unions, intersections, and so on.

## Main definitions

* `set.finite_of_finite` creates a `set.finite` proof from a `finite` instance
* `set.finite.finite` creates a `finite` instance from a `set.finite` proof
* `finite.set.subset` for finiteness of subsets of a finite set

## Tags

finiteness, finite sets

-/

open set
open_locale classical

universes u v w x
variables {α : Type u} {β : Type v} {ι : Sort w} {γ : Type x}

/-- Constructor for `set.finite` using a `finite` instance. -/
theorem set.finite_of_finite (s : set α) [finite s] : s.finite := ⟨fintype.of_finite s⟩

/-- Projection of `set.finite` to its `finite` instance.
This is intended to be used with dot notation.
See also `set.finite.fintype`. -/
@[nolint dup_namespace]
protected lemma set.finite.finite {s : set α} (h : s.finite) : finite s :=
finite.of_fintype h.fintype

lemma set.finite_iff_finite {s : set α} : s.finite ↔ finite s :=
⟨λ h, h.finite, λ h, by exactI set.finite_of_finite s⟩

/-- Construct a `finite` instance for a `set` from a `finset` with the same elements. -/
protected lemma finite.of_finset {p : set α} (s : finset α) (H : ∀ x, x ∈ s ↔ x ∈ p) : finite p :=
finite.of_fintype (fintype.of_finset s H)

/-! ### Finite instances

There is seemingly some overlap between the following instances and the `fintype` instances
in `data.set.finite`. While every `fintype` instance gives a `finite` instance, those
instances that depend on `fintype` or `decidable` instances need an additional `finite` instance
to be able to generally apply.

Some set instances do not appear here since they are consequences of others, for example
`subtype.finite` for subsets of a finite type.
-/

namespace finite.set

example {s : set α} [finite α] : finite s := infer_instance
example : finite (∅ : set α) := infer_instance
example (a : α) : finite ({a} : set α) := infer_instance

instance finite_union (s t : set α) [finite s] [finite t] :
  finite (s ∪ t : set α) :=
by { haveI := fintype.of_finite s, haveI := fintype.of_finite t, apply_instance }

instance finite_sep (s : set α) (p : α → Prop) [finite s] :
  finite ({a ∈ s | p a} : set α) :=
by { haveI := fintype.of_finite s, apply_instance }

protected lemma subset (s : set α) {t : set α} [finite s] (h : t ⊆ s) : finite t :=
by { rw eq_sep_of_subset h, apply_instance }

instance finite_inter_of_right (s t : set α) [finite t] :
  finite (s ∩ t : set α) := finite.set.subset t (inter_subset_right s t)

instance finite_inter_of_left (s t : set α) [finite s] :
  finite (s ∩ t : set α) := finite.set.subset s (inter_subset_left s t)

instance finite_diff (s t : set α) [finite s] :
  finite (s \ t : set α) := finite.set.subset s (diff_subset s t)

instance finite_Union [finite ι] (f : ι → set α) [∀ i, finite (f i)] : finite (⋃ i, f i) :=
begin
  convert_to finite (⋃ (i : plift ι), f i.down),
  { congr, ext, simp },
  haveI := fintype.of_finite (plift ι),
  haveI := λ i, fintype.of_finite (f i),
  apply_instance,
end

instance finite_sUnion {s : set (set α)} [finite s] [H : ∀ (t : s), finite (t : set α)] :
  finite (⋃₀ s) :=
by { rw sUnion_eq_Union, exact @finite.set.finite_Union _ _ _ _ H }

lemma finite_bUnion {ι : Type*} (s : set ι) [finite s] (t : ι → set α) (H : ∀ i ∈ s, finite (t i)) :
  finite (⋃(x ∈ s), t x) :=
begin
  convert_to finite (⋃ (x : s), t x),
  { congr' 1, ext, simp },
  haveI : ∀ (i : s), finite (t i) := λ i, H i i.property,
  apply_instance,
end

instance finite_bUnion' {ι : Type*} (s : set ι) [finite s] (t : ι → set α) [∀ i, finite (t i)] :
  finite (⋃(x ∈ s), t x) :=
finite_bUnion s t (λ i h, infer_instance)

/--
Example: `finite (⋃ (i < n), f i)` where `f : ℕ → set α` and `[∀ i, finite (f i)]`
(when given instances from `data.nat.interval`).
-/
instance finite_bUnion'' {ι : Type*} (p : ι → Prop) [h : finite {x | p x}]
  (t : ι → set α) [∀ i, finite (t i)] :
  finite (⋃ x (h : p x), t x) :=
@finite.set.finite_bUnion' _ _ (set_of p) h t _

instance finite_Inter {ι : Sort*} [nonempty ι] (t : ι → set α) [∀ i, finite (t i)] :
  finite (⋂ i, t i) :=
finite.set.subset (t $ classical.arbitrary ι) (Inter_subset _ _)

instance finite_insert (a : α) (s : set α) [finite s] : finite (insert a s : set α) :=
((set.finite_of_finite s).insert a).finite

instance finite_image (s : set α) (f : α → β) [finite s] : finite (f '' s) :=
((set.finite_of_finite s).image f).finite

instance finite_range (f : ι → α) [finite ι] : finite (range f) :=
by { haveI := fintype.of_finite (plift ι), apply_instance }

instance finite_replacement [finite α] (f : α → β) : finite {(f x) | (x : α)} :=
finite.set.finite_range f

instance finite_prod (s : set α) (t : set β) [finite s] [finite t] :
  finite (s ×ˢ t : set (α × β)) :=
by { haveI := fintype.of_finite s, haveI := fintype.of_finite t, apply_instance }

instance finite_image2 (f : α → β → γ) (s : set α) (t : set β) [finite s] [finite t] :
  finite (image2 f s t : set γ) :=
by { rw ← image_prod, apply_instance }

instance finite_seq (f : set (α → β)) (s : set α) [finite f] [finite s] : finite (f.seq s) :=
by { rw seq_def, apply_instance }

end finite.set

/-! ### Non-instances -/

lemma set.finite_univ_iff : finite (set.univ : set α) ↔ finite α :=
(equiv.set.univ α).finite_iff

lemma finite.of_finite_univ [finite ↥(univ : set α)] : finite α :=
set.finite_univ_iff.mp ‹_›

lemma finite.set.finite_of_finite_image (s : set α)
  {f : α → β} (h : s.inj_on f) [finite (f '' s)] : finite s :=
finite.of_equiv _ (equiv.of_bijective _ h.bij_on_image.bijective).symm


import game.world_06_proposition
namespace mynat

example (P Q : Prop) (p : P) (q : Q) : P ∧ Q := begin[nat_num_game]
  split,
  exact p,
  exact q,
end

lemma and_symm (P Q : Prop) : P ∧ Q → Q ∧ P := begin[nat_num_game]
  intro r, cases r,
  split, exact r_right, exact r_left,
end

lemma and_trans (P Q R : Prop) : P ∧ Q → Q ∧ R → P ∧ R := begin[nat_num_game]
  intros pq qr, cases pq, cases qr,
  split, exact pq_left, exact qr_right,
end

lemma iff_trans (P Q R : Prop) : (P ↔ Q) → (Q ↔ R) → (P ↔ R) := begin[nat_num_game]
  intros iff_pq iff_qr, cases iff_pq, cases iff_qr,
  split, apply iff_qr_mp ∘ iff_pq_mp, apply iff_pq_mpr ∘ iff_qr_mpr,
end

example (P Q : Prop) : Q → (P ∨ Q) := begin[nat_num_game]
  intro q,
  right,
  exact q,
end

lemma or_symm (P Q : Prop) : P ∨ Q → Q ∨ P := begin[nat_num_game]
  intro pq, cases pq,
  right, exact pq,
  left, exact pq,
end

lemma and_or_distrib_left (P Q R : Prop) : P ∧ (Q ∨ R) ↔ (P ∧ Q) ∨ (P ∧ R) := begin[nat_num_game]
  split, {
    intro h, cases h, cases h_right, {
      left, split, exact h_left, exact h_right
    }, {
      right, split, exact h_left, exact h_right
    }
  }, {
    intro h, cases h, {
      cases h, split,
      exact h_left, { left, exact h_right }
    }, {
      cases h, split,
      exact h_left, { right, exact h_right }
    }
  }
end

lemma contra (P Q : Prop) : (P ∧ ¬ P) → Q := begin[nat_num_game]
  intro either, cases either, exfalso,
  apply either_right either_left,
end

lemma contrapositive2 (P Q : Prop) : (¬ Q → ¬ P) → (P → Q) := begin[nat_num_game]
  by_cases p: P; by_cases q: Q, repeat {cc},
end

end mynat


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov, Johannes Hölzl
-/
import order.conditionally_complete_lattice
import logic.function.iterate
import order.rel_iso

/-!
# Order continuity

We say that a function is *left order continuous* if it sends all least upper bounds
to least upper bounds. The order dual notion is called *right order continuity*.

For monotone functions `ℝ → ℝ` these notions correspond to the usual left and right continuity.

We prove some basic lemmas (`map_sup`, `map_Sup` etc) and prove that an `rel_iso` is both left
and right order continuous.
-/

universes u v w x

variables {α : Type u} {β : Type v} {γ : Type w} {ι : Sort x}

open function order_dual set

/-!
### Definitions
-/

/-- A function `f` between preorders is left order continuous if it preserves all suprema.  We
define it using `is_lub` instead of `Sup` so that the proof works both for complete lattices and
conditionally complete lattices. -/
def left_ord_continuous [preorder α] [preorder β] (f : α → β) :=
∀ ⦃s : set α⦄ ⦃x⦄, is_lub s x → is_lub (f '' s) (f x)

/-- A function `f` between preorders is right order continuous if it preserves all infima.  We
define it using `is_glb` instead of `Inf` so that the proof works both for complete lattices and
conditionally complete lattices. -/
def right_ord_continuous [preorder α] [preorder β] (f : α → β) :=
∀ ⦃s : set α⦄ ⦃x⦄, is_glb s x → is_glb (f '' s) (f x)

namespace left_ord_continuous

section preorder

variables (α) [preorder α] [preorder β] [preorder γ] {g : β → γ} {f : α → β}

protected lemma id : left_ord_continuous (id : α → α) := λ s x h, by simpa only [image_id] using h

variable {α}

protected lemma order_dual : left_ord_continuous f → right_ord_continuous (to_dual ∘ f ∘ of_dual) :=
id

lemma map_is_greatest (hf : left_ord_continuous f) {s : set α} {x : α} (h : is_greatest s x):
  is_greatest (f '' s) (f x) :=
⟨mem_image_of_mem f h.1, (hf h.is_lub).1⟩

lemma comp (hg : left_ord_continuous g) (hf : left_ord_continuous f) :
  left_ord_continuous (g ∘ f) :=
λ s x h, by simpa only [image_image] using hg (hf h)

protected lemma iterate {f : α → α} (hf : left_ord_continuous f) (n : ℕ) :
  left_ord_continuous (f^[n]) :=
nat.rec_on n (left_ord_continuous.id α) $ λ n ihn, ihn.comp hf

end preorder

section semilattice_sup

variables [semilattice_sup α] [semilattice_sup β] {f : α → β}

lemma map_sup (hf : left_ord_continuous f) (x y : α) :
  f (x ⊔ y) = f x ⊔ f y :=
(hf is_lub_pair).unique $ by simp only [image_pair, is_lub_pair]

lemma le_iff (hf : left_ord_continuous f) (h : injective f) {x y} :
  f x ≤ f y ↔ x ≤ y :=
by simp only [← sup_eq_right, ← hf.map_sup, h.eq_iff]

lemma lt_iff (hf : left_ord_continuous f) (h : injective f) {x y} :
  f x < f y ↔ x < y :=
by simp only [lt_iff_le_not_le, hf.le_iff h]

variable (f)

/-- Convert an injective left order continuous function to an order embedding. -/
def to_order_embedding (hf : left_ord_continuous f) (h : injective f) :
  α ↪o β :=
⟨⟨f, h⟩, λ x y, hf.le_iff h⟩

variable {f}

@[simp] lemma coe_to_order_embedding (hf : left_ord_continuous f) (h : injective f) :
  ⇑(hf.to_order_embedding f h) = f := rfl

end semilattice_sup

section complete_lattice

variables [complete_lattice α] [complete_lattice β] {f : α → β}

lemma map_Sup' (hf : left_ord_continuous f) (s : set α) :
  f (Sup s) = Sup (f '' s) :=
(hf $ is_lub_Sup s).Sup_eq.symm

lemma map_Sup (hf : left_ord_continuous f) (s : set α) :
  f (Sup s) = ⨆ x ∈ s, f x :=
by rw [hf.map_Sup', Sup_image]

lemma map_supr (hf : left_ord_continuous f) (g : ι → α) :
  f (⨆ i, g i) = ⨆ i, f (g i) :=
by simp only [supr, hf.map_Sup', ← range_comp]

end complete_lattice

section conditionally_complete_lattice

variables [conditionally_complete_lattice α] [conditionally_complete_lattice β] [nonempty ι]
  {f : α → β}

lemma map_cSup (hf : left_ord_continuous f) {s : set α} (sne : s.nonempty) (sbdd : bdd_above s) :
  f (Sup s) = Sup (f '' s) :=
((hf $ is_lub_cSup sne sbdd).cSup_eq $ sne.image f).symm

lemma map_csupr (hf : left_ord_continuous f) {g : ι → α} (hg : bdd_above (range g)) :
  f (⨆ i, g i) = ⨆ i, f (g i) :=
by simp only [supr, hf.map_cSup (range_nonempty _) hg, ← range_comp]

end conditionally_complete_lattice

end left_ord_continuous

namespace right_ord_continuous

section preorder

variables (α) [preorder α] [preorder β] [preorder γ] {g : β → γ} {f : α → β}

protected lemma id : right_ord_continuous (id : α → α) := λ s x h, by simpa only [image_id] using h

variable {α}

protected lemma order_dual : right_ord_continuous f → left_ord_continuous (to_dual ∘ f ∘ of_dual) :=
id

lemma map_is_least (hf : right_ord_continuous f) {s : set α} {x : α} (h : is_least s x):
  is_least (f '' s) (f x) :=
hf.order_dual.map_is_greatest h

lemma mono (hf : right_ord_continuous f) : monotone f :=
hf.order_dual.mono.dual

lemma comp (hg : right_ord_continuous g) (hf : right_ord_continuous f) :
  right_ord_continuous (g ∘ f) :=
hg.order_dual.comp hf.order_dual

protected lemma iterate {f : α → α} (hf : right_ord_continuous f) (n : ℕ) :
  right_ord_continuous (f^[n]) :=
hf.order_dual.iterate n

end preorder

section semilattice_inf

variables [semilattice_inf α] [semilattice_inf β] {f : α → β}

lemma map_inf (hf : right_ord_continuous f) (x y : α) :
  f (x ⊓ y) = f x ⊓ f y :=
hf.order_dual.map_sup x y

lemma le_iff (hf : right_ord_continuous f) (h : injective f) {x y} :
  f x ≤ f y ↔ x ≤ y :=
hf.order_dual.le_iff h

lemma lt_iff (hf : right_ord_continuous f) (h : injective f) {x y} :
  f x < f y ↔ x < y :=
hf.order_dual.lt_iff h

variable (f)

/-- Convert an injective left order continuous function to a `order_embedding`. -/
def to_order_embedding (hf : right_ord_continuous f) (h : injective f) : α ↪o β :=
⟨⟨f, h⟩, λ x y, hf.le_iff h⟩

variable {f}

@[simp] lemma coe_to_order_embedding (hf : right_ord_continuous f) (h : injective f) :
  ⇑(hf.to_order_embedding f h) = f := rfl

end semilattice_inf

section complete_lattice

variables [complete_lattice α] [complete_lattice β] {f : α → β}

lemma map_Inf' (hf : right_ord_continuous f) (s : set α) :
  f (Inf s) = Inf (f '' s) :=
hf.order_dual.map_Sup' s

lemma map_Inf (hf : right_ord_continuous f) (s : set α) :
  f (Inf s) = ⨅ x ∈ s, f x :=
hf.order_dual.map_Sup s

lemma map_infi (hf : right_ord_continuous f) (g : ι → α) :
  f (⨅ i, g i) = ⨅ i, f (g i) :=
hf.order_dual.map_supr g

end complete_lattice

section conditionally_complete_lattice

variables [conditionally_complete_lattice α] [conditionally_complete_lattice β] [nonempty ι]
  {f : α → β}

lemma map_cInf (hf : right_ord_continuous f) {s : set α} (sne : s.nonempty) (sbdd : bdd_below s) :
  f (Inf s) = Inf (f '' s) :=
hf.order_dual.map_cSup sne sbdd

lemma map_cinfi (hf : right_ord_continuous f) {g : ι → α} (hg : bdd_below (range g)) :
  f (⨅ i, g i) = ⨅ i, f (g i) :=
hf.order_dual.map_csupr hg

end conditionally_complete_lattice

end right_ord_continuous

namespace order_iso

section preorder

variables [preorder α] [preorder β] (e : α ≃o β)
  {s : set α} {x : α}

protected lemma left_ord_continuous : left_ord_continuous e :=
λ s x hx,
⟨monotone.mem_upper_bounds_image (λ x y, e.map_rel_iff.2) hx.1,
  λ y hy, e.rel_symm_apply.1 $ (is_lub_le_iff hx).2 $ λ x' hx', e.rel_symm_apply.2 $ hy $
    mem_image_of_mem _ hx'⟩

protected lemma right_ord_continuous : right_ord_continuous e :=
order_iso.left_ord_continuous e.dual

end preorder

end order_iso


import .hcf
import ..myint.dvd
import ..logic

namespace hidden

open myint

namespace mynat

theorem coprime_imp_either_nzero {m n : mynat} (h : coprime m n) :
m ≠ 0 ∨ n ≠ 0 :=
begin
  by_contradiction h0,
  rw [not_or_distrib, not_not, not_not] at h0,
  cases h0 with hm hn,
  subst hm, subst hn,
  unfold coprime at h,
  suffices : (0 : mynat) = 1,
    from mynat.no_confusion this,
  apply h; from dvd_refl,
end

theorem coprime_imp_hcf_one {m n : mynat} (h : coprime m n) :
hcf m n = 1 :=
begin
  apply h,
    from hcf_dvd_left _ _ (coprime_imp_either_nzero h),
  from hcf_dvd_right _ _ (coprime_imp_either_nzero h),
end

theorem bezouts_lemma_coprime {m n : mynat} (h : coprime m n):
∃ x y : myint, ↑m * x + ↑n * y = 1 :=
begin
  rw [←coe_one, bezouts_lemma (coprime_imp_either_nzero h), coprime_imp_hcf_one h],
  from dvd_refl,
end

open classical

local attribute [instance] prop_decidable

theorem euclids_lemma {p m n: mynat} (hp : prime p) : p ∣ m * n → p ∣ m ∨ p ∣ n :=
begin
  assume h,
  by_cases p ∣ m,
    from or.inl h,
  right,
  suffices : coprime p m,
    apply coe_coe_dvd.mpr,
    cases bezouts_lemma_coprime this with x hx,
    cases hx with y hxy,
    have hxyn := congr_arg (λ x, ↑n * x) hxy,
    dsimp only [] at hxyn,
    rw [myint.mul_one, myint.mul_add] at hxyn,
    rw ←hxyn,
    apply myint.dvd_sum,
      rw [(by ac_refl : ↑n * (↑p * x) = ↑p * (↑n * x))],
      from myint.dvd_mul (↑n * x) (myint.dvd_refl ↑p),
    rw [←myint.mul_assoc, myint.coe_coe_mul, mul_comm],
    apply myint.dvd_mul,
    apply myint.coe_coe_dvd.mp,
    assumption,
  intros k hkp hkm,
  cases hp.right k hkp with hkeq1 hkeqp,
    from hkeq1,
  rw hkeqp at hkm,
  contradiction,
end

-- Requires some form of FTA
theorem dvd_coprime {m n k : mynat}:
coprime m n → m ∣ k * n → m ∣ k := sorry

theorem coprime_imp_prod_dvd {m n k : mynat}:
coprime m n → m ∣ k → n ∣ k → m * n ∣ k :=
begin
  assume hcp hmk hnk,
  cases hmk with a ha,
  cases hnk with b hb,
  rw hb at ha,
  have hmb : m ∣ b,
    have hmprod : m ∣ b * n,
      rw [ha, mul_comm],
      apply dvd_mul,
      from dvd_refl,
    apply dvd_coprime,
    repeat {assumption},
  cases hmb with c hc,
  rw [hc, mul_assoc] at hb,
  existsi c, assumption,
end

-- Could go on to state and prove FTA via multisets

end mynat
end hidden


/-
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
-/
import combinatorics.set_family.compression.down
import order.upper_lower.basic
import data.fintype.big_operators

/-!
# Harris-Kleitman inequality

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

This file proves the Harris-Kleitman inequality. This relates `𝒜.card * ℬ.card` and
`2 ^ card α * (𝒜 ∩ ℬ).card` where `𝒜` and `ℬ` are upward- or downcard-closed finite families of
finsets. This can be interpreted as saying that any two lower sets (resp. any two upper sets)
correlate in the uniform measure.

## Main declarations

* `is_lower_set.le_card_inter_finset`: One form of the Harris-Kleitman inequality.

## References

* [D. J. Kleitman, *Families of non-disjoint subsets*][kleitman1966]
-/

open finset
open_locale big_operators

variables {α : Type*} [decidable_eq α] {𝒜 ℬ : finset (finset α)} {s : finset α} {a : α}

lemma is_lower_set.non_member_subfamily (h : is_lower_set (𝒜 : set (finset α))) :
  is_lower_set (𝒜.non_member_subfamily a : set (finset α)) :=
λ s t hts, by { simp_rw [mem_coe, mem_non_member_subfamily], exact and.imp (h hts) (mt $ @hts _) }

lemma is_lower_set.member_subfamily (h : is_lower_set (𝒜 : set (finset α))) :
  is_lower_set (𝒜.member_subfamily a : set (finset α)) :=
begin
  rintro s t hts,
  simp_rw [mem_coe, mem_member_subfamily],
  exact and.imp (h $ insert_subset_insert _ hts) (mt $ @hts _),
end

lemma is_lower_set.member_subfamily_subset_non_member_subfamily
  (h : is_lower_set (𝒜 : set (finset α))) :
  𝒜.member_subfamily a ⊆ 𝒜.non_member_subfamily a :=
λ s, by { rw [mem_member_subfamily, mem_non_member_subfamily],
  exact and.imp_left (h $ subset_insert _ _) }

/-- **Harris-Kleitman inequality**: Any two lower sets of finsets correlate. -/
lemma is_lower_set.le_card_inter_finset'
  (h𝒜 : is_lower_set (𝒜 : set (finset α))) (hℬ : is_lower_set (ℬ : set (finset α)))
  (h𝒜s : ∀ t ∈ 𝒜, t ⊆ s) (hℬs : ∀ t ∈ ℬ, t ⊆ s) :
  𝒜.card * ℬ.card ≤ 2 ^ s.card * (𝒜 ∩ ℬ).card :=
begin
  induction s using finset.induction with a s hs ih generalizing 𝒜 ℬ,
  { simp_rw [subset_empty, ←subset_singleton_iff', subset_singleton_iff] at h𝒜s hℬs,
    obtain rfl | rfl := h𝒜s,
    { simp only [card_empty, empty_inter, mul_zero, zero_mul] },
    obtain rfl | rfl := hℬs,
    { simp only [card_empty, inter_empty, mul_zero, zero_mul] },
    { simp only [card_empty, pow_zero, inter_singleton_of_mem, mem_singleton, card_singleton] } },
  rw [card_insert_of_not_mem hs, ←card_member_subfamily_add_card_non_member_subfamily a 𝒜,
    ←card_member_subfamily_add_card_non_member_subfamily a ℬ, add_mul, mul_add, mul_add,
    add_comm (_ * _), add_add_add_comm],
  refine (add_le_add_right (mul_add_mul_le_mul_add_mul
    (card_le_of_subset h𝒜.member_subfamily_subset_non_member_subfamily) $
    card_le_of_subset hℬ.member_subfamily_subset_non_member_subfamily) _).trans _,
  rw [←two_mul, pow_succ, mul_assoc],
  have h₀ : ∀ 𝒞 : finset (finset α), (∀ t ∈ 𝒞, t ⊆ insert a s) → ∀ t ∈ 𝒞.non_member_subfamily a,
    t ⊆ s,
  { rintro 𝒞 h𝒞 t ht,
    rw mem_non_member_subfamily at ht,
    exact (subset_insert_iff_of_not_mem ht.2).1 (h𝒞 _ ht.1) },
  have h₁ : ∀ 𝒞 : finset (finset α), (∀ t ∈ 𝒞, t ⊆ insert a s) → ∀ t ∈ 𝒞.member_subfamily a, t ⊆ s,
  { rintro 𝒞 h𝒞 t ht,
    rw mem_member_subfamily at ht,
    exact (subset_insert_iff_of_not_mem ht.2).1 ((subset_insert _ _).trans $ h𝒞 _ ht.1) },
  refine mul_le_mul_left' _ _,
  refine (add_le_add (ih (h𝒜.member_subfamily) (hℬ.member_subfamily) (h₁ _ h𝒜s) $ h₁ _ hℬs) $
    ih (h𝒜.non_member_subfamily) (hℬ.non_member_subfamily) (h₀ _ h𝒜s) $ h₀ _ hℬs).trans_eq _,
  rw [←mul_add, ←member_subfamily_inter, ←non_member_subfamily_inter,
    card_member_subfamily_add_card_non_member_subfamily],
end

variables [fintype α]

/-- **Harris-Kleitman inequality**: Any two lower sets of finsets correlate. -/
lemma is_lower_set.le_card_inter_finset
  (h𝒜 : is_lower_set (𝒜 : set (finset α))) (hℬ : is_lower_set (ℬ : set (finset α))) :
  𝒜.card * ℬ.card ≤ 2 ^ fintype.card α * (𝒜 ∩ ℬ).card :=
h𝒜.le_card_inter_finset' hℬ (λ _ _, subset_univ _) $ λ _ _, subset_univ _

/-- **Harris-Kleitman inequality**: Upper sets and lower sets of finsets anticorrelate. -/
lemma is_upper_set.card_inter_le_finset
  (h𝒜 : is_upper_set (𝒜 : set (finset α))) (hℬ : is_lower_set (ℬ : set (finset α))) :
  2 ^ fintype.card α * (𝒜 ∩ ℬ).card ≤ 𝒜.card * ℬ.card :=
begin
  rw [←is_lower_set_compl, ←coe_compl] at h𝒜,
  have := h𝒜.le_card_inter_finset hℬ,
  rwa [card_compl, fintype.card_finset, tsub_mul, tsub_le_iff_tsub_le, ←mul_tsub, ←card_sdiff
    (inter_subset_right _ _), sdiff_inter_self_right, sdiff_compl, _root_.inf_comm] at this,
end

/-- **Harris-Kleitman inequality**: Lower sets and upper sets of finsets anticorrelate. -/
lemma is_lower_set.card_inter_le_finset
  (h𝒜 : is_lower_set (𝒜 : set (finset α))) (hℬ : is_upper_set (ℬ : set (finset α))) :
  2 ^ fintype.card α * (𝒜 ∩ ℬ).card ≤ 𝒜.card * ℬ.card :=
by { rw [inter_comm, mul_comm 𝒜.card], exact hℬ.card_inter_le_finset h𝒜 }

/-- **Harris-Kleitman inequality**: Any two upper sets of finsets correlate. -/
lemma is_upper_set.le_card_inter_finset
  (h𝒜 : is_upper_set (𝒜 : set (finset α))) (hℬ : is_upper_set (ℬ : set (finset α))) :
  𝒜.card * ℬ.card ≤ 2 ^ fintype.card α * (𝒜 ∩ ℬ).card :=
begin
  rw [←is_lower_set_compl, ←coe_compl] at h𝒜,
  have := h𝒜.card_inter_le_finset hℬ,
  rwa [card_compl, fintype.card_finset, tsub_mul, le_tsub_iff_le_tsub, ←mul_tsub, ←card_sdiff
    (inter_subset_right _ _), sdiff_inter_self_right, sdiff_compl, _root_.inf_comm] at this,
  { exact mul_le_mul_left' (card_le_of_subset $ inter_subset_right _ _) _ },
  { rw ←fintype.card_finset,
    exact mul_le_mul_right' (card_le_univ _) _ }
end


/-
  Presheaf (of types).

  https://stacks.math.columbia.edu/tag/006D

  Author: Ramon Fernandez Mir
-/

import topology.basic
import topology.opens

universes u v

-- Definition of a presheaf.

open topological_space lattice

structure presheaf (α : Type u) [topological_space α] :=
(F     : opens α → Type v)
(res   : ∀ (U V) (HVU : V ⊆ U), F U → F V)
(Hid   : ∀ (U), res U U (set.subset.refl U) = id)
(Hcomp : ∀ (U V W) (HWV : W ⊆ V) (HVU : V ⊆ U),
  res U W (set.subset.trans HWV HVU) = res V W HWV ∘ res U V HVU)

namespace presheaf

variables {α : Type u} [topological_space α]

instance : has_coe_to_fun (presheaf α) :=
{ F := λ _, opens α → Type v,
  coe := presheaf.F }

-- Simplification lemmas for Hid and Hcomp.

@[simp] lemma Hcomp' (F : presheaf α) :
∀ (U V W) (HWV : W ⊆ V) (HVU : V ⊆ U) (s : F U),
  (F.res U W (set.subset.trans HWV HVU)) s =
  (F.res V W HWV) ((F.res U V HVU) s) :=
λ U V W HWV HVU s, by rw F.Hcomp U V W HWV HVU

@[simp] lemma Hid' (F : presheaf α) :
∀ (U) (s : F U),
  (F.res U U (set.subset.refl U)) s = s :=
λ U s, by rw F.Hid U; simp

-- Morphism of presheaves.

structure morphism (F G : presheaf α) :=
(map      : ∀ (U), F U → G U)
(commutes : ∀ (U V) (HVU : V ⊆ U),
  (G.res U V HVU) ∘ (map U) = (map V) ∘ (F.res U V HVU))

local infix `⟶`:80 := morphism

section morphism

def comp {F G H : presheaf α} (fg : F ⟶ G) (gh : G ⟶ H) : F ⟶ H :=
{ map := λ U, gh.map U ∘ fg.map U,
  commutes := λ U V HVU,
    begin
      rw [←function.comp.assoc, gh.commutes U V HVU], symmetry,
      rw [function.comp.assoc, ←fg.commutes U V HVU]
    end }

local infix `⊚`:80 := comp

def id (F : presheaf α) : F ⟶ F :=
{ map := λ U, id,
  commutes := λ U V HVU, by simp, }

structure iso (F G : presheaf α) :=
(mor : F ⟶ G)
(inv : G ⟶ F)
(mor_inv_id : mor ⊚ inv = id F)
(inv_mor_id : inv ⊚ mor = id G)

end morphism

end presheaf


import tactic
import data.zmod.basic
import field_theory.finite.basic
import data.nat.prime_norm_num

/-

# Prove the theorem, due to Kraichik, asserting that 13|2^70+3^70

This is the sixth question in Sierpinski's book "250 elementary problems
in number theory".

-/

example : 13 ∣ 2^70 + 3^70 :=
begin
  -- use a computer algebra package to work out (2^70+3^70)/13
  use 192550423461109399456637645953021,
  norm_num,
end

-- Here is a more honest proof, using Fermat's Little Theorem
example : 13 ∣ 2^70 + 3^70 :=
begin
  -- reduce to a question about `zmod 13`
  rw ← zmod.nat_coe_zmod_eq_zero_iff_dvd,
  -- get rid of the arrows
  push_cast, -- oops that did some weird stuff
  -- fix up the goal
  change (2 : zmod 13) ^ 70 + (3 : zmod 13) ^ 70 = 0,
  have h0 : nat.prime 13 := by norm_num,
  haveI : fact (nat.prime 13) := ⟨h0⟩,
  -- apply Fermat's Little Theorem
  have h1 : (2 : zmod 13)^12 = 1,
  { apply zmod.pow_card_sub_one_eq_one,
    intro h2,
    have h3 : ((2 : ℕ) : zmod 13) = 0,
      assumption_mod_cast,
    rw zmod.nat_coe_zmod_eq_zero_iff_dvd at h3,
    revert h3,
    norm_num,
  },
  -- For 3 we can do better
  have h2 : (3 : zmod 13)^3 = 1,
    refl,
  -- use `conv` mode to rewrite the `70`s in the goal
  conv_lhs begin
    congr,
    rw (show 70 = 12 * 5 + 10, by norm_num),
    skip,
    rw (show 70 = 3 * 23 + 1, by norm_num),
  end,
  -- now use Fermat's Little Theorem to simplify
  rw [pow_add, pow_add, pow_mul, pow_mul, h1, h2],
  simp,
  -- We still have to work out 2^10 though, so
  -- in some sense we're still doing a calculation, just
  -- a smaller one
  norm_num,
  refl, -- lol, funny way to finish (these are numbers mod 13)
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 algebra.direct_limit
import field_theory.splitting_field

/-!
# 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

-/

universes u v w
noncomputable theory
open_locale classical big_operators
open polynomial

variables (k : Type u) [field k]

/-- Typeclass for algebraically closed fields.

To show `polynomial.splits p f` for an arbitrary ring homomorphism `f`,
see `is_alg_closed.splits_codomain` and `is_alg_closed.splits_domain`.
-/
class is_alg_closed : Prop :=
(splits : ∀ p : polynomial k, p.splits $ ring_hom.id k)

/-- Every polynomial splits in the field extension `f : K →+* k` if `k` is algebraically closed.

See also `is_alg_closed.splits_domain` for the case where `K` is algebraically closed.
-/
theorem is_alg_closed.splits_codomain {k K : Type*} [field k] [is_alg_closed k] [field K]
  {f : K →+* k} (p : polynomial K) : p.splits f :=
by { convert is_alg_closed.splits (p.map f), simp [splits_map_iff] }

/-- Every polynomial splits in the field extension `f : K →+* k` if `K` is algebraically closed.

See also `is_alg_closed.splits_codomain` for the case where `k` is algebraically closed.
-/
theorem is_alg_closed.splits_domain {k K : Type*} [field k] [is_alg_closed k] [field K]
  {f : k →+* K} (p : polynomial k) : p.splits f :=
polynomial.splits_of_splits_id _ $ is_alg_closed.splits _

namespace is_alg_closed

theorem of_exists_root (H : ∀ p : polynomial k, p.monic → irreducible p → ∃ x, p.eval x = 0) :
  is_alg_closed k :=
⟨λ p, or.inr $ λ q hq hqp,
 have irreducible (q * C (leading_coeff q)⁻¹),
   by { rw ← coe_norm_unit_of_ne_zero hq.ne_zero,
        exact irreducible_of_associated associated_normalize hq },
 let ⟨x, hx⟩ := H (q * C (leading_coeff q)⁻¹) (monic_mul_leading_coeff_inv hq.ne_zero) this in
 degree_mul_leading_coeff_inv q hq.ne_zero ▸ degree_eq_one_of_irreducible_of_root this hx⟩

lemma degree_eq_one_of_irreducible [is_alg_closed k] {p : polynomial k} (h_nz : p ≠ 0)
  (hp : irreducible p) :
  p.degree = 1 :=
degree_eq_one_of_irreducible_of_splits h_nz hp (is_alg_closed.splits_codomain _)

lemma algebra_map_surjective_of_is_integral {k K : Type*} [field k] [domain K]
  [hk : is_alg_closed k] [algebra k K] (hf : algebra.is_integral k K) :
  function.surjective (algebra_map k K) :=
begin
  refine λ x, ⟨-((minpoly k x).coeff 0), _⟩,
  have hq : (minpoly k x).leading_coeff = 1 := minpoly.monic (hf x),
  have h : (minpoly k x).degree = 1 := degree_eq_one_of_irreducible k
    (minpoly.ne_zero (hf x)) (minpoly.irreducible (hf x)),
  have : (aeval x (minpoly k x)) = 0 := minpoly.aeval k x,
  rw [eq_X_add_C_of_degree_eq_one h, hq, C_1, one_mul,
    aeval_add, aeval_X, aeval_C, add_eq_zero_iff_eq_neg] at this,
  exact (ring_hom.map_neg (algebra_map k K) ((minpoly k x).coeff 0)).symm ▸ this.symm,
end

lemma algebra_map_surjective_of_is_integral' {k K : Type*} [field k] [integral_domain K]
  [hk : is_alg_closed k] (f : k →+* K) (hf : f.is_integral) : function.surjective f :=
@algebra_map_surjective_of_is_integral k K _ _ _ f.to_algebra hf

lemma algebra_map_surjective_of_is_algebraic {k K : Type*} [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 ((is_algebraic_iff_is_integral' k).mp hf)

end is_alg_closed

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

theorem is_alg_closure_iff (K : Type v) [field K] [algebra k K] :
  is_alg_closure k K ↔ is_alg_closed K ∧ algebra.is_algebraic k K :=
⟨λ h, ⟨h.1, h.2⟩, λ h, ⟨h.1, h.2⟩⟩

namespace algebraic_closure

open mv_polynomial

/-- The subtype of monic irreducible polynomials -/
@[reducible] def monic_irreducible : Type u :=
{ f : polynomial k // 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 (f : monic_irreducible k) : mv_polynomial (monic_irreducible k) k :=
polynomial.eval₂ mv_polynomial.C (X f) f

/-- The span of `f(x_f)` across monic irreducible polynomials `f` where `x_f` is an
indeterminate. -/
def span_eval : 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 (s : finset (monic_irreducible k)) :
  mv_polynomial (monic_irreducible k) k →ₐ[k] splitting_field (∏ x in s, x : polynomial k) :=
mv_polynomial.aeval $ λ f,
  if hf : f ∈ s
  then root_of_splits _
    ((splits_prod_iff _ $ λ (j : monic_irreducible k) _, j.2.2.ne_zero).1
      (splitting_field.splits _) f hf)
    (mt is_unit_iff_degree_eq_zero.2 f.2.2.not_unit)
  else 37

theorem to_splitting_field_eval_X_self {s : finset (monic_irreducible k)} {f} (hf : f ∈ s) :
  to_splitting_field k s (eval_X_self k f) = 0 :=
by { rw [to_splitting_field, eval_X_self, ← alg_hom.coe_to_ring_hom, hom_eval₂,
         alg_hom.coe_to_ring_hom, mv_polynomial.aeval_X, dif_pos hf,
         ← algebra_map_eq, alg_hom.comp_algebra_map],
  exact map_root_of_splits _ _ _ }

theorem span_eval_ne_top : span_eval k ≠ ⊤ :=
begin
  rw [ideal.ne_top_iff_one, span_eval, ideal.span, ← set.image_univ, finsupp.mem_span_iff_total],
  rintros ⟨v, _, hv⟩,
  replace hv := congr_arg (to_splitting_field k v.support) hv,
  rw [alg_hom.map_one, finsupp.total_apply, finsupp.sum, alg_hom.map_sum, finset.sum_eq_zero] at hv,
  { exact zero_ne_one hv },
  intros j hj,
  rw [smul_eq_mul, alg_hom.map_mul, to_splitting_field_eval_X_self k hj, mul_zero]
end

/-- A random maximal ideal that contains `span_eval k` -/
def max_ideal : ideal (mv_polynomial (monic_irreducible k) k) :=
classical.some $ ideal.exists_le_maximal _ $ span_eval_ne_top k

instance max_ideal.is_maximal : (max_ideal k).is_maximal :=
(classical.some_spec $ ideal.exists_le_maximal _ $ span_eval_ne_top k).1

theorem le_max_ideal : span_eval k ≤ max_ideal k :=
(classical.some_spec $ ideal.exists_le_maximal _ $ span_eval_ne_top k).2

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

instance adjoin_monic.field : field (adjoin_monic k) :=
ideal.quotient.field _

instance adjoin_monic.inhabited : inhabited (adjoin_monic k) := ⟨37⟩

/-- The canonical ring homomorphism to `adjoin_monic k`. -/
def to_adjoin_monic : k →+* adjoin_monic k :=
(ideal.quotient.mk _).comp C

instance adjoin_monic.algebra : algebra k (adjoin_monic k) :=
(to_adjoin_monic k).to_algebra

theorem adjoin_monic.algebra_map : algebra_map k (adjoin_monic k) = (ideal.quotient.mk _).comp C :=
rfl

theorem adjoin_monic.is_integral (z : adjoin_monic k) : is_integral k z :=
let ⟨p, hp⟩ := ideal.quotient.mk_surjective z in hp ▸
mv_polynomial.induction_on p (λ x, is_integral_algebra_map) (λ p q, is_integral_add)
  (λ p f ih, @is_integral_mul _ _ _ _ _ _ (ideal.quotient.mk _ _) ih ⟨f, f.2.1,
    by { erw [adjoin_monic.algebra_map, ← hom_eval₂,
              ideal.quotient.eq_zero_iff_mem],
      exact le_max_ideal k (ideal.subset_span ⟨f, rfl⟩) }⟩)

theorem adjoin_monic.exists_root {f : polynomial k} (hfm : f.monic) (hfi : irreducible f) :
  ∃ x : adjoin_monic k, f.eval₂ (to_adjoin_monic k) x = 0 :=
⟨ideal.quotient.mk _ $ X (⟨f, hfm, hfi⟩ : monic_irreducible k),
 by { rw [to_adjoin_monic, ← hom_eval₂, ideal.quotient.eq_zero_iff_mem],
      exact le_max_ideal k (ideal.subset_span $ ⟨_, rfl⟩) }⟩

/-- The `n`th step of constructing `algebraic_closure`, together with its `field` instance. -/
def step_aux (n : ℕ) : Σ α : Type u, field α :=
nat.rec_on n ⟨k, infer_instance⟩ $ λ n ih, ⟨@adjoin_monic ih.1 ih.2, @adjoin_monic.field ih.1 ih.2⟩

/-- The `n`th step of constructing `algebraic_closure`. -/
def step (n : ℕ) : Type u :=
(step_aux k n).1

instance step.field (n : ℕ) : field (step k n) :=
(step_aux k n).2

instance step.inhabited (n) : inhabited (step k n) := ⟨37⟩

/-- The canonical inclusion to the `0`th step. -/
def to_step_zero : k →+* step k 0 :=
ring_hom.id k

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

instance step.algebra_succ (n) : algebra (step k n) (step k (n + 1)) :=
(to_step_succ k n).to_algebra

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

/-- The canonical ring homomorphism to a step with a greater index. -/
def to_step_of_le (m n : ℕ) (h : m ≤ n) : step k m →+* step k n :=
{ to_fun := nat.le_rec_on h (λ n, to_step_succ k n),
  map_one' := begin
    induction h with n h ih, { exact nat.le_rec_on_self 1 },
    rw [nat.le_rec_on_succ h, ih, ring_hom.map_one]
  end,
  map_mul' := λ x y, begin
    induction h with n h ih, { simp_rw nat.le_rec_on_self },
    simp_rw [nat.le_rec_on_succ h, ih, ring_hom.map_mul]
  end,
  map_zero' := begin
    induction h with n h ih, { exact nat.le_rec_on_self 0 },
    rw [nat.le_rec_on_succ h, ih, ring_hom.map_zero]
  end,
  map_add' := λ x y, begin
    induction h with n h ih, { simp_rw nat.le_rec_on_self },
    simp_rw [nat.le_rec_on_succ h, ih, ring_hom.map_add]
  end }

@[simp] lemma coe_to_step_of_le (m n : ℕ) (h : m ≤ n) :
  (to_step_of_le k m n h : step k m → step k n) = nat.le_rec_on h (λ n, to_step_succ k n) :=
rfl

instance step.algebra (n) : algebra k (step k n) :=
(to_step_of_le k 0 n n.zero_le).to_algebra

instance step.scalar_tower (n) : is_scalar_tower k (step k n) (step k (n + 1)) :=
is_scalar_tower.of_algebra_map_eq $ λ z,
  @nat.le_rec_on_succ (step k) 0 n n.zero_le (n + 1).zero_le (λ n, to_step_succ k n) z

theorem step.is_integral (n) : ∀ z : step k n, is_integral k z :=
nat.rec_on n (λ z, is_integral_algebra_map) $ λ n ih z,
  is_integral_trans ih _ (adjoin_monic.is_integral (step k n) z : _)

instance to_step_of_le.directed_system :
  directed_system (step k) (λ i j h, to_step_of_le k i j h) :=
⟨λ i x h, nat.le_rec_on_self x, λ i₁ i₂ i₃ h₁₂ h₂₃ x, (nat.le_rec_on_trans h₁₂ h₂₃ x).symm⟩

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 : Type u :=
ring.direct_limit (algebraic_closure.step k) (λ i j h, algebraic_closure.to_step_of_le k i j h)

namespace algebraic_closure

instance : field (algebraic_closure k) :=
field.direct_limit.field _ _

instance : inhabited (algebraic_closure k) := ⟨37⟩

/-- The canonical ring embedding from the `n`th step to the algebraic closure. -/
def of_step (n : ℕ) : step k n →+* algebraic_closure k :=
ring_hom.of $ ring.direct_limit.of _ _ _

instance algebra_of_step (n) : algebra (step k n) (algebraic_closure k) :=
(of_step k n).to_algebra

theorem of_step_succ (n : ℕ) : (of_step k (n + 1)).comp (to_step_succ k n) = of_step k n :=
ring_hom.ext $ λ x, show ring.direct_limit.of (step k) (λ i j h, to_step_of_le k i j h) _ _ = _,
  by { convert ring.direct_limit.of_f n.le_succ x, ext x, exact (nat.le_rec_on_succ' x).symm }

theorem exists_of_step (z : algebraic_closure k) : ∃ n x, of_step k n x = z :=
ring.direct_limit.exists_of z

-- slow
theorem exists_root {f : polynomial (algebraic_closure k)}
  (hfm : f.monic) (hfi : irreducible f) :
  ∃ x : algebraic_closure k, f.eval x = 0 :=
begin
  have : ∃ n p, polynomial.map (of_step k n) p = f,
  { convert ring.direct_limit.polynomial.exists_of f },
  unfreezingI { obtain ⟨n, p, rfl⟩ := this },
  rw monic_map_iff at hfm,
  have := hfm.irreducible_of_irreducible_map (of_step k n) p hfi,
  obtain ⟨x, hx⟩ := to_step_succ.exists_root k hfm this,
  refine ⟨of_step k (n + 1) x, _⟩,
  rw [← of_step_succ k n, eval_map, ← hom_eval₂, hx, ring_hom.map_zero]
end

instance : is_alg_closed (algebraic_closure k) :=
is_alg_closed.of_exists_root _ $ λ f, exists_root k

instance : algebra k (algebraic_closure k) :=
(of_step k 0).to_algebra

/-- Canonical algebra embedding from the `n`th step to the algebraic closure. -/
def of_step_hom (n) : step k n →ₐ[k] algebraic_closure k :=
{ commutes' := λ x, ring.direct_limit.of_f n.zero_le x,
  .. of_step k n }

theorem is_algebraic : algebra.is_algebraic k (algebraic_closure k) :=
λ z, (is_algebraic_iff_is_integral _).2 $ let ⟨n, x, hx⟩ := exists_of_step k z in
hx ▸ is_integral_alg_hom (of_step_hom k n) (step.is_integral k n x)

instance : is_alg_closure k (algebraic_closure k) :=
⟨algebraic_closure.is_alg_closed k, is_algebraic k⟩

end algebraic_closure

/--
Every element `f` in a nontrivial finite-dimensional algebra `A`
over an algebraically closed field `K`
has non-empty spectrum:
that is, there is some `c : K` so `f - c • 1` is not invertible.
-/
-- We will use this both to show eigenvalues exist, and to prove Schur's lemma.
lemma exists_spectrum_of_is_alg_closed_of_finite_dimensional (𝕜 : Type*) [field 𝕜] [is_alg_closed 𝕜]
  {A : Type*} [nontrivial A] [ring A] [algebra 𝕜 A] [I : finite_dimensional 𝕜 A] (f : A) :
  ∃ c : 𝕜, ¬ is_unit (f - algebra_map 𝕜 A c) :=
begin
  obtain ⟨p, ⟨h_mon, h_eval_p⟩⟩ := is_integral_of_noetherian I f,
  have nu : ¬ is_unit (aeval f p), { rw [←aeval_def] at h_eval_p, rw h_eval_p, simp, },
  rw [eq_prod_roots_of_monic_of_splits_id h_mon (is_alg_closed.splits p),
    ←multiset.prod_to_list, alg_hom.map_list_prod] at nu,
  replace nu := mt list.prod_is_unit nu,
  simp only [not_forall, exists_prop, aeval_C, multiset.mem_to_list,
    list.mem_map, aeval_X, exists_exists_and_eq_and, multiset.mem_map, alg_hom.map_sub] at nu,
  exact ⟨nu.some, nu.some_spec.2⟩,
end


/-
Copyright (c) 2023 Mantas Bakšys, Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mantas Bakšys, Yaël Dillies

! This file was ported from Lean 3 source module algebra.order.chebyshev
! leanprover-community/mathlib commit b7399344324326918d65d0c74e9571e3a8cb9199
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.BigOperators.Order
import Mathbin.Algebra.Order.Rearrangement
import Mathbin.GroupTheory.Perm.Cycle.Basic

/-!
# Chebyshev's sum inequality

This file proves the Chebyshev sum inequality.

Chebyshev's inequality states `(∑ i in s, f i) * (∑ i in s, g i) ≤ s.card * ∑ i in s, f i * g i`
when `f g : ι → α` monovary, and the reverse inequality when `f` and `g` antivary.

## Main declarations

* `monovary_on.sum_mul_sum_le_card_mul_sum`: Chebyshev's inequality.
* `antivary_on.card_mul_sum_le_sum_mul_sum`: Chebyshev's inequality, dual version.
* `sq_sum_le_card_mul_sum_sq`: Special case of Chebyshev's inequality when `f = g`.

## Implementation notes

In fact, we don't need much compatibility between the addition and multiplication of `α`, so we can
actually decouple them by replacing multiplication with scalar multiplication and making `f` and `g`
land in different types.
As a bonus, this makes the dual statement trivial. The multiplication versions are provided for
convenience.

The case for `monotone`/`antitone` pairs of functions over a `linear_order` is not deduced in this
file because it is easily deducible from the `monovary` API.
-/

open Equiv Equiv.Perm Finset Function OrderDual

open BigOperators

variable {ι α β : Type _}

/-! ### Scalar multiplication versions -/

section Smul

variable [LinearOrderedRing α] [LinearOrderedAddCommGroup β] [Module α β] [OrderedSMul α β]
  {s : Finset ι} {σ : Perm ι} {f : ι → α} {g : ι → β}

/-- **Chebyshev's Sum Inequality**: When `f` and `g` monovary together (eg they are both
monotone/antitone), the scalar product of their sum is less than the size of the set times their
scalar product. -/
theorem MonovaryOn.sum_smul_sum_le_card_smul_sum (hfg : MonovaryOn f g s) :
    ((∑ i in s, f i) • ∑ i in s, g i) ≤ s.card • ∑ i in s, f i • g i := by
  classical
    obtain ⟨σ, hσ, hs⟩ := s.countable_to_set.exists_cycle_on
    rw [← card_range s.card, sum_smul_sum_eq_sum_perm hσ]
    exact
      sum_le_card_nsmul _ _ _ fun n _ =>
        hfg.sum_smul_comp_perm_le_sum_smul fun x hx => hs fun h => hx <| is_fixed_pt.perm_pow h _
#align monovary_on.sum_smul_sum_le_card_smul_sum MonovaryOn.sum_smul_sum_le_card_smul_sum

/-- **Chebyshev's Sum Inequality**: When `f` and `g` antivary together (eg one is monotone, the
other is antitone), the scalar product of their sum is less than the size of the set times their
scalar product. -/
theorem AntivaryOn.card_smul_sum_le_sum_smul_sum (hfg : AntivaryOn f g s) :
    (s.card • ∑ i in s, f i • g i) ≤ (∑ i in s, f i) • ∑ i in s, g i := by
  convert hfg.dual_right.sum_smul_sum_le_card_smul_sum
#align antivary_on.card_smul_sum_le_sum_smul_sum AntivaryOn.card_smul_sum_le_sum_smul_sum

variable [Fintype ι]

/-- **Chebyshev's Sum Inequality**: When `f` and `g` monovary together (eg they are both
monotone/antitone), the scalar product of their sum is less than the size of the set times their
scalar product. -/
theorem Monovary.sum_smul_sum_le_card_smul_sum (hfg : Monovary f g) :
    ((∑ i, f i) • ∑ i, g i) ≤ Fintype.card ι • ∑ i, f i • g i :=
  (hfg.MonovaryOn _).sum_smul_sum_le_card_smul_sum
#align monovary.sum_smul_sum_le_card_smul_sum Monovary.sum_smul_sum_le_card_smul_sum

/-- **Chebyshev's Sum Inequality**: When `f` and `g` antivary together (eg one is monotone, the
other is antitone), the scalar product of their sum is less than the size of the set times their
scalar product. -/
theorem Antivary.card_smul_sum_le_sum_smul_sum (hfg : Antivary f g) :
    (Fintype.card ι • ∑ i, f i • g i) ≤ (∑ i, f i) • ∑ i, g i := by
  convert(hfg.dual_right.monovary_on _).sum_smul_sum_le_card_smul_sum
#align antivary.card_smul_sum_le_sum_smul_sum Antivary.card_smul_sum_le_sum_smul_sum

end Smul

/-!
### Multiplication versions

Special cases of the above when scalar multiplication is actually multiplication.
-/

section Mul

variable [LinearOrderedRing α] {s : Finset ι} {σ : Perm ι} {f g : ι → α}

/-- **Chebyshev's Sum Inequality**: When `f` and `g` monovary together (eg they are both
monotone/antitone), the product of their sum is less than the size of the set times their scalar
product. -/
theorem MonovaryOn.sum_mul_sum_le_card_mul_sum (hfg : MonovaryOn f g s) :
    ((∑ i in s, f i) * ∑ i in s, g i) ≤ s.card * ∑ i in s, f i * g i :=
  by
  rw [← nsmul_eq_mul]
  exact hfg.sum_smul_sum_le_card_smul_sum
#align monovary_on.sum_mul_sum_le_card_mul_sum MonovaryOn.sum_mul_sum_le_card_mul_sum

/-- **Chebyshev's Sum Inequality**: When `f` and `g` antivary together (eg one is monotone, the
other is antitone), the product of their sum is greater than the size of the set times their scalar
product. -/
theorem AntivaryOn.card_mul_sum_le_sum_mul_sum (hfg : AntivaryOn f g s) :
    ((s.card : α) * ∑ i in s, f i * g i) ≤ (∑ i in s, f i) * ∑ i in s, g i :=
  by
  rw [← nsmul_eq_mul]
  exact hfg.card_smul_sum_le_sum_smul_sum
#align antivary_on.card_mul_sum_le_sum_mul_sum AntivaryOn.card_mul_sum_le_sum_mul_sum

/-- Special case of **Chebyshev's Sum Inequality** or the **Cauchy-Schwarz Inequality**: The square
of the sum is less than the size of the set times the sum of the squares. -/
theorem sq_sum_le_card_mul_sum_sq : (∑ i in s, f i) ^ 2 ≤ s.card * ∑ i in s, f i ^ 2 :=
  by
  simp_rw [sq]
  exact (monovaryOn_self _ _).sum_mul_sum_le_card_mul_sum
#align sq_sum_le_card_mul_sum_sq sq_sum_le_card_mul_sum_sq

variable [Fintype ι]

/-- **Chebyshev's Sum Inequality**: When `f` and `g` monovary together (eg they are both
monotone/antitone), the product of their sum is less than the size of the set times their scalar
product. -/
theorem Monovary.sum_mul_sum_le_card_mul_sum (hfg : Monovary f g) :
    ((∑ i, f i) * ∑ i, g i) ≤ Fintype.card ι * ∑ i, f i * g i :=
  (hfg.MonovaryOn _).sum_mul_sum_le_card_mul_sum
#align monovary.sum_mul_sum_le_card_mul_sum Monovary.sum_mul_sum_le_card_mul_sum

/-- **Chebyshev's Sum Inequality**: When `f` and `g` antivary together (eg one is monotone, the
other is antitone), the product of their sum is less than the size of the set times their scalar
product. -/
theorem Antivary.card_mul_sum_le_sum_mul_sum (hfg : Antivary f g) :
    ((Fintype.card ι : α) * ∑ i, f i * g i) ≤ (∑ i, f i) * ∑ i, g i :=
  (hfg.AntivaryOn _).card_mul_sum_le_sum_mul_sum
#align antivary.card_mul_sum_le_sum_mul_sum Antivary.card_mul_sum_le_sum_mul_sum

end Mul

variable [LinearOrderedField α] {s : Finset ι} {f : ι → α}

theorem sum_div_card_sq_le_sum_sq_div_card :
    ((∑ i in s, f i) / s.card) ^ 2 ≤ (∑ i in s, f i ^ 2) / s.card :=
  by
  obtain rfl | hs := s.eq_empty_or_nonempty
  · simp
  rw [← card_pos, ← @Nat.cast_pos α] at hs
  rw [div_pow, div_le_div_iff (sq_pos_of_ne_zero _ hs.ne') hs, sq (s.card : α), mul_left_comm, ←
    mul_assoc]
  exact mul_le_mul_of_nonneg_right sq_sum_le_card_mul_sum_sq hs.le
#align sum_div_card_sq_le_sum_sq_div_card sum_div_card_sq_le_sum_sq_div_card


import cw3.cw2_restructured

/-
  This is part of coursework 3!
  It's ended up being mostly useless because I didn't have enough time for the separating powers trick.
-/
open myring

/--
Two elements of a ring are coprime if only units divide them both.
-/
def coprime {R : Type} [comm_ring R] (a b : R) : Prop := ∀ (d : R), d \ a → d \ b → is_unit d

lemma divis_add {R : Type} [comm_ring R] {a b c: R} : a \ b → a \ c → a \ (b+c) :=
begin
  intros h1 h2,
  cases h1 with kb hkb,
  cases h2 with kc hkc,
  use (kb + kc),
  rw mul_add,
  rw [hkb, hkc],
end

lemma divis_neg  {R : Type} [comm_ring R] {a b : R} : a \ b → a \ (-b) :=
begin
  intro h,
  cases h with k hk,
  use -k,
  rw hk,
  ring,
end

lemma divis_sub {R : Type} [comm_ring R] {a b c: R} : a \ b → a \ c → a \ (b-c) :=
begin
  intros h1 h2,
  cases h1 with kb hkb,
  cases h2 with kc hkc,
  use (kb - kc),
  rw mul_sub,
  rw [hkc, hkb],
end

/--
Bezout's identity for PIDs
I thought this might have been useful but it turns out it's not.
I'm leaving it in because it might be interesting
-/
theorem bezout_identity {R: Type} [pid R] {a b : R} (h : coprime a b) : ∃(c d : R), a*c + b*d = 1 :=
begin
  let I := sum_ideal (principal_ideal a) (principal_ideal b),
  have hi := pid.hpid I,
  cases hi with d hd,
  have hai : a ∈ I,
  {
    use a,
    split,
      use 1,
      rw mul_one,
      use 0,
      split,
        exact zero_mem_ideal,
        rw add_zero,
  },
  have hbi : b ∈ I,
  {
    use 0,
    split,
      exact zero_mem_ideal,
      use b,
      split,
        use 1,
        rw mul_one,
        rw zero_add,
  },
  have had : d \ a,
  {
    rw hd at hai,
    cases hai with e he,
    use e,
    exact he,
  },
  have hbd : d \ b,
  {
    rw hd at hbi,
    cases hbi with e he,
    use e,
    exact he,
  },
  have hone : (1:R) ∈ I,
  {
    rw hd,
    have hu := h d had hbd,
    rw is_unit_iff_exists_inv at hu,
    cases hu with di hdi,
    use di,
    exact eq_comm.mp hdi,
  },
  cases hone with k hk,
  cases hk with hk hl,
  cases hl with l hl,
  cases hl with hl hkl,
  cases hk with q hq,
  cases hl with r hr,
  rw hkl,
  use q,
  use r,
  rw hq,
  rw hr,
end

/--
Euclid's Lemma for PIDs.
I thought this might have been useful but it turns out it's not.
I'm leaving it in because it might be interesting
-/
theorem euclid_lemma {R : Type} [pid R] (n a b : R) (hc : coprime n a) : n \ (a*b) → n \ b :=
begin
  intro h,
  have h2 := bezout_identity hc,
  cases h2 with r hr,
  cases hr with s hs,
  apply_fun λ x, b*x at hs,
  rw mul_add at hs,
  rw mul_one at hs,
  cases h with d hd,
  use b*r + s*d,
  nth_rewrite 0 ←hs,
  nth_rewrite 1 ←mul_assoc,
  nth_rewrite 3 mul_comm,
  rw hd,
  ring,
end

/-
variables {R : Type} [ufd R]

lemma associates_equiv : equivalence (@associates R _ ) :=
begin
  split,
  {
    intro x,
    use 1,
    split,
    exact is_unit_one,
    rw mul_one,
  },
  split,
  {
    intros x y h,
    cases h with u hu,
    cases hu with hui hu,
    rw hu,
    rw is_unit_iff_exists_inv at hui,
    cases hui with ui hui,
    use ui,
    split,
    {
      rw is_unit_iff_exists_inv,
      use u,
      rw mul_comm,
      exact hui,
    },
    {
      rw [mul_assoc, hui, mul_one],
    }
  },
  {
    intros x y z h1 h2,
    cases h1 with u1 hu1,
    cases h2 with u2 hu2,
    cases hu1 with hui1 hu1,
    cases hu2 with hui2 hu2,
    use (u1 * u2),
    split,
    {
      exact is_unit.mul hui1 hui2,
    },
    {
      rw [hu2, hu1, mul_assoc],
    }
  }
end

def S (R: Type) [ufd R] : setoid R :=
{ r := associates,
  iseqv := associates_equiv }

-- I'm not sure how to get this one working
def irreducible_Ra : quotient (S R) → Prop := quotient.lift (λ a, irreducible a) begin
  sorry
end

theorem ufd_finite_factorisation  (a : quotient (S R)) :
 ∃ (s : multiset (quotient (S R))), ∀(x ∈ s), irreducible (coe x) :=
begin
  sorry
end
-/

/--
The separating powers trick for UFDs

Not enough time to do this :(
-/
theorem separating_powers_trick {R : Type} [ufd R] {p a b : R} {n : ℕ} (hcop : coprime a b) (heq : p^n = a * b) :
∃ (r u : R), is_unit u  ∧ u * r^n =  a :=
begin
  sorry
end
#lint


import data.nat.basic
import data.nat.parity
import data.int.basic
import data.equiv.denumerable
import tactic

lemma frog_explicit_formula
{frog : ℕ → ℤ}
{step : ℤ}
{start : ℤ}
(frog_0 : frog 0 = start)
(frog_step : ∀ n, frog (n+1) = frog n + step)
(n : ℕ)
:
frog n = start + n * step := begin
induction n with d hd,
rw frog_0, norm_num,
rw [frog_step, hd, ←nat.add_one],
ring, ring,
end

def int_sq_enum_inv : ℤ × ℤ → ℕ := encodable.encode

open denumerable

def strategy_c (n : ℕ): ℤ := (of_nat (ℤ × ℤ) n).fst + n * (of_nat (ℤ × ℤ) n).snd
theorem part_c
(frog : ℕ → ℤ)
-- It starts somewhere, let's call that` start`
(start : ℤ)
(frog_start : frog 0 = start)
-- the same positive integer n each time)
(step : ℤ)
-- every second it jumps n units to the right.
(frog_step : ∀ n, frog (n+1) = frog n + step) :
∃n, frog n = (strategy_c n) :=
begin
-- use encodable.encode ⟨start, step⟩,
use int_sq_enum_inv ⟨start, step⟩,
unfold strategy_c, unfold int_sq_enum_inv,

rw denumerable.of_nat_encode, simp only [],

rw frog_explicit_formula frog_start frog_step,
end


theorem Nat.zeroDiv {n : Nat} : 0 / n = 0 := by
    rw Nat.divDef
    have key : ¬ (0 < n ∧ n ≤ 0) by
        intro h
        have h' := Nat.ltOfLtOfLe h.1 h.2
        exact Nat.notLtZero 0 h'
    rw ifNeg key

theorem Nat.div_le_div_of_mul_aux (k n m : Nat) : n / k ≤ (n + m) / k := by {
    induction m with
    | zero => { exact Nat.leRefl _ }
    | succ m ih => { exact sorry }
}

theorem Nat.div_le_div_of_mul {k n m : Nat} (h : n ≤ m) : n / k ≤ m / k := by {
    have h' := Nat.div_le_div_of_mul_aux k n (m - n);
    exact sorry
}

theorem Nat.div_le_of_le_mul {k n m : Nat} (h : k ≤ n * m) : k / m ≤ n := by {
    induction k with
    | zero => { rw Nat.zeroDiv; exact Nat.zeroLe _ }
    | succ k ih => {
        have hk : k ≤ n * m := Nat.leTrans (Nat.leSucc _) h;
        have ih' := ih (Nat.leTrans (Nat.leSucc _) h);
        exact sorry
    }
}

theorem Nat.div_lt_of_lt_mul {k n m : Nat} (h : k < n * m) : k / m < n := by {
    exact sorry
}


import tactic
import data.set.basic
import data.real.basic
import algebra.order.floor
import data.real.irrational
import data.set.basic
import data.real.basic
import data.rat.basic

lemma p_is_positive (q : ℝ) (h_q_gt_one : q > 1) : (q / (q - 1)) > 0 :=
begin
  have hq : q - 1 > 0 := by linarith,
  have hqp: q > 0 := by linarith,
  exact div_pos hqp hq,
end