/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro

Dimension of modules and vector spaces.
-/
import linear_algebra.basic
import linear_algebra.linear_map_module
import linear_algebra.prod_module
import linear_algebra.quotient_module
import set_theory.ordinal
noncomputable theory

local attribute [instance] classical.prop_decidable

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

namespace vector_space
variables [field α] [vector_space α β]

variables (α β)
def dim : cardinal :=
cardinal.min
  (nonempty_subtype.2 (@exists_is_basis α β _ _))
  (λ b, cardinal.mk b.1)
variables {α β}

include α
theorem basis_le_span (I J : set β) (h1 : is_basis I) (h2 : ∀x, x ∈ span J) : cardinal.mk I ≤ cardinal.mk J :=
or.cases_on (le_or_lt cardinal.omega $ cardinal.mk J)
(assume h4 : cardinal.omega ≤ cardinal.mk J,
le_of_not_lt $ assume h3 : cardinal.mk I > cardinal.mk J,
let h5 : J → set β := λ j, (h1.1.repr j).support.to_set in
have h6 : ¬I ⊆ ⋃ j, h5 j,
  from λ H, @not_lt_of_le _ _ (cardinal.mk I) (cardinal.mk (⋃ j, h5 j))
    (⟨set.embedding_of_subset H⟩) $
  calc  cardinal.mk (⋃ j, h5 j)
      ≤ cardinal.sum (λ j, cardinal.mk (h5 j)) : cardinal.mk_Union_le_sum_mk
  ... ≤ cardinal.sum (λ j : J, cardinal.omega.{v}) : cardinal.sum_le_sum _ _ $ λ j,
    le_of_lt $ cardinal.lt_omega_iff_finite.2 $ finset.finite_to_set _
  ... = cardinal.mk J * cardinal.omega : cardinal.sum_const _ _
  ... = max (cardinal.mk J) (cardinal.omega) : cardinal.mul_eq_max h4 (le_refl _)
  ... = cardinal.mk J : max_eq_left h4
  ... < cardinal.mk I : h3,
let ⟨i₀, h7⟩ := not_forall.1 h6 in
let ⟨h7, h8⟩ := not_imp.1 h7 in
have h9 : _ := λ j : J, not_exists.1 (mt set.mem_Union.2 h8) j,
have h9 : _ := λ j : J, by_contradiction $ mt (finsupp.mem_support_iff (h1.1.repr j) i₀).2 $ h9 j,
let ⟨h10, h11, h12⟩ := h2 i₀ in
have h13 : _ := (repr_eq_single h1.1 h7).symm.trans $
  (congr_arg h1.1.repr h12).trans $
  repr_finsupp_sum _ $ λ j _, h1.2 _,
have h14 : ((finsupp.single i₀ (1:α) : lc α β) : β → α) i₀ = _,
  from congr_fun (congr_arg finsupp.to_fun h13) i₀,
begin
  rw [finsupp.sum_apply, finsupp.single_eq_same, finsupp.sum] at h14,
  rw [← finset.sum_subset (finset.empty_subset _), finset.sum_empty] at h14,
  { exact zero_ne_one h14.symm },
  intros v h15 h16,
  have h17 := by_contradiction (mt (h11 v) ((finsupp.mem_support_iff _ _).1 h15)),
  have h18 : (linear_independent.repr (h1.left) v) i₀ = 0 := h9 ⟨v, h17⟩,
  rw [repr_smul h1.1 (h1.2 _), finsupp.smul_apply, h18, smul_eq_mul, mul_zero]
end)
(assume h4 : cardinal.mk J < cardinal.omega,
let ⟨h5, h6⟩ := exists_finite_card_le_of_finite_of_linear_independent_of_span
  (cardinal.lt_omega_iff_finite.1 h4) h1.1 (λ _ _, h2 _) in
by rwa [← cardinal.nat_cast_le, cardinal.finset_card, cardinal.finset_card, finset.coe_to_finset, finset.coe_to_finset] at h6)

/-- dimension theorem -/
theorem mk_eq_mk_of_basis {I J : set β} (h1 : is_basis I) (h2 : is_basis J) : cardinal.mk I = cardinal.mk J :=
le_antisymm (basis_le_span _ _ h1 h2.2) (basis_le_span _ _ h2 h1.2)

theorem mk_basis {b : set β} (h : is_basis b) : cardinal.mk b = dim α β :=
begin
  cases (show ∃ b', dim α β = _, from cardinal.min_eq _ _) with b' e,
  refine mk_eq_mk_of_basis h _,
  generalize : classical.some _ = b1,
  exact b1.2,
end

variables [vector_space α γ]

theorem dim_eq_of_linear_equiv (f : β ≃ₗ γ) : dim α β = dim α γ :=
let ⟨b, hb⟩ := exists_is_basis β in
(mk_basis hb).symm.trans $ (cardinal.mk_eq_of_injective f.to_equiv.bijective.1).symm.trans $
mk_basis $ hb.linear_equiv

theorem dim_prod : dim α (β × γ) = dim α β + dim α γ :=
let ⟨b, hb⟩ := exists_is_basis β in
let ⟨c, hc⟩ := exists_is_basis γ in
have H1 : _ := prod.is_basis_inl_union_inr hb hc,
have H2 : _ := @mk_basis.{u v} _ (β × γ) _ _ _ H1,
begin
  rw [← mk_basis hb, ← mk_basis hc, ← H2, cardinal.mk_union_of_disjiont],
  rw [cardinal.mk_eq_of_injective prod.injective_inl.{v v}],
  rw [cardinal.mk_eq_of_injective prod.injective_inr.{v v}],
  intros z h,
  rcases h with ⟨⟨x, h1, h2⟩, ⟨y, h3, h4⟩⟩,
  subst h4,
  cases prod.inl_eq_inr.1 h2 with h4 h5,
  substs h4 h5,
  exact zero_not_mem_of_linear_independent (@zero_ne_one α _) hb.1 h1
end

theorem dim_quotient {s : set β} [is_submodule s] : dim α (quotient_module.quotient β s) + dim α s = dim α β :=
nonempty.rec_on (quotient_module.quotient_prod_linear_equiv s) $ λ f,
dim_prod.symm.trans $ dim_eq_of_linear_equiv f

/-- rank-nullity theorem -/
theorem dim_im_add_dim_ker (f : linear_map β γ) : dim α f.im + dim α f.ker = dim α β :=
by rw [← dim_eq_of_linear_equiv (linear_map.quot_ker_equiv_im f), dim_quotient]

end vector_space


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

! This file was ported from Lean 3 source module category_theory.category.Kleisli
! leanprover-community/mathlib commit 70d50ecfd4900dd6d328da39ab7ebd516abe4025
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/

import Mathlib.CategoryTheory.Category.Basic

/-!
# The Kleisli construction on the Type category

Define the Kleisli category for (control) monads.
`CategoryTheory/Monad/Kleisli` defines the general version for a monad on `C`, and demonstrates
the equivalence between the two.

## TODO

Generalise this to work with CategoryTheory.Monad
-/

universe u v

namespace CategoryTheory

-- This file is about Lean 3 declaration "Kleisli".
set_option linter.uppercaseLean3 false

/-- The Kleisli category on the (type-)monad `m`. Note that the monad is not assumed to be lawful
yet. -/
@[nolint unusedArguments]
def KleisliCat (_ : Type u → Type v) :=
  Type u
#align category_theory.Kleisli CategoryTheory.KleisliCat

/-- Construct an object of the Kleisli category from a type. -/
def KleisliCat.mk (m) (α : Type u) : KleisliCat m :=
  α
#align category_theory.Kleisli.mk CategoryTheory.KleisliCat.mk

instance KleisliCat.categoryStruct {m} [Monad.{u, v} m] :
    CategoryStruct (KleisliCat m) where
  Hom α β := α → m β
  id _ x := pure x
  comp f g := f >=> g
#align category_theory.Kleisli.category_struct CategoryTheory.KleisliCat.categoryStruct

instance KleisliCat.category {m} [Monad.{u, v} m] [LawfulMonad m] : Category (KleisliCat m) := by
  -- Porting note: was
  -- refine' { id_comp' := _, comp_id' := _, assoc' := _ } <;> intros <;> ext <;> unfold_projs <;>
  --  simp only [(· >=> ·), functor_norm]
  refine' { id_comp := _, comp_id := _, assoc := _ } <;> intros <;> refine funext (fun x => ?_) <;>
  simp [CategoryStruct.id, CategoryStruct.comp, (· >=> ·)]
#align category_theory.Kleisli.category CategoryTheory.KleisliCat.category

@[simp]
theorem KleisliCat.id_def {m} [Monad m] (α : KleisliCat m) : 𝟙 α = @pure m _ α :=
  rfl
#align category_theory.Kleisli.id_def CategoryTheory.KleisliCat.id_def

theorem KleisliCat.comp_def {m} [Monad m] (α β γ : KleisliCat m) (xs : α ⟶ β) (ys : β ⟶ γ) (a : α) :
    (xs ≫ ys) a = xs a >>= ys :=
  rfl
#align category_theory.Kleisli.comp_def CategoryTheory.KleisliCat.comp_def

instance : Inhabited (KleisliCat id) :=
  ⟨PUnit⟩

instance {α : Type u} [Inhabited α] : Inhabited (KleisliCat.mk id α) :=
  ⟨show α from default⟩

end CategoryTheory


def foo1mk (_ : ∀ (α : Type) (a : α), a = a) : Nat := 37
def foo2mk (_ : ∀ {α : Type} (a : α), a = a) : Nat := 37 -- implicit binder

example (x) : foo1mk x = foo1mk x := rfl -- works
example (x : ∀ {α : Type} (a : α), a = a) : 37 = foo2mk x := rfl -- works
example (x) : 37 = foo2mk @x := rfl -- works
example (x) : foo1mk x = foo1mk x := rfl -- works
example (x : ∀ {α : Type} (a : α), a = a) : foo2mk x = foo2mk x := rfl -- works
example (x) : foo2mk x = foo2mk x := rfl -- works
example (x) : foo2mk x = 37 := rfl -- works
example (x) : foo2mk x = foo2mk x := rfl  -- works

universe u v w

structure ApplicativeTransformation (F : Type u → Type v) [Applicative F] [LawfulApplicative F]
  (G : Type u → Type w) [Applicative G] [LawfulApplicative G] : Type max (u + 1) v w where
  app : ∀ α : Type u, F α → G α
  preserves_pure' : ∀ {α : Type u} (x : α), app _ (pure x) = pure x
  preserves_seq' : ∀ {α β : Type u} (x : F (α → β)) (y : F α), app _ (x <*> y) = app _ x <*> app _ y

variable (F : Type u → Type v) [Applicative F] [LawfulApplicative F]

variable (G : Type u → Type w) [Applicative G] [LawfulApplicative G]

instance : CoeFun (ApplicativeTransformation F G) fun _ => ∀ {α}, F α → G α :=
  ⟨ApplicativeTransformation.app⟩

variable {F G}

@[simp]
theorem coe_mk (f : ∀ (α : Type u), F α → G α) (pp ps) :
  (ApplicativeTransformation.mk f pp ps) = f :=
  rfl


/-
Copyright (c) 2020 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma
-/
import ring_theory.localization.away
import ring_theory.ideal.over
import ring_theory.jacobson_ideal

/-!
# Jacobson Rings
The following conditions are equivalent for a ring `R`:
1. Every radical ideal `I` is equal to its Jacobson radical
2. Every radical ideal `I` can be written as an intersection of maximal ideals
3. Every prime ideal `I` is equal to its Jacobson radical
Any ring satisfying any of these equivalent conditions is said to be Jacobson.
Some particular examples of Jacobson rings are also proven.
`is_jacobson_quotient` says that the quotient of a Jacobson ring is Jacobson.
`is_jacobson_localization` says the localization of a Jacobson ring to a single element is Jacobson.
`is_jacobson_polynomial_iff_is_jacobson` says polynomials over a Jacobson ring form a Jacobson ring.
## Main definitions
Let `R` be a commutative ring. Jacobson Rings are defined using the first of the above conditions
* `is_jacobson R` is the proposition that `R` is a Jacobson ring. It is a class,
  implemented as the predicate that for any ideal, `I.is_radical` implies `I.jacobson = I`.

## Main statements
* `is_jacobson_iff_prime_eq` is the equivalence between conditions 1 and 3 above.
* `is_jacobson_iff_Inf_maximal` is the equivalence between conditions 1 and 2 above.
* `is_jacobson_of_surjective` says that if `R` is a Jacobson ring and `f : R →+* S` is surjective,
  then `S` is also a Jacobson ring
* `is_jacobson_mv_polynomial` says that multi-variate polynomials over a Jacobson ring are Jacobson.
## Tags
Jacobson, Jacobson Ring
-/

namespace ideal

open polynomial
open_locale polynomial

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

/-- A ring is a Jacobson ring if for every radical ideal `I`,
 the Jacobson radical of `I` is equal to `I`.
 See `is_jacobson_iff_prime_eq` and `is_jacobson_iff_Inf_maximal` for equivalent definitions. -/
class is_jacobson (R : Type*) [comm_ring R] : Prop :=
(out' : ∀ (I : ideal R), I.is_radical → I.jacobson = I)

theorem is_jacobson_iff {R} [comm_ring R] :
  is_jacobson R ↔ ∀ (I : ideal R), I.is_radical → I.jacobson = I :=
⟨λ h, h.1, λ h, ⟨h⟩⟩

theorem is_jacobson.out {R} [comm_ring R] :
  is_jacobson R → ∀ {I : ideal R}, I.is_radical → I.jacobson = I := is_jacobson_iff.1

/--  A ring is a Jacobson ring if and only if for all prime ideals `P`,
 the Jacobson radical of `P` is equal to `P`. -/
lemma is_jacobson_iff_prime_eq : is_jacobson R ↔ ∀ P : ideal R, is_prime P → P.jacobson = P :=
begin
  refine is_jacobson_iff.trans ⟨λ h I hI, h I hI.is_radical, _⟩,
  refine λ h I hI, le_antisymm (λ x hx, _) (λ x hx, mem_Inf.mpr (λ _ hJ, hJ.left hx)),
  rw [← hI.radical, radical_eq_Inf I, mem_Inf],
  intros P hP,
  rw set.mem_set_of_eq at hP,
  erw mem_Inf at hx,
  erw [← h P hP.right, mem_Inf],
  exact λ J hJ, hx ⟨le_trans hP.left hJ.left, hJ.right⟩
end

/-- A ring `R` is Jacobson if and only if for every prime ideal `I`,
 `I` can be written as the infimum of some collection of maximal ideals.
 Allowing ⊤ in the set `M` of maximal ideals is equivalent, but makes some proofs cleaner. -/
lemma is_jacobson_iff_Inf_maximal : is_jacobson R ↔
  ∀ {I : ideal R}, I.is_prime → ∃ M : set (ideal R), (∀ J ∈ M, is_maximal J ∨ J = ⊤) ∧ I = Inf M :=
⟨λ H I h, eq_jacobson_iff_Inf_maximal.1 (H.out h.is_radical),
  λ H, is_jacobson_iff_prime_eq.2 (λ P hP, eq_jacobson_iff_Inf_maximal.2 (H hP))⟩

lemma is_jacobson_iff_Inf_maximal' : is_jacobson R ↔
  ∀ {I : ideal R}, I.is_prime → ∃ M : set (ideal R),
  (∀ (J ∈ M) (K : ideal R), J < K → K = ⊤) ∧ I = Inf M :=
⟨λ H I h, eq_jacobson_iff_Inf_maximal'.1 (H.out h.is_radical),
  λ H, is_jacobson_iff_prime_eq.2 (λ P hP, eq_jacobson_iff_Inf_maximal'.2 (H hP))⟩

lemma radical_eq_jacobson [H : is_jacobson R] (I : ideal R) : I.radical = I.jacobson :=
le_antisymm (le_Inf (λ J ⟨hJ, hJ_max⟩, (is_prime.radical_le_iff hJ_max.is_prime).mpr hJ))
            (H.out (radical_is_radical I) ▸ jacobson_mono le_radical)

/-- Fields have only two ideals, and the condition holds for both of them.  -/
@[priority 100]
instance is_jacobson_field {K : Type*} [field K] : is_jacobson K :=
⟨λ I hI, or.rec_on (eq_bot_or_top I)
(λ h, le_antisymm (Inf_le ⟨le_rfl, h.symm ▸ bot_is_maximal⟩) (h.symm ▸ bot_le))
(λ h, by rw [h, jacobson_eq_top_iff])⟩

theorem is_jacobson_of_surjective [H : is_jacobson R] :
  (∃ (f : R →+* S), function.surjective f) → is_jacobson S :=
begin
  rintros ⟨f, hf⟩,
  rw is_jacobson_iff_Inf_maximal,
  intros p hp,
  use map f '' {J : ideal R | comap f p ≤ J ∧ J.is_maximal },
  use λ j ⟨J, hJ, hmap⟩, hmap ▸ (map_eq_top_or_is_maximal_of_surjective f hf hJ.right).symm,
  have : p = map f (comap f p).jacobson :=
    (is_jacobson.out' _ $ hp.is_radical.comap f).symm ▸ (map_comap_of_surjective f hf p).symm,
  exact this.trans (map_Inf hf (λ J ⟨hJ, _⟩, le_trans (ideal.ker_le_comap f) hJ)),
end

@[priority 100]
instance is_jacobson_quotient [is_jacobson R] : is_jacobson (R ⧸ I) :=
is_jacobson_of_surjective ⟨quotient.mk I, (by rintro ⟨x⟩; use x; refl)⟩

lemma is_jacobson_iso (e : R ≃+* S) : is_jacobson R ↔ is_jacobson S :=
⟨λ h, @is_jacobson_of_surjective _ _ _ _ h ⟨(e : R →+* S), e.surjective⟩,
  λ h, @is_jacobson_of_surjective _ _ _ _ h ⟨(e.symm : S →+* R), e.symm.surjective⟩⟩

lemma is_jacobson_of_is_integral [algebra R S] (hRS : algebra.is_integral R S)
  (hR : is_jacobson R) : is_jacobson S :=
begin
  rw is_jacobson_iff_prime_eq,
  introsI P hP,
  by_cases hP_top : comap (algebra_map R S) P = ⊤,
  { simp [comap_eq_top_iff.1 hP_top] },
  { haveI : nontrivial (R ⧸ comap (algebra_map R S) P) := quotient.nontrivial hP_top,
    rw jacobson_eq_iff_jacobson_quotient_eq_bot,
    refine eq_bot_of_comap_eq_bot (is_integral_quotient_of_is_integral hRS) _,
    rw [eq_bot_iff, ← jacobson_eq_iff_jacobson_quotient_eq_bot.1 ((is_jacobson_iff_prime_eq.1 hR)
      (comap (algebra_map R S) P) (comap_is_prime _ _)), comap_jacobson],
    refine Inf_le_Inf (λ J hJ, _),
    simp only [true_and, set.mem_image, bot_le, set.mem_set_of_eq],
    haveI : J.is_maximal, { simpa using hJ },
    exact exists_ideal_over_maximal_of_is_integral (is_integral_quotient_of_is_integral hRS) J
      (comap_bot_le_of_injective _ algebra_map_quotient_injective) }
end

lemma is_jacobson_of_is_integral' (f : R →+* S) (hf : f.is_integral)
  (hR : is_jacobson R) : is_jacobson S :=
@is_jacobson_of_is_integral _ _ _ _ f.to_algebra hf hR

end is_jacobson

section localization
open is_localization submonoid
variables {R S : Type*} [comm_ring R] [comm_ring S] {I : ideal R}
variables (y : R) [algebra R S] [is_localization.away y S]

lemma disjoint_powers_iff_not_mem (hI : I.is_radical) :
  disjoint ((submonoid.powers y) : set R) ↑I ↔ y ∉ I.1 :=
begin
  refine ⟨λ h, set.disjoint_left.1 h (mem_powers _), λ h, disjoint_iff.mpr (eq_bot_iff.mpr _)⟩,
  rintros x ⟨⟨n, rfl⟩, hx'⟩,
  exact h (hI $ mem_radical_of_pow_mem $ le_radical hx')
end

variables (S)

/-- If `R` is a Jacobson ring, then maximal ideals in the localization at `y`
correspond to maximal ideals in the original ring `R` that don't contain `y`.
This lemma gives the correspondence in the particular case of an ideal and its comap.
See `le_rel_iso_of_maximal` for the more general relation isomorphism -/
lemma is_maximal_iff_is_maximal_disjoint [H : is_jacobson R] (J : ideal S) :
  J.is_maximal ↔ (comap (algebra_map R S) J).is_maximal ∧ y ∉ ideal.comap (algebra_map R S) J :=
begin
  split,
  { refine λ h, ⟨_, λ hy, h.ne_top (ideal.eq_top_of_is_unit_mem _ hy
      (map_units _ ⟨y, submonoid.mem_powers _⟩))⟩,
    have hJ : J.is_prime := is_maximal.is_prime h,
    rw is_prime_iff_is_prime_disjoint (submonoid.powers y) at hJ,
    have : y ∉ (comap (algebra_map R S) J).1 :=
      set.disjoint_left.1 hJ.right (submonoid.mem_powers _),
    erw [← H.out hJ.left.is_radical, mem_Inf] at this,
    push_neg at this,
    rcases this with ⟨I, hI, hI'⟩,
    convert hI.right,
    by_cases hJ : J = map (algebra_map R S) I,
    { rw [hJ, comap_map_of_is_prime_disjoint (powers y) S I (is_maximal.is_prime hI.right)],
      rwa disjoint_powers_iff_not_mem y hI.right.is_prime.is_radical },
    { have hI_p : (map (algebra_map R S) I).is_prime,
      { refine is_prime_of_is_prime_disjoint (powers y) _ I hI.right.is_prime _,
        rwa disjoint_powers_iff_not_mem y hI.right.is_prime.is_radical },
      have : J ≤ map (algebra_map R S) I :=
        (map_comap (submonoid.powers y) S J) ▸ (map_mono hI.left),
      exact absurd (h.1.2 _ (lt_of_le_of_ne this hJ)) hI_p.1 } },
  { refine λ h, ⟨⟨λ hJ, h.1.ne_top (eq_top_iff.2 _), λ I hI, _⟩⟩,
    { rwa [eq_top_iff, ← (is_localization.order_embedding (powers y) S).le_iff_le] at hJ },
    { have := congr_arg (map (algebra_map R S)) (h.1.1.2 _ ⟨comap_mono (le_of_lt hI), _⟩),
      rwa [map_comap (powers y) S I, map_top] at this,
      refine λ hI', hI.right _,
      rw [← map_comap (powers y) S I, ← map_comap (powers y) S J],
      exact map_mono hI' } }
end

variables {S}

/-- If `R` is a Jacobson ring, then maximal ideals in the localization at `y`
correspond to maximal ideals in the original ring `R` that don't contain `y`.
This lemma gives the correspondence in the particular case of an ideal and its map.
See `le_rel_iso_of_maximal` for the more general statement, and the reverse of this implication -/
lemma is_maximal_of_is_maximal_disjoint [is_jacobson R] (I : ideal R) (hI : I.is_maximal)
  (hy : y ∉ I) : (map (algebra_map R S) I).is_maximal :=
begin
  rw [is_maximal_iff_is_maximal_disjoint S y,
    comap_map_of_is_prime_disjoint (powers y) S I (is_maximal.is_prime hI)
    ((disjoint_powers_iff_not_mem y hI.is_prime.is_radical).2 hy)],
  exact ⟨hI, hy⟩
end

/-- If `R` is a Jacobson ring, then maximal ideals in the localization at `y`
correspond to maximal ideals in the original ring `R` that don't contain `y` -/
def order_iso_of_maximal [is_jacobson R] :
  {p : ideal S // p.is_maximal} ≃o {p : ideal R // p.is_maximal ∧ y ∉ p} :=
{ to_fun := λ p,
    ⟨ideal.comap (algebra_map R S) p.1, (is_maximal_iff_is_maximal_disjoint S y p.1).1 p.2⟩,
  inv_fun := λ p,
    ⟨ideal.map (algebra_map R S) p.1, is_maximal_of_is_maximal_disjoint y p.1 p.2.1 p.2.2⟩,
  left_inv := λ J, subtype.eq (map_comap (powers y) S J),
  right_inv := λ I, subtype.eq (comap_map_of_is_prime_disjoint _ _ I.1 (is_maximal.is_prime I.2.1)
    ((disjoint_powers_iff_not_mem y I.2.1.is_prime.is_radical).2 I.2.2)),
  map_rel_iff' := λ I I', ⟨λ h, (show I.val ≤ I'.val,
    from (map_comap (powers y) S I.val) ▸ (map_comap (powers y) S I'.val) ▸ (ideal.map_mono h)),
    λ h x hx, h hx⟩ }

include y

/-- If `S` is the localization of the Jacobson ring `R` at the submonoid generated by `y : R`, then
`S` is Jacobson. -/
lemma is_jacobson_localization [H : is_jacobson R] : is_jacobson S :=
begin
  rw is_jacobson_iff_prime_eq,
  refine λ P' hP', le_antisymm _ le_jacobson,
  obtain ⟨hP', hPM⟩ := (is_localization.is_prime_iff_is_prime_disjoint (powers y) S P').mp hP',
  have hP := H.out hP'.is_radical,
  refine (is_localization.map_comap (powers y) S P'.jacobson).ge.trans
    ((map_mono _).trans (is_localization.map_comap (powers y) S P').le),
  have : Inf { I : ideal R | comap (algebra_map R S) P' ≤ I ∧ I.is_maximal ∧ y ∉ I } ≤
    comap (algebra_map R S) P',
  { intros x hx,
    have hxy : x * y ∈ (comap (algebra_map R S) P').jacobson,
    { rw [ideal.jacobson, mem_Inf],
      intros J hJ,
      by_cases y ∈ J,
      { exact J.mul_mem_left x h },
      { exact J.mul_mem_right y ((mem_Inf.1 hx) ⟨hJ.left, ⟨hJ.right, h⟩⟩) } },
    rw hP at hxy,
    cases hP'.mem_or_mem hxy with hxy hxy,
    { exact hxy },
    { exact (hPM.le_bot ⟨submonoid.mem_powers _, hxy⟩).elim } },
  refine le_trans _ this,
  rw [ideal.jacobson, comap_Inf', Inf_eq_infi],
  refine infi_le_infi_of_subset (λ I hI, ⟨map (algebra_map R S) I, ⟨_, _⟩⟩),
  { exact ⟨le_trans (le_of_eq ((is_localization.map_comap (powers y) S P').symm)) (map_mono hI.1),
    is_maximal_of_is_maximal_disjoint y _ hI.2.1 hI.2.2⟩ },
  { exact is_localization.comap_map_of_is_prime_disjoint _ S I (is_maximal.is_prime hI.2.1)
    ((disjoint_powers_iff_not_mem y hI.2.1.is_prime.is_radical).2 hI.2.2) }
end

end localization

namespace polynomial
open polynomial

section comm_ring
variables {R S : Type*} [comm_ring R] [comm_ring S] [is_domain S]
variables {Rₘ Sₘ : Type*} [comm_ring Rₘ] [comm_ring Sₘ]

/-- If `I` is a prime ideal of `R[X]` and `pX ∈ I` is a non-constant polynomial,
  then the map `R →+* R[x]/I` descends to an integral map when localizing at `pX.leading_coeff`.
  In particular `X` is integral because it satisfies `pX`, and constants are trivially integral,
  so integrality of the entire extension follows by closure under addition and multiplication. -/
lemma is_integral_is_localization_polynomial_quotient
  (P : ideal R[X]) (pX : R[X]) (hpX : pX ∈ P)
  [algebra (R ⧸ P.comap (C : R →+* _)) Rₘ]
  [is_localization.away (pX.map (quotient.mk (P.comap (C : R →+* R[X])))).leading_coeff Rₘ]
  [algebra (R[X] ⧸ P) Sₘ]
  [is_localization ((submonoid.powers (pX.map
    (quotient.mk (P.comap (C : R →+* R[X])))).leading_coeff).map
    (quotient_map P C le_rfl) : submonoid (R[X] ⧸ P)) Sₘ] :
  (is_localization.map Sₘ (quotient_map P C le_rfl)
    ((submonoid.powers
      (pX.map (quotient.mk (P.comap (C : R →+* R[X])))).leading_coeff).le_comap_map) : Rₘ →+* _)
    .is_integral :=
begin
  let P' : ideal R := P.comap C,
  let M : submonoid (R ⧸ P') :=
  submonoid.powers (pX.map (quotient.mk (P.comap (C : R →+* R[X])))).leading_coeff,
  let M' : submonoid (R[X] ⧸ P) :=
  (submonoid.powers (pX.map (quotient.mk (P.comap (C : R →+* R[X])))).leading_coeff).map
    (quotient_map P C le_rfl),
  let φ : R ⧸ P' →+* R[X] ⧸ P := quotient_map P C le_rfl,
  let φ' : Rₘ →+* Sₘ := is_localization.map Sₘ φ M.le_comap_map,
  have hφ' : φ.comp (quotient.mk P') = (quotient.mk P).comp C := rfl,
  intro p,
  obtain ⟨⟨p', ⟨q, hq⟩⟩, hp⟩ := is_localization.surj M' p,
  suffices : φ'.is_integral_elem (algebra_map _ _ p'),
  { obtain ⟨q', hq', rfl⟩ := hq,
    obtain ⟨q'', hq''⟩ := is_unit_iff_exists_inv'.1 (is_localization.map_units Rₘ (⟨q', hq'⟩ : M)),
    refine φ'.is_integral_of_is_integral_mul_unit p (algebra_map _ _ (φ q')) q'' _ (hp.symm ▸ this),
    convert trans (trans (φ'.map_mul _ _).symm (congr_arg φ' hq'')) φ'.map_one using 2,
    rw [← φ'.comp_apply, is_localization.map_comp, ring_hom.comp_apply, subtype.coe_mk] },
  refine is_integral_of_mem_closure''
    (((algebra_map _ Sₘ).comp (quotient.mk P)) '' (insert X {p | p.degree ≤ 0})) _ _ _,
  { rintros x ⟨p, hp, rfl⟩,
    refine hp.rec_on (λ hy, _) (λ hy, _),
    { refine hy.symm ▸ (φ.is_integral_elem_localization_at_leading_coeff ((quotient.mk P) X)
        (pX.map (quotient.mk P')) _ M ⟨1, pow_one _⟩),
      rwa [eval₂_map, hφ', ← hom_eval₂, quotient.eq_zero_iff_mem, eval₂_C_X] },
    { rw [set.mem_set_of_eq, degree_le_zero_iff] at hy,
      refine hy.symm ▸ ⟨X - C (algebra_map _ _ ((quotient.mk P') (p.coeff 0))), monic_X_sub_C _, _⟩,
      simp only [eval₂_sub, eval₂_C, eval₂_X],
      rw [sub_eq_zero, ← φ'.comp_apply, is_localization.map_comp],
      refl } },
  { obtain ⟨p, rfl⟩ := quotient.mk_surjective p',
    refine polynomial.induction_on p
      (λ r, subring.subset_closure $ set.mem_image_of_mem _ (or.inr degree_C_le))
      (λ _ _ h1 h2, _) (λ n _ hr, _),
    { convert subring.add_mem _ h1 h2,
      rw [ring_hom.map_add, ring_hom.map_add] },
    { rw [pow_succ X n, mul_comm X, ← mul_assoc, ring_hom.map_mul, ring_hom.map_mul],
      exact subring.mul_mem _ hr (subring.subset_closure (set.mem_image_of_mem _ (or.inl rfl))) } },
end

/-- If `f : R → S` descends to an integral map in the localization at `x`,
  and `R` is a Jacobson ring, then the intersection of all maximal ideals in `S` is trivial -/
lemma jacobson_bot_of_integral_localization
  {R : Type*} [comm_ring R] [is_domain R] [is_jacobson R]
  (Rₘ Sₘ : Type*) [comm_ring Rₘ] [comm_ring Sₘ]
  (φ : R →+* S) (hφ : function.injective φ) (x : R) (hx : x ≠ 0)
  [algebra R Rₘ] [is_localization.away x Rₘ]
  [algebra S Sₘ] [is_localization ((submonoid.powers x).map φ : submonoid S) Sₘ]
  (hφ' : ring_hom.is_integral
    (is_localization.map Sₘ φ (submonoid.powers x).le_comap_map : Rₘ →+* Sₘ)) :
  (⊥ : ideal S).jacobson = (⊥ : ideal S) :=
begin
  have hM : ((submonoid.powers x).map φ : submonoid S) ≤ non_zero_divisors S :=
    map_le_non_zero_divisors_of_injective φ hφ (powers_le_non_zero_divisors_of_no_zero_divisors hx),
  letI : is_domain Sₘ := is_localization.is_domain_of_le_non_zero_divisors _ hM,
  let φ' : Rₘ →+* Sₘ := is_localization.map _ φ (submonoid.powers x).le_comap_map,
  suffices : ∀ I : ideal Sₘ, I.is_maximal → (I.comap (algebra_map S Sₘ)).is_maximal,
  { have hϕ' : comap (algebra_map S Sₘ) (⊥ : ideal Sₘ) = (⊥ : ideal S),
    { rw [← ring_hom.ker_eq_comap_bot, ← ring_hom.injective_iff_ker_eq_bot],
      exact is_localization.injective Sₘ hM },
    have hSₘ : is_jacobson Sₘ := is_jacobson_of_is_integral' φ' hφ' (is_jacobson_localization x),
    refine eq_bot_iff.mpr (le_trans _ (le_of_eq hϕ')),
    rw [← hSₘ.out is_radical_bot_of_no_zero_divisors, comap_jacobson],
    exact Inf_le_Inf (λ j hj, ⟨bot_le, let ⟨J, hJ⟩ := hj in hJ.2 ▸ this J hJ.1.2⟩) },
  introsI I hI,
  -- Remainder of the proof is pulling and pushing ideals around the square and the quotient square
  haveI : (I.comap (algebra_map S Sₘ)).is_prime := comap_is_prime _ I,
  haveI : (I.comap φ').is_prime := comap_is_prime φ' I,
  haveI : (⊥ : ideal (S ⧸ I.comap (algebra_map S Sₘ))).is_prime := bot_prime,
  have hcomm: φ'.comp (algebra_map R Rₘ) = (algebra_map S Sₘ).comp φ := is_localization.map_comp _,
  let f := quotient_map (I.comap (algebra_map S Sₘ)) φ le_rfl,
  let g := quotient_map I (algebra_map S Sₘ) le_rfl,
  have := is_maximal_comap_of_is_integral_of_is_maximal' φ' hφ' I hI,
  have := ((is_maximal_iff_is_maximal_disjoint Rₘ x _).1 this).left,
  have : ((I.comap (algebra_map S Sₘ)).comap φ).is_maximal,
  { rwa [comap_comap, hcomm, ← comap_comap] at this },
  rw ← bot_quotient_is_maximal_iff at this ⊢,
  refine is_maximal_of_is_integral_of_is_maximal_comap' f _ ⊥
    ((eq_bot_iff.2 (comap_bot_le_of_injective f quotient_map_injective)).symm ▸ this),
  exact f.is_integral_tower_bot_of_is_integral g quotient_map_injective
    ((comp_quotient_map_eq_of_comp_eq hcomm I).symm ▸
    (ring_hom.is_integral_trans _ _ (ring_hom.is_integral_of_surjective _
      (is_localization.surjective_quotient_map_of_maximal_of_localization (submonoid.powers x) Rₘ
      (by rwa [comap_comap, hcomm, ← bot_quotient_is_maximal_iff])))
      (ring_hom.is_integral_quotient_of_is_integral _ hφ'))),
end

/-- Used to bootstrap the proof of `is_jacobson_polynomial_iff_is_jacobson`.
  That theorem is more general and should be used instead of this one. -/
private lemma is_jacobson_polynomial_of_domain
  (R : Type*) [comm_ring R] [is_domain R] [hR : is_jacobson R]
  (P : ideal R[X]) [is_prime P] (hP : ∀ (x : R), C x ∈ P → x = 0) :
  P.jacobson = P :=
begin
  by_cases Pb : P = ⊥,
  { exact Pb.symm ▸ jacobson_bot_polynomial_of_jacobson_bot
      (hR.out is_radical_bot_of_no_zero_divisors) },
  { rw jacobson_eq_iff_jacobson_quotient_eq_bot,
    haveI : (P.comap (C : R →+* R[X])).is_prime := comap_is_prime C P,
    obtain ⟨p, pP, p0⟩ := exists_nonzero_mem_of_ne_bot Pb hP,
    let x := (polynomial.map (quotient.mk (comap (C : R →+* _) P)) p).leading_coeff,
    have hx : x ≠ 0 := by rwa [ne.def, leading_coeff_eq_zero],
    refine jacobson_bot_of_integral_localization
      (localization.away x)
      (localization ((submonoid.powers x).map (P.quotient_map C le_rfl) :
        submonoid (R[X] ⧸ P)))
      (quotient_map P C le_rfl) quotient_map_injective
      x hx
      _,
    -- `convert` is noticeably faster than `exact` here:
    convert is_integral_is_localization_polynomial_quotient P p pP }
end

lemma is_jacobson_polynomial_of_is_jacobson (hR : is_jacobson R) :
  is_jacobson R[X] :=
begin
  refine is_jacobson_iff_prime_eq.mpr (λ I, _),
  introI hI,
  let R' : subring (R[X] ⧸ I) := ((quotient.mk I).comp C).range,
  let i : R →+* R' := ((quotient.mk I).comp C).range_restrict,
  have hi : function.surjective (i : R → R') := ((quotient.mk I).comp C).range_restrict_surjective,
  have hi' : (polynomial.map_ring_hom i : R[X] →+* R'[X]).ker ≤ I,
  { refine λ f hf, polynomial_mem_ideal_of_coeff_mem_ideal I f (λ n, _),
    replace hf := congr_arg (λ (g : polynomial (((quotient.mk I).comp C).range)), g.coeff n) hf,
    change (polynomial.map ((quotient.mk I).comp C).range_restrict f).coeff n = 0 at hf,
    rw [coeff_map, subtype.ext_iff] at hf,
    rwa [mem_comap, ← quotient.eq_zero_iff_mem, ← ring_hom.comp_apply], },
  haveI := map_is_prime_of_surjective
    (show function.surjective (map_ring_hom i), from map_surjective i hi) hi',
  suffices : (I.map (polynomial.map_ring_hom i)).jacobson = (I.map (polynomial.map_ring_hom i)),
  { replace this := congr_arg (comap (polynomial.map_ring_hom i)) this,
    rw [← map_jacobson_of_surjective _ hi',
      comap_map_of_surjective _ _, comap_map_of_surjective _ _] at this,
    refine le_antisymm (le_trans (le_sup_of_le_left le_rfl)
      (le_trans (le_of_eq this) (sup_le le_rfl hi'))) le_jacobson,
    all_goals {exact polynomial.map_surjective i hi} },
  exact @is_jacobson_polynomial_of_domain R' _ _ (is_jacobson_of_surjective ⟨i, hi⟩)
    (map (map_ring_hom i) I) _ (eq_zero_of_polynomial_mem_map_range I),
end

theorem is_jacobson_polynomial_iff_is_jacobson :
  is_jacobson R[X] ↔ is_jacobson R :=
begin
  refine ⟨_, is_jacobson_polynomial_of_is_jacobson⟩,
  introI H,
  exact is_jacobson_of_surjective ⟨eval₂_ring_hom (ring_hom.id _) 1, λ x,
    ⟨C x, by simp only [coe_eval₂_ring_hom, ring_hom.id_apply, eval₂_C]⟩⟩,
end

instance [is_jacobson R] : is_jacobson R[X] :=
is_jacobson_polynomial_iff_is_jacobson.mpr ‹is_jacobson R›

end comm_ring

section
variables {R : Type*} [comm_ring R] [is_jacobson R]
variables (P : ideal R[X]) [hP : P.is_maximal]

include P hP

lemma is_maximal_comap_C_of_is_maximal [nontrivial R] (hP' : ∀ (x : R), C x ∈ P → x = 0) :
  is_maximal (comap (C : R →+* R[X]) P : ideal R) :=
begin
  haveI hp'_prime : (P.comap (C : R →+* R[X]) : ideal R).is_prime := comap_is_prime C P,
  obtain ⟨m, hm⟩ := submodule.nonzero_mem_of_bot_lt (bot_lt_of_maximal P polynomial_not_is_field),
  have : (m : R[X]) ≠ 0, rwa [ne.def, submodule.coe_eq_zero],
  let φ : R ⧸ P.comap (C : R →+* R[X])  →+* R[X] ⧸ P := quotient_map P (C : R →+* R[X]) le_rfl,
  let M : submonoid (R ⧸ P.comap C) :=
    submonoid.powers ((m : R[X]).map
      (quotient.mk (P.comap (C : R →+* R[X]) : ideal R))).leading_coeff,
  rw ← bot_quotient_is_maximal_iff,
  have hp0 : ((m : R[X]).map
    (quotient.mk (P.comap (C : R →+* R[X]) : ideal R))).leading_coeff ≠ 0 :=
    λ hp0', this $ map_injective (quotient.mk (P.comap (C : R →+* R[X]) : ideal R))
      ((injective_iff_map_eq_zero (quotient.mk (P.comap (C : R →+* R[X]) : ideal R))).2 (λ x hx,
      by rwa [quotient.eq_zero_iff_mem, (by rwa eq_bot_iff : (P.comap C : ideal R) = ⊥)] at hx))
      (by simpa only [leading_coeff_eq_zero, polynomial.map_zero] using hp0'),
  have hM : (0 : R ⧸ P.comap C) ∉ M := λ ⟨n, hn⟩, hp0 (pow_eq_zero hn),
  suffices : (⊥ : ideal (localization M)).is_maximal,
  { rw ← is_localization.comap_map_of_is_prime_disjoint M (localization M) ⊥ bot_prime
        (disjoint_iff_inf_le.mpr $ λ x hx, hM (hx.2 ▸ hx.1)),
    refine ((is_maximal_iff_is_maximal_disjoint (localization M) _ _).mp (by rwa map_bot)).1,
    swap, exact localization.is_localization },
  let M' : submonoid (R[X] ⧸ P) := M.map φ,
  have hM' : (0 : R[X] ⧸ P) ∉ M' :=
    λ ⟨z, hz⟩, hM (quotient_map_injective (trans hz.2 φ.map_zero.symm) ▸ hz.1),
  haveI : is_domain (localization M') :=
    is_localization.is_domain_localization (le_non_zero_divisors_of_no_zero_divisors hM'),
  suffices : (⊥ : ideal (localization M')).is_maximal,
  { rw le_antisymm bot_le (comap_bot_le_of_injective _ (is_localization.map_injective_of_injective
      M (localization M) (localization M') quotient_map_injective )),
    refine is_maximal_comap_of_is_integral_of_is_maximal' _ _ ⊥ this,
    apply is_integral_is_localization_polynomial_quotient P _ (submodule.coe_mem m) },
  rw (map_bot.symm : (⊥ : ideal (localization M')) =
                     map (algebra_map (R[X] ⧸ P) (localization M')) ⊥),
  let bot_maximal := ((bot_quotient_is_maximal_iff _).mpr hP),
  refine map.is_maximal (algebra_map _ _) (is_field.localization_map_bijective hM' _) bot_maximal,
  rwa [← quotient.maximal_ideal_iff_is_field_quotient, ← bot_quotient_is_maximal_iff],
end

/-- Used to bootstrap the more general `quotient_mk_comp_C_is_integral_of_jacobson` -/
private lemma quotient_mk_comp_C_is_integral_of_jacobson' [nontrivial R] (hR : is_jacobson R)
  (hP' : ∀ (x : R), C x ∈ P → x = 0) :
  ((quotient.mk P).comp C : R →+* R[X] ⧸ P).is_integral :=
begin
  refine (is_integral_quotient_map_iff _).mp _,
  let P' : ideal R := P.comap C,
  obtain ⟨pX, hpX, hp0⟩ :=
    exists_nonzero_mem_of_ne_bot (ne_of_lt (bot_lt_of_maximal P polynomial_not_is_field)).symm hP',
  let M : submonoid (R ⧸ P') := submonoid.powers (pX.map (quotient.mk P')).leading_coeff,
  let φ : R ⧸ P' →+* R[X] ⧸ P := quotient_map P C le_rfl,
  haveI hp'_prime : P'.is_prime := comap_is_prime C P,
  have hM : (0 : R ⧸ P') ∉ M := λ ⟨n, hn⟩, hp0 $ leading_coeff_eq_zero.mp (pow_eq_zero hn),
  let M' : submonoid (R[X] ⧸ P) := M.map (quotient_map P C le_rfl),
  refine ((quotient_map P C le_rfl).is_integral_tower_bot_of_is_integral
    (algebra_map _ (localization M')) _ _),
  { refine is_localization.injective (localization M')
      (show M' ≤ _, from le_non_zero_divisors_of_no_zero_divisors (λ hM', hM _)),
    exact (let ⟨z, zM, z0⟩ := hM' in (quotient_map_injective (trans z0 φ.map_zero.symm)) ▸ zM) },
  { rw ← is_localization.map_comp M.le_comap_map,
    refine ring_hom.is_integral_trans (algebra_map (R ⧸ P') (localization M))
      (is_localization.map (localization M') _ M.le_comap_map) _ _,
    { exact (algebra_map (R ⧸ P') (localization M)).is_integral_of_surjective
      (is_field.localization_map_bijective hM ((quotient.maximal_ideal_iff_is_field_quotient _).mp
                                               (is_maximal_comap_C_of_is_maximal P hP'))).2 },
    { -- `convert` here is faster than `exact`, and this proof is near the time limit.
      convert is_integral_is_localization_polynomial_quotient P pX hpX } }
end

/-- If `R` is a Jacobson ring, and `P` is a maximal ideal of `R[X]`,
  then `R → R[X]/P` is an integral map. -/
lemma quotient_mk_comp_C_is_integral_of_jacobson :
  ((quotient.mk P).comp C : R →+* R[X] ⧸ P).is_integral :=
begin
  let P' : ideal R := P.comap C,
  haveI : P'.is_prime := comap_is_prime C P,
  let f : R[X] →+* polynomial (R ⧸ P') := polynomial.map_ring_hom (quotient.mk P'),
  have hf : function.surjective f := map_surjective (quotient.mk P') quotient.mk_surjective,
  have hPJ : P = (P.map f).comap f,
  { rw comap_map_of_surjective _ hf,
    refine le_antisymm (le_sup_of_le_left le_rfl) (sup_le le_rfl _),
    refine λ p hp, polynomial_mem_ideal_of_coeff_mem_ideal P p (λ n, quotient.eq_zero_iff_mem.mp _),
    simpa only [coeff_map, coe_map_ring_hom] using (polynomial.ext_iff.mp hp) n },
  refine ring_hom.is_integral_tower_bot_of_is_integral _ _ (injective_quotient_le_comap_map P) _,
  rw ← quotient_mk_maps_eq,
  refine ring_hom.is_integral_trans _ _
    ((quotient.mk P').is_integral_of_surjective quotient.mk_surjective) _,
  apply quotient_mk_comp_C_is_integral_of_jacobson' _ _ (λ x hx, _),
  any_goals { exact ideal.is_jacobson_quotient },
  { exact or.rec_on (map_eq_top_or_is_maximal_of_surjective f hf hP)
    (λ h, absurd (trans (h ▸ hPJ : P = comap f ⊤) comap_top : P = ⊤) hP.ne_top) id },
  { apply_instance, },
  { obtain ⟨z, rfl⟩ := quotient.mk_surjective x,
    rwa [quotient.eq_zero_iff_mem, mem_comap, hPJ, mem_comap, coe_map_ring_hom, map_C] }
end

lemma is_maximal_comap_C_of_is_jacobson :
  (P.comap (C : R →+* R[X])).is_maximal :=
begin
  rw [← @mk_ker _ _ P, ring_hom.ker_eq_comap_bot, comap_comap],
  exact is_maximal_comap_of_is_integral_of_is_maximal' _
    (quotient_mk_comp_C_is_integral_of_jacobson P) ⊥ ((bot_quotient_is_maximal_iff _).mpr hP),
end

omit P hP

lemma comp_C_integral_of_surjective_of_jacobson
  {S : Type*} [field S] (f : R[X] →+* S) (hf : function.surjective f) :
  (f.comp C).is_integral :=
begin
  haveI : (f.ker).is_maximal := ring_hom.ker_is_maximal_of_surjective f hf,
  let g : R[X] ⧸ f.ker →+* S := ideal.quotient.lift f.ker f (λ _ h, h),
  have hfg : (g.comp (quotient.mk f.ker)) = f := ring_hom_ext' rfl rfl,
  rw [← hfg, ring_hom.comp_assoc],
  refine ring_hom.is_integral_trans _ g (quotient_mk_comp_C_is_integral_of_jacobson f.ker)
    (g.is_integral_of_surjective _), --(quotient.lift_surjective f.ker f _ hf)),
  rw [← hfg] at hf,
  exact function.surjective.of_comp hf,
end

end

end polynomial

open mv_polynomial ring_hom

namespace mv_polynomial

lemma is_jacobson_mv_polynomial_fin {R : Type*} [comm_ring R] [H : is_jacobson R] :
  ∀ (n : ℕ), is_jacobson (mv_polynomial (fin n) R)
| 0 := ((is_jacobson_iso ((rename_equiv R
  (equiv.equiv_pempty (fin 0))).to_ring_equiv.trans (is_empty_ring_equiv R pempty))).mpr H)
| (n+1) := (is_jacobson_iso (fin_succ_equiv R n).to_ring_equiv).2
  (polynomial.is_jacobson_polynomial_iff_is_jacobson.2 (is_jacobson_mv_polynomial_fin n))

/-- General form of the nullstellensatz for Jacobson rings, since in a Jacobson ring we have
  `Inf {P maximal | P ≥ I} = Inf {P prime | P ≥ I} = I.radical`. Fields are always Jacobson,
  and in that special case this is (most of) the classical Nullstellensatz,
  since `I(V(I))` is the intersection of maximal ideals containing `I`, which is then `I.radical` -/
instance is_jacobson {R : Type*} [comm_ring R] {ι : Type*} [finite ι] [is_jacobson R] :
  is_jacobson (mv_polynomial ι R) :=
begin
  casesI nonempty_fintype ι,
  haveI := classical.dec_eq ι,
  let e := fintype.equiv_fin ι,
  rw is_jacobson_iso (rename_equiv R e).to_ring_equiv,
  exact is_jacobson_mv_polynomial_fin _
end

variables {n : ℕ}

lemma quotient_mk_comp_C_is_integral_of_jacobson
  {R : Type*} [comm_ring R] [is_jacobson R]
  (P : ideal (mv_polynomial (fin n) R)) [P.is_maximal] :
  ((quotient.mk P).comp mv_polynomial.C : R →+* mv_polynomial _ R ⧸ P).is_integral :=
begin
  unfreezingI {induction n with n IH},
  { refine ring_hom.is_integral_of_surjective _ (function.surjective.comp quotient.mk_surjective _),
    exact C_surjective (fin 0) },
  { rw [← fin_succ_equiv_comp_C_eq_C, ← ring_hom.comp_assoc, ← ring_hom.comp_assoc,
      ← quotient_map_comp_mk le_rfl, ring_hom.comp_assoc (polynomial.C),
      ← quotient_map_comp_mk le_rfl, ring_hom.comp_assoc, ring_hom.comp_assoc,
      ← quotient_map_comp_mk le_rfl, ← ring_hom.comp_assoc (quotient.mk _)],
    refine ring_hom.is_integral_trans _ _ _ _,
    { refine ring_hom.is_integral_trans _ _ (is_integral_of_surjective _ quotient.mk_surjective) _,
      refine ring_hom.is_integral_trans _ _ _ _,
      { apply (is_integral_quotient_map_iff _).mpr (IH _),
        apply polynomial.is_maximal_comap_C_of_is_jacobson _,
        { exact mv_polynomial.is_jacobson_mv_polynomial_fin n },
        { apply comap_is_maximal_of_surjective,
          exact (fin_succ_equiv R n).symm.surjective } },
      { refine (is_integral_quotient_map_iff _).mpr _,
        rw ← quotient_map_comp_mk le_rfl,
        refine ring_hom.is_integral_trans _ _ _ ((is_integral_quotient_map_iff _).mpr _),
        { exact ring_hom.is_integral_of_surjective _ quotient.mk_surjective },
        { apply polynomial.quotient_mk_comp_C_is_integral_of_jacobson _,
          { exact mv_polynomial.is_jacobson_mv_polynomial_fin n },
          { exact comap_is_maximal_of_surjective _ (fin_succ_equiv R n).symm.surjective } } } },
    { refine (is_integral_quotient_map_iff _).mpr _,
      refine ring_hom.is_integral_trans _ _ _ (is_integral_of_surjective _ quotient.mk_surjective),
      exact ring_hom.is_integral_of_surjective _ (fin_succ_equiv R n).symm.surjective } }
end

lemma comp_C_integral_of_surjective_of_jacobson
  {R : Type*} [comm_ring R] [is_jacobson R]
  {σ : Type*} [finite σ] {S : Type*} [field S] (f : mv_polynomial σ R →+* S)
  (hf : function.surjective f) : (f.comp C).is_integral :=
begin
  casesI nonempty_fintype σ,
  have e := (fintype.equiv_fin σ).symm,
  let f' : mv_polynomial (fin _) R →+* S :=
    f.comp (rename_equiv R e).to_ring_equiv.to_ring_hom,
  have hf' : function.surjective f' :=
    ((function.surjective.comp hf (rename_equiv R e).surjective)),
  have : (f'.comp C).is_integral,
  { haveI : (f'.ker).is_maximal := ker_is_maximal_of_surjective f' hf',
    let g : mv_polynomial _ R ⧸ f'.ker →+* S := ideal.quotient.lift f'.ker f' (λ _ h, h),
    have hfg : (g.comp (quotient.mk f'.ker)) = f' := ring_hom_ext (λ r, rfl) (λ i, rfl),
    rw [← hfg, ring_hom.comp_assoc],
    refine ring_hom.is_integral_trans _ g (quotient_mk_comp_C_is_integral_of_jacobson f'.ker)
      (g.is_integral_of_surjective _),
    rw ← hfg at hf',
    exact function.surjective.of_comp hf' },
  rw ring_hom.comp_assoc at this,
  convert this,
  refine ring_hom.ext (λ x, _),
  exact ((rename_equiv R e).commutes' x).symm,
end

end mv_polynomial

end ideal


/-
Copyright (c) 2016 Leonardo de Moura. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import data.set.lattice

/-!
# Functoriality of `set`

This file defines the functor structure of `set`.
-/

universes u

open function

namespace set
variables {α β : Type u} {s : set α} {f : α → set β} {g : set (α → β)}

instance : monad.{u} set :=
{ pure       := λ α a, {a},
  bind       := λ α β s f, ⋃ i ∈ s, f i,
  seq        := λ α β, set.seq,
  map        := λ α β, set.image }

@[simp] lemma bind_def : s >>= f = ⋃ i ∈ s, f i := rfl
@[simp] lemma fmap_eq_image (f : α → β) : f <$> s = f '' s := rfl
@[simp] lemma seq_eq_set_seq (s : set (α → β)) (t : set α) : s <*> t = s.seq t := rfl
@[simp] lemma pure_def (a : α) : (pure a : set α) = {a} := rfl

instance : is_lawful_monad set :=
{ id_map                := λ α, image_id,
  comp_map              := λ α β γ f g s, image_comp _ _ _,
  pure_bind             := λ α β, bUnion_singleton,
  bind_assoc            := λ α β γ s f g, by simp only [bind_def, bUnion_Union],
  bind_pure_comp_eq_map := λ α β f s, (image_eq_Union _ _).symm,
  bind_map_eq_seq       := λ α β s t, seq_def.symm }

instance : is_comm_applicative (set : Type u → Type u) :=
⟨ λ α β s t, prod_image_seq_comm s t ⟩

instance : alternative set :=
{ orelse := λ α, (∪),
  failure := λ α, ∅,
  .. set.monad }

end set


/-
Copyright (c) 2022 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma
-/
import computational_monads.oracle_spec

/-!
# Computations with Oracle Access

This file defines a representation of a computation with access to a set of oracles,
given by some `oracle_spec`. `oracle_comp spec α` will represent a computation
using the oracles of `spec : oracle_spec`, returning values of type `α`.
The definion is similar to a free monad, having built in `bind` and `pure` operations,
and an additional constructor for oracle queries.

We give probability distribution semantics for such a computation as `eval_dist` and `prob_event`.
`simulate` and `simulate'` will give semantics for running a computation by simulating the
oracles, using a (potentially empty) different set of oracles.

Notationally, we tend towards using `return` and `>>=` for the monadic operations,
and do-notation for specifying longer computations.

We additionally define a `decidable` typeclass for computations for which return values
all have `decidable_eq` instances, which will later be used to define `fin_support`.

Note that we don't have a constructor for unbounded recursion such as a fixpoint.
This creates issues with the distributional semantics since without termination it may not exist.
In theory this could be solved by introducing a typeclass for finite computation,
and only defining distributions on computations with such an instance.
However without a clear use case, we avoid doing this for simplicity.
-/

variables {α β γ : Type} {spec spec' : oracle_spec}

open oracle_spec

/-- Type to represent computations with access so oracles specified by and `oracle_spec`. -/
inductive oracle_comp (spec : oracle_spec) : Type → Type 1
| pure' (α : Type) (a : α) : oracle_comp α
| bind' (α β : Type) (oa : oracle_comp α) (ob : α → oracle_comp β) : oracle_comp β
| query (i : spec.ι) (t : spec.domain i) : oracle_comp (spec.range i)

namespace oracle_comp

instance nonempty (spec : oracle_spec) (α : Type) [h : nonempty α] :
  nonempty (oracle_comp spec α) := h.elim (λ x, ⟨pure' α x⟩)

instance inhabited (spec : oracle_spec) (α : Type) [h : inhabited α] :
  inhabited (oracle_comp spec α) := ⟨pure' α default⟩

/-- Simple computation for qurying a coin-flipping oracle for a single result. -/
@[reducible, inline] def coin : oracle_comp coin_spec bool := query () ()

section monad

/-- Natural monad structure on `oracle_comp`.
Simplification lemmas will tend towards `return` and `>>=` over `pure'` and `bind'`. -/
instance monad (spec : oracle_spec) : monad (oracle_comp spec) :=
{ pure := oracle_comp.pure', bind := oracle_comp.bind' }

@[simp] lemma pure'_eq_return (spec) (a : α) :
  (pure' α a : oracle_comp spec α) = return a := rfl

@[simp] lemma pure_eq_return (spec) (a : α) :
  (pure a : oracle_comp spec α) = return a := rfl

@[simp] lemma bind'_eq_bind (oa : oracle_comp spec α) (ob : α → oracle_comp spec β) :
  bind' α β oa ob = (oa >>= ob) := rfl

lemma map_eq_bind_return_comp (oa : oracle_comp spec α) (f : α → β) :
  f <$> oa = oa >>= return ∘ f := rfl

/-- Simple computation flipping two coins and returning a value based on them -/
example : oracle_comp coin_spec ℕ :=
do { b ← coin, b' ← coin,
  x ← return (if b && b' then 2 else 3),
  y ← return (if b || b' then 3 else 4),
  return (x * y) }

end monad

/-- Slightly nicer induction priciple, avoiding use of `bind'` and `pure'`.
  Use as induction principle with `induction oa using oracle_comp.induction_on` -/
@[elab_as_eliminator] def induction_on {C : Π {α : Type}, oracle_comp spec α → Sort*}
  {α : Type} (oa : oracle_comp spec α)
  (h_return : ∀ {α : Type} (a : α), C (return a))
  (h_bind : ∀ {α β : Type} {oa : oracle_comp spec α} {ob : α → oracle_comp spec β},
    C oa → (∀ a, C (ob a)) → C (oa >>= ob) )
  (h_query : ∀ i t, C (query i t)) : C oa :=
begin
  induction oa with α a α β oa ob hoa hob i t,
  { exact h_return _ },
  { exact h_bind hoa hob },
  { exact h_query i t }
end

/-- Check that the induction principal works properly. -/
example (oa : oracle_comp spec α) : true := by induction oa using oracle_comp.induction_on; trivial

/-- Constructing an `oracle_comp` implies the existence of some element of the underlying type.
  The assumption that the range of the oracles is `inhabited` is the key point for this. -/
def inhabited_base (oa : oracle_comp spec α) : inhabited α :=
begin
  induction oa with α a α β oa ob hoa hob i t,
  { exact ⟨a⟩ },
  { exact let ⟨a⟩ := hoa in hob a },
  { exact ⟨arbitrary (spec.range i)⟩ }
end

/-- Shorthand for querying the left side of two available oracles. -/
@[inline, reducible] def query₁ {spec spec' : oracle_spec}
  (i : spec.ι) (t : spec.domain i) : oracle_comp (spec ++ spec') (spec.range i) :=
@query (spec ++ spec') (sum.inl i) t

/-- Shorthand for querying the right side of two available oracles. -/
@[inline, reducible] def query₂ {spec spec' : oracle_spec}
  (i : spec'.ι) (t : spec'.domain i) : oracle_comp (spec ++ spec') (spec'.range i) :=
@query (spec ++ spec') (sum.inr i) t

section decidable

/-- Inductive definition for computations that only return values of types with `decidable_eq`.
In this case we can explicitly calculate the `support` as a `finset` rather than a `set`.
TODO: this seems like bad naming? overlaps? `decidable_comp`? -/
class inductive decidable : Π {α : Type}, oracle_comp spec α → Type 1
| decidable_pure' (α : Type) (a : α) (h : decidable_eq α) : decidable (pure' α a)
| decidable_bind' (α β : Type) (oa : oracle_comp spec α) (ob : α → oracle_comp spec β)
    (hoa : decidable oa) (hob : ∀ α, decidable (ob α)) : decidable (bind' α β oa ob)
| decidable_query (i : spec.ι) (t : spec.domain i) : decidable (query i t)

open decidable

/-- Version of `decidable_eq_of_decidable` taking an explicit `decidable` argument -/
def decidable_eq_of_decidable' : Π {α : Type} {oa : oracle_comp spec α}
  (h : decidable oa), decidable_eq α
| _ _ (decidable_pure' α a h) := h
| _ _ (decidable_bind' α β oa ob hoa hob) := decidable_eq_of_decidable' (hob (inhabited_base oa).1)
| _ _ (decidable_query i t) := spec.range_decidable_eq i

/-- Given a `decidable` instance on an `oracle_comp`, we can extract a
  `decidable_eq` instance on the resutlt type of the computation -/
def decidable_eq_of_decidable (oa : oracle_comp spec α) [h : oa.decidable] :
  decidable_eq α := decidable_eq_of_decidable' h

instance decidable_return [h : decidable_eq α] (a : α) :
  decidable (return a : oracle_comp spec α) := decidable_pure' α a h

instance decidable_pure' [h : decidable_eq α] (a : α) :
  decidable (pure' α a : oracle_comp spec α) := decidable_pure' α a h

instance decidable_pure [h : decidable_eq α] (a : α) :
  decidable (pure a : oracle_comp spec α) := decidable_pure' α a h

instance decidable_bind (oa : oracle_comp spec α) (ob : α → oracle_comp spec β) [h : decidable oa]
  [h' : ∀ a, decidable (ob a)] : decidable (oa >>= ob) := decidable_bind' α β oa ob h h'

instance decidable_bind' (oa : oracle_comp spec α) (ob : α → oracle_comp spec β) [h : decidable oa]
  [h' : ∀ a, decidable (ob a)] : decidable (bind' α β oa ob) := decidable_bind' α β oa ob h h'

instance decidable_map [h : decidable_eq β] (oa : oracle_comp spec α) [h' : oa.decidable]
  (f : α → β) : decidable (f <$> oa) := decidable_bind' α β oa _ h' (λ a, decidable_pure' β _ h)

instance decidable_query (i : spec.ι) (t : spec.domain i) :
  decidable (query i t) := decidable_query i t

instance decidable_coin : decidable coin := decidable_query _ _

def decidable_of_decidable_bind_fst {oa : oracle_comp spec α} {ob : α → oracle_comp spec β} :
  Π (h : decidable (oa >>= ob)), oa.decidable
| (decidable_bind' α β _ _ hoa hob) := hoa

def decidable_of_decidable_bind_snd {oa : oracle_comp spec α} {ob : α → oracle_comp spec β}
  (a : α) : Π (h : decidable (oa >>= ob)), (ob a).decidable
| (decidable_bind' α β _ _ hoa hob) := hob a

end decidable

/-- Simple computations should have automatic decidable instances -/
example :
do {b ← coin, b' ← coin,
    x ← return (b && b'),
    y ← return (b || b'),
    return (if x then 1 else if y then 2 else 3)}.decidable := by apply_instance

end oracle_comp


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
universes u w

def buffer (α : Type u) := Σ n, array n α

def mk_buffer {α : Type u} : buffer α :=
⟨0, {data := λ i, fin.elim0 i}⟩

def array.to_buffer {α : Type u} {n : nat} (a : array n α) : buffer α :=
⟨n, a⟩

namespace buffer
variables {α : Type u} {β : Type w}

def nil : buffer α :=
mk_buffer

def size (b : buffer α) : nat :=
b.1

def to_array (b : buffer α) : array (b.size) α :=
b.2

def push_back : buffer α → α → buffer α
| ⟨n, a⟩ v := ⟨n+1, a.push_back v⟩

def pop_back : buffer α → buffer α
| ⟨0, a⟩   := ⟨0, a⟩
| ⟨n+1, a⟩ := ⟨n, a.pop_back⟩

def read : Π (b : buffer α), fin b.size → α
| ⟨n, a⟩ i := a.read i

def write : Π (b : buffer α), fin b.size → α → buffer α
| ⟨n, a⟩ i v := ⟨n, a.write i v⟩

def read' [inhabited α] : buffer α → nat → α
| ⟨n, a⟩ i := a.read' i

def write' : buffer α → nat → α → buffer α
| ⟨n, a⟩ i v := ⟨n, a.write' i v⟩

lemma read_eq_read' [inhabited α] (b : buffer α) (i : nat) (h : i < b.size) :
  read b ⟨i, h⟩ = read' b i :=
by cases b; unfold read read'; simp [array.read_eq_read']

lemma write_eq_write' (b : buffer α) (i : nat) (h : i < b.size) (v : α) :
  write b ⟨i, h⟩ v = write' b i v :=
by cases b; unfold write write'; simp [array.write_eq_write']

def to_list (b : buffer α) : list α :=
b.to_array.to_list

protected def to_string (b : buffer char) : string :=
b.to_array.to_list.as_string

def append_list {α : Type u} : buffer α → list α → buffer α
| b []      := b
| b (v::vs) := append_list (b.push_back v) vs

def append_string (b : buffer char) (s : string) : buffer char :=
b.append_list s.to_list

lemma lt_aux_1 {a b c : nat} (h : a + c < b) : a < b :=
lt_of_le_of_lt (nat.le_add_right a c) h

lemma lt_aux_2 {n : nat} (h : 0 < n) : n - 1 < n :=
nat.sub_lt h (nat.succ_pos 0)

lemma lt_aux_3 {n i} (h : i + 1 < n) : n - 2 - i < n  :=
have n > 0,     from lt_trans (nat.zero_lt_succ i) h,
have n - 2 < n, from nat.sub_lt this (dec_trivial),
lt_of_le_of_lt (nat.sub_le _ _) this

def append_array {α : Type u} {n : nat} (nz : 0 < n) :
  buffer α → array n α → ∀ i : nat, i < n → buffer α
| ⟨m, b⟩ a 0     _ :=
  let i : fin n := ⟨n - 1, lt_aux_2 nz⟩ in
  ⟨m+1, b.push_back (a.read i)⟩
| ⟨m, b⟩ a (j+1) h :=
  let i : fin n := ⟨n - 2 - j, lt_aux_3 h⟩ in
  append_array ⟨m+1, b.push_back (a.read i)⟩ a j (lt_aux_1 h)

protected def append {α : Type u} : buffer α → buffer α → buffer α
| b ⟨0, a⟩   := b
| b ⟨n+1, a⟩ := append_array (nat.zero_lt_succ _) b a n (nat.lt_succ_self _)

def iterate : Π b : buffer α, β → (fin b.size → α → β → β) → β
| ⟨_, a⟩ b f := a.iterate b f

def foreach : Π b : buffer α, (fin b.size → α → α) → buffer α
| ⟨n, a⟩ f := ⟨n, a.foreach f⟩

/-- Monadically map a function over the buffer. -/
@[inline]
def mmap {m} [monad m] (b : buffer α) (f : α → m β) : m (buffer β) :=
do b' ← b.2.mmap f, return b'.to_buffer

/-- Map a function over the buffer. -/
@[inline]
def map : buffer α → (α → β) → buffer β
| ⟨n, a⟩ f := ⟨n, a.map f⟩

def foldl : buffer α → β → (α → β → β) → β
| ⟨_, a⟩ b f := a.foldl b f

def rev_iterate : Π (b : buffer α), β → (fin b.size → α → β → β) → β
| ⟨_, a⟩ b f := a.rev_iterate b f

def take (b : buffer α) (n : nat) : buffer α :=
if h : n ≤ b.size then ⟨n, b.to_array.take n h⟩ else b

def take_right (b : buffer α) (n : nat) : buffer α :=
if h : n ≤ b.size then ⟨n, b.to_array.take_right n h⟩ else b

def drop (b : buffer α) (n : nat) : buffer α :=
if h : n ≤ b.size then ⟨_, b.to_array.drop n h⟩ else b

def reverse (b : buffer α) : buffer α :=
⟨b.size, b.to_array.reverse⟩

protected def mem (v : α) (a : buffer α) : Prop := ∃i, read a i = v

instance : has_mem α (buffer α) := ⟨buffer.mem⟩

instance : has_append (buffer α) :=
⟨buffer.append⟩

instance [has_repr α] : has_repr (buffer α) :=
⟨repr ∘ to_list⟩

meta instance [has_to_format α] : has_to_format (buffer α) :=
⟨to_fmt ∘ to_list⟩

meta instance [has_to_tactic_format α] : has_to_tactic_format (buffer α) :=
⟨tactic.pp ∘ to_list⟩

end buffer

def list.to_buffer {α : Type u} (l : list α) : buffer α :=
mk_buffer.append_list l

@[reducible] def char_buffer := buffer char

/-- Convert a format object into a character buffer with the provided
    formatting options. -/
meta constant format.to_buffer : format → options → buffer char

def string.to_char_buffer (s : string) : char_buffer :=
buffer.nil.append_string s


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Stephen Morgan, Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.eq_to_hom
import Mathlib.PostPort

universes u₁ u₂ v₁ v₂ u₃ u₄ v₃ v₄

namespace Mathlib

namespace category_theory

/--
`prod C D` gives the cartesian product of two categories.

See https://stacks.math.columbia.edu/tag/001K.
-/
protected instance prod (C : Type u₁) [category C] (D : Type u₂) [category D] : category (C × D) :=
  category.mk

-- rfl lemmas for category.prod

@[simp] theorem prod_id (C : Type u₁) [category C] (D : Type u₂) [category D] (X : C) (Y : D) : 𝟙 = (𝟙, 𝟙) :=
  rfl

@[simp] theorem prod_comp (C : Type u₁) [category C] (D : Type u₂) [category D] {P : C} {Q : C} {R : C} {S : D} {T : D} {U : D} (f : (P, S) ⟶ (Q, T)) (g : (Q, T) ⟶ (R, U)) : f ≫ g = (prod.fst f ≫ prod.fst g, prod.snd f ≫ prod.snd g) :=
  rfl

@[simp] theorem prod_id_fst (C : Type u₁) [category C] (D : Type u₂) [category D] (X : C × D) : prod.fst 𝟙 = 𝟙 :=
  rfl

@[simp] theorem prod_id_snd (C : Type u₁) [category C] (D : Type u₂) [category D] (X : C × D) : prod.snd 𝟙 = 𝟙 :=
  rfl

@[simp] theorem prod_comp_fst (C : Type u₁) [category C] (D : Type u₂) [category D] {X : C × D} {Y : C × D} {Z : C × D} (f : X ⟶ Y) (g : Y ⟶ Z) : prod.fst (f ≫ g) = prod.fst f ≫ prod.fst g :=
  rfl

@[simp] theorem prod_comp_snd (C : Type u₁) [category C] (D : Type u₂) [category D] {X : C × D} {Y : C × D} {Z : C × D} (f : X ⟶ Y) (g : Y ⟶ Z) : prod.snd (f ≫ g) = prod.snd f ≫ prod.snd g :=
  rfl

/--
`prod.category.uniform C D` is an additional instance specialised so both factors have the same
universe levels. This helps typeclass resolution.
-/
protected instance uniform_prod (C : Type u₁) [category C] (D : Type u₁) [category D] : category (C × D) :=
  category_theory.prod C D

-- Next we define the natural functors into and out of product categories. For now this doesn't

-- address the universal properties.

namespace prod

/-- `sectl C Z` is the functor `C ⥤ C × D` given by `X ↦ (X, Z)`. -/
@[simp] theorem sectl_obj (C : Type u₁) [category C] {D : Type u₂} [category D] (Z : D) (X : C) : functor.obj (sectl C Z) X = (X, Z) :=
  Eq.refl (functor.obj (sectl C Z) X)

/-- `sectr Z D` is the functor `D ⥤ C × D` given by `Y ↦ (Z, Y)` . -/
def sectr {C : Type u₁} [category C] (Z : C) (D : Type u₂) [category D] : D ⥤ C × D :=
  functor.mk (fun (X : D) => (Z, X)) fun (X Y : D) (f : X ⟶ Y) => (𝟙, f)

/-- `fst` is the functor `(X, Y) ↦ X`. -/
@[simp] theorem fst_obj (C : Type u₁) [category C] (D : Type u₂) [category D] (X : C × D) : functor.obj (fst C D) X = prod.fst X :=
  Eq.refl (functor.obj (fst C D) X)

/-- `snd` is the functor `(X, Y) ↦ Y`. -/
@[simp] theorem snd_map (C : Type u₁) [category C] (D : Type u₂) [category D] (X : C × D) (Y : C × D) (f : X ⟶ Y) : functor.map (snd C D) f = prod.snd f :=
  Eq.refl (functor.map (snd C D) f)

/-- The functor swapping the factors of a cartesian product of categories, `C × D ⥤ D × C`. -/
@[simp] theorem swap_map (C : Type u₁) [category C] (D : Type u₂) [category D] (_x : C × D) : ∀ (_x_1 : C × D) (f : _x ⟶ _x_1), functor.map (swap C D) f = (prod.snd f, prod.fst f) :=
  fun (_x_1 : C × D) (f : _x ⟶ _x_1) => Eq.refl (functor.map (swap C D) f)

/--
Swapping the factors of a cartesion product of categories twice is naturally isomorphic
to the identity functor.
-/
@[simp] theorem symmetry_hom_app (C : Type u₁) [category C] (D : Type u₂) [category D] (X : C × D) : nat_trans.app (iso.hom (symmetry C D)) X = 𝟙 :=
  Eq.refl (nat_trans.app (iso.hom (symmetry C D)) X)

/--
The equivalence, given by swapping factors, between `C × D` and `D × C`.
-/
@[simp] theorem braiding_counit_iso_inv_app (C : Type u₁) [category C] (D : Type u₂) [category D] (X : D × C) : nat_trans.app (iso.inv (equivalence.counit_iso (braiding C D))) X = inv (eq_to_hom (braiding._proof_3 C D X)) :=
  Eq.refl (inv (eq_to_hom (braiding._proof_3 C D X)))

protected instance swap_is_equivalence (C : Type u₁) [category C] (D : Type u₂) [category D] : is_equivalence (swap C D) :=
  is_equivalence.of_equivalence (braiding C D)

end prod

/--
The "evaluation at `X`" functor, such that
`(evaluation.obj X).obj F = F.obj X`,
which is functorial in both `X` and `F`.
-/
def evaluation (C : Type u₁) [category C] (D : Type u₂) [category D] : C ⥤ (C ⥤ D) ⥤ D :=
  functor.mk
    (fun (X : C) => functor.mk (fun (F : C ⥤ D) => functor.obj F X) fun (F G : C ⥤ D) (α : F ⟶ G) => nat_trans.app α X)
    fun (X Y : C) (f : X ⟶ Y) => nat_trans.mk fun (F : C ⥤ D) => functor.map F f

/--
The "evaluation of `F` at `X`" functor,
as a functor `C × (C ⥤ D) ⥤ D`.
-/
@[simp] theorem evaluation_uncurried_obj (C : Type u₁) [category C] (D : Type u₂) [category D] (p : C × (C ⥤ D)) : functor.obj (evaluation_uncurried C D) p = functor.obj (prod.snd p) (prod.fst p) :=
  Eq.refl (functor.obj (evaluation_uncurried C D) p)

namespace functor

/-- The cartesian product of two functors. -/
@[simp] theorem prod_obj {A : Type u₁} [category A] {B : Type u₂} [category B] {C : Type u₃} [category C] {D : Type u₄} [category D] (F : A ⥤ B) (G : C ⥤ D) (X : A × C) : obj (prod F G) X = (obj F (prod.fst X), obj G (prod.snd X)) :=
  Eq.refl (obj (prod F G) X)

/- Because of limitations in Lean 3's handling of notations, we do not setup a notation `F × G`.
   You can use `F.prod G` as a "poor man's infix", or just write `functor.prod F G`. -/

end functor

namespace nat_trans

/-- The cartesian product of two natural transformations. -/
@[simp] theorem prod_app {A : Type u₁} [category A] {B : Type u₂} [category B] {C : Type u₃} [category C] {D : Type u₄} [category D] {F : A ⥤ B} {G : A ⥤ B} {H : C ⥤ D} {I : C ⥤ D} (α : F ⟶ G) (β : H ⟶ I) (X : A × C) : app (prod α β) X = (app α (prod.fst X), app β (prod.snd X)) :=
  Eq.refl (app (prod α β) X)


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

! This file was ported from Lean 3 source module ring_theory.ideal.associated_prime
! leanprover-community/mathlib commit a652f6c3cd9ec14a56fe56229010f0fe0217a07c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.Span
import Mathbin.RingTheory.Ideal.Operations
import Mathbin.RingTheory.Finiteness
import Mathbin.RingTheory.Localization.Ideal
import Mathbin.RingTheory.Ideal.MinimalPrime

/-!

# Associated primes of a module

We provide the definition and related lemmas about associated primes of modules.

## Main definition
- `is_associated_prime`: `is_associated_prime I M` if the prime ideal `I` is the
  annihilator of some `x : M`.
- `associated_primes`: The set of associated primes of a module.

## Main results
- `exists_le_is_associated_prime_of_is_noetherian_ring`: In a noetherian ring, any `ann(x)` is
  contained in an associated prime for `x ≠ 0`.
- `associated_primes.eq_singleton_of_is_primary`: In a noetherian ring, `I.radical` is the only
  associated prime of `R ⧸ I` when `I` is primary.

## Todo

Generalize this to a non-commutative setting once there are annihilator for non-commutative rings.

-/

variable {R : Type _} [CommRing R] (I J : Ideal R) (M : Type _) [AddCommGroup M] [Module R M]

/-- `is_associated_prime I M` if the prime ideal `I` is the annihilator of some `x : M`. -/
def IsAssociatedPrime : Prop :=
  I.IsPrime ∧ ∃ x : M, I = (R ∙ x).annihilator
#align is_associated_prime IsAssociatedPrime

variable (R)

/-- The set of associated primes of a module. -/
def associatedPrimes : Set (Ideal R) :=
  { I | IsAssociatedPrime I M }
#align associated_primes associatedPrimes

variable {I J M R} (h : IsAssociatedPrime I M)

variable {M' : Type _} [AddCommGroup M'] [Module R M'] (f : M →ₗ[R] M')

theorem AssociatePrimes.mem_iff : I ∈ associatedPrimes R M ↔ IsAssociatedPrime I M :=
  Iff.rfl
#align associate_primes.mem_iff AssociatePrimes.mem_iff

theorem IsAssociatedPrime.isPrime : I.IsPrime :=
  h.1
#align is_associated_prime.is_prime IsAssociatedPrime.isPrime

theorem IsAssociatedPrime.map_of_injective (h : IsAssociatedPrime I M) (hf : Function.Injective f) :
    IsAssociatedPrime I M' := by
  obtain ⟨x, rfl⟩ := h.2
  refine' ⟨h.1, ⟨f x, _⟩⟩
  ext r
  rw [Submodule.mem_annihilator_span_singleton, Submodule.mem_annihilator_span_singleton, ←
    map_smul, ← f.map_zero, hf.eq_iff]
#align is_associated_prime.map_of_injective IsAssociatedPrime.map_of_injective

theorem LinearEquiv.isAssociatedPrime_iff (l : M ≃ₗ[R] M') :
    IsAssociatedPrime I M ↔ IsAssociatedPrime I M' :=
  ⟨fun h => h.map_of_injective l l.Injective, fun h => h.map_of_injective l.symm l.symm.Injective⟩
#align linear_equiv.is_associated_prime_iff LinearEquiv.isAssociatedPrime_iff

theorem not_isAssociatedPrime_of_subsingleton [Subsingleton M] : ¬IsAssociatedPrime I M :=
  by
  rintro ⟨hI, x, hx⟩
  apply hI.ne_top
  rwa [Subsingleton.elim x 0, submodule.span_singleton_eq_bot.mpr rfl, Submodule.annihilator_bot] at
    hx
#align not_is_associated_prime_of_subsingleton not_isAssociatedPrime_of_subsingleton

variable (R)

theorem exists_le_isAssociatedPrime_of_isNoetherianRing [H : IsNoetherianRing R] (x : M)
    (hx : x ≠ 0) : ∃ P : Ideal R, IsAssociatedPrime P M ∧ (R ∙ x).annihilator ≤ P :=
  by
  have : (R ∙ x).annihilator ≠ ⊤ := by
    rwa [Ne.def, Ideal.eq_top_iff_one, Submodule.mem_annihilator_span_singleton, one_smul]
  obtain ⟨P, ⟨l, h₁, y, rfl⟩, h₃⟩ :=
    set_has_maximal_iff_noetherian.mpr H
      { P | (R ∙ x).annihilator ≤ P ∧ P ≠ ⊤ ∧ ∃ y : M, P = (R ∙ y).annihilator }
      ⟨(R ∙ x).annihilator, rfl.le, this, x, rfl⟩
  refine' ⟨_, ⟨⟨h₁, _⟩, y, rfl⟩, l⟩
  intro a b hab
  rw [or_iff_not_imp_left]
  intro ha
  rw [Submodule.mem_annihilator_span_singleton] at ha hab
  have H₁ : (R ∙ y).annihilator ≤ (R ∙ a • y).annihilator :=
    by
    intro c hc
    rw [Submodule.mem_annihilator_span_singleton] at hc⊢
    rw [smul_comm, hc, smul_zero]
  have H₂ : (Submodule.span R {a • y}).annihilator ≠ ⊤ := by
    rwa [Ne.def, Submodule.annihilator_eq_top_iff, Submodule.span_singleton_eq_bot]
  rwa [← h₃ (R ∙ a • y).annihilator ⟨l.trans H₁, H₂, _, rfl⟩ H₁,
    Submodule.mem_annihilator_span_singleton, smul_comm, smul_smul]
#align exists_le_is_associated_prime_of_is_noetherian_ring exists_le_isAssociatedPrime_of_isNoetherianRing

variable {R}

theorem associatedPrimes.subset_of_injective (hf : Function.Injective f) :
    associatedPrimes R M ⊆ associatedPrimes R M' := fun I h => h.map_of_injective f hf
#align associated_primes.subset_of_injective associatedPrimes.subset_of_injective

theorem LinearEquiv.AssociatedPrimes.eq (l : M ≃ₗ[R] M') :
    associatedPrimes R M = associatedPrimes R M' :=
  le_antisymm (associatedPrimes.subset_of_injective l l.Injective)
    (associatedPrimes.subset_of_injective l.symm l.symm.Injective)
#align linear_equiv.associated_primes.eq LinearEquiv.AssociatedPrimes.eq

theorem associatedPrimes.eq_empty_of_subsingleton [Subsingleton M] : associatedPrimes R M = ∅ := by
  ext; simp only [Set.mem_empty_iff_false, iff_false_iff];
  apply not_isAssociatedPrime_of_subsingleton
#align associated_primes.eq_empty_of_subsingleton associatedPrimes.eq_empty_of_subsingleton

variable (R M)

theorem associatedPrimes.nonempty [IsNoetherianRing R] [Nontrivial M] :
    (associatedPrimes R M).Nonempty :=
  by
  obtain ⟨x, hx⟩ := exists_ne (0 : M)
  obtain ⟨P, hP, _⟩ := exists_le_isAssociatedPrime_of_isNoetherianRing R x hx
  exact ⟨P, hP⟩
#align associated_primes.nonempty associatedPrimes.nonempty

variable {R M}

theorem IsAssociatedPrime.annihilator_le (h : IsAssociatedPrime I M) :
    (⊤ : Submodule R M).annihilator ≤ I :=
  by
  obtain ⟨hI, x, rfl⟩ := h
  exact Submodule.annihilator_mono le_top
#align is_associated_prime.annihilator_le IsAssociatedPrime.annihilator_le

theorem IsAssociatedPrime.eq_radical (hI : I.IsPrimary) (h : IsAssociatedPrime J (R ⧸ I)) :
    J = I.radical := by
  obtain ⟨hJ, x, e⟩ := h
  have : x ≠ 0 := by
    rintro rfl
    apply hJ.1
    rwa [submodule.span_singleton_eq_bot.mpr rfl, Submodule.annihilator_bot] at e
  obtain ⟨x, rfl⟩ := Ideal.Quotient.mkₐ_surjective R _ x
  replace e : ∀ {y}, y ∈ J ↔ x * y ∈ I
  · intro y
    rw [e, Submodule.mem_annihilator_span_singleton, ← map_smul, smul_eq_mul, mul_comm,
      Ideal.Quotient.mkₐ_eq_mk, ← Ideal.Quotient.mk_eq_mk, Submodule.Quotient.mk_eq_zero]
  apply le_antisymm
  · intro y hy
    exact (hI.2 <| e.mp hy).resolve_left ((Submodule.Quotient.mk_eq_zero I).Not.mp this)
  · rw [hJ.radical_le_iff]
    intro y hy
    exact e.mpr (I.mul_mem_left x hy)
#align is_associated_prime.eq_radical IsAssociatedPrime.eq_radical

theorem associatedPrimes.eq_singleton_of_isPrimary [IsNoetherianRing R] (hI : I.IsPrimary) :
    associatedPrimes R (R ⧸ I) = {I.radical} :=
  by
  ext J
  rw [Set.mem_singleton_iff]
  refine' ⟨IsAssociatedPrime.eq_radical hI, _⟩
  rintro rfl
  haveI : Nontrivial (R ⧸ I) := ⟨⟨(I.Quotient.mk : _) 1, (I.Quotient.mk : _) 0, _⟩⟩
  obtain ⟨a, ha⟩ := associatedPrimes.nonempty R (R ⧸ I)
  exact ha.eq_radical hI ▸ ha
  rw [Ne.def, Ideal.Quotient.eq, sub_zero, ← Ideal.eq_top_iff_one]
  exact hI.1
#align associated_primes.eq_singleton_of_is_primary associatedPrimes.eq_singleton_of_isPrimary


import sylow.cauchy orbit.normalizer

namespace mygroup

variables {G : Type} [group G]
open classical function set mygroup.subgroup mygroup.group mygroup.group_hom
  lagrange

-- Definition of p-group for finite groups, not using definition of order of
-- an element explicitly
-- class p_group [fintype G] (p : ℕ) extends group G :=
-- (card_pow_p: ∃ n : ℕ , fincard G = p^n)

-- -- A p-subgroup is a subgroup of a group G which is itself a p-group
-- class p_subgroup (G : Type) [group G] [fintype G] (p : ℕ) extends subgroup G :=
-- (card_pow_p: ∃ n : ℕ , fincard (carrier) = p^n)

def is_p_subgroup (H : subgroup G) (p : ℕ) := ∃ n : ℕ , fincard H = p ^ n

def dumb_fun' (H : subgroup G) (g : G) (X : set G) : set G :=
  {t | ∃ x ∈ X , t = g * x}

lemma dumb_fun_lcoset_eq (g h : G) (H : subgroup G) :
  dumb_fun' H h (g ⋆ H) = h * g ⋆ H :=
begin
  ext, split,
  { rintro ⟨x, ⟨h', hh', rfl⟩, rfl⟩,
    exact ⟨h', hh', (group.mul_assoc _ _ _).symm⟩ },
  { rintro ⟨h', hh', rfl⟩,
    refine ⟨g * h', ⟨h', hh', rfl⟩, group.mul_assoc _ _ _⟩ }
end

def dumb_fun (H : subgroup G) (g : G) (X : lcosets H) : lcosets H :=
⟨dumb_fun' H g X.1,
  begin
  rcases X with ⟨g', ⟨w, rfl⟩⟩,
  use g * w, ext, split,
    { intro hx,
      rcases hx with ⟨hx_w, ⟨h, hh, rfl⟩, rfl⟩,
      use h,
      simpa [group.mul_assoc] },
    { rintro ⟨h, hh, rfl⟩,
      use w * h,
      simpa [group.mul_assoc] }
  end⟩

def laction.comap {H : Type} [group H] (f : H →* G) (S : Type) (μ : laction G S) :
  laction H S :=
{ to_fun := λ h s, f h •[μ] s,
  map_one' := λ s, (map_one f).symm ▸ μ.map_one s,
  map_assoc' := λ g h s, (map_mul f g h).symm ▸ μ.map_assoc' _ _ _ }

def dumb_action (H : subgroup  G) : laction G (lcosets H) :=
{ to_fun := dumb_fun H,
  map_one' :=
  begin
    intro S, unfold dumb_fun, dsimp, unfold dumb_fun', simp
  end,
  map_assoc' :=
  begin
    rintros g h ⟨_, g', rfl⟩,
    unfold dumb_fun, unfold dumb_fun',
    norm_num, ext1, norm_num, split,
      { rintro ⟨_, ⟨t, ⟨s, ⟨hs, ht⟩⟩, rfl⟩, rfl⟩,
        use t, split, use [s, hs], exact ht,
        rw group.mul_assoc },
      { rintro ⟨_, ⟨s, hs, rfl⟩, rfl⟩,
        iterate 3 { split }, use [s, hs],
        simp [group.mul_assoc] }
  end }

def dumb_action' (H : subgroup G) : laction H (lcosets H) :=
laction.comap (𝒾 H) (lcosets H) (dumb_action H)

def normal_in_normalizer_of_set (H : subgroup G) : normal (normalizer_of_set H.carrier) :=
{ conj_mem' :=
    begin
      intros n hnorm g,
      dsimp at *,
      cases g with g hg,
      cases n with n hn,
      rw mem_coe,
      rw mem_comap',
      norm_num,
      change g ∈ normalizer_of_set H.carrier at hg,
      rw mem_normalizer_of_set_iff at hg,
      specialize hg n,
      rw ← hg,
      unfold comap at hnorm,
      rw mem_preimage at hnorm,
      change n ∈ H at hnorm,
      assumption,
    end,
  .. comap (𝒾 (normalizer_of_set H.carrier)) H }

def to_lcosets (g : G) (H : subgroup G) : lcosets H := ⟨g ⋆ H, ⟨g, rfl⟩⟩

lemma aux_lemma [fintype G] (H : subgroup G) (g : G) :
  (H : set G) ≤ conjugate_subgroup g H ↔ g ∈ normalizer H :=
⟨begin
  intro h,
  show conjugate_subgroup g H = H,
  apply subgroup.ext',
  symmetry,
  apply fincard.eq_of_card_eq_subset,
    exact h,
  change fincard H = fincard (conjugate_subgroup g H),
  apply fincard.of_equiv,
  apply mul_equiv.to_equiv,
  apply mul_equiv_of_is_conjugate,
  exact conjugate_is_conjugate g H
end, begin
  intro h,
  change conjugate_subgroup g H = H at h,
  conv_lhs {rw ←h},
  apply subset.refl
end⟩

lemma foo [fintype G] (H : subgroup G) (g : G):
to_lcosets g H  ∈ (fixed_points (dumb_action' H)) ↔ g ∈ normalizer H :=
begin
  rw ←aux_lemma,
  unfold fixed_points,
  unfold to_lcosets,
  unfold dumb_action',
  unfold dumb_action,
  unfold laction.comap,
  simp,
  unfold dumb_fun,
  simp,
  unfold dumb_fun',
  unfold conjugate_subgroup,
  simp,
  unfold_coes,
  simp,
  split,
  { intros h1 h hh,
    specialize h1 ⟨h, hh⟩,
    simp * at *,
    use g⁻¹ * h * g,
    rw ext_iff at h1,
    specialize h1 (h * g),
    have h2 : h * g ∈ g ⋆ H,
      rw ←h1,
      use g,
      use 1,
      use H.one_mem,
      rw group.mul_one,
      rcases h2 with ⟨j, hj1, hj2⟩,
      rw group.mul_assoc,
      rw hj2,
      rw [← group.mul_assoc, group.mul_left_inv, group.one_mul],
      use hj1,
      rw ← hj2,
      simp [group.mul_assoc] },
  { rintros h1 ⟨h, hh⟩,
    ext x, split,
    { rintro ⟨_, ⟨k, hk1, rfl⟩, rfl⟩,
      rcases h1 hh with ⟨w, hw, rfl⟩,
      show g * w * g⁻¹ * _ ∈ _,
      use w * k,
      use H.mul_mem hw hk1,
      simp [group.mul_assoc]
    },
    { rintro ⟨j, hx, rfl⟩,
      rw set.mem_set_of_eq,
      rcases h1 hh with ⟨w, hw, rfl⟩,
      use g*w⁻¹*j,
      split,
        use w⁻¹*j,
        split,
          apply H.mul_mem (H.inv_mem hw) hx,
        rw group.mul_assoc,
      simp [group.mul_assoc] } }
end

def projection [fintype G] (H : subgroup G) :
  normalizer H → fixed_points (dumb_action' H) :=
λ h, ⟨to_lcosets h.1 H, (foo H h.1).2 h.2⟩

lemma proj_eq_coset [fintype G] (H : subgroup G) (b : fixed_points (dumb_action' H)) :
  ∃ g, (𝒾 (normalizer H)) '' ((projection H) ⁻¹' {b}) = g ⋆ H :=
begin
  rcases b with ⟨⟨_, g, rfl⟩, hg⟩,
  use g,
  change to_lcosets g H ∈ _ at hg,
  rw foo at hg,
  ext x,
  split,
    rintro ⟨⟨k, hk⟩, hk2, rfl⟩,
    rw mem_preimage at hk2,
    rw mem_singleton_iff at hk2,
    unfold projection at hk2,
    unfold to_lcosets at hk2,
    rw subtype.mk_eq_mk at hk2,
    rw subtype.mk_eq_mk at hk2,
    rw ←hk2,
    use 1,
    use H.one_mem,
    rw group.mul_one,
    refl,
  rintro ⟨a, ha, rfl⟩,
  use g * a,
    apply subgroup.mul_mem _ hg,
    apply le_normalizer H,
    exact ha,
  split,
  rw mem_preimage,
  rw mem_singleton_iff,
    unfold projection,
    unfold to_lcosets,
    rw subtype.mk_eq_mk,
    rw subtype.mk_eq_mk,
    rw lagrange.lcoset_eq,
    convert ha,
    simp [group.mul_assoc],
  refl
end

--lemma card_eq_card_of_injective ()
lemma proj_fincard [fintype G] (H : subgroup G) (b : fixed_points (dumb_action' H)) :
  fincard ((projection H) ⁻¹' {b}) = fincard H :=
begin
  cases proj_eq_coset H b with g hg,
  rw @lagrange.eq_card_of_lcoset _ _ H g,
  have h := fincard.card_eq_image_of_injective (𝒾 (normalizer H)) injective_𝒾,
  rw ← hg,
  rw ← h
end

noncomputable instance boo36 [fintype G] (H : subgroup G) : fintype H := fintype.of_injective (𝒾 H) injective_𝒾

def ZZZ [fintype G] (H : subgroup G) := fincard.finsum_fibres (projection H)

def lcosets_to_sets  (H : subgroup G): lcosets H → { B | ∃ g : G, B = lcoset g H } := id

open_locale classical

noncomputable instance boo38 [fintype G] (H : subgroup G) : fintype (lcosets H) :=
fintype.of_surjective (λ g, to_lcosets g H) begin
  rintro ⟨C_val, g, rfl⟩,
  use g,
  refl
end

lemma card_subgroup_eq_card_carrier (H : subgroup G) : fincard H = fincard H.carrier :=
begin
  apply fincard.of_equiv,
  use [id, id];
  {intros x, refl}
end

lemma zero_lt_card_subgroup [fintype G] (H : subgroup G): 0 < fincard H  :=
begin
  suffices: fincard H ≠ 0,
  exact nat.pos_of_ne_zero this,
  intro h,
  rw [card_subgroup_eq_card_carrier, fincard.card_eq_zero_iff H.carrier] at h,
  rw [← mem_empty_eq (1 : G), ← h],
  exact H.one_mem,
end

lemma index_normalizer_congr_index_modp [fintype G]
  {p : ℕ} (hp: p.prime) (H : subgroup G) (h: is_p_subgroup H p) :
  index' (normalizer_of_set (H : set G)) H ≡ index H [MOD p] :=
  begin
    have claim: ∀ g : G, to_lcosets g H ∈ (fixed_points (dumb_action' H)) ↔
      g ∈ normalizer_of_set H.carrier,
      { intro g,
        rw normalizer_of_set_eq_normalizer,
        exact foo H g },
    have h2 : fincard (fixed_points (dumb_action' H)) =
      (index' (normalizer_of_set (H : set G)) H),
      { cases h with n hn,
        unfold index',
        erw normalizer_of_set_eq_normalizer,
        rw ← fincard.finsum_fibres (projection H),
        simp_rw proj_fincard,
        rw ← finsum_in_eq_finsum (λ _, fincard H),
        rw @finsum_const_nat _ _ _ (fincard H),
        rw nat.mul_div_cancel,
        exact zero_lt_card_subgroup H,
        simp,
        apply_instance },
    have h3 : index H = fincard (lcosets H),
      { unfold index,
        rw @lagrange.lagrange _ _ H,
        rw _root_.mul_comm,
        rw nat.mul_div_cancel,
        exact zero_lt_card_subgroup H },
    have : index H ≡ (index' (normalizer_of_set (H : set G)) H) [MOD p],
      rw h3,
      rw ←h2,
      cases h with n hn,
      apply card_set_congr_card_fixed_points_mod_prime (dumb_action' H) _ hp n hn,
    exact this.symm
  end

lemma p_div_index_div_normalizer_of_set [fintype G](H : subgroup G) {p : ℕ} (hp: p.prime) (h: is_p_subgroup H p):
p ∣ index H → p ∣ (index' (normalizer_of_set (H : set G)) H):=
begin
  intro hH,
  have h1: index' (normalizer_of_set (H : set G)) H  ≡ H.index [MOD p],
    {apply index_normalizer_congr_index_modp hp H h},
  refine nat.modeq.modeq_zero_iff.mp _,
    apply nat.modeq.trans h1,
    apply nat.modeq.symm,
    apply nat.modeq.modeq_of_dvd,
    rw [int.coe_nat_zero, sub_zero],
    norm_cast,
    exact hH,
end

lemma normalizer_neq_subgroup [fintype G]
  (H : subgroup G) {p : ℕ} (hp: p.prime) (h: is_p_subgroup H p) :
  p ∣ index H → normalizer_of_set (H : set G) ≠ H :=
begin
  intro hH,
  have h1: index' (normalizer_of_set (H : set G)) H  ≡ H.index [MOD p],
    { apply index_normalizer_congr_index_modp hp H h },
  have h2: p ∣ (index' (normalizer_of_set (H : set G)) H),
    { apply p_div_index_div_normalizer_of_set H hp h, assumption },
  have h3: (index' (normalizer_of_set (H : set G)) H) ≠ 1,
    { intro hfalse,
      rw hfalse at h2,
      exact nat.prime.not_dvd_one hp h2 },
  have h4: fincard (normalizer_of_set (H : set G)) ≠ fincard H,
    { unfold index' at h3,
      intro hfalse,
      rw hfalse at h3,
      apply h3,
      apply nat.div_self,
      apply zero_lt_card_subgroup },
  intro hfalse,
  apply h4,
  rw hfalse,
end

lemma index_eq_card_quotient [fintype G] (H : normal G): index (H : subgroup G) = fincard (G /ₘ H) :=
begin
  unfold index,
  rw lagrange.card_quotient_eq_mul H,
  change _ /fincard H = _,
  rw nat.mul_comm,
  rw nat.mul_div_assoc,
  rw nat.div_self,
  rw nat.mul_one,
  apply zero_lt_card_subgroup,
  refl,
end

noncomputable instance boo54 [fintype G] (N : normal G) : fintype (G /ₘ N) :=
fintype.of_surjective (quotient.mk N) begin
  exact quotient.is_surjective_mk
end

def equiv_comap_of_sub (K : subgroup G) (H : normal G)
  (h : H.to_subgroup ≤ K) : normal.comap (𝒾 K) H ≃ H :=
{ to_fun := λ g, ⟨g.1.1,
    begin
      rcases g with ⟨⟨g, _⟩, hg⟩,
      exact hg
    end⟩,
  inv_fun := λ g, ⟨⟨g.1, h g.2⟩, g.2⟩,
  left_inv := by rintro ⟨⟨_, _⟩, _⟩; simp,
  right_inv := by rintro ⟨_, _⟩; simp }

def equiv_comap_of_sub' (H K : subgroup G)
  (h : H ≤ K) : subgroup.comap (𝒾 K) H ≃ H :=
{ to_fun := λ g, ⟨g.1.1,
    begin
      rcases g with ⟨⟨g, _⟩, hg⟩,
      exact hg
    end⟩,
  inv_fun := λ g, ⟨⟨g.1, h g.2⟩, g.2⟩,
  left_inv := by rintro ⟨⟨_, _⟩, _⟩; simp,
  right_inv := by rintro ⟨_, _⟩; simp }

def equiv_map_of_sub (H : subgroup G) (K : subgroup H) :
  map (𝒾 H) K ≃ K :=
{ to_fun := λ k,
    begin
      refine ⟨⟨k.1, _⟩, _⟩;
        rcases k with ⟨k, ⟨_, hk⟩, hk', rfl⟩,
        exact hk,
        exact hk',
    end,
  inv_fun := λ k, ⟨k.1, k, k.2, rfl⟩,
  left_inv := by rintro ⟨_, _, _, _⟩; simp,
  right_inv := by rintro ⟨_, _⟩; simp }

lemma index_eq_index' [fintype G] (H K : subgroup G) (h: K ≤ H):
  index (comap (𝒾 H) K) = index' H K :=
begin
  unfold index,
  unfold index',
  rw fincard.of_equiv (equiv_comap_of_sub' K H h)
end

lemma index'_eq_card_quotient [fintype G] (H : subgroup G) (K : normal H):
  index' H (map (𝒾 H) K) = fincard (H /ₘ K) :=
begin
  unfold index',
  have h := lagrange.card_quotient_eq_mul K,
  rw h,
  rw fincard.of_equiv (equiv_map_of_sub H ↑K),
  rw _root_.mul_comm,
  convert nat.mul_div_cancel _ _,
  exact zero_lt_card_subgroup _,
end

theorem sylow_one [fintype G]
  {p m n: ℕ} {hp : p.prime}{hG : fincard G = p ^ n * m} {hdiv : ¬ p ∣ m} :
  ∀ (i ≤ n), ∃ H : subgroup G, fincard H = p ^ i :=
begin
  intros i hin,
  induction i with i hi,
  { use ⊥ ,
    rw nat.pow_zero,
    exact fincard_bot },
  rw nat.succ_eq_add_one at hin,
  have useful : 0 < n - i := nat.le_sub_left_of_add_le hin,
  have useful2 : i ≤ n,
    refine le_trans _ hin, simp,
  specialize hi useful2,
  cases hi with H hH,

  have fact0: p ∣ index H,
  { unfold index,
    rw [hG, hH, show n = i + (n - i), by simp [← nat.add_sub_assoc useful2 _],
        nat.pow_add, nat.mul_assoc, nat.mul_comm,
        nat.mul_div_assoc _ (show p ^ i ∣ p ^ i, by refl),
        nat.div_self (nat.pow_pos (nat.prime.pos hp) i),
        nat.mul_assoc, nat.mul_one],
    use p^(n - i - 1) * m, ring,
    rw nat.mul_assoc, congr,
    rw ← nat.pow_succ, congr,
    rw nat.succ_eq_add_one,
    generalize h : n - i = w,
    rw h at useful,
    refine (nat.sub_add_cancel _).symm,
    linarith },
  have fact1: index' (normalizer_of_set (H : set G)) H  ≡ H.index [MOD p],
  {  refine index_normalizer_congr_index_modp hp H _ ,
    use i, exact hH },
  have fact2: p ∣ (index' (normalizer_of_set (H : set G)) H),
  {  refine (p_div_index_div_normalizer_of_set H hp _ _),
    use i, exact hH, exact fact0},
  have fact3: p ∣ fincard (normalizer_of_set (H : set G) /ₘ normal_in_normalizer_of_set H),
    { rw ← index'_eq_card_quotient,
      cases fact2 with k hk,
      use k,
      rw ← hk,
      unfold index',
      congr' 1,
      rw fincard.of_equiv (equiv_map_of_sub _ _),
      unfold normal_in_normalizer_of_set,
      convert fincard.of_equiv (equiv_comap_of_sub' _ _ _),
      rw normalizer_of_set_eq_normalizer,
      exact le_normalizer H
    },
  have fact4: ∃ (K : subgroup (normalizer_of_set (H : set G) /ₘ normal_in_normalizer_of_set H)), fincard K = p,
    { refine @cauchy _ _ _ p hp fact3, },
  cases fact4 with K hK,
  have := quotient.quotient.comap_iso _ K,
  use map (𝒾 (normalizer_of_set H.carrier)) (quotient.comap (normal_in_normalizer_of_set H) K),
  unfold map,
  rw card_subgroup_eq_card_carrier,
  simp,
  rw ← fincard.card_eq_image_of_injective (𝒾 (normalizer_of_set H.carrier)),
  change fincard (quotient.comap (normal_in_normalizer_of_set H) K).carrier = p ^ i.succ,
  rw ←  card_subgroup_eq_card_carrier,
  rw @quotient.comap_card_eq _ _ _ (normal_in_normalizer_of_set H) K,
  rw hK,
  rw nat.pow_succ,
  congr,
  rw ← hH,
  apply fincard.of_equiv,
  refine equiv.trans (equiv_comap_of_sub _ _ _) _,
  { rintro h hh,
    unfold quotient.comap,
    rw mem_coe,
    rw mem_comap',
    convert K.one_mem,
    rw ← mem_kernel,
    rw quotient.kernel_mk,
    exact hh
  },
  { unfold normal_in_normalizer_of_set,
      convert (equiv_comap_of_sub' _ _ _),
    rw normalizer_of_set_eq_normalizer,
    exact le_normalizer H,
  },
  exact injective_𝒾,
end

def conjugate_iso (g : G) (H : subgroup G) : H ≅ conjugate_subgroup g H :=
{ to_fun := λ (h : H) , ⟨g * h * g⁻¹, begin use [h, h.2] end⟩,
  map_mul' :=
    begin
      rintro ⟨x, hx⟩ ⟨y, hy⟩,
      congr' 1,
      change g * (x * y) * g⁻¹ = _,
      simp [group.mul_assoc],
    end,
  is_bijective :=
    begin
      split,
      { intros x y hxy ,
        dsimp at *,
        cases y with y hy,
        cases x with x hx,
        rw subtype.mk_eq_mk at hxy,
        simpa using hxy,
        },
      { unfold surjective,
        rintro ⟨b, h, hh, rfl⟩,
        use ⟨h, hh⟩,
        simp }
    end }

lemma conjugates_eq_cardinality (g : G) (H : subgroup G) :
  fincard H = fincard (conjugate_subgroup g H) :=
fincard.of_equiv (group_hom.mul_equiv_of_iso (conjugate_iso g H)).to_equiv

def is_sylow_p_subgroup [fintype G] {p m n: ℕ} (hp : p.prime)(hG : fincard G = p ^ n * m)
 (hdiv : ¬ p ∣ m) (K : subgroup G): Prop := fincard K = p ^ n

def dumb_action2 (H K: subgroup G) : laction K (lcosets H) :=
laction.comap (𝒾 K) (lcosets H) (dumb_action H)

theorem sylow_two [fintype G]{p m n: ℕ} (hp : p.prime)(hG : fincard G = p ^ n * m)
 (hdiv : ¬ p ∣ m) (H K : subgroup G) (h₁ : is_sylow_p_subgroup hp hG hdiv H)(h₂ : is_sylow_p_subgroup hp hG hdiv K) :
∃ (g : G), H = conjugate_subgroup g K  :=
begin
  have claim: ¬ p ∣ index H,
  { unfold index,
    unfold is_sylow_p_subgroup at h₁,
    rw [hG, h₁, nat.mul_comm, nat.mul_div_assoc, nat.div_self, nat.mul_one],
    exact hdiv,
    apply nat.pow_pos (nat.prime.pos hp),
    simp},
  have fact: ¬ H.index ≡ 0 [MOD p],
  { intro h, apply claim,
    apply nat.modeq.modeq_zero_iff.1, exact h },

  have claim3: H.index ≡ fincard (fixed_points (dumb_action2 H K)) [MOD p],
  { unfold is_sylow_p_subgroup at * ,
    --apply card_set_congr_card_fixed_points_mod_prime dumb_action2 p hp h₂
    sorry},
  sorry
end

-- Consider the action of K on the set X of cosets of H in G μ: K × X → X, (y, xH) ↦ yxH.
--Consider the points fixed by the action. Notice that since H is a Sylow p subgroup then p does not divide
--fincard X = index H, hence fincard (fixed points μ) ≠ 0. We then want to show that xH ∈ fixed_points μ
--implies that the conjugate of K by x is a subgroup of H. Since conjugates are isomorphic they have the same cardinality.
--Hence x K x⁻¹ = H.

--Define the number of Sylow p-subgroups of G.
-- noncomputable def number_sylow_p (G : Type) [group G] {p : ℕ} (hp : p.prime) :=
-- fincard {K : subgroup G // is_sylow_p_subgroup K hp}

-- theorem sylow_three_part1 [fintype G]{p m n: ℕ}{hp : p.prime}
--   {hG : fincard G = p ^ n * m} {hdiv : ¬ p ∣ m}:
-- number_sylow_p G hp ≡ 1 [MOD p] := sorry
-- theorem sylow_three_part2 [fintype G]{p m n: ℕ} {hp : p.prime}{hG : fincard G = p ^ n * m} {hdiv : ¬ p ∣ m}:
-- number_sylow_p G hp ∣ m := sorry
--By Sylow 1 ∃ a Sylow p-subgroup P, so we set X = Sylp(G) = {Sylow p-groups in G}
--Then P acts on X by μ : P × X → X, (x, Q) ↦ xQx⁻¹ (this is what we defined conjugate_action to be)
--By card_set_congr_card_fixed_points_mod_prime we have
-- number_sylow_p = fincard X ≡ fincard (fixed points μ) [MOD p]. Want to show fincard (fixed points μ) = 1.
--Let P ∈ fixed points μ and Q ∈ fixed points μ. Then P is a subgroup of normalizer_of_set Q
--Both P and Q are Sylow p-subgroups of normalizer_of_set Q, so ∃ x ∈ normalizer_of_set Q s.t. xQx⁻¹ = P (Sylow 2)
--By def of normalizer_of_set Q we have Q = P, so fixed_points μ = {P}, proving the first part of the theorem.end
--Now if P acts on X by conjugation ∃ ! orbit such that X = orbit G P (Sylow 2).
--By orbit-stabilizer number_sylow_p = (fincard X) ∣ (fincard G)=p^n *m which implies it divides m.

end mygroup


import GMLInit.Data.Index.Basic
import GMLInit.Data.Index.Map

protected abbrev List.option {α} (xs : List α) : List (Option α) := none :: xs.map some

namespace Index
variable {α} {xs : List α}

def option : Option (Index xs) → Index xs.option
| none => head
| some i => tail (i.map some)

def unoption (k : Index xs.option) : Option (Index xs) :=
  match k with
  | head => none
  | tail i => i.unmap some

theorem unoption_option : (i : Option (Index xs)) → unoption (option i) = i
| none => rfl
| some i => congrArg some (unmap_map some i)

theorem option_unoption : (k : Index (List.option xs)) → option (unoption k) = k
| head => rfl
| tail k => congrArg tail (map_unmap some k)

theorem option_eq_iff_eq_unoption (i : Option (Index xs)) (k : Index (List.option xs)) : option i = k ↔ i = unoption k := by
  constr
  · intro h; rw [←h, unoption_option]
  · intro h; rw [h, option_unoption]

theorem unoption_eq_iff_eq_option (k : Index (List.option xs)) (i : Option (Index xs)) : unoption k = i ↔ k = option i := by
  constr
  · intro h; rw [←h, option_unoption]
  · intro h; rw [h, unoption_option]

def optionEquiv (xs : List α) : Equiv (Option (Index xs)) (Index (List.option xs)) where
  fwd := option
  rev := unoption
  spec := by
    intros
    constr
    · intro | rfl => exact unoption_option ..
    · intro | rfl => exact option_unoption ..

theorem val_option (i : Option (Index xs)) : (match i with | none => none | some i => some i.val) = (option i).val := by
  match i with
  | none => rfl
  | some i => rw [option, val_map]

theorem val_unoption (k : Index (List.option xs)) : k.val = (match k.unoption with | none => none | some k => some k.val) := by
  rw [←option_unoption k, val_option, unoption_option]

end Index