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

! This file was ported from Lean 3 source module data.polynomial.hasse_deriv
! leanprover-community/mathlib commit a148d797a1094ab554ad4183a4ad6f130358ef64
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Polynomial.BigOperators
import Mathlib.Data.Nat.Choose.Cast
import Mathlib.Data.Nat.Choose.Vandermonde
import Mathlib.Data.Polynomial.Derivative
import Mathlib.Tactic.FieldSimp

/-!
# Hasse derivative of polynomials

The `k`th Hasse derivative of a polynomial `∑ a_i X^i` is `∑ (i.choose k) a_i X^(i-k)`.
It is a variant of the usual derivative, and satisfies `k! * (hasseDeriv k f) = derivative^[k] f`.
The main benefit is that is gives an atomic way of talking about expressions such as
`(derivative^[k] f).eval r / k!`, that occur in Taylor expansions, for example.

## Main declarations

In the following, we write `D k` for the `k`-th Hasse derivative `hasse_deriv k`.

* `Polynomial.hasseDeriv`: the `k`-th Hasse derivative of a polynomial
* `Polynomial.hasseDeriv_zero`: the `0`th Hasse derivative is the identity
* `Polynomial.hasseDeriv_one`: the `1`st Hasse derivative is the usual derivative
* `Polynomial.factorial_smul_hasseDeriv`: the identity `k! • (D k f) = derivative^[k] f`
* `Polynomial.hasseDeriv_comp`: the identity `(D k).comp (D l) = (k+l).choose k • D (k+l)`
* `Polynomial.hasseDeriv_mul`:
  the "Leibniz rule" `D k (f * g) = ∑ ij in antidiagonal k, D ij.1 f * D ij.2 g`

For the identity principle, see `Polynomial.eq_zero_of_hasseDeriv_eq_zero`
in `Data/Polynomial/Taylor.lean`.

## Reference

https://math.fontein.de/2009/08/12/the-hasse-derivative/

-/

noncomputable section

namespace Polynomial

open Nat BigOperators Polynomial

open Function

open Nat hiding nsmul_eq_mul

variable {R : Type _} [Semiring R] (k : ℕ) (f : R[X])

/-- The `k`th Hasse derivative of a polynomial `∑ a_i X^i` is `∑ (i.choose k) a_i X^(i-k)`.
It satisfies `k! * (hasse_deriv k f) = derivative^[k] f`. -/
def hasseDeriv (k : ℕ) : R[X] →ₗ[R] R[X] :=
  lsum fun i => monomial (i - k) ∘ₗ DistribMulAction.toLinearMap R R (i.choose k)
#align polynomial.hasse_deriv Polynomial.hasseDeriv

theorem hasseDeriv_apply :
    hasseDeriv k f = f.sum fun i r => monomial (i - k) (↑(i.choose k) * r) := by
  dsimp [hasseDeriv]
  congr; ext; congr
  apply nsmul_eq_mul
#align polynomial.hasse_deriv_apply Polynomial.hasseDeriv_apply

theorem hasseDeriv_coeff (n : ℕ) : (hasseDeriv k f).coeff n = (n + k).choose k * f.coeff (n + k) :=
  by
  rw [hasseDeriv_apply, coeff_sum, sum_def, Finset.sum_eq_single (n + k), coeff_monomial]
  · simp only [if_true, add_tsub_cancel_right, eq_self_iff_true]
  · intro i _hi hink
    rw [coeff_monomial]
    by_cases hik : i < k
    · simp only [Nat.choose_eq_zero_of_lt hik, ite_self, Nat.cast_zero, MulZeroClass.zero_mul]
    · push_neg at hik
      rw [if_neg]
      contrapose! hink
      exact (tsub_eq_iff_eq_add_of_le hik).mp hink
  · intro h
    simp only [not_mem_support_iff.mp h, monomial_zero_right, MulZeroClass.mul_zero, coeff_zero]
#align polynomial.hasse_deriv_coeff Polynomial.hasseDeriv_coeff

theorem hasseDeriv_zero' : hasseDeriv 0 f = f := by
  simp only [hasseDeriv_apply, tsub_zero, Nat.choose_zero_right, Nat.cast_one, one_mul,
    sum_monomial_eq]
#align polynomial.hasse_deriv_zero' Polynomial.hasseDeriv_zero'

@[simp]
theorem hasseDeriv_zero : @hasseDeriv R _ 0 = LinearMap.id :=
  LinearMap.ext <| hasseDeriv_zero'
#align polynomial.hasse_deriv_zero Polynomial.hasseDeriv_zero

theorem hasseDeriv_eq_zero_of_lt_natDegree (p : R[X]) (n : ℕ) (h : p.natDegree < n) :
    hasseDeriv n p = 0 := by
  rw [hasseDeriv_apply, sum_def]
  refine' Finset.sum_eq_zero fun x hx => _
  simp [Nat.choose_eq_zero_of_lt ((le_natDegree_of_mem_supp _ hx).trans_lt h)]
#align polynomial.hasse_deriv_eq_zero_of_lt_nat_degree Polynomial.hasseDeriv_eq_zero_of_lt_natDegree

theorem hasseDeriv_one' : hasseDeriv 1 f = derivative f := by
  simp only [hasseDeriv_apply, derivative_apply, ← C_mul_X_pow_eq_monomial, Nat.choose_one_right,
    (Nat.cast_commute _ _).eq]
#align polynomial.hasse_deriv_one' Polynomial.hasseDeriv_one'

@[simp]
theorem hasseDeriv_one : @hasseDeriv R _ 1 = derivative :=
  LinearMap.ext <| hasseDeriv_one'
#align polynomial.hasse_deriv_one Polynomial.hasseDeriv_one

@[simp]
theorem hasseDeriv_monomial (n : ℕ) (r : R) :
    hasseDeriv k (monomial n r) = monomial (n - k) (↑(n.choose k) * r) := by
  ext i
  simp only [hasseDeriv_coeff, coeff_monomial]
  by_cases hnik : n = i + k
  · rw [if_pos hnik, if_pos, ← hnik]
    apply tsub_eq_of_eq_add_rev
    rwa [add_comm]
  · rw [if_neg hnik, MulZeroClass.mul_zero]
    by_cases hkn : k ≤ n
    · rw [← tsub_eq_iff_eq_add_of_le hkn] at hnik
      rw [if_neg hnik]
    · push_neg  at hkn
      rw [Nat.choose_eq_zero_of_lt hkn, Nat.cast_zero, MulZeroClass.zero_mul, ite_self]
#align polynomial.hasse_deriv_monomial Polynomial.hasseDeriv_monomial

theorem hasseDeriv_apply_one (hk : 0 < k) : hasseDeriv k (1 : R[X]) = 0 := by
  rw [← C_1, hasseDeriv_C k _ hk]
#align polynomial.hasse_deriv_apply_one Polynomial.hasseDeriv_apply_one

theorem hasseDeriv_X (hk : 1 < k) : hasseDeriv k (X : R[X]) = 0 := by
  rw [← monomial_one_one_eq_X, hasseDeriv_monomial, Nat.choose_eq_zero_of_lt hk, Nat.cast_zero,
    MulZeroClass.zero_mul, monomial_zero_right]
set_option linter.uppercaseLean3 false in
#align polynomial.hasse_deriv_X Polynomial.hasseDeriv_X

theorem factorial_smul_hasseDeriv : ⇑(k ! • @hasseDeriv R _ k) = @derivative R _^[k] := by
  induction' k with k ih
  · rw [hasseDeriv_zero, factorial_zero, iterate_zero, one_smul, LinearMap.id_coe]
  ext (f n) : 2
  rw [iterate_succ_apply', ← ih]
  simp only [LinearMap.smul_apply, coeff_smul, LinearMap.map_smul_of_tower, coeff_derivative,
    hasseDeriv_coeff, ← @choose_symm_add _ k]
  simp only [nsmul_eq_mul, factorial_succ, mul_assoc, succ_eq_add_one, ← add_assoc,
    add_right_comm n 1 k, ← cast_succ]
  rw [← (cast_commute (n + 1) (f.coeff (n + k + 1))).eq]
  simp only [← mul_assoc]
  norm_cast
  congr 2
  rw [mul_comm (k+1) _, mul_assoc, mul_assoc]
  congr 1
  have : n + k + 1 = n + (k + 1) := by apply add_assoc
  rw [←choose_symm_of_eq_add this, choose_succ_right_eq, mul_comm]
  congr
  rw [add_assoc, add_tsub_cancel_left]
#align polynomial.factorial_smul_hasse_deriv Polynomial.factorial_smul_hasseDeriv

theorem hasseDeriv_comp (k l : ℕ) :
    (@hasseDeriv R _ k).comp (hasseDeriv l) = (k + l).choose k • hasseDeriv (k + l) := by
  ext i : 2
  simp only [LinearMap.smul_apply, comp_apply, LinearMap.coe_comp, smul_monomial, hasseDeriv_apply,
    mul_one, monomial_eq_zero_iff, sum_monomial_index, mul_zero, ←
    tsub_add_eq_tsub_tsub, add_comm l k]
  rw_mod_cast [nsmul_eq_mul]
  rw [←Nat.cast_mul]
  congr 2
  by_cases hikl : i < k + l
  · rw [choose_eq_zero_of_lt hikl, mul_zero]
    by_cases hil : i < l
    · rw [choose_eq_zero_of_lt hil, mul_zero]
    · push_neg at hil
      rw [← tsub_lt_iff_right hil] at hikl
      rw [choose_eq_zero_of_lt hikl, zero_mul]
  push_neg at hikl
  apply @cast_injective ℚ
  have h1 : l ≤ i := le_of_add_le_right hikl
  have h2 : k ≤ i - l := le_tsub_of_add_le_right hikl
  have h3 : k ≤ k + l := le_self_add
  push_cast
  rw [cast_choose ℚ h1, cast_choose ℚ h2, cast_choose ℚ h3, cast_choose ℚ hikl]
  rw [show i - (k + l) = i - l - k by rw [add_comm]; apply tsub_add_eq_tsub_tsub]
  simp only [add_tsub_cancel_left]
  have H : ∀ n : ℕ, (n ! : ℚ) ≠ 0 := by exact_mod_cast factorial_ne_zero
  field_simp [H]
  ring
#align polynomial.hasse_deriv_comp Polynomial.hasseDeriv_comp

theorem natDegree_hasseDeriv_le (p : R[X]) (n : ℕ) : natDegree (hasseDeriv n p) ≤ natDegree p - n :=
  by
  classical
    rw [hasseDeriv_apply, sum_def]
    refine' (natDegree_sum_le _ _).trans _
    simp_rw [Function.comp, natDegree_monomial]
    rw [Finset.fold_ite, Finset.fold_const]
    · simp only [ite_self, max_eq_right, zero_le', Finset.fold_max_le, true_and_iff, and_imp,
        tsub_le_iff_right, mem_support_iff, Ne.def, Finset.mem_filter]
      intro x hx hx'
      have hxp : x ≤ p.natDegree := le_natDegree_of_ne_zero hx
      have hxn : n ≤ x := by
        contrapose! hx'
        simp [Nat.choose_eq_zero_of_lt hx']
      rwa [tsub_add_cancel_of_le (hxn.trans hxp)]
    · simp
#align polynomial.nat_degree_hasse_deriv_le Polynomial.natDegree_hasseDeriv_le

theorem natDegree_hasseDeriv [NoZeroSMulDivisors ℕ R] (p : R[X]) (n : ℕ) :
    natDegree (hasseDeriv n p) = natDegree p - n := by
  cases' lt_or_le p.natDegree n with hn hn
  · simpa [hasseDeriv_eq_zero_of_lt_natDegree, hn] using (tsub_eq_zero_of_le hn.le).symm
  · refine' map_natDegree_eq_sub _ _
    · exact fun h => hasseDeriv_eq_zero_of_lt_natDegree _ _
    · classical
        simp only [ite_eq_right_iff, Ne.def, natDegree_monomial, hasseDeriv_monomial]
        intro k c c0 hh
        -- this is where we use the `smul_eq_zero` from `NoZeroSMulDivisors`
        rw [← nsmul_eq_mul, smul_eq_zero, Nat.choose_eq_zero_iff] at hh
        exact (tsub_eq_zero_of_le (Or.resolve_right hh c0).le).symm
#align polynomial.nat_degree_hasse_deriv Polynomial.natDegree_hasseDeriv

section

open AddMonoidHom Finset.Nat

theorem hasseDeriv_mul (f g : R[X]) :
    hasseDeriv k (f * g) = ∑ ij in antidiagonal k, hasseDeriv ij.1 f * hasseDeriv ij.2 g := by
  let D k := (@hasseDeriv R _ k).toAddMonoidHom
  let Φ := @AddMonoidHom.mul R[X] _
  show
    (compHom (D k)).comp Φ f g =
      ∑ ij : ℕ × ℕ in antidiagonal k, ((compHom.comp ((compHom Φ) (D ij.1))).flip (D ij.2) f) g
  simp only [← finset_sum_apply]
  congr 2
  clear f g
  ext (m r n s) : 4
  simp only [finset_sum_apply, coe_mul_left, coe_comp, flip_apply, Function.comp_apply,
             hasseDeriv_monomial, LinearMap.toAddMonoidHom_coe, compHom_apply_apply,
             coe_mul, monomial_mul_monomial]
  have aux :
    ∀ x : ℕ × ℕ,
      x ∈ antidiagonal k →
        monomial (m - x.1 + (n - x.2)) (↑(m.choose x.1) * r * (↑(n.choose x.2) * s)) =
          monomial (m + n - k) (↑(m.choose x.1) * ↑(n.choose x.2) * (r * s)) :=
    by
    intro x hx
    rw [Finset.Nat.mem_antidiagonal] at hx
    subst hx
    by_cases hm : m < x.1
    · simp only [Nat.choose_eq_zero_of_lt hm, Nat.cast_zero, MulZeroClass.zero_mul,
                 monomial_zero_right]
    by_cases hn : n < x.2
    · simp only [Nat.choose_eq_zero_of_lt hn, Nat.cast_zero, MulZeroClass.zero_mul,
                 MulZeroClass.mul_zero, monomial_zero_right]
    push_neg at hm hn
    rw [tsub_add_eq_add_tsub hm, ← add_tsub_assoc_of_le hn, ← tsub_add_eq_tsub_tsub,
      add_comm x.2 x.1, mul_assoc, ← mul_assoc r, ← (Nat.cast_commute _ r).eq, mul_assoc, mul_assoc]
  rw [Finset.sum_congr rfl aux]
  rw [← LinearMap.map_sum, ← Finset.sum_mul]
  congr
  rw_mod_cast [←Nat.add_choose_eq]
#align polynomial.hasse_deriv_mul Polynomial.hasseDeriv_mul

end

end Polynomial


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

/-!
# Matrix results for barycentric co-ordinates

Results about the matrix of barycentric co-ordinates for a family of points in an affine space, with
respect to some affine basis.
-/

open_locale affine big_operators matrix
open set

universes u₁ u₂ u₃ u₄

variables {ι : Type u₁} {k : Type u₂} {V : Type u₃} {P : Type u₄}
variables [add_comm_group V] [affine_space V P]

namespace affine_basis

section ring

variables [ring k] [module k V] (b : affine_basis ι k P)

/-- Given an affine basis `p`, and a family of points `q : ι' → P`, this is the matrix whose
rows are the barycentric coordinates of `q` with respect to `p`.

It is an affine equivalent of `basis.to_matrix`. -/
noncomputable def to_matrix {ι' : Type*} (q : ι' → P) : matrix ι' ι k :=
λ i j, b.coord j (q i)

@[simp] lemma to_matrix_apply {ι' : Type*} (q : ι' → P) (i : ι') (j : ι) :
  b.to_matrix q i j = b.coord j (q i) :=
rfl

@[simp]

variables {ι' : Type*} [fintype ι'] [fintype ι] (b₂ : affine_basis ι k P)

lemma to_matrix_row_sum_one {ι' : Type*} (q : ι' → P) (i : ι') :
  ∑ j, b.to_matrix q i j = 1 :=
by simp

/-- Given a family of points `p : ι' → P` and an affine basis `b`, if the matrix whose rows are the
coordinates of `p` with respect `b` has a right inverse, then `p` is affine independent. -/
lemma affine_independent_of_to_matrix_right_inv [decidable_eq ι']
  (p : ι' → P) {A : matrix ι ι' k} (hA : (b.to_matrix p) ⬝ A = 1) : affine_independent k p :=
begin
  rw affine_independent_iff_eq_of_fintype_affine_combination_eq,
  intros w₁ w₂ hw₁ hw₂ hweq,
  have hweq' : (b.to_matrix p).vec_mul w₁ = (b.to_matrix p).vec_mul w₂,
  { ext j,
    change ∑ i, (w₁ i) • (b.coord j (p i)) = ∑ i, (w₂ i) • (b.coord j (p i)),
    rw [← finset.univ.affine_combination_eq_linear_combination _ _ hw₁,
        ← finset.univ.affine_combination_eq_linear_combination _ _ hw₂,
        ← finset.univ.map_affine_combination p w₁ hw₁,
        ← finset.univ.map_affine_combination p w₂ hw₂, hweq], },
  replace hweq' := congr_arg (λ w, A.vec_mul w) hweq',
  simpa only [matrix.vec_mul_vec_mul, ← matrix.mul_eq_mul, hA, matrix.vec_mul_one] using hweq',
end

/-- Given a family of points `p : ι' → P` and an affine basis `b`, if the matrix whose rows are the
coordinates of `p` with respect `b` has a left inverse, then `p` spans the entire space. -/
lemma affine_span_eq_top_of_to_matrix_left_inv [decidable_eq ι] [nontrivial k]
  (p : ι' → P) {A : matrix ι ι' k} (hA : A ⬝ b.to_matrix p = 1) : affine_span k (range p) = ⊤ :=
begin
  suffices : ∀ i, b i ∈ affine_span k (range p),
  { rw [eq_top_iff, ← b.tot, affine_span_le],
    rintros q ⟨i, rfl⟩,
    exact this i, },
  intros i,
  have hAi : ∑ j, A i j = 1,
  { calc ∑ j, A i j = ∑ j, (A i j) * ∑ l, b.to_matrix p j l : by simp
                ... = ∑ j, ∑ l, (A i j) * b.to_matrix p j l : by simp_rw finset.mul_sum
                ... = ∑ l, ∑ j, (A i j) * b.to_matrix p j l : by rw finset.sum_comm
                ... = ∑ l, (A ⬝ b.to_matrix p) i l : rfl
                ... = 1 : by simp [hA, matrix.one_apply, finset.filter_eq], },
  have hbi : b i = finset.univ.affine_combination k p (A i),
  { apply b.ext_elem,
    intros j,
    rw [b.coord_apply, finset.univ.map_affine_combination _ _ hAi,
      finset.univ.affine_combination_eq_linear_combination _ _ hAi],
    change _ = (A ⬝ b.to_matrix p) i j,
    simp_rw [hA, matrix.one_apply, @eq_comm _ i j] },
  rw hbi,
  exact affine_combination_mem_affine_span hAi p,
end

/-- A change of basis formula for barycentric coordinates.

See also `affine_basis.to_matrix_inv_mul_affine_basis_to_matrix`. -/
@[simp] lemma to_matrix_vec_mul_coords (x : P) :
  (b.to_matrix b₂).vec_mul (b₂.coords x) = b.coords x :=
begin
  ext j,
  change _ = b.coord j x,
  conv_rhs { rw ← b₂.affine_combination_coord_eq_self x, },
  rw finset.map_affine_combination _ _ _ (b₂.sum_coord_apply_eq_one x),
  simp [matrix.vec_mul, matrix.dot_product, to_matrix_apply, coords],
end

variables [decidable_eq ι]

lemma to_matrix_mul_to_matrix :
  (b.to_matrix b₂) ⬝ (b₂.to_matrix b) = 1 :=
begin
  ext l m,
  change (b₂.to_matrix b).vec_mul (b.coords (b₂ l)) m = _,
  rw [to_matrix_vec_mul_coords, coords_apply, ← to_matrix_apply, to_matrix_self],
end

lemma is_unit_to_matrix :
  is_unit (b.to_matrix b₂) :=
⟨{ val     := b.to_matrix b₂,
   inv     := b₂.to_matrix b,
   val_inv := b.to_matrix_mul_to_matrix b₂,
   inv_val := b₂.to_matrix_mul_to_matrix b, }, rfl⟩

lemma is_unit_to_matrix_iff [nontrivial k] (p : ι → P) :
  is_unit (b.to_matrix p) ↔ affine_independent k p ∧ affine_span k (range p) = ⊤ :=
begin
  split,
  { rintros ⟨⟨B, A, hA, hA'⟩, (rfl : B = b.to_matrix p)⟩,
    rw matrix.mul_eq_mul at hA hA',
    exact ⟨b.affine_independent_of_to_matrix_right_inv p hA,
           b.affine_span_eq_top_of_to_matrix_left_inv p hA'⟩, },
  { rintros ⟨h_tot, h_ind⟩,
    let b' : affine_basis ι k P := ⟨p, h_tot, h_ind⟩,
    change is_unit (b.to_matrix b'),
    exact b.is_unit_to_matrix b', },
end

end ring

section comm_ring
variables [comm_ring k] [module k V] [decidable_eq ι] [fintype ι]
variables (b b₂ : affine_basis ι k P)

/-- A change of basis formula for barycentric coordinates.

See also `affine_basis.to_matrix_vec_mul_coords`. -/
@[simp] lemma to_matrix_inv_vec_mul_to_matrix (x : P) :
  (b.to_matrix b₂)⁻¹.vec_mul (b.coords x) = b₂.coords x :=
begin
  have hu := b.is_unit_to_matrix b₂,
  rw matrix.is_unit_iff_is_unit_det at hu,
  rw [← b.to_matrix_vec_mul_coords b₂, matrix.vec_mul_vec_mul, matrix.mul_nonsing_inv _ hu,
    matrix.vec_mul_one],
end

/-- If we fix a background affine basis `b`, then for any other basis `b₂`, we can characterise
the barycentric coordinates provided by `b₂` in terms of determinants relative to `b`. -/
lemma det_smul_coords_eq_cramer_coords (x : P) :
  (b.to_matrix b₂).det • b₂.coords x = (b.to_matrix b₂)ᵀ.cramer (b.coords x) :=
begin
  have hu := b.is_unit_to_matrix b₂,
  rw matrix.is_unit_iff_is_unit_det at hu,
  rw [← b.to_matrix_inv_vec_mul_to_matrix, matrix.det_smul_inv_vec_mul_eq_cramer_transpose _ _ hu],
end
end comm_ring

end affine_basis


import data.polynomial
open finset
universes u v
variables
          {R : Type u}[nonzero_comm_ring R]
          {A : Type v} [fintype A][decidable_eq A]
          (M : matrix A A R)
          (N : matrix A A (polynomial R))
namespace tools
open polynomial
open with_bot
notation `Σ` := finset.sum finset.univ
open_locale big_operators
/-!
    We start by explaining the strategy.
    Let :
    `(s : finset A)(φ :A → polynomial R)(a : A)`
    `(hyp : ∀ b : A, a ≠ b →  degree (φ b) < degree (φ a) )`
    `(hyp_not_nul : ⊥  < degree (φ a))`:
    Then
    `if a ∈ s then (degree (finset.sum s φ ) =  degree (φ a))`
            ` else degree (finset.sum s φ ) < (degree (φ a))`
    The caracteristic polynomial is constuct as a product over permutation.
    We analyse each term of the sum.
        If `σ = id ` then the degree of the polynomial is `card A` else the degre is less (`<`) than `card A`
    That permit to apply the next lemma.
-/

namespace with_bot

end with_bot

lemma χ_degree_strategy (s : finset A)(φ :A → polynomial R)(a : A)
(hyp : ∀ b : A, a ≠ b →  degree (φ b) < degree (φ a) ) (hyp_not_nul : ⊥  < degree (φ a)):

        if a ∈ s then (degree (finset.sum s φ ) =  degree (φ a)) else degree (finset.sum s φ ) < (degree (φ a)) :=
begin
    apply (finset.induction_on s), {
        intros, let F :=  not_mem_empty a, split_ifs,
        rw finset.sum_empty, rw degree_zero, assumption,
    },
    {{
        intros ℓ s hyp_ℓ hyp_rec,
        let p1 := φ a,
        let p2 := finset.sum s φ ,
        split_ifs with H,
            by_cases a = ℓ,
                {
                    rw sum_insert (by assumption),
                    rw ← h,
                    split_ifs at hyp_rec,
                        {
                            rw h at h_1, trivial,
                            },
                        {   rw add_comm,
                            apply degree_add_eq_of_degree_lt,exact hyp_rec,
                            },

                },
                {
                    split_ifs at hyp_rec,
                    {
                        rw sum_insert (by assumption),rw ← hyp_rec,
                        apply degree_add_eq_of_degree_lt, rw hyp_rec,
                        exact hyp ℓ h,
                        },
                    {
                        rw sum_insert (by assumption),
                        let g := mem_of_mem_insert_of_ne H h, trivial,
                        },
                },
            split_ifs at hyp_rec,
            {   have : a ∈ insert ℓ s,
                    apply  mem_insert_of_mem  h, trivial,

            },
            {
                rw sum_insert (by assumption),
                have : a ≠ ℓ,
                    let g := mem_insert_self ℓ s,
                    intro, rw a_1 at H, trivial,
                specialize hyp ℓ this,
                apply lt_of_le_of_lt (degree_add_le (φ ℓ ) p2),
                apply  max_lt (hyp)(hyp_rec),
            },
    }},
end

/--
    A friend version.
-/
lemma proof_strategy.car_pol_degree  (φ :A → polynomial R)(a : A)
(hyp : ∀ b : A, a ≠ b →  degree (φ b) < degree (φ a) )
(hyp_not_nul : ⊥  < degree (φ a)):
       (degree (Σ  φ ) =  degree (φ a))  :=
begin
    let g := χ_degree_strategy (finset.univ) φ a hyp hyp_not_nul,
    split_ifs at g, assumption,
    let h := mem_univ a, trivial,
end

theorem my_theo (a b : with_bot ℕ  ) : a ≤ b → a+1 ≤ b+1 := begin
    intros,
    rcases  b, intros, rcases a,
    exact le_refl (none +1),
    erw  le_bot_iff at a_1, rw a_1,
    refine le_refl _,
    rcases a,
    exact bot_le,
    apply  some_le_some.mpr, apply add_le_add,
    apply some_le_some.mp a_1, exact le_refl 1,
end
#check with_bot.some_lt_some

lemma  zero_le_one' :  (0 : with_bot ℕ )  ≤ 1 :=
        begin     apply coe_le_coe.mpr,
            exact zero_le_one,
end

lemma prod_monic (s : finset A)(φ : A → polynomial R)  (hyp : ∀ a : A, monic (φ a)) :
                monic (finset.prod s  (λ x : A, φ x))  :=
 begin
    apply (finset.induction_on s), {
      erw prod_empty at  *,
      exact leading_coeff_C _,
    },
    {
        intros ℓ  s hyp' hyp_rec,
        rw finset.prod_insert (by assumption),
        apply monic_mul, exact hyp ℓ, exact hyp_rec,
    },
 end

lemma degree_prod_monic (s : finset A)(φ : A → polynomial R)
(hyp_lc : ∀ ℓ : A, monic (φ ℓ )) :
  degree (finset.prod s  (λ x : A, φ x)) =  finset.sum s ( λ x : A, degree (φ x)) :=
  begin
        apply (finset.induction_on s), {
          rw prod_empty,
          exact degree_C (one_ne_zero),
    },
    {
        intros ℓ  s hyp' hyp_rec,
        rw finset.prod_insert (by assumption),
        rw finset.sum_insert (by assumption),
        let g := monic_mul (hyp_lc ℓ ) (prod_monic s φ hyp_lc) ,
        rw ← hyp_rec,
        apply degree_mul_eq',
        conv_lhs {
            erw  monic.def.mp (hyp_lc ℓ), rw one_mul,
            erw  monic.def.mp (prod_monic s φ hyp_lc),
        },
        exact one_ne_zero,
    },
  end

theorem cast_with_bot   (a  : ℕ ) :  nat.cast (a) = (a: with_bot ℕ ) := begin
    apply (nat.rec_on a),  {
        exact rfl,
    },
    intros ℓ  hyp_rec,
    change _ = ↑ℓ + ↑1,
    erw ← hyp_rec, exact rfl,
end
lemma prod_monic_one  (s : finset A)(φ : A → polynomial R)(hyp : ∀ ℓ : A, degree(φ ℓ ) = 1 )
(hyp_lc : ∀ ℓ : A, monic(φ ℓ) ) :   -- monic !
  degree (finset.prod s  (λ x : A, φ x)) =  card s :=
 begin
    rw degree_prod_monic s φ  hyp_lc,
    let g := @finset.sum_const _ _ s _ 1,
    conv_lhs{
        apply_congr, skip,
        rw hyp x,
    },
    rw finset.sum_const,  rw add_monoid.smul_one, unfold_coes, rw some_eq_coe, refine cast_with_bot  _ ,

end

lemma degree_prod_le_sum_degree (s : finset A)(φ : A → polynomial R)  :
                degree (finset.prod s  (λ x : A, φ x)) ≤ finset.sum s ( λ x : A, degree (φ x)) :=
 begin apply (finset.induction_on s), {
          rw prod_empty, rw sum_empty,
          rw degree_one, exact le_refl 0,
          },
        intros ℓ s hyp_ℓ hyp_rec,
        rw sum_insert (by assumption), rw prod_insert (by assumption),
        exact le_trans (degree_mul_le _ _) (add_le_add_left' (hyp_rec)),
 end

theorem sum_le (s : finset A) (φ : A → (with_bot ℕ) ) (hyp : ∀ ℓ : A, φ ℓ ≤ 1)  :
        finset.sum s φ ≤  card s :=
begin
    apply (finset.induction_on s), {
        rw sum_empty, rw card_empty, exact le_refl 0,
    },
    intros ℓ s hyp_l hyp_rec,
    rw sum_insert (by assumption), rw card_insert_of_not_mem(by assumption), rw coe_add, rw add_comm,
    apply add_le_add' hyp_rec (hyp ℓ ),
end

lemma prod_degree_one_le_card (s : finset A)(φ : A → polynomial R) (hyp : ∀ ℓ : A, degree(φ ℓ ) ≤  1 ) :
    degree (finset.prod s  (λ x : A, φ x)) ≤ card s := begin
        apply le_trans (degree_prod_le_sum_degree s φ),
        apply sum_le  , exact hyp,
end

lemma le_add_compensation (a : ℕ) { b c d : with_bot ℕ} : (a : with_bot ℕ ) + c ≤  b +d  →  b ≤ a →  c ≤ d :=
begin
    intros hyp1 hyp2 ,
    have r : b+d ≤  a + d,
        exact add_le_add_right' hyp2,
    have : (a : with_bot ℕ ) + c ≤  a + d,
        apply le_trans (hyp1) (r),
    rcases c, exact bot_le,
    rcases d, erw le_bot_iff at this, trivial,
    rw ← some_eq_coe at  * ,
    erw ← coe_add at this, erw ← coe_add at this,
    let F := coe_le_coe.mp this,
    apply coe_le_coe.mpr,
    exact (add_le_add_iff_left a).mp F,
end
/-!
    The last technical lemma
-/
example (a b: ℕ ): a = b →  a ≤ b := begin
library_search,
end
lemma add_eq_bot (a : ℕ ) (b : with_bot ℕ ) : (a : with_bot ℕ ) + b = ⊥  →   b = ⊥  :=
begin
    cases b, intros,  rw none_eq_bot, intros, rw some_eq_coe at a_1, rw ← coe_add at a_1,  finish,
end
#check with_bot.
--by cases a; cases b; simp [none_eq_bot, some_eq_coe, coe_add.symm]
lemma ert (a b : ℕ) : (a = b ) → (a : with_bot ℕ ) = b := begin
  intros,exact congr_arg coe a_1,
end

lemma tre (a b : ℕ ) : (a : with_bot ℕ ) = b → a = b := begin
  intros,exact option.some_inj.mp a_1,
end
lemma left_cancel ( a : ℕ ) {b c : with_bot ℕ } : ↑a + b = a + c → b = c := begin
    intros,
    rcases b, rcases c, exact rfl, rw none_eq_bot  at a_1,
    rw add_bot at a_1, rw some_eq_coe at a_1, let g := (add_eq_bot a) c,
    let h :=  eq.symm a_1,
    specialize g h, trivial, rw some_eq_coe at a_1, rw ← coe_add at a_1,cases c, finish,
    rw some_eq_coe at a_1, rw ← coe_add at a_1, let k := tre (a+b) (a+c) a_1,
    rw some_eq_coe , rw some_eq_coe,
    apply ert,
    apply eq_of_add_eq_add_left k,
end
theorem proof_stra (a : ℕ) { b c d : ℕ} :   a ≤ c → b ≤ d →  (a+ b = c +d → (a=c ∧ b = d)) :=
begin
    intros,split, apply le_antisymm, assumption,
    apply (add_le_add_iff_left b).mp,
    conv_rhs {
        rw add_comm,
        rw a_3, rw add_comm,
    },
    apply (add_le_add_iff_right c).mpr , assumption,
    apply le_antisymm, assumption,
    apply (add_le_add_iff_left a).mp,
    conv_rhs  {
        rw a_3,
    },
    apply (add_le_add_iff_right d).mpr , assumption,
end

/--
        I use proof_strategy 2
-/
theorem q_card_insert_eq_card (s : finset A) (φ : A → (with_bot ℕ) )
(hyp : ∀ ℓ : A, φ ℓ ≤ 1) (ℓ0 ∉ s ):
 finset.sum (insert ℓ0 s)  φ = card (insert ℓ0 s) → finset.sum s  φ = card  s :=
 begin
     rw sum_insert(by assumption),
    rw card_insert_of_not_mem(by assumption), rw [coe_add, add_comm], intros  hyp_s,
    apply le_antisymm( sum_le s φ hyp),
    have pre_strat :  ↑1 + ↑(card s)   =   φ ℓ0 + finset.sum s (λ (x : A), φ x),
        rw add_comm, rw ← hyp_s, rw add_comm,
    apply  le_add_compensation 1 (le_of_eq (pre_strat)),
    exact (hyp ℓ0),
 end

theorem jenesaispas (s : finset A) (φ : A → (with_bot ℕ) )
(hyp : ∀ ℓ : A, φ ℓ ≤ 1) :
 finset.sum s φ = card s → (∀ ℓ : A, ℓ ∈ s → φ ℓ = 1) :=
 begin
    apply (finset.induction_on s), {
        rw sum_empty, intros, let g := not_mem_empty ℓ , trivial,
    },
    {
        intros ℓ s hyp_l hyp_rec,intros,

        by_cases ℓ_1 = ℓ,{ let h' := h,
            by_cases (finset.sum s φ = ↑(card s)),{
                rw [sum_insert(by assumption),card_insert_of_not_mem(by assumption), coe_add] at a,
            intros,rw h',
                rw h at a, rw add_comm at a, refine left_cancel (card s) a ,
            },
            let pre_strat := q_card_insert_eq_card s φ hyp ℓ hyp_l a,trivial,
            },
        {
            let  p := mem_of_mem_insert_of_ne a_1 h,
            let pre_strat := q_card_insert_eq_card s φ hyp ℓ hyp_l a,
            specialize hyp_rec pre_strat, exact hyp_rec ℓ_1 p,
        },
    },
 end

theorem det_card_term_'11 ( s: finset A) (φ : A → polynomial R)
(hyp : ∀ ℓ : A, degree(φ ℓ ) ≤ (1 : with_bot ℕ  ))  :
    degree (finset.prod s  (λ x :A, φ x)) =  card s → (∀ ℓ : A, ℓ ∈ s → degree (φ ℓ ) = 1)  :=
begin
    let je := jenesaispas s (λ x, degree (φ x)) hyp,
    intros,
    have rr :  finset.sum s (λ x, degree (φ x))  = card s,
        apply le_antisymm,{
            apply sum_le s , exact hyp,
        },
        {
            rw ← a,
            exact degree_prod_le_sum_degree s φ,
        },
    exact je rr ℓ  a_1,
 end

theorem degree_prod_le_one_lt_card (φ : A → polynomial R)
(hyp : ∀ ℓ : A, degree(φ ℓ ) ≤ 1 )
(hyp_lc : ∃  ℓ0 : A, degree (φ ℓ0) < 1) :

    degree (finset.prod finset.univ  (λ x :A, φ x)) <  fintype.card A :=

begin
    by_contradiction contra, push_neg at contra,
    let g := det_card_term_'11 (finset.univ) φ hyp,
    have : ↑(fintype.card A) = degree (finset.prod univ (λ (x : A), φ x)),
        apply le_antisymm (by assumption),
            apply le_trans (degree_prod_le_sum_degree (finset.univ) φ),
            apply sum_le ,
            exact hyp,
        rcases hyp_lc with ⟨ ζ, j⟩,
        specialize g (eq.symm this) ζ (mem_univ _),
        rw g at j,exact lt_irrefl 1 j,
end

end tools

/-
  unfold car_matrix, split_ifs, rw eval_add, rw eval_C, rw eval_X, rw h, rw add_val, rw smul_val, rw one_val, rw mul_ite,
     rw mul_one, rw mul_zero,simp, rw eval_C,rw add_val, rw smul_val, rw one_val, rw mul_ite,split_ifs, rw mul_zero,rw add_zero,
-/


import data.nat.gcd
open nat
/-2∗. True or false?
(i) If a and b are positive integers, and there exist integers λ and μ such that λa + μb = 1, then
gcd(a, b) = 1.
(ii) If a and b are positive integers, and there exist integers λ and μ such that λa + μb = 7,
then gcd(a, b) = 7.-/
variables {a b μ ν: ℕ}

theorem Q0802i : ∃ μ, ∃ ν, μ*a + ν*b = 1 → gcd a b = 1 := sorry

theorem Q0802ii : ∃ μ, ∃ ν, μ*a + ν*b = 7 → gcd a b = 7 := sorry


import interior_world.level4 --hide
/-

# Level 5: Characterization of the interior

-/
variables {X : Type} -- hide
variables [topological_space X] (x : X)  (A B : set X) -- hide

namespace topological_space -- hide

/- Lemma
The interior of a set A is the biggest subset satisfying:
 - It is contained in A
 - It is open.
-/
lemma interior_def'': is_open B ∧ B ⊆ A ∧ (∀ U, U ⊆ A → is_open U → U ⊆ B) ↔ B = interior A :=
begin
  split,
  {
    rintros ⟨is_open_B, ⟨B_subset_A, B_is_biggest_open⟩⟩,
    ext1,
    split,
    {
      apply interior_maximal A B B_subset_A is_open_B,
    },
    {
      intro ha,
      exact B_is_biggest_open (interior A) (interior_is_subset A) (interior_is_open A) ha,
    },
  },
  {
    intro,
    subst B,
    exact ⟨interior_is_open A, ⟨interior_is_subset A, interior_maximal A⟩⟩,
  },

end

end topological_space -- hide


import tactic
import data.nat.basic
import data.real.basic

open_locale classical
noncomputable theory

open_locale big_operators
open finset

theorem cauchy_induction {P : ℕ → Prop} (h1 : Π (n : ℕ), P (n + 1) → P n) (h2 : Π (n : ℕ), P n → P (2 * n))
{m : ℕ} (hm : 0 < m) (hp : P m) :
∀ (n : ℕ), P n :=

begin
  intro n,
  have lt_pow_two := nat.lt_two_pow n,
  have le_m_pow_two : n <= 2 ^ n * m,
  {
    have le_pow_two := nat.le_of_lt lt_pow_two,
    have hm' := nat.succ_le_of_lt hm,
    have target_times_one := nat.mul_le_mul le_pow_two hm',
    rw mul_one at target_times_one,
    refine target_times_one,
  },
  have two_pow_k_times_m : (∀ k : ℕ, P (2 ^ k * m)),
  {
    intro k,
    induction k with i hi,
    {
      rw [pow_zero, one_mul],
      refine hp,
    },
    {
      rw [pow_succ, mul_assoc],
      refine h2 (2 ^ i * m) hi,
    },
  },
  have two_pow_n_times_m := two_pow_k_times_m n,
  refine nat.decreasing_induction h1 le_m_pow_two two_pow_n_times_m,
end


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

! This file was ported from Lean 3 source module topology.algebra.order.left_right
! leanprover-community/mathlib commit bcfa726826abd57587355b4b5b7e78ad6527b7e4
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Topology.ContinuousOn

/-!
# Left and right continuity

In this file we prove a few lemmas about left and right continuous functions:

* `continuousWithinAt_Ioi_iff_Ici`: two definitions of right continuity
  (with `(a, ∞)` and with `[a, ∞)`) are equivalent;
* `continuousWithinAt_Iio_iff_Iic`: two definitions of left continuity
  (with `(-∞, a)` and with `(-∞, a]`) are equivalent;
* `continuousAt_iff_continuous_left_right`, `continuousAt_iff_continuous_left'_right'` :
  a function is continuous at `a` if and only if it is left and right continuous at `a`.

## Tags

left continuous, right continuous
-/

open Set Filter Topology

section PartialOrder

variable {α β : Type _} [TopologicalSpace α] [PartialOrder α] [TopologicalSpace β]

theorem continuousWithinAt_Ioi_iff_Ici {a : α} {f : α → β} :
    ContinuousWithinAt f (Ioi a) a ↔ ContinuousWithinAt f (Ici a) a := by
  simp only [← Ici_diff_left, continuousWithinAt_diff_self]
#align continuous_within_at_Ioi_iff_Ici continuousWithinAt_Ioi_iff_Ici

theorem continuousWithinAt_Iio_iff_Iic {a : α} {f : α → β} :
    ContinuousWithinAt f (Iio a) a ↔ ContinuousWithinAt f (Iic a) a :=
  @continuousWithinAt_Ioi_iff_Ici αᵒᵈ _ _ _ _ _ f
#align continuous_within_at_Iio_iff_Iic continuousWithinAt_Iio_iff_Iic

theorem nhds_left'_le_nhds_ne (a : α) : 𝓝[<] a ≤ 𝓝[≠] a :=
  nhdsWithin_mono a fun _ => ne_of_lt
#align nhds_left'_le_nhds_ne nhds_left'_le_nhds_ne

theorem nhds_right'_le_nhds_ne (a : α) : 𝓝[>] a ≤ 𝓝[≠] a :=
  nhdsWithin_mono a fun _ => ne_of_gt
#align nhds_right'_le_nhds_ne nhds_right'_le_nhds_ne

end PartialOrder

section TopologicalSpace

variable {α β : Type _} [TopologicalSpace α] [LinearOrder α] [TopologicalSpace β]

theorem nhds_left_sup_nhds_right (a : α) : 𝓝[≤] a ⊔ 𝓝[≥] a = 𝓝 a := by
  rw [← nhdsWithin_union, Iic_union_Ici, nhdsWithin_univ]
#align nhds_left_sup_nhds_right nhds_left_sup_nhds_right

theorem nhds_left'_sup_nhds_right (a : α) : 𝓝[<] a ⊔ 𝓝[≥] a = 𝓝 a := by
  rw [← nhdsWithin_union, Iio_union_Ici, nhdsWithin_univ]
#align nhds_left'_sup_nhds_right nhds_left'_sup_nhds_right

theorem nhds_left_sup_nhds_right' (a : α) : 𝓝[≤] a ⊔ 𝓝[>] a = 𝓝 a := by
  rw [← nhdsWithin_union, Iic_union_Ioi, nhdsWithin_univ]
#align nhds_left_sup_nhds_right' nhds_left_sup_nhds_right'

theorem nhds_left'_sup_nhds_right' (a : α) : 𝓝[<] a ⊔ 𝓝[>] a = 𝓝[≠] a := by
  rw [← nhdsWithin_union, Iio_union_Ioi]
#align nhds_left'_sup_nhds_right' nhds_left'_sup_nhds_right'

theorem continuousAt_iff_continuous_left_right {a : α} {f : α → β} :
    ContinuousAt f a ↔ ContinuousWithinAt f (Iic a) a ∧ ContinuousWithinAt f (Ici a) a := by
  simp only [ContinuousWithinAt, ContinuousAt, ← tendsto_sup, nhds_left_sup_nhds_right]
#align continuous_at_iff_continuous_left_right continuousAt_iff_continuous_left_right

theorem continuousAt_iff_continuous_left'_right' {a : α} {f : α → β} :
    ContinuousAt f a ↔ ContinuousWithinAt f (Iio a) a ∧ ContinuousWithinAt f (Ioi a) a := by
  rw [continuousWithinAt_Ioi_iff_Ici, continuousWithinAt_Iio_iff_Iic,
    continuousAt_iff_continuous_left_right]
#align continuous_at_iff_continuous_left'_right' continuousAt_iff_continuous_left'_right'

end TopologicalSpace


import tactic.tidy

import set_category.diagram_lemmas
import help_functions

namespace Product

open set
     diagram_lemmas
     classical
     function
     help_functions
     category_theory

universes v u

local notation f ` ⊚ `:80 g:80 := category_struct.comp g f

def is_product {X : Type v} [category X]
    (A B : X)
    {P : X} (π₁ : P ⟶ A) (π₂ : P ⟶ B): Prop :=
    Π (Q : X) (q₁ : Q ⟶ A) (q₂ : Q ⟶ B),
            ∃! p : Q ⟶ P, q₁ = π₁ ⊚ p ∧ q₂ = π₂ ⊚ p

variables (A B : Type u)

lemma cartesian_product_is_product :
    is_product A B prod.fst prod.snd :=
    begin
        intros Q q₁ q₂,
        let p : Q → (A × B) := λ k, ⟨q₁ k,q₂ k⟩,
        use p,
        tidy
    end

lemma jointly_mono
    {X : Type v} [category X]
    (A B P : X) {Q: X} (π₁ : P ⟶ A) (π₂ : P ⟶ B)
        (prod: is_product A B π₁ π₂)
        {s s₁: Q ⟶ P}
        (h1 : π₁ ⊚ s₁ = π₁ ⊚ s)
        (h2 : π₂ ⊚ s₁ = π₂ ⊚ s):
        s₁ = s :=
    begin
        have prod_Q := prod Q (π₁ ⊚ s₁) (π₂ ⊚ s₁),
        cases prod_Q with p spec_p,
        have spec_s1 : π₁ ⊚ s = π₁ ⊚ p :=
            h1 ▸ spec_p.1.1,
        have spec_s2 : π₂ ⊚ s = π₂ ⊚ p :=
            h2 ▸ spec_p.1.2,
        rw spec_p.2 s ⟨h1, h2⟩,
        exact spec_p.2 s₁ ⟨rfl, rfl⟩,
    end

open prod

lemma jointly_mono_set
        {Q : Type u}
        {f g: Q → (A × B)}
        (h1 : fst ∘ f = fst ∘ g)
        (h2 : snd ∘ f = snd ∘ g):
        f = g :=
        have elements : ∀ q : Q , f q = g q :=
            assume q,
            have π₁ : (f q).1 = (g q).1 :=
                 have f1 : (prod.fst ∘ f) q = (prod.fst ∘ g) q := by rw h1,
                 f1,
            have π₂ : prod.snd (f q) = prod.snd (g q) :=
                 have s1 : (prod.snd ∘ f) q = (prod.snd ∘ g) q := by rw h2,
                 s1,
            by {
                ext1,
                exact π₁, exact π₂
            },
        funext elements

end Product


/-
Copyright (c) 2021 Chris Hughes, Junyan Xu. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Junyan Xu
-/
import data.finsupp.fintype
import data.mv_polynomial.equiv
import set_theory.cardinal.ordinal
/-!
# Cardinality of Multivariate Polynomial Ring

The main result in this file is `mv_polynomial.cardinal_mk_le_max`, which says that
the cardinality of `mv_polynomial σ R` is bounded above by the maximum of `#R`, `#σ`
and `ℵ₀`.
-/
universes u v

open cardinal
open_locale cardinal

namespace mv_polynomial

section two_universes

variables {σ : Type u} {R : Type v} [comm_semiring R]

@[simp] lemma cardinal_mk_eq_max_lift [nonempty σ] [nontrivial R] :
  #(mv_polynomial σ R) = max (max (cardinal.lift.{u} $ #R) $ cardinal.lift.{v} $ #σ) ℵ₀ :=
(mk_finsupp_lift_of_infinite _ R).trans $
by rw [mk_finsupp_nat, max_assoc, lift_max, lift_aleph_0, max_comm]

@[simp] lemma cardinal_mk_eq_lift [is_empty σ] : #(mv_polynomial σ R) = cardinal.lift.{u} (#R) :=
((is_empty_ring_equiv R σ).to_equiv.trans equiv.ulift.{u}.symm).cardinal_eq

end two_universes

variables {σ R : Type u} [comm_semiring R]

lemma cardinal_mk_eq_max [nonempty σ] [nontrivial R] :
  #(mv_polynomial σ R) = max (max (#R) (#σ)) ℵ₀ := by simp

/-- The cardinality of the multivariate polynomial ring, `mv_polynomial σ R` is at most the maximum
of `#R`, `#σ` and `ℵ₀` -/
lemma cardinal_mk_le_max : #(mv_polynomial σ R) ≤ max (max (#R) (#σ)) ℵ₀ :=
cardinal_lift_mk_le_max.trans $ by rw [lift_id, lift_id]

end mv_polynomial


import game.order.level05
import data.real.basic
open real

namespace xena -- hide

/-
# Chapter 2 : Order

## Level 6

An interesting result to prove.
-/

/- Lemma
For any two non-negative real numbers $a$ and $b$, we have that
$$a \le b \iff a^2 \le b^2 $$.
-/
theorem le_iff_sq_le (a b : ℝ) (ha : 0 ≤ a) (hb : 0 ≤ b): a ≤ b ↔ a^2 ≤ b^2:=
begin
    split,
    intro h,
    have h1 : a^2 ≤ a * b,
        have h11 : a ≤ a, linarith,
        have h12 := mul_le_mul h11 h ha ha,
        have h13 : a * a = a^2, ring,
        rw h13 at h12, exact h12,
    have h2 : a * b ≤ b^2,
        have h21 : b ≤ b, linarith,
        have h22 := mul_le_mul h21 h ha hb,
        rw mul_comm at h22,
        have h23 : b * b = b^2, ring,
        rw h23 at h22, exact h22,
    exact le_trans h1 h2,
    intro h,
    have ha2 : 0 ≤ a^2, exact pow_nonneg ha 2,
    have hb2 : 0 ≤ b^2, exact pow_nonneg hb 2,
    have h1 := (sqrt_le ha2 hb2).mpr h,
    have h2a := sqrt_sqr ha,
    have h2b := sqrt_sqr hb,
    rw h2a at h1, rw h2b at h1, exact h1, done

end

end xena -- hide


/-
Copyright (c) 2020 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon
-/
import data.nat.basic

/-!
# `nat.upto`

`nat.upto p`, with `p` a predicate on `ℕ`, is a subtype of elements `n : ℕ` such that no value
(strictly) below `n` satisfies `p`.

This type has the property that `>` is well-founded when `∃ i, p i`, which allows us to implement
searches on `ℕ`, starting at `0` and with an unknown upper-bound.

It is similar to the well founded relation constructed to define `nat.find` with
the difference that, in `nat.upto p`, `p` does not need to be decidable. In fact,
`nat.find` could be slightly altered to factor decidability out of its
well founded relation and would then fulfill the same purpose as this file.
-/

namespace nat

/-- The subtype of natural numbers `i` which have the property that
no `j` less than `i` satisfies `p`. This is an initial segment of the
natural numbers, up to and including the first value satisfying `p`.

We will be particularly interested in the case where there exists a value
satisfying `p`, because in this case the `>` relation is well-founded.  -/
@[reducible]
def upto (p : ℕ → Prop) : Type := {i : ℕ // ∀ j < i, ¬ p j}

namespace upto

variable {p : ℕ → Prop}

/-- Lift the "greater than" relation on natural numbers to `nat.upto`. -/
protected def gt (p) (x y : upto p) : Prop := x.1 > y.1

instance : has_lt (upto p) := ⟨λ x y, x.1 < y.1⟩

/-- The "greater than" relation on `upto p` is well founded if (and only if) there exists a value
satisfying `p`. -/
protected lemma wf : (∃ x, p x) → well_founded (upto.gt p)
| ⟨x, h⟩ := begin
  suffices : upto.gt p = measure (λ y : nat.upto p, x - y.val),
  { rw this, apply measure_wf },
  ext ⟨a, ha⟩ ⟨b, _⟩,
  dsimp [measure, inv_image, upto.gt],
  rw nat.sub_lt_sub_left_iff,
  exact le_of_not_lt (λ h', ha _ h' h),
end

/-- Zero is always a member of `nat.upto p` because it has no predecessors. -/
def zero : nat.upto p := ⟨0, λ j h, false.elim (nat.not_lt_zero _ h)⟩

/-- The successor of `n` is in `nat.upto p` provided that `n` doesn't satisfy `p`. -/
def succ (x : nat.upto p) (h : ¬ p x.val) : nat.upto p :=
⟨x.val.succ, λ j h', begin
  rcases nat.lt_succ_iff_lt_or_eq.1 h' with h' | rfl;
  [exact x.2 _ h', exact h]
end⟩

end upto
end nat


/-
Copyright (c) 2022 James Gallicchio.

Authors: James Gallicchio
-/

@[reducible]
def Tuple (α : Type u) : Nat → Type u
| 0   => PUnit
| 1   => α
| (n+1)+1 => α × Tuple α (Nat.succ n)

namespace Tuple

@[inline]
def toList (t : Tuple α n) : List α :=
  match n, t with
  | 0,   ()     => []
  | 1,   a      => [a]
  | _+2, (a,as) => a :: toList as

@[simp]
theorem length_toList (t : Tuple α n)
  : t.toList.length = n
  := by
  induction n with
  | zero => simp [toList]
  | succ n ih =>
    cases n <;> simp [toList, ih]

@[inline]
def ofList (L : List α) : Tuple α L.length :=
  match L with
  | []        => ()
  | [x]       => x
  | x::y::xs  => (x, ofList (y::xs))

end Tuple

/-! ## List.choose

Returns list of all ways of choosing `n` elements from `L`.
This is equivalent to the list of all `(L[i1], ... L[in])`
for `0 ≤ i1 < i2 < ... < in < L.length`.
-/
def List.chooseSucc : (n : Nat) → List α → List (Tuple α n.succ)
| 0  , L     => L
| _+1, []    => []
| n+1, x::xs =>
  -- Either x is in the tuple,
  (List.chooseSucc n xs |>.map ((x, ·))) ++
  -- or it is not.
  (List.chooseSucc (n+1) xs)

def List.choose (n : Nat) (h_n : n = n.pred.succ := by decide)
  : List α → List (Tuple α n) :=
  h_n ▸ List.chooseSucc n.pred


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Mario Carneiro
-/
import data.int.order.basic

/-! # Least upper bound and greatest lower bound properties for integers

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

In this file we prove that a bounded above nonempty set of integers has the greatest element, and a
counterpart of this statement for the least element.

## Main definitions

* `int.least_of_bdd`: if `P : ℤ → Prop` is a decidable predicate, `b` is a lower bound of the set
  `{m | P m}`, and there exists `m : ℤ` such that `P m` (this time, no witness is required), then
  `int.least_of_bdd` returns the least number `m` such that `P m`, together with proofs of `P m` and
  of the minimality. This definition is computable and does not rely on the axiom of choice.
* `int.greatest_of_bdd`: a similar definition with all inequalities reversed.

## Main statements

* `int.exists_least_of_bdd`: if `P : ℤ → Prop` is a predicate such that the set `{m : P m}` is
  bounded below and nonempty, then this set has the least element. This lemma uses classical logic
  to avoid assumption `[decidable_pred P]`. See `int.least_of_bdd` for a constructive counterpart.

* `int.coe_least_of_bdd_eq`: `(int.least_of_bdd b Hb Hinh : ℤ)` does not depend on `b`.

* `int.exists_greatest_of_bdd`, `int.coe_greatest_of_bdd_eq`: versions of the above lemmas with all
  inequalities reversed.

## Tags

integer numbers, least element, greatest element
-/

namespace int

/-- A computable version of `exists_least_of_bdd`: given a decidable predicate on the
integers, with an explicit lower bound and a proof that it is somewhere true, return
the least value for which the predicate is true. -/
def least_of_bdd {P : ℤ → Prop} [decidable_pred P]
  (b : ℤ) (Hb : ∀ z : ℤ, P z → b ≤ z) (Hinh : ∃ z : ℤ, P z) :
  {lb : ℤ // P lb ∧ (∀ z : ℤ, P z → lb ≤ z)} :=
have EX : ∃ n : ℕ, P (b + n), from
  let ⟨elt, Helt⟩ := Hinh in
  match elt, le.dest (Hb _ Helt), Helt with
  | ._, ⟨n, rfl⟩, Hn := ⟨n, Hn⟩
  end,
⟨b + (nat.find EX : ℤ), nat.find_spec EX, λ z h,
  match z, le.dest (Hb _ h), h with
  | ._, ⟨n, rfl⟩, h := add_le_add_left
    (int.coe_nat_le.2 $ nat.find_min' _ h) _
  end⟩

/-- If `P : ℤ → Prop` is a predicate such that the set `{m : P m}` is bounded below and nonempty,
then this set has the least element. This lemma uses classical logic to avoid assumption
`[decidable_pred P]`. See `int.least_of_bdd` for a constructive counterpart. -/
theorem exists_least_of_bdd {P : ℤ → Prop}
  (Hbdd : ∃ b : ℤ, ∀ z : ℤ, P z → b ≤ z) (Hinh : ∃ z : ℤ, P z) :
  ∃ lb : ℤ, P lb ∧ (∀ z : ℤ, P z → lb ≤ z) :=
by classical; exact let ⟨b, Hb⟩ := Hbdd, ⟨lb, H⟩ := least_of_bdd b Hb Hinh in ⟨lb, H⟩

lemma coe_least_of_bdd_eq {P : ℤ → Prop} [decidable_pred P]
  {b b' : ℤ} (Hb : ∀ z : ℤ, P z → b ≤ z) (Hb' : ∀ z : ℤ, P z → b' ≤ z) (Hinh : ∃ z : ℤ, P z) :
  (least_of_bdd b Hb Hinh : ℤ) = least_of_bdd b' Hb' Hinh :=
begin
  rcases least_of_bdd b Hb Hinh with ⟨n, hn, h2n⟩,
  rcases least_of_bdd b' Hb' Hinh with ⟨n', hn', h2n'⟩,
  exact le_antisymm (h2n _ hn') (h2n' _ hn),
end

/-- A computable version of `exists_greatest_of_bdd`: given a decidable predicate on the
integers, with an explicit upper bound and a proof that it is somewhere true, return
the greatest value for which the predicate is true. -/
def greatest_of_bdd {P : ℤ → Prop} [decidable_pred P]
  (b : ℤ) (Hb : ∀ z : ℤ, P z → z ≤ b) (Hinh : ∃ z : ℤ, P z) :
  {ub : ℤ // P ub ∧ (∀ z : ℤ, P z → z ≤ ub)} :=
have Hbdd' : ∀ (z : ℤ), P (-z) → -b ≤ z, from λ z h, neg_le.1 (Hb _ h),
have Hinh' : ∃ z : ℤ, P (-z), from
let ⟨elt, Helt⟩ := Hinh in ⟨-elt, by rw [neg_neg]; exact Helt⟩,
let ⟨lb, Plb, al⟩ := least_of_bdd (-b) Hbdd' Hinh' in
⟨-lb, Plb, λ z h, le_neg.1 $ al _ $ by rwa neg_neg⟩

/-- If `P : ℤ → Prop` is a predicate such that the set `{m : P m}` is bounded above and nonempty,
then this set has the greatest element. This lemma uses classical logic to avoid assumption
`[decidable_pred P]`. See `int.greatest_of_bdd` for a constructive counterpart. -/
theorem exists_greatest_of_bdd {P : ℤ → Prop}
  (Hbdd : ∃ b : ℤ, ∀ z : ℤ, P z → z ≤ b) (Hinh : ∃ z : ℤ, P z) :
  ∃ ub : ℤ, P ub ∧ (∀ z : ℤ, P z → z ≤ ub) :=
by classical; exact let ⟨b, Hb⟩ := Hbdd, ⟨lb, H⟩ := greatest_of_bdd b Hb Hinh in ⟨lb, H⟩

lemma coe_greatest_of_bdd_eq {P : ℤ → Prop} [decidable_pred P]
  {b b' : ℤ} (Hb : ∀ z : ℤ, P z → z ≤ b) (Hb' : ∀ z : ℤ, P z → z ≤ b') (Hinh : ∃ z : ℤ, P z) :
  (greatest_of_bdd b Hb Hinh : ℤ) = greatest_of_bdd b' Hb' Hinh :=
begin
  rcases greatest_of_bdd b Hb Hinh with ⟨n, hn, h2n⟩,
  rcases greatest_of_bdd b' Hb' Hinh with ⟨n', hn', h2n'⟩,
  exact le_antisymm (h2n' _ hn) (h2n _ hn'),
end

end int


/-
Copyright (c) 2020 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Devon Tuma
-/
import ring_theory.ideal.quotient
import ring_theory.polynomial.basic

/-!
# Jacobson radical

The Jacobson radical of a ring `R` is defined to be the intersection of all maximal ideals of `R`.
This is similar to how the nilradical is equal to the intersection of all prime ideals of `R`.

We can extend the idea of the nilradical to ideals of `R`,
by letting the radical of an ideal `I` be the intersection of prime ideals containing `I`.
Under this extension, the original nilradical is the radical of the zero ideal `⊥`.
Here we define the Jacobson radical of an ideal `I` in a similar way,
as the intersection of maximal ideals containing `I`.

## Main definitions

Let `R` be a commutative ring, and `I` be an ideal of `R`

* `jacobson I` is the jacobson radical, i.e. the infimum of all maximal ideals containing I.

* `is_local I` is the proposition that the jacobson radical of `I` is itself a maximal ideal

## Main statements

* `mem_jacobson_iff` gives a characterization of members of the jacobson of I

* `is_local_of_is_maximal_radical`: if the radical of I is maximal then so is the jacobson radical

## Tags

Jacobson, Jacobson radical, Local Ideal

-/

universes u v

namespace ideal
variables {R : Type u} {S : Type v}
open_locale polynomial

section jacobson

section ring
variables [ring R] [ring S] {I : ideal R}

/-- The Jacobson radical of `I` is the infimum of all maximal (left) ideals containing `I`. -/
def jacobson (I : ideal R) : ideal R :=
Inf {J : ideal R | I ≤ J ∧ is_maximal J}

lemma le_jacobson : I ≤ jacobson I :=
λ x hx, mem_Inf.mpr (λ J hJ, hJ.left hx)

@[simp] lemma jacobson_idem : jacobson (jacobson I) = jacobson I :=
le_antisymm (Inf_le_Inf (λ J hJ, ⟨Inf_le hJ, hJ.2⟩)) le_jacobson

@[simp] lemma jacobson_top : jacobson (⊤ : ideal R) = ⊤ :=
eq_top_iff.2 le_jacobson

@[simp] theorem jacobson_eq_top_iff : jacobson I = ⊤ ↔ I = ⊤ :=
⟨λ H, classical.by_contradiction $ λ hi, let ⟨M, hm, him⟩ := exists_le_maximal I hi in
  lt_top_iff_ne_top.1
    (lt_of_le_of_lt (show jacobson I ≤ M, from Inf_le ⟨him, hm⟩) $
      lt_top_iff_ne_top.2 hm.ne_top) H,
λ H, eq_top_iff.2 $ le_Inf $ λ J ⟨hij, hj⟩, H ▸ hij⟩

lemma jacobson_eq_bot : jacobson I = ⊥ → I = ⊥ :=
λ h, eq_bot_iff.mpr (h ▸ le_jacobson)

lemma jacobson_eq_self_of_is_maximal [H : is_maximal I] : I.jacobson = I :=
le_antisymm (Inf_le ⟨le_of_eq rfl, H⟩) le_jacobson

@[priority 100]
instance jacobson.is_maximal [H : is_maximal I] : is_maximal (jacobson I) :=
⟨⟨λ htop, H.1.1 (jacobson_eq_top_iff.1 htop),
  λ J hJ, H.1.2 _ (lt_of_le_of_lt le_jacobson hJ)⟩⟩

theorem mem_jacobson_iff {x : R} : x ∈ jacobson I ↔ ∀ y, ∃ z, z * y * x + z - 1 ∈ I :=
⟨λ hx y, classical.by_cases
  (assume hxy : I ⊔ span {y * x + 1} = ⊤,
    let ⟨p, hpi, q, hq, hpq⟩ := submodule.mem_sup.1 ((eq_top_iff_one _).1 hxy) in
    let ⟨r, hr⟩ := mem_span_singleton'.1 hq in
    ⟨r, by rw [mul_assoc, ←mul_add_one, hr, ← hpq, ← neg_sub, add_sub_cancel]; exact I.neg_mem hpi⟩)
  (assume hxy : I ⊔ span {y * x + 1} ≠ ⊤,
    let ⟨M, hm1, hm2⟩ := exists_le_maximal _ hxy in
    suffices x ∉ M, from (this $ mem_Inf.1 hx ⟨le_trans le_sup_left hm2, hm1⟩).elim,
    λ hxm, hm1.1.1 $ (eq_top_iff_one _).2 $ add_sub_cancel' (y * x) 1 ▸ M.sub_mem
      (le_sup_right.trans hm2 $ subset_span rfl)
      (M.mul_mem_left _ hxm)),
λ hx, mem_Inf.2 $ λ M ⟨him, hm⟩, classical.by_contradiction $ λ hxm,
  let ⟨y, i, hi, df⟩ := hm.exists_inv hxm, ⟨z, hz⟩ := hx (-y) in
  hm.1.1 $ (eq_top_iff_one _).2 $ sub_sub_cancel (z * -y * x + z) 1 ▸ M.sub_mem
    (by { rw [mul_assoc, ←mul_add_one, neg_mul, ← (sub_eq_iff_eq_add.mpr df.symm), neg_sub,
            sub_add_cancel],
          exact M.mul_mem_left _ hi }) (him hz)⟩

lemma exists_mul_sub_mem_of_sub_one_mem_jacobson {I : ideal R} (r : R)
  (h : r - 1 ∈ jacobson I) : ∃ s, s * r - 1 ∈ I :=
begin
  cases mem_jacobson_iff.1 h 1 with s hs,
  use s,
  simpa [mul_sub] using hs
end

/-- An ideal equals its Jacobson radical iff it is the intersection of a set of maximal ideals.
Allowing the set to include ⊤ is equivalent, and is included only to simplify some proofs. -/
theorem eq_jacobson_iff_Inf_maximal :
  I.jacobson = I ↔ ∃ M : set (ideal R), (∀ J ∈ M, is_maximal J ∨ J = ⊤) ∧ I = Inf M :=
begin
  use λ hI, ⟨{J : ideal R | I ≤ J ∧ J.is_maximal}, ⟨λ _ hJ, or.inl hJ.right, hI.symm⟩⟩,
  rintros ⟨M, hM, hInf⟩,
  refine le_antisymm (λ x hx, _) le_jacobson,
  rw [hInf, mem_Inf],
  intros I hI,
  cases hM I hI with is_max is_top,
  { exact (mem_Inf.1 hx) ⟨le_Inf_iff.1 (le_of_eq hInf) I hI, is_max⟩ },
  { exact is_top.symm ▸ submodule.mem_top }
end

theorem eq_jacobson_iff_Inf_maximal' :
  I.jacobson = I ↔ ∃ M : set (ideal R), (∀ (J ∈ M) (K : ideal R), J < K → K = ⊤) ∧ I = Inf M :=
eq_jacobson_iff_Inf_maximal.trans
  ⟨λ h, let ⟨M, hM⟩ := h in ⟨M, ⟨λ J hJ K hK, or.rec_on (hM.1 J hJ) (λ h, h.1.2 K hK)
    (λ h, eq_top_iff.2 (le_of_lt (h ▸ hK))), hM.2⟩⟩,
  λ h, let ⟨M, hM⟩ := h in ⟨M, ⟨λ J hJ, or.rec_on (classical.em (J = ⊤)) (λ h, or.inr h)
    (λ h, or.inl ⟨⟨h, hM.1 J hJ⟩⟩), hM.2⟩⟩⟩

/-- An ideal `I` equals its Jacobson radical if and only if every element outside `I`
also lies outside of a maximal ideal containing `I`. -/
lemma eq_jacobson_iff_not_mem :
  I.jacobson = I ↔ ∀ x ∉ I, ∃ M : ideal R, (I ≤ M ∧ M.is_maximal) ∧ x ∉ M :=
begin
  split,
  { intros h x hx,
    erw [← h, mem_Inf] at hx,
    push_neg at hx,
    exact hx },
  { refine λ h, le_antisymm (λ x hx, _) le_jacobson,
    contrapose hx,
    erw mem_Inf,
    push_neg,
    exact h x hx }
end

theorem map_jacobson_of_surjective {f : R →+* S} (hf : function.surjective f) :
  ring_hom.ker f ≤ I → map f (I.jacobson) = (map f I).jacobson :=
begin
  intro h,
  unfold ideal.jacobson,
  have : ∀ J ∈ {J : ideal R | I ≤ J ∧ J.is_maximal}, f.ker ≤ J := λ J hJ, le_trans h hJ.left,
  refine trans (map_Inf hf this) (le_antisymm _ _),
  { refine Inf_le_Inf (λ J hJ, ⟨comap f J, ⟨⟨le_comap_of_map_le hJ.1, _⟩,
    map_comap_of_surjective f hf J⟩⟩),
    haveI : J.is_maximal := hJ.right,
    exact comap_is_maximal_of_surjective f hf },
  { refine Inf_le_Inf_of_subset_insert_top (λ j hj, hj.rec_on (λ J hJ, _)),
    rw ← hJ.2,
    cases map_eq_top_or_is_maximal_of_surjective f hf hJ.left.right with htop hmax,
    { exact htop.symm ▸ set.mem_insert ⊤ _ },
    { exact set.mem_insert_of_mem ⊤ ⟨map_mono hJ.1.1, hmax⟩ } },
end

lemma map_jacobson_of_bijective {f : R →+* S} (hf : function.bijective f) :
  map f (I.jacobson) = (map f I).jacobson :=
map_jacobson_of_surjective hf.right
  (le_trans (le_of_eq (f.injective_iff_ker_eq_bot.1 hf.left)) bot_le)

lemma comap_jacobson {f : R →+* S} {K : ideal S} :
  comap f (K.jacobson) = Inf (comap f '' {J : ideal S | K ≤ J ∧ J.is_maximal}) :=
trans (comap_Inf' f _) (Inf_eq_infi).symm

theorem comap_jacobson_of_surjective {f : R →+* S} (hf : function.surjective f) {K : ideal S} :
  comap f (K.jacobson) = (comap f K).jacobson :=
begin
  unfold ideal.jacobson,
  refine le_antisymm _ _,
  { refine le_trans (comap_mono (le_of_eq (trans top_inf_eq.symm Inf_insert.symm))) _,
    rw [comap_Inf', Inf_eq_infi],
    refine infi_le_infi_of_subset (λ J hJ, _),
    have : comap f (map f J) = J := trans (comap_map_of_surjective f hf J)
      (le_antisymm (sup_le_iff.2 ⟨le_of_eq rfl, le_trans (comap_mono bot_le) hJ.left⟩) le_sup_left),
    cases map_eq_top_or_is_maximal_of_surjective _ hf hJ.right with htop hmax,
    { refine ⟨⊤, ⟨set.mem_insert ⊤ _, htop ▸ this⟩⟩ },
    { refine ⟨map f J, ⟨set.mem_insert_of_mem _
        ⟨le_map_of_comap_le_of_surjective f hf hJ.1, hmax⟩, this⟩⟩ } },
  { rw comap_Inf,
    refine le_infi_iff.2 (λ J, (le_infi_iff.2 (λ hJ, _))),
    haveI : J.is_maximal := hJ.right,
    refine Inf_le ⟨comap_mono hJ.left, comap_is_maximal_of_surjective _ hf⟩ }
end

@[mono] lemma jacobson_mono {I J : ideal R} : I ≤ J → I.jacobson ≤ J.jacobson :=
begin
  intros h x hx,
  erw mem_Inf at ⊢ hx,
  exact λ K ⟨hK, hK_max⟩, hx ⟨trans h hK, hK_max⟩
end

end ring

section comm_ring
variables [comm_ring R] [comm_ring S] {I : ideal R}

lemma radical_le_jacobson : radical I ≤ jacobson I :=
le_Inf (λ J hJ, (radical_eq_Inf I).symm ▸ Inf_le ⟨hJ.left, is_maximal.is_prime hJ.right⟩)

lemma eq_radical_of_eq_jacobson : jacobson I = I → radical I = I :=
λ h, le_antisymm (le_trans radical_le_jacobson (le_of_eq h)) le_radical

lemma is_unit_of_sub_one_mem_jacobson_bot (r : R)
  (h : r - 1 ∈ jacobson (⊥ : ideal R)) : is_unit r :=
begin
  cases exists_mul_sub_mem_of_sub_one_mem_jacobson r h with s hs,
  rw [mem_bot, sub_eq_zero, mul_comm] at hs,
  exact is_unit_of_mul_eq_one _ _ hs
end

lemma mem_jacobson_bot {x : R} : x ∈ jacobson (⊥ : ideal R) ↔ ∀ y, is_unit (x * y + 1) :=
⟨λ hx y, let ⟨z, hz⟩ := (mem_jacobson_iff.1 hx) y in
  is_unit_iff_exists_inv.2 ⟨z, by rwa [add_mul, one_mul, ← sub_eq_zero, mul_right_comm,
    mul_comm _ z, mul_right_comm]⟩,
λ h, mem_jacobson_iff.mpr (λ y, (let ⟨b, hb⟩ := is_unit_iff_exists_inv.1 (h y) in
  ⟨b, (submodule.mem_bot R).2 (hb ▸ (by ring))⟩))⟩

/-- An ideal `I` of `R` is equal to its Jacobson radical if and only if
the Jacobson radical of the quotient ring `R/I` is the zero ideal -/
theorem jacobson_eq_iff_jacobson_quotient_eq_bot :
  I.jacobson = I ↔ jacobson (⊥ : ideal (R ⧸ I)) = ⊥ :=
begin
  have hf : function.surjective (quotient.mk I) := submodule.quotient.mk_surjective I,
  split,
  { intro h,
    replace h := congr_arg (map (quotient.mk I)) h,
    rw map_jacobson_of_surjective hf (le_of_eq mk_ker) at h,
    simpa using h },
  { intro h,
    replace h := congr_arg (comap (quotient.mk I)) h,
    rw [comap_jacobson_of_surjective hf, ← (quotient.mk I).ker_eq_comap_bot] at h,
    simpa using h }
end

/-- The standard radical and Jacobson radical of an ideal `I` of `R` are equal if and only if
the nilradical and Jacobson radical of the quotient ring `R/I` coincide -/
theorem radical_eq_jacobson_iff_radical_quotient_eq_jacobson_bot :
  I.radical = I.jacobson ↔ radical (⊥ : ideal (R ⧸ I)) = jacobson ⊥ :=
begin
  have hf : function.surjective (quotient.mk I) := submodule.quotient.mk_surjective I,
  split,
  { intro h,
    have := congr_arg (map (quotient.mk I)) h,
    rw [map_radical_of_surjective hf (le_of_eq mk_ker),
      map_jacobson_of_surjective hf (le_of_eq mk_ker)] at this,
    simpa using this },
  { intro h,
    have := congr_arg (comap (quotient.mk I)) h,
    rw [comap_radical, comap_jacobson_of_surjective hf, ← (quotient.mk I).ker_eq_comap_bot] at this,
    simpa using this }
end

lemma jacobson_radical_eq_jacobson :
  I.radical.jacobson = I.jacobson :=
le_antisymm (le_trans (le_of_eq (congr_arg jacobson (radical_eq_Inf I)))
  (Inf_le_Inf (λ J hJ, ⟨Inf_le ⟨hJ.1, hJ.2.is_prime⟩, hJ.2⟩))) (jacobson_mono le_radical)

end comm_ring

end jacobson

section polynomial
open polynomial

variables [comm_ring R]

lemma jacobson_bot_polynomial_le_Inf_map_maximal :
  jacobson (⊥ : ideal R[X]) ≤ Inf (map (C : R →+* R[X]) '' {J : ideal R | J.is_maximal}) :=
begin
  refine le_Inf (λ J, exists_imp_distrib.2 (λ j hj, _)),
  haveI : j.is_maximal := hj.1,
  refine trans (jacobson_mono bot_le) (le_of_eq _ : J.jacobson ≤ J),
  suffices : (⊥ : ideal (polynomial (R ⧸ j))).jacobson = ⊥,
  { rw [← hj.2, jacobson_eq_iff_jacobson_quotient_eq_bot],
    replace this :=
    congr_arg (map (polynomial_quotient_equiv_quotient_polynomial j).to_ring_hom) this,
    rwa [map_jacobson_of_bijective _, map_bot] at this,
    exact (ring_equiv.bijective (polynomial_quotient_equiv_quotient_polynomial j)) },
  refine eq_bot_iff.2 (λ f hf, _),
  simpa [(λ hX, by simpa using congr_arg (λ f, coeff f 1) hX : (X : (R ⧸ j)[X]) ≠ 0)]
    using eq_C_of_degree_eq_zero (degree_eq_zero_of_is_unit ((mem_jacobson_bot.1 hf) X)),
end

lemma jacobson_bot_polynomial_of_jacobson_bot (h : jacobson (⊥ : ideal R) = ⊥) :
  jacobson (⊥ : ideal R[X]) = ⊥ :=
begin
  refine eq_bot_iff.2 (le_trans jacobson_bot_polynomial_le_Inf_map_maximal _),
  refine (λ f hf, ((submodule.mem_bot _).2 (polynomial.ext (λ n, trans _ (coeff_zero n).symm)))),
  suffices : f.coeff n ∈ ideal.jacobson ⊥, by rwa [h, submodule.mem_bot] at this,
  exact mem_Inf.2 (λ j hj, (mem_map_C_iff.1 ((mem_Inf.1 hf) ⟨j, ⟨hj.2, rfl⟩⟩)) n),
end

end polynomial

section is_local

variables [comm_ring R]

/-- An ideal `I` is local iff its Jacobson radical is maximal. -/
class is_local (I : ideal R) : Prop := (out : is_maximal (jacobson I))

theorem is_local_iff {I : ideal R} : is_local I ↔ is_maximal (jacobson I) :=
⟨λ h, h.1, λ h, ⟨h⟩⟩

theorem is_local_of_is_maximal_radical {I : ideal R} (hi : is_maximal (radical I)) : is_local I :=
⟨have radical I = jacobson I,
from le_antisymm (le_Inf $ λ M ⟨him, hm⟩, hm.is_prime.radical_le_iff.2 him)
  (Inf_le ⟨le_radical, hi⟩),
show is_maximal (jacobson I), from this ▸ hi⟩

theorem is_local.le_jacobson {I J : ideal R} (hi : is_local I) (hij : I ≤ J) (hj : J ≠ ⊤) :
  J ≤ jacobson I :=
let ⟨M, hm, hjm⟩ := exists_le_maximal J hj in
le_trans hjm $ le_of_eq $ eq.symm $ hi.1.eq_of_le hm.1.1 $ Inf_le ⟨le_trans hij hjm, hm⟩

theorem is_local.mem_jacobson_or_exists_inv {I : ideal R} (hi : is_local I) (x : R) :
  x ∈ jacobson I ∨ ∃ y, y * x - 1 ∈ I :=
classical.by_cases
  (assume h : I ⊔ span {x} = ⊤,
    let ⟨p, hpi, q, hq, hpq⟩ := submodule.mem_sup.1 ((eq_top_iff_one _).1 h) in
    let ⟨r, hr⟩ := mem_span_singleton.1 hq in
    or.inr ⟨r, by rw [← hpq, mul_comm, ← hr, ← neg_sub, add_sub_cancel]; exact I.neg_mem hpi⟩)
  (assume h : I ⊔ span {x} ≠ ⊤,
    or.inl $ le_trans le_sup_right (hi.le_jacobson le_sup_left h) $ mem_span_singleton.2 $
      dvd_refl x)

end is_local

theorem is_primary_of_is_maximal_radical [comm_ring R] {I : ideal R} (hi : is_maximal (radical I)) :
  is_primary I :=
have radical I = jacobson I,
from le_antisymm (le_Inf $ λ M ⟨him, hm⟩, hm.is_prime.radical_le_iff.2 him)
  (Inf_le ⟨le_radical, hi⟩),
⟨ne_top_of_lt $ lt_of_le_of_lt le_radical (lt_top_iff_ne_top.2 hi.1.1),
λ x y hxy, ((is_local_of_is_maximal_radical hi).mem_jacobson_or_exists_inv y).symm.imp
  (λ ⟨z, hz⟩, by rw [← mul_one x, ← sub_sub_cancel (z * y) 1, mul_sub, mul_left_comm]; exact
    I.sub_mem (I.mul_mem_left _ hxy) (I.mul_mem_left _ hz))
  (this ▸ id)⟩

end ideal