/-= Chapter 4: Quantifiers and equality =-/

/- The universal quantifier -/
namespace universal

example (α : Type) (p q : α → Prop) : (∀ x : α, p x ∧ q x) → ∀ y : α, p y :=
  λ h : ∀ x : α, p x ∧ q x =>
  λ y : α =>
  show p y from (h y).left

example (α : Type) (p q : α → Prop) : (∀ x : α, p x ∧ q x) → ∀ x : α, p x :=
  fun h : ∀ x : α, p x ∧ q x =>
  fun z : α =>
  show p z from And.left (h z)

variable (α : Type) (r : α → α → Prop)
variable (trans_r : ∀ x y z, r x y → r y z → r x z)

variable (a b c : α)
variable (hab : r a b) (hbc : r b c)

#check trans_r
#check trans_r a b c
#check trans_r a b c hab
#check trans_r a b c hab hbc

namespace implicit_trans

  variable (α : Type) (r : α → α → Prop)
  variable (trans_r : ∀ {x y z}, r x y → r y z → r x z)

  variable (a b c : α)
  variable (hab : r a b) (hbc : r b c)

  #check trans_r
  #check trans_r hab
  #check trans_r hab hbc

end implicit_trans

namespace equivalence_relation

  variable (α : Type) (r : α → α → Prop)

  variable (refl_r : ∀ x, r x x)
  variable (symm_r : ∀ {x y}, r x y → r y x)
  variable (trans_r : ∀ {x y z}, r x y → r y z → r x z)

  example (a b c d : α) (hab : r a b) (hcb : r c b) (hcd : r c d) : r a d :=
    trans_r hab (trans_r (symm_r hcb) hcd)

end equivalence_relation

end universal

/- Equality -/
namespace equality

#check Eq.refl
#check Eq.symm
#check Eq.trans

universe u

#check @Eq.refl.{u}
#check @Eq.symm.{u}
#check @Eq.trans.{u}

variable (α β : Type) (a b c d : α)
variable (hab : a = b) (hcb : c = b) (hcd : c = d)

example : a = d :=
  Eq.trans hab (Eq.trans (Eq.symm hcb) hcd)

example : a = d := hab.trans (hcb.symm.trans hcd)

example (f : α → β) (a : α) : (λ x => f x) a = f a := Eq.refl _
example (a b : α) : (a, b).1 = a := Eq.refl _
example : 2 + 3 = 5 := Eq.refl _

example (f : α → β) (a : α) : (λ x => f x) a = f a := rfl
example (a b : α) : (a, b).1 = a := rfl
example : 2 + 3 = 5 := rfl

example (p : α → Prop) (h1 : a = b) (h2 : p a) : p b :=
  Eq.subst h1 h2

example (p : α → Prop) (h1 : a = b) (h2 : p a) : p b :=
  h1 ▸ h2

namespace subst_helpers

  variable (α : Type)
  variable (a b : α)
  variable (f g : α → Nat)
  variable (h₁ : a = b)
  variable (h₂ : f = g)

  example : f a = f b := congrArg f h₁
  example : f a = g a := congrFun h₂ a
  example : f a = g b := congr h₂ h₁

end subst_helpers

namespace nat_identities

  variable (a b c d : Nat)

  example : a + 0 = a := Nat.add_zero a
  example : 0 + a = a := Nat.zero_add a
  example : a * 1 = a := Nat.mul_one a
  example : 1 * a = a := Nat.one_mul a
  example : a + b = b + a := Nat.add_comm a b
  example : (a + b) + c = a + (b + c) := Nat.add_assoc a b c
  example : a * b = b * a := Nat.mul_comm a b
  example : (a * b) * c = a * (b * c) := Nat.mul_assoc a b c
  example : a * (b + c) = (a * b) + (a * c) := Nat.mul_add a b c
  example : a * (b + c) = (a * b) + (a * c) := Nat.left_distrib a b c
  example : (a + b) * c = (a * c) + (b * c) := Nat.add_mul a b c
  example : (a + b) * c = (a * c) + (b * c) := Nat.right_distrib a b c

  example (x y : Nat) : (x + y) * (x + y) = x * x + y * x + x * y + y * y :=
    have h₁ : (x + y) * (x + y) = (x + y) * x + (x + y) * y :=
      Nat.mul_add (x + y) x y
    have h₂ : (x + y) * (x + y) = x * x + y * x + (x * y + y * y) :=
      (Nat.add_mul x y x) ▸ (Nat.add_mul x y y) ▸ h₁
    h₂.trans (Nat.add_assoc (x * x + y * x) (x * y) (y * y)).symm

end nat_identities

end equality

/- Calculational proofs -/
namespace calculational_proofs

variable (a b c d e : Nat)
variable (h₁ : a = b)
variable (h₂ : b = c + 1)
variable (h₃ : c = d)
variable (h₄ : e = 1 + d)

theorem T : a = e :=
  calc
    a = b     := h₁
    _ = c + 1 := h₂
    _ = d + 1 := congrArg Nat.succ h₃
    _ = 1 + d := Nat.add_comm d 1
    _ = e     := Eq.symm h₄

theorem T₂ : a = e :=
  calc
    a = b     := by rw [h₁]
    _ = c + 1 := by rw [h₂]
    _ = d + 1 := by rw [h₃]
    _ = 1 + d := by rw [Nat.add_comm]
    _ = e     := by rw [h₄]

theorem T₃ : a = e :=
  calc
    a = d + 1 := by rw [h₁, h₂, h₃]
    _ = 1 + d := by rw [Nat.add_comm]
    _ = e     := by rw [h₄]

theorem T₄ : a = e :=
  by rw [h₁, h₂, h₃, Nat.add_comm, h₄]

theorem T₅ : a = e :=
  by simp [h₁, h₂, h₃, Nat.add_comm, h₄]

example (h₁ : a = b) (h₂ : b ≤ c) (h₃ : c + 1 < d) : a < d :=
  calc
    a = b     := h₁
    _ < b + 1 := Nat.lt_succ_self b
    _ ≤ c + 1 := Nat.succ_le_succ h₂
    _ < d     := h₃

example (x y : Nat) : (x + y) * (x + y) = x * x + y * x + x * y + y * y :=
  calc
    _ = (x + y) * (x + y)               := by rfl
    _ = (x + y) * x + (x + y) * y       := by rw [Nat.mul_add]
    _ = x * x + y * x + (x + y) * y     := by rw [Nat.add_mul]
    _ = x * x + y * x + (x * y + y * y) := by rw [Nat.add_mul]
    _ = x * x + y * x + x * y + y * y   := by rw [←Nat.add_assoc]

example (x y : Nat) : (x + y) * (x + y) = x * x + y * x + x * y + y * y :=
  by rw [Nat.mul_add, Nat.add_mul, Nat.add_mul, ←Nat.add_assoc]

example (x y : Nat) : (x + y) * (x + y) = x * x + y * x + x * y + y * y :=
  by simp [Nat.mul_add, Nat.add_mul, Nat.add_assoc, Nat.add_left_comm]

end calculational_proofs

/- The existential quantifier -/
namespace existential_quantifier

example : ∃ x : Nat, x > 0 :=
  have h : 1 > 0 := Nat.zero_lt_succ 0
  Exists.intro 1 h

example (x : Nat) (h : x > 0) : ∃ y, y < x :=
  Exists.intro 0 h

example (x y z : Nat) (hxy : x < y) (hyz : y < z) : ∃ w, x < w ∧ w < z :=
  Exists.intro y (And.intro hxy hyz)

#check @Exists.intro

example : ∃ x : Nat, x > 0 :=
  have h : 1 > 0 := Nat.zero_lt_succ 0
  ⟨1, h⟩

example (x : Nat) (h : x > 0) : ∃ y, y < x :=
  ⟨0, h⟩

example (x y z : Nat) (hxy : x < y) (hyz : y < z) : ∃ w, x < w ∧ w < z :=
  ⟨y, hxy, hyz⟩

section infer_predicate

  variable (g : Nat → Nat → Nat)
  variable (hg : g 0 0 = 0)

  theorem gex₁ : ∃ x, g x x = x := ⟨0, hg⟩
  theorem gex₂ : ∃ x, g x 0 = x := ⟨0, hg⟩
  theorem gex₃ : ∃ x, g 0 0 = x := ⟨0, hg⟩
  theorem gex₄ : ∃ x, g x x = 0 := ⟨0, hg⟩

  -- display implicit arguments
  set_option pp.explicit true
  #print gex₁
  #print gex₂
  #print gex₃
  #print gex₄

end infer_predicate

variable (α : Type) (p q : α → Prop)

example (h : ∃ x, p x ∧ q x) : ∃ x, q x ∧ p x :=
  Exists.elim h
    (λ w =>
     λ hw : p w ∧ q w =>
     show ∃ x, q x ∧ p x from ⟨w, hw.right, hw.left⟩)

example (h : ∃ x, p x ∧ q x) : ∃ x, q x ∧ p x :=
  match h with
  | ⟨w, hw⟩ => ⟨w, hw.right, hw.left⟩

example (h : ∃ x, p x ∧ q x) : ∃ x, q x ∧ p x :=
  match h with
  | ⟨(w : α), (hw : p w ∧ q w)⟩ => ⟨w, hw.right, hw.left⟩

example (h : ∃ x, p x ∧ q x) : ∃ x, q x ∧ p x :=
  match h with
  | ⟨w, hpw, hqw⟩ => ⟨w, hqw, hpw⟩

example (h : ∃ x, p x ∧ q x) : ∃ x, q x ∧ p x :=
  let ⟨w, hpw, hqw⟩ := h
  ⟨w, hqw, hpw⟩

example : (∃ x, p x ∧ q x) → ∃ x, q x ∧ p x :=
  λ ⟨w, hpw, hqw⟩ => ⟨w, hqw, hpw⟩

def is_even (a : Nat) := ∃ b, a = 2 * b

theorem even_plus_even (h₁ : is_even a) (h₂ : is_even b) : is_even (a + b) :=
  Exists.elim h₁ (fun w₁ (hw₁ : a = 2 * w₁) =>
  Exists.elim h₂ (fun w₂ (hw₂ : b = 2 * w₂) =>
    Exists.intro (w₁ + w₂)
      (calc
        _ = a + b           := by rfl
        _ = 2 * w₁ + 2 * w₂ := by rw [hw₁, hw₂]
        _ = 2 * (w₁ + w₂)   := by rw [Nat.mul_add])))

theorem even_plus_even_short
    (h₁ : is_even a) (h₂ : is_even b) : is_even (a + b) :=
  match h₁, h₂ with
  | ⟨w₁, hw₁⟩, ⟨w₂, hw₂⟩ => ⟨w₁ + w₂, by rw [hw₁, hw₂, Nat.mul_add]⟩

theorem even_plus_even_readable
    (h₁ : is_even a) (h₂ : is_even b) : is_even (a + b) :=
  let ⟨w₁, (hw₁ : a = 2 * w₁)⟩ := h₁
  let ⟨w₂, (hw₂ : b = 2 * w₂)⟩ := h₂
  let even_sum := calc
    _ = a + b           := by rfl
    _ = 2 * w₁ + 2 * w₂ := by rw [hw₁, hw₂]
    _ = 2 * (w₁ + w₂)   := by rw [Nat.left_distrib]
  show is_even (a + b) from ⟨w₁ + w₂, even_sum⟩

section classical_exists
  open Classical
  variable (p : α → Prop)

  example (h : ¬ ∀ x, ¬ p x) : ∃ x, p x :=
    byContradiction
      (fun h₁ : ¬ ∃ x, p x =>
        have h₂ : ∀ x, ¬ p x :=
          fun x =>
          fun h₃ : p x =>
          have h₄ : ∃ x, p x := ⟨x, h₃⟩
          show False from h₁ h₄
        show False from h h₂)

  example (hnaxnpx : ¬ ∀ x, ¬ p x) : ∃ x, p x :=
    byContradiction λ hnexpx : ¬ ∃ x, p x =>
      suffices caxnpx : ∀ x, ¬ p x from show False from hnaxnpx caxnpx
      show ∀ x, ¬ p x from λ x (hpx : p x) =>
        have cexpx : ∃ x, p x := ⟨x, hpx⟩
        show False from hnexpx cexpx

end classical_exists

end existential_quantifier

/- More on the proof language -/
namespace proof_language

variable (f : Nat → Nat)
variable (h : ∀ x : Nat, f x ≤ f (x + 1))

example : f 0 ≤ f 3 :=
  have : f 0 ≤ f 1 := h 0
  have : f 0 ≤ f 2 := Nat.le_trans this (h 1)
  show f 0 ≤ f 3 from Nat.le_trans this (h 2)

example : f 0 ≤ f 3 :=
  have : f 0 ≤ f 1 := h 0
  have : f 0 ≤ f 2 := Nat.le_trans (by assumption) (h 1)
  show f 0 ≤ f 3 from Nat.le_trans (by assumption) (h 2)

example (_ : f 0 ≥ f 1) (_ : f 1 ≥ f 2) : f 0 = f 2 :=
  have : f 0 ≥ f 2 := Nat.le_trans ‹f 1 ≥ f 2› ‹f 0 ≥ f 1›
  have : f 0 ≤ f 2 := Nat.le_trans (h 0) (h 1)
  show f 0 = f 2 from Nat.le_antisymm this ‹f 0 ≥ f 2›

example (n : Nat) : Nat := ‹Nat›

end proof_language

/- Exercises -/
namespace ex_1

variable (α : Type) (p q : α → Prop)

example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) :=
  have fwd : (∀ x, p x ∧ q x) → (∀ x, p x) ∧ (∀ x, q x) := λ axpxqx =>
    have axpx : ∀ x, p x := λ x => (axpxqx x).left
    have axqx : ∀ x, q x := λ x => (axpxqx x).right
    show (∀ x, p x) ∧ (∀ x, q x) from ⟨axpx, axqx⟩
  have rev : (∀ x, p x) ∧ (∀ x, q x) → (∀ x, p x ∧ q x) := λ axpxaxqx =>
    have axpx : ∀ x, p x := axpxaxqx.left
    have axqx : ∀ x, q x := axpxaxqx.right
    show ∀ x, p x ∧ q x from λ x => ⟨axpx x, axqx x⟩
  show (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) from ⟨fwd, rev⟩

example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) := λ _ _ x =>
  have : p x → q x := ‹∀ x, p x → q x› x
  have : p x := ‹∀ x, p x› x
  show q x from ‹p x → q x› ‹p x›

example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x := λ axpxaxqx x =>
  match axpxaxqx with
  | Or.inl axpx => Or.inl (axpx x)
  | Or.inr axqx => Or.inr (axqx x)

-- The converse of the last example is not derivable because even if
-- (p x ∨ q x) is true for every x, it could be that p x is true for some x's
-- and q x is true for others. We can't commit to either
-- (∀ x, p x) or (∀ x, q x).

end ex_1

namespace ex_2

variable (α : Type) (p q : α → Prop)
variable (r : Prop)

example : α → ((∀ x : α, r) ↔ r) := λ a =>
  have fwd : (∀ x : α, r) → r := λ f => f a
  have rev : r → (∀ x : α, r) := λ hr x => hr
  show (∀ x : α, r) ↔ r from ⟨fwd, rev⟩

example : (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r :=
  have fwd : (∀ x, p x ∨ r) → (∀ x, p x) ∨ r := λ axpxr =>
    match (Classical.em r) with
    | Or.inl (hr : r) =>
      Or.inr hr
    | Or.inr (hnr : ¬ r) =>
      show (∀ x, p x) ∨ r from Or.inl λ x =>
        show p x from match (axpxr x : p x ∨ r) with
        | Or.inl px => px
        | Or.inr hr => absurd hr hnr
  have rev : (∀ x, p x) ∨ r → (∀ x, p x ∨ r) := λ axpxr x =>
    match axpxr with
    | Or.inl axpx => Or.inl (axpx x)
    | Or.inr r => Or.inr r
  show (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r from ⟨fwd, rev⟩

example : (∀ x, r → p x) ↔ (r → ∀ x, p x) :=
  have fwd : (∀ x, r → p x) → (r → ∀ x, p x) := λ haxrpx hr x =>
    show p x from haxrpx x hr
  have rev : (r → ∀ x, p x) → (∀ x, r → p x) := λ hraxpx x hr =>
    show p x from hraxpx hr x
  show (∀ x, r → p x) ↔ (r → ∀ x, p x) from ⟨fwd, rev⟩

end ex_2

namespace ex_3

variable (men : Type) (barber : men)
variable (shaves : men → men → Prop)

-- Copied from Chapter 3's exercises
theorem p_iff_np_false : ¬(p ↔ ¬p) := λ p_iff_np =>
  have hpnp : p → ¬p := p_iff_np.mp
  have hnpp : ¬p → p := p_iff_np.mpr
  have hnp : ¬p := λ hp => hpnp hp hp
  have hnnp : ¬¬p := λ hnp => hnp (hnpp hnp)
  show False from hnnp hnp

example (h : ∀ x : men, shaves barber x ↔ ¬ shaves x x) : False :=
  have h_barber : shaves barber barber ↔ ¬ shaves barber barber := h barber
  show False from p_iff_np_false h_barber

end ex_3

namespace ex_4

def even (n : Nat) : Prop := ∃ m, n = 2 * m

def prime (n : Nat) : Prop := n > 1 ∧ ¬ ∃ m₁ m₂, m₁ < n ∧ m₂ < n ∧ m₁ * m₂ = n

def infinitely_many (P : Nat → Prop) : Prop := ∀ n : Nat, ∃ m, m > n ∧ P m

def infinitely_many_primes : Prop := infinitely_many prime

def Fermat_number (n : Nat) : Prop := ∃ m : Nat, n = 2 ^ (2 ^ m) + 1

def Fermat_prime (n : Nat) : Prop := Fermat_number n ∧ prime n

def infinitely_many_Fermat_primes : Prop := infinitely_many Fermat_prime

def goldbach_conjecture : Prop :=
  ∀ n, n > 2 → even n → ∃ p₁ p₂, prime p₁ ∧ prime p₂ ∧ n = p₁ + p₂

def Goldbach's_weak_conjecture : Prop :=
  ∀ n, n > 5 → ¬ even n →
  ∃ p₁ p₂ p₃, prime p₁ ∧ prime p₂ ∧ prime p₃ ∧ n = p₁ + p₂ + p₃

def Fermat's_last_theorem : Prop :=
  ∀ n, n > 2 → ¬ ∃ a b c : Nat, a ^ n + b ^ n = c ^ n

end ex_4

namespace ex_5

variable (α : Type) (p q : α → Prop)
variable (r : Prop)

example : (∃ x : α, r) → r := λ ⟨x, hr⟩ => hr

example (a : α) : r → (∃ x : α, r) := λ hr => ⟨a, hr⟩

example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r :=
  have fwd : (∃ x, p x ∧ r) → (∃ x, p x) ∧ r := λ ⟨x, px, hr⟩ =>
    show (∃ x, p x) ∧ r from ⟨⟨x, px⟩, hr⟩
  have rev : (∃ x, p x) ∧ r → (∃ x, p x ∧ r) := λ ⟨⟨x, px⟩, hr⟩ =>
    show ∃ x, p x ∧ r from ⟨x, px, hr⟩
  show (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r from ⟨fwd, rev⟩

example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) :=
  have fwd : (∃ x, p x ∨ q x) → (∃ x, p x) ∨ (∃ x, q x) := λ ⟨x, pxqx⟩ =>
    match pxqx with
    | Or.inl px => Or.inl ⟨x, px⟩
    | Or.inr qx => Or.inr ⟨x, qx⟩
  have rev : (∃ x, p x) ∨ (∃ x, q x) → (∃ x, p x ∨ q x) := λ _ =>
    match ‹(∃ x, p x) ∨ (∃ x, q x)› with
    | Or.inl ⟨x, px⟩ => ⟨x, Or.inl px⟩
    | Or.inr ⟨x, qx⟩ => ⟨x, Or.inr qx⟩
  show (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) from ⟨fwd, rev⟩

example : (∀ x, p x) ↔ ¬ (∃ x, ¬ p x) :=
  have fwd : (∀ x, p x) → ¬ (∃ x, ¬ p x) := λ axpx ⟨x, npx⟩ =>
    show False from npx (axpx x)
  have rev : ¬ (∃ x, ¬ p x) → (∀ x, p x) := λ (_ : ¬ ∃ x, ¬ p x) x =>
    Classical.byContradiction λ (_ : ¬ p x) =>
      have : ∃ x, ¬ p x := ⟨x, ‹¬ p x›⟩
      show False from ‹¬ (∃ x, ¬ p x)› ‹∃ x, ¬ p x›
  show (∀ x, p x) ↔ ¬ (∃ x, ¬ p x) from ⟨fwd, rev⟩

example : (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) :=
  have fwd : (∃ x, p x) → ¬ (∀ x, ¬ p x) := λ ⟨x, px⟩ axnpx =>
    show False from axnpx x px
  have rev : ¬ (∀ x, ¬ p x) → (∃ x, p x) := λ _ : ¬ ∀ x, ¬ p x =>
    Classical.byContradiction λ _ : ¬ ∃ x, p x =>
      have : ∀ x, ¬ p x := λ x px =>
        have : ∃ x, p x := ⟨x, px⟩
        show False from ‹¬ ∃ x, p x› ‹∃ x, p x›
      show False from ‹¬ ∀ x, ¬ p x› ‹∀ x, ¬ p x›
  show (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) from ⟨fwd, rev⟩

example : (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) :=
  have fwd : (¬ ∃ x, p x) → (∀ x, ¬ p x) := λ (_ : ¬ ∃ x, p x) x px =>
    have : ∃ x, p x := ⟨x, px⟩
    show False from ‹¬ ∃ x, p x› ‹∃ x, p x›
  have rev : (∀ x, ¬ p x) → (¬ ∃ x, p x) := λ (_ : ∀ x, ¬ p x) ⟨x, px⟩ =>
    have : ¬ p x := ‹∀ x, ¬ p x› x
    show False from ‹¬ p x› ‹p x›
  show (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) from ⟨fwd, rev⟩

example : (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) :=
  have fwd : (¬ ∀ x, p x) → (∃ x, ¬ p x) := λ (_ : ¬ ∀ x, p x) =>
    Classical.byContradiction λ (_ : ¬ ∃ x, ¬ p x) =>
      have : ∀ x, p x := λ x =>
        Classical.byContradiction λ (_ : ¬ p x) =>
          have : ∃ x, ¬ p x := ⟨x, ‹¬ p x›⟩
          show False from ‹¬ (∃ x, ¬ p x)› ‹∃ x, ¬ p x›
      show False from ‹¬ ∀ x, p x› ‹∀ x, p x›
  have rev : (∃ x, ¬ p x) → (¬ ∀ x, p x) := λ ⟨x, npx⟩ (_ : ∀ x, p x) =>
    have : p x := ‹∀ x, p x› x
    show False from ‹¬ p x› ‹p x›
  show (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) from ⟨fwd, rev⟩

example : (∀ x, p x → r) ↔ (∃ x, p x) → r :=
  have fwd : (∀ x, p x → r) → (∃ x, p x) → r := λ (_ : ∀ x, p x → r) ⟨x, px⟩ =>
    show r from ‹∀ x, p x → r› x px
  have rev : ((∃ x, p x) → r) → (∀ x, p x → r) := λ (_ : (∃ x, p x) → r) x px =>
    show r from ‹(∃ x, p x) → r› ⟨x, px⟩
  show (∀ x, p x → r) ↔ (∃ x, p x) → r from ⟨fwd, rev⟩

example (a : α) : (∃ x, p x → r) ↔ (∀ x, p x) → r :=
  have fwd : (∃ x, p x → r) → (∀ x, p x) → r :=
    λ ⟨x, (_ : p x → r)⟩ (_ : ∀ x, p x) =>
      have : p x := ‹∀ x, p x› x
      show r from ‹p x → r› ‹p x›
  have rev : ((∀ x, p x) → r) → (∃ x, p x → r) :=
    λ (_ : (∀ x, p x) → r) =>
      show ∃ x, p x → r from Classical.byContradiction λ (_ : ¬∃ x, p x → r) =>
        have : ∀ x, p x := Classical.byContradiction λ (_ : ¬∀ x, p x) =>
          have : ∀ x, p x := λ x =>
            show p x from Classical.byContradiction λ (_ : ¬(p x)) =>
              have : ∃ x, p x → r := ⟨x, λ _ => absurd ‹p x› ‹¬(p x)›⟩
              show False from ‹¬∃ x, p x → r› ‹∃ x, p x → r›
          show False from ‹¬∀ x, p x› ‹∀ x, p x›
        have : r := ‹(∀ x, p x) → r› ‹∀ x, p x›
        have : ∃ x, p x → r := ⟨a, λ _ => ‹r›⟩
        show False from ‹¬∃ x, p x → r› ‹∃ x, p x → r›
  show (∃ x, p x → r) ↔ (∀ x, p x) → r from ⟨fwd, rev⟩

example (a : α) : (∃ x, r → p x) ↔ (r → ∃ x, p x) :=
  have fwd : (∃ x, r → p x) → (r → ∃ x, p x) :=
    λ ⟨x, (_ : r → p x)⟩ (_ : r) =>
      have : p x := ‹r → p x› ‹r›
      show ∃ x, p x from ⟨x, ‹p x›⟩
  have rev : (r → ∃ x, p x) → (∃ x, r → p x) :=
    λ (_ : r → ∃ x, p x) =>
      show ∃ x, r → p x from Classical.byContradiction λ (_ : ¬∃ x, r → p x) =>
        have : r := Classical.byContradiction λ (_ : ¬r) =>
          have : ∃ x, r → p x := ⟨a, λ _ => absurd ‹r› ‹¬r›⟩
          show False from ‹¬∃ x, r → p x› ‹∃ x, r → p x›
        let ⟨x, (_ : p x)⟩ := ‹r → ∃ x, p x› ‹r›
        have : ∃ x, r → p x := ⟨x, λ _ => ‹p x›⟩
        show False from ‹¬∃ x, r → p x› ‹∃ x, r → p x›
  show (∃ x, r → p x) ↔ (r → ∃ x, p x) from ⟨fwd, rev⟩

end ex_5


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

! This file was ported from Lean 3 source module data.fintype.perm
! leanprover-community/mathlib commit 509de852e1de55e1efa8eacfa11df0823f26f226
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Fintype.Card
import Mathlib.GroupTheory.Perm.Basic
import Mathlib.Tactic.Ring

/-!
# `Fintype` instances for `Equiv` and `Perm`

Main declarations:
* `permsOfFinset s`: The finset of permutations of the finset `s`.

-/

open Function

open Nat

universe u v

variable {α β γ : Type _}

open Finset Function List Equiv Equiv.Perm

variable [DecidableEq α] [DecidableEq β]

/-- Given a list, produce a list of all permutations of its elements. -/
def permsOfList : List α → List (Perm α)
  | [] => [1]
  | a :: l => permsOfList l ++ l.bind fun b => (permsOfList l).map fun f => Equiv.swap a b * f
#align perms_of_list permsOfList

theorem length_permsOfList : ∀ l : List α, length (permsOfList l) = l.length !
  | [] => rfl
  | a :: l => by
    rw [length_cons, Nat.factorial_succ]
    simp only [permsOfList, length_append, length_permsOfList, length_bind, comp,
     length_map, map_const', sum_replicate, smul_eq_mul, succ_mul]
    ring
#align length_perms_of_list length_permsOfList

theorem mem_permsOfList_of_mem {l : List α} {f : Perm α} (h : ∀ x, f x ≠ x → x ∈ l) :
    f ∈ permsOfList l := by
  induction l generalizing f
  -- with a l IH
  case nil =>
    -- Porting note: Previous code was:
    -- exact List.mem_singleton.2 (Equiv.ext fun x => Decidable.by_contradiction <| h x)
    --
    -- `h x` does not work as expected.
    -- This is because `x ∈ []` is not `False` before `simp`.
    exact List.mem_singleton.2 (Equiv.ext fun x => Decidable.by_contradiction <| by
      intro h'; simp at h; apply h x; intro h''; apply h'; simp; exact h'')
  case cons a l IH =>
  by_cases hfa : f a = a
  · refine' mem_append_left _ (IH fun x hx => mem_of_ne_of_mem _ (h x hx))
    rintro rfl
    exact hx hfa
  have hfa' : f (f a) ≠ f a := mt (fun h => f.injective h) hfa
  have : ∀ x : α, (Equiv.swap a (f a) * f) x ≠ x → x ∈ l := by
    intro x hx
    have hxa : x ≠ a := by
      rintro rfl
      apply hx
      simp only [mul_apply, swap_apply_right]
    refine' List.mem_of_ne_of_mem hxa (h x fun h => _)
    simp only [mul_apply, swap_apply_def, mul_apply, Ne.def, apply_eq_iff_eq] at hx
    split_ifs at hx with h_1
    exacts[hxa (h.symm.trans h_1), hx h]
  suffices f ∈ permsOfList l ∨ ∃ b ∈ l, ∃ g ∈ permsOfList l, Equiv.swap a b * g = f by
    simpa only [permsOfList, exists_prop, List.mem_map, mem_append, List.mem_bind]
  refine' or_iff_not_imp_left.2 fun _hfl => ⟨f a, _, Equiv.swap a (f a) * f, IH this, _⟩
  · exact mem_of_ne_of_mem hfa (h _ hfa')
  · rw [← mul_assoc, mul_def (swap a (f a)) (swap a (f a)), swap_swap, ← Perm.one_def, one_mul]
#align mem_perms_of_list_of_mem mem_permsOfList_of_mem

theorem mem_of_mem_permsOfList :
    -- porting notes: was `∀ {x}` but need to capture the `x`
    ∀ {l : List α} {f : Perm α}, f ∈ permsOfList l → (x :α ) → f x ≠ x → x ∈ l
  | [], f, h, heq_iff_eq => by
    have : f = 1 := by simpa [permsOfList] using h
    rw [this]; simp
  | a :: l, f, h, x =>
    (mem_append.1 h).elim (fun h hx => mem_cons_of_mem _ (mem_of_mem_permsOfList h x hx))
      fun h hx =>
      let ⟨y, hy, hy'⟩ := List.mem_bind.1 h
      let ⟨g, hg₁, hg₂⟩ := List.mem_map.1 hy'
      -- Porting note: Seems like the implicit variable `x` of type `α` is needed.
      if hxa : x = a then by simp [hxa]
      else
        if hxy : x = y then mem_cons_of_mem _ <| by rwa [hxy]
        else mem_cons_of_mem a <| mem_of_mem_permsOfList hg₁ _ <| by
              rw [eq_inv_mul_iff_mul_eq.2 hg₂, mul_apply, swap_inv, swap_apply_def]
              split_ifs <;> [exact Ne.symm hxy, exact Ne.symm hxa, exact hx]
#align mem_of_mem_perms_of_list mem_of_mem_permsOfList

theorem mem_permsOfList_iff {l : List α} {f : Perm α} :
    f ∈ permsOfList l ↔ ∀ {x}, f x ≠ x → x ∈ l :=
  ⟨mem_of_mem_permsOfList, mem_permsOfList_of_mem⟩
#align mem_perms_of_list_iff mem_permsOfList_iff

theorem nodup_permsOfList : ∀ {l : List α} (_ : l.Nodup), (permsOfList l).Nodup
  | [], _ => by simp [permsOfList]
  | a :: l, hl => by
    have hl' : l.Nodup := hl.of_cons
    have hln' : (permsOfList l).Nodup := nodup_permsOfList hl'
    have hmeml : ∀ {f : Perm α}, f ∈ permsOfList l → f a = a := fun {f} hf =>
      not_not.1 (mt (mem_of_mem_permsOfList hf _) (nodup_cons.1 hl).1)
    rw [permsOfList, List.nodup_append, List.nodup_bind, pairwise_iff_get]
    refine ⟨?_, ⟨⟨?_,?_ ⟩, ?_⟩⟩
    · exact hln'
    · exact fun _ _ => hln'.map fun _ _ => mul_left_cancel
    · intros i j hij x hx₁ hx₂
      let ⟨f, hf⟩ := List.mem_map.1 hx₁
      let ⟨g, hg⟩ := List.mem_map.1 hx₂
      have hix : x a = List.get l i := by
        rw [← hf.2, mul_apply, hmeml hf.1, swap_apply_left]
      have hiy : x a = List.get l j := by
        rw [← hg.2, mul_apply, hmeml hg.1, swap_apply_left]
      have hieqj : i = j := nodup_iff_injective_get.1 hl' (hix.symm.trans hiy)
      exact absurd hieqj (_root_.ne_of_lt hij)
    · intros f hf₁ hf₂
      let ⟨x, hx, hx'⟩ := List.mem_bind.1 hf₂
      let ⟨g, hg⟩ := List.mem_map.1 hx'
      have hgxa : g⁻¹ x = a := f.injective <| by rw [hmeml hf₁, ← hg.2]; simp
      have hxa : x ≠ a := fun h => (List.nodup_cons.1 hl).1 (h ▸ hx)
      exact  (List.nodup_cons.1 hl).1 <|
          hgxa ▸ mem_of_mem_permsOfList hg.1 _ (by rwa [apply_inv_self, hgxa])
#align nodup_perms_of_list nodup_permsOfList

/-- Given a finset, produce the finset of all permutations of its elements. -/
def permsOfFinset (s : Finset α) : Finset (Perm α) :=
  Quotient.hrecOn s.1 (fun l hl => ⟨permsOfList l, nodup_permsOfList hl⟩)
    (fun a b hab =>
      hfunext (congr_arg _ (Quotient.sound hab)) fun ha hb _ =>
        heq_of_eq <| Finset.ext <| by simp [mem_permsOfList_iff, hab.mem_iff])
    s.2
#align perms_of_finset permsOfFinset

theorem mem_perms_of_finset_iff :
    ∀ {s : Finset α} {f : Perm α}, f ∈ permsOfFinset s ↔ ∀ {x}, f x ≠ x → x ∈ s := by
  rintro ⟨⟨l⟩, hs⟩ f ; exact mem_permsOfList_iff
#align mem_perms_of_finset_iff mem_perms_of_finset_iff

theorem card_perms_of_finset : ∀ s : Finset α, (permsOfFinset s).card = s.card ! := by
  rintro ⟨⟨l⟩, hs⟩ ; exact length_permsOfList l
#align card_perms_of_finset card_perms_of_finset

/-- The collection of permutations of a fintype is a fintype. -/
def fintypePerm [Fintype α] : Fintype (Perm α) :=
  ⟨permsOfFinset (@Finset.univ α _), by simp [mem_perms_of_finset_iff]⟩
#align fintype_perm fintypePerm

instance equivFintype [Fintype α] [Fintype β] : Fintype (α ≃ β) :=
  if h : Fintype.card β = Fintype.card α then
    Trunc.recOnSubsingleton (Fintype.truncEquivFin α) fun eα =>
      Trunc.recOnSubsingleton (Fintype.truncEquivFin β) fun eβ =>
        @Fintype.ofEquiv _ (Perm α) fintypePerm
          (equivCongr (Equiv.refl α) (eα.trans (Eq.recOn h eβ.symm)) : α ≃ α ≃ (α ≃ β))
  else ⟨∅, fun x => False.elim (h (Fintype.card_eq.2 ⟨x.symm⟩))⟩

theorem Fintype.card_perm [Fintype α] : Fintype.card (Perm α) = (Fintype.card α)! :=
  Subsingleton.elim (@fintypePerm α _ _) (@equivFintype α α _ _ _ _) ▸ card_perms_of_finset _
#align fintype.card_perm Fintype.card_perm

theorem Fintype.card_equiv [Fintype α] [Fintype β] (e : α ≃ β) :
    Fintype.card (α ≃ β) = (Fintype.card α)! :=
  Fintype.card_congr (equivCongr (Equiv.refl α) e) ▸ Fintype.card_perm
#align fintype.card_equiv Fintype.card_equiv


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

! This file was ported from Lean 3 source module init.data.list.qsort
! leanprover-community/mathlib commit 4a03bdeb31b3688c31d02d7ff8e0ff2e5d6174db
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
prelude
import Leanbin.Init.Data.List.Lemmas
import Leanbin.Init.Wf

namespace List

-- Note: we can't use the equation compiler here because
-- init.meta.well_founded_tactics uses this file
def Qsort.f {α} (lt : α → α → Bool) :
    ∀ x : List α, (∀ y : List α, length y < length x → List α) → List α
  | [], IH => []
  | h :: t, IH =>
    by
    induction' e : partition (fun x => lt h x = tt) t with large small
    have : length Small < length (h :: t) ∧ length large < length (h :: t) :=
      by
      rw [partition_eq_filter_filter] at e
      injection e
      subst large
      subst Small
      constructor <;> exact Nat.succ_le_succ (length_le_of_sublist (filter_sublist _))
    exact IH Small this.left ++ h :: IH large this.right
#align list.qsort.F List.Qsort.f

/-- This is based on the minimalist Haskell "quicksort".

   Remark: this is *not* really quicksort since it doesn't partition the elements in-place -/
def qsort {α} (lt : α → α → Bool) : List α → List α :=
  WellFounded.fix (InvImage.wf length Nat.lt_wfRel) (Qsort.f lt)
#align list.qsort List.qsort

@[simp]
theorem qsort_nil {α} (lt : α → α → Bool) : qsort lt [] = [] := by
  rw [qsort, WellFounded.fix_eq, qsort.F]
#align list.qsort_nil List.qsort_nil

@[simp]
theorem qsort_cons {α} (lt : α → α → Bool) (h t) :
    qsort lt (h :: t) =
      let (large, Small) := partition (fun x => lt h x = true) t
      qsort lt Small ++ h :: qsort lt large :=
  by
  rw [qsort, WellFounded.fix_eq, qsort.F]
  induction' e : partition (fun x => lt h x = tt) t with large small
  simp [e]; rw [e]
#align list.qsort_cons List.qsort_cons

end List


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

import group_theory.subgroup.basic
import group_theory.group_action.basic
import order.order_dual

/-!

# Fixing submonoid, fixing subgroup of an action

In the presence of of an action of a monoid or a group,
this file defines the fixing submonoid or the fixing subgroup,
and relates it to the set of fixed points via a Galois connection.

## Main definitions

* `fixing_submonoid M s` : in the presence of `mul_action M α` (with `monoid M`)
  it is the `submonoid M` consisting of elements which fix `s : set α` pointwise.

* `fixing_submonoid_fixed_points_gc M α` is the `galois_connection`
  that relates `fixing_submonoid` with `fixed_points`.

* `fixing_subgroup M s` : in the presence of `mul_action M α` (with `group M`)
  it is the `subgroup M` consisting of elements which fix `s : set α` pointwise.

* `fixing_subgroup_fixed_points_gc M α` is the `galois_connection`
  that relates `fixing_subgroup` with `fixed_points`.

TODO :

* Maybe other lemmas are useful

* Treat semigroups ?

-/

section monoid

open mul_action

variables (M : Type*) {α : Type*} [monoid M] [mul_action M α]

/-- The submonoid fixing a set under a `mul_action`. -/
@[to_additive /-" The additive submonoid fixing a set under an `add_action`. "-/]
def fixing_submonoid (s : set α) : submonoid M :=
{ carrier := { ϕ : M | ∀ x : s, ϕ • (x : α) = x },
  one_mem' := λ _, one_smul _ _,
  mul_mem' := λ x y hx hy z, by rw [mul_smul, hy z, hx z], }

lemma mem_fixing_submonoid_iff {s : set α} {m : M} :
  m ∈ fixing_submonoid M s ↔ ∀ y ∈ s, m • y = y :=
⟨λ hg y hy, hg ⟨y, hy⟩, λ h ⟨y, hy⟩, h y hy⟩

variable (α)

/-- The Galois connection between fixing submonoids and fixed points of a monoid action -/
theorem fixing_submonoid_fixed_points_gc : galois_connection
  (order_dual.to_dual ∘ (fixing_submonoid M))
  ((λ P : submonoid M, (fixed_points P α)) ∘ order_dual.of_dual) :=
λ s P, ⟨λ h s hs p, h p.2 ⟨s, hs⟩, λ h p hp s, h s.2 ⟨p, hp⟩⟩

lemma fixing_submonoid_antitone : antitone (λ (s : set α), fixing_submonoid M s) :=
(fixing_submonoid_fixed_points_gc M α).monotone_l

lemma fixed_points_antitone :
  antitone (λ (P : submonoid M), fixed_points P α) :=
(fixing_submonoid_fixed_points_gc M α).monotone_u.dual_left

/-- Fixing submonoid of union is intersection -/
lemma fixing_submonoid_union {s t : set α} :
  fixing_submonoid M (s ∪ t) = fixing_submonoid M s ⊓ fixing_submonoid M t :=
(fixing_submonoid_fixed_points_gc M α).l_sup

/-- Fixing submonoid of Union is intersection -/
lemma fixing_submonoid_Union {ι : Sort*} {s : ι → set α} :
  fixing_submonoid M (⋃ i, s i) = ⨅ i, fixing_submonoid M (s i) :=
(fixing_submonoid_fixed_points_gc M α).l_supr

/-- Fixed points of sup of submonoids is intersection -/
lemma fixed_points_submonoid_sup {P Q : submonoid M} :
  fixed_points ↥(P ⊔ Q) α = fixed_points P α ∩ fixed_points Q α :=
(fixing_submonoid_fixed_points_gc M α).u_inf

/-- Fixed points of supr of submonoids is intersection -/
lemma fixed_points_submonoid_supr {ι : Sort*} {P : ι → submonoid M} :
  fixed_points ↥(supr P) α = ⋂ i, fixed_points (P i) α :=
(fixing_submonoid_fixed_points_gc M α).u_infi

end monoid

section group

open mul_action

variables (M : Type*) {α : Type*} [group M] [mul_action M α]

/-- The subgroup fixing a set under a `mul_action`. -/
@[to_additive /-" The additive subgroup fixing a set under an `add_action`. "-/]
def fixing_subgroup (s : set α) : subgroup M :=
{ inv_mem' := λ _ hx z, by rw [inv_smul_eq_iff, hx z],
  ..fixing_submonoid M s, }

lemma mem_fixing_subgroup_iff {s : set α} {m : M} :
  m ∈ fixing_subgroup M s ↔ ∀ y ∈ s, m • y = y :=
⟨λ hg y hy, hg ⟨y, hy⟩, λ h ⟨y, hy⟩, h y hy⟩

variable (α)

/-- The Galois connection between fixing subgroups and fixed points of a group action -/
lemma fixing_subgroup_fixed_points_gc : galois_connection
  (order_dual.to_dual ∘ fixing_subgroup M)
  ((λ P : subgroup M, fixed_points P α) ∘ order_dual.of_dual) :=
λ s P, ⟨λ h s hs p, h p.2 ⟨s, hs⟩, λ h p hp s, h s.2 ⟨p, hp⟩⟩

lemma fixing_subgroup_antitone : antitone (fixing_subgroup M : set α → subgroup M) :=
(fixing_subgroup_fixed_points_gc M α).monotone_l

lemma fixed_points_subgroup_antitone :
  antitone (λ (P : subgroup M), fixed_points P α) :=
(fixing_subgroup_fixed_points_gc M α).monotone_u.dual_left

/-- Fixing subgroup of union is intersection -/
lemma fixing_subgroup_union {s t : set α} :
  fixing_subgroup M (s ∪ t) = fixing_subgroup M s ⊓ fixing_subgroup M t :=
(fixing_subgroup_fixed_points_gc M α).l_sup

/-- Fixing subgroup of Union is intersection -/
lemma fixing_subgroup_Union {ι : Sort*} {s : ι → set α} :
  fixing_subgroup M (⋃ i, s i) = ⨅ i, fixing_subgroup M (s i) :=
(fixing_subgroup_fixed_points_gc M α).l_supr

/-- Fixed points of sup of subgroups is intersection -/
lemma fixed_points_subgroup_sup {P Q : subgroup M} :
  fixed_points ↥(P ⊔ Q) α = fixed_points P α ∩ fixed_points Q α :=
(fixing_subgroup_fixed_points_gc M α).u_inf

/-- Fixed points of supr of subgroups is intersection -/
lemma fixed_points_subgroup_supr {ι : Sort*} {P : ι → subgroup M} :
  fixed_points ↥(supr P) α = ⋂ i, fixed_points (P i) α :=
(fixing_subgroup_fixed_points_gc M α).u_infi

end group


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

section linear_ordered_field
variables {α : Type*} [linear_ordered_field α] {a b c d : α}

def div_pos := @div_pos_of_pos_of_pos

lemma inv_pos {a : α} : 0 < a → 0 < a⁻¹ :=
by rw [inv_eq_one_div]; exact div_pos zero_lt_one

lemma inv_lt_zero {a : α} : a < 0 → a⁻¹ < 0 :=
by rw [inv_eq_one_div]; exact div_neg_of_pos_of_neg zero_lt_one

lemma one_le_div_iff_le (hb : 0 < b) : 1 ≤ a / b ↔ b ≤ a :=
⟨le_of_one_le_div a hb, one_le_div_of_le a hb⟩

lemma one_lt_div_iff_lt (hb : 0 < b) : 1 < a / b ↔ b < a :=
⟨lt_of_one_lt_div a hb, one_lt_div_of_lt a hb⟩

lemma div_le_one_iff_le (hb : 0 < b) : a / b ≤ 1 ↔ a ≤ b :=
le_iff_le_iff_lt_iff_lt.2 (one_lt_div_iff_lt hb)

lemma div_lt_one_iff_lt (hb : 0 < b) : a / b < 1 ↔ a < b :=
lt_iff_lt_of_le_iff_le (one_le_div_iff_le hb)

lemma le_div_iff (hc : 0 < c) : a ≤ b / c ↔ a * c ≤ b :=
⟨mul_le_of_le_div hc, le_div_of_mul_le hc⟩

lemma le_div_iff' (hc : 0 < c) : a ≤ b / c ↔ c * a ≤ b :=
by rw [mul_comm, le_div_iff hc]

lemma div_le_iff (hb : 0 < b) : a / b ≤ c ↔ a ≤ c * b :=
⟨le_mul_of_div_le hb, by rw [mul_comm]; exact div_le_of_le_mul hb⟩

lemma div_le_iff' (hb : 0 < b) : a / b ≤ c ↔ a ≤ b * c :=
by rw [mul_comm, div_le_iff hb]

lemma lt_div_iff (hc : 0 < c) : a < b / c ↔ a * c < b :=
⟨mul_lt_of_lt_div hc, lt_div_of_mul_lt hc⟩

lemma lt_div_iff' (hc : 0 < c) : a < b / c ↔ c * a < b :=
by rw [mul_comm, lt_div_iff hc]

lemma div_le_iff_of_neg (hc : c < 0) : b / c ≤ a ↔ a * c ≤ b :=
⟨mul_le_of_div_le_of_neg hc, div_le_of_mul_le_of_neg hc⟩

lemma div_lt_iff (hc : 0 < c) : b / c < a ↔ b < a * c :=
lt_iff_lt_of_le_iff_le (le_div_iff hc)

lemma div_lt_iff' (hc : 0 < c) : b / c < a ↔ b < c * a :=
by rw [mul_comm, div_lt_iff hc]

lemma div_lt_iff_of_neg (hc : c < 0) : b / c < a ↔ a * c < b :=
⟨mul_lt_of_gt_div_of_neg hc, div_lt_of_mul_gt_of_neg hc⟩

lemma inv_le_inv (ha : 0 < a) (hb : 0 < b) : a⁻¹ ≤ b⁻¹ ↔ b ≤ a :=
by rw [inv_eq_one_div, div_le_iff ha,
       ← div_eq_inv_mul, one_le_div_iff_le hb]

lemma inv_le (ha : 0 < a) (hb : 0 < b) : a⁻¹ ≤ b ↔ b⁻¹ ≤ a :=
by rw [← inv_le_inv hb (inv_pos ha), division_ring.inv_inv (ne_of_gt ha)]

lemma le_inv (ha : 0 < a) (hb : 0 < b) : a ≤ b⁻¹ ↔ b ≤ a⁻¹ :=
by rw [← inv_le_inv (inv_pos hb) ha, division_ring.inv_inv (ne_of_gt hb)]

lemma one_div_le_one_div (ha : 0 < a) (hb : 0 < b) : 1 / a ≤ 1 / b ↔ b ≤ a :=
by simpa [one_div_eq_inv] using inv_le_inv ha hb

lemma inv_lt_inv (ha : 0 < a) (hb : 0 < b) : a⁻¹ < b⁻¹ ↔ b < a :=
lt_iff_lt_of_le_iff_le (inv_le_inv hb ha)

lemma inv_lt (ha : 0 < a) (hb : 0 < b) : a⁻¹ < b ↔ b⁻¹ < a :=
lt_iff_lt_of_le_iff_le (le_inv hb ha)

lemma lt_inv (ha : 0 < a) (hb : 0 < b) : a < b⁻¹ ↔ b < a⁻¹ :=
lt_iff_lt_of_le_iff_le (inv_le hb ha)

lemma one_div_lt_one_div (ha : 0 < a) (hb : 0 < b) : 1 / a < 1 / b ↔ b < a :=
lt_iff_lt_of_le_iff_le (one_div_le_one_div hb ha)

def div_nonneg := @div_nonneg_of_nonneg_of_pos

lemma div_lt_div_right (hc : 0 < c) : a / c < b / c ↔ a < b :=
⟨lt_imp_lt_of_le_imp_le (λ h, div_le_div_of_le_of_pos h hc),
 λ h, div_lt_div_of_lt_of_pos h hc⟩

lemma div_le_div_right (hc : 0 < c) : a / c ≤ b / c ↔ a ≤ b :=
le_iff_le_iff_lt_iff_lt.2 (div_lt_div_right hc)

lemma div_lt_div_right_of_neg (hc : c < 0) : a / c < b / c ↔ b < a :=
⟨lt_imp_lt_of_le_imp_le (λ h, div_le_div_of_le_of_neg h hc),
 λ h, div_lt_div_of_lt_of_neg h hc⟩

lemma div_le_div_right_of_neg (hc : c < 0) : a / c ≤ b / c ↔ b ≤ a :=
le_iff_le_iff_lt_iff_lt.2 (div_lt_div_right_of_neg hc)

lemma div_lt_div_left (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : a / b < a / c ↔ c < b :=
(mul_lt_mul_left ha).trans (inv_lt_inv hb hc)

lemma div_le_div_left (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : a / b ≤ a / c ↔ c ≤ b :=
le_iff_le_iff_lt_iff_lt.2 (div_lt_div_left ha hc hb)

lemma div_lt_div_iff (b0 : 0 < b) (d0 : 0 < d) :
  a / b < c / d ↔ a * d < c * b :=
by rw [lt_div_iff d0, div_mul_eq_mul_div, div_lt_iff b0]

lemma div_lt_div (hac : a < c) (hbd : d ≤ b) (c0 : 0 ≤ c) (d0 : 0 < d) :
  a / b < c / d :=
(div_lt_div_iff (lt_of_lt_of_le d0 hbd) d0).2 (mul_lt_mul hac hbd d0 c0)

lemma div_lt_div' (hac : a ≤ c) (hbd : d < b) (c0 : 0 < c) (d0 : 0 < d) :
  a / b < c / d :=
(div_lt_div_iff (lt_trans d0 hbd) d0).2 (mul_lt_mul' hac hbd (le_of_lt d0) c0)

lemma half_pos {a : α} (h : 0 < a) : 0 < a / 2 := div_pos h two_pos

lemma one_half_pos : (0:α) < 1 / 2 := half_pos zero_lt_one

def half_lt_self := @div_two_lt_of_pos

lemma one_half_lt_one : (1 / 2 : α) < 1 := half_lt_self zero_lt_one

lemma ivl_translate : (λx, x + c) '' {r:α | a ≤ r ∧ r ≤ b } = {r:α | a + c ≤ r ∧ r ≤ b + c} :=
calc (λx, x + c) '' {r | a ≤ r ∧ r ≤ b } = (λx, x - c) ⁻¹' {r | a ≤ r ∧ r ≤ b } :
    congr_fun (set.image_eq_preimage_of_inverse
      (assume a, add_sub_cancel a c) (assume b, sub_add_cancel b c)) _
  ... = {r | a + c ≤ r ∧ r ≤ b + c} :
    set.ext $ by simp [-sub_eq_add_neg, le_sub_iff_add_le, sub_le_iff_le_add]

lemma ivl_stretch (hc : 0 < c) : (λx, x * c) '' {r | a ≤ r ∧ r ≤ b } = {r | a * c ≤ r ∧ r ≤ b * c} :=
calc (λx, x * c) '' {r | a ≤ r ∧ r ≤ b } = (λx, x / c) ⁻¹' {r | a ≤ r ∧ r ≤ b } :
    congr_fun (set.image_eq_preimage_of_inverse
      (assume a, mul_div_cancel _ $ ne_of_gt hc) (assume b, div_mul_cancel _ $ ne_of_gt hc)) _
  ... = {r | a * c ≤ r ∧ r ≤ b * c} :
    set.ext $ by simp [le_div_iff, div_le_iff, hc]

instance linear_ordered_field.to_densely_ordered [linear_ordered_field α] : densely_ordered α :=
{ dense := assume a₁ a₂ h, ⟨(a₁ + a₂) / 2,
  calc a₁ = (a₁ + a₁) / 2 : (add_self_div_two a₁).symm
    ... < (a₁ + a₂) / 2 : div_lt_div_of_lt_of_pos (add_lt_add_left h _) two_pos,
  calc (a₁ + a₂) / 2 < (a₂ + a₂) / 2 : div_lt_div_of_lt_of_pos (add_lt_add_right h _) two_pos
    ... = a₂ : add_self_div_two a₂⟩ }

instance linear_ordered_field.to_no_top_order [linear_ordered_field α] : no_top_order α :=
{ no_top := assume a, ⟨a + 1, lt_add_of_le_of_pos (le_refl a) zero_lt_one ⟩ }

instance linear_ordered_field.to_no_bot_order [linear_ordered_field α] : no_bot_order α :=
{ no_bot := assume a, ⟨a + -1,
    add_lt_of_le_of_neg (le_refl _) (neg_lt_of_neg_lt $ by simp [zero_lt_one]) ⟩ }

lemma inv_lt_one {a : α} (ha : 1 < a) : a⁻¹ < 1 :=
by rw [inv_eq_one_div]; exact div_lt_of_mul_lt_of_pos (lt_trans zero_lt_one ha) (by simp *)

lemma one_lt_inv (h₁ : 0 < a) (h₂ : a < 1) : 1 < a⁻¹ :=
by rw [inv_eq_one_div, lt_div_iff h₁]; simp [h₂]

lemma inv_le_one {a : α} (ha : 1 ≤ a) : a⁻¹ ≤ 1 :=
by rw [inv_eq_one_div]; exact div_le_of_le_mul (lt_of_lt_of_le zero_lt_one ha) (by simp *)

lemma one_le_inv {x : α} (hx0 : 0 < x) (hx : x ≤ 1) : 1 ≤ x⁻¹ :=
le_of_mul_le_mul_left (by simpa [mul_inv_cancel (ne.symm (ne_of_lt hx0))]) hx0

lemma mul_self_inj_of_nonneg {a b : α} (a0 : 0 ≤ a) (b0 : 0 ≤ b) : a * a = b * b ↔ a = b :=
(mul_self_eq_mul_self_iff a b).trans $ or_iff_left_of_imp $
λ h, by subst a; rw [le_antisymm (neg_nonneg.1 a0) b0, neg_zero]

lemma div_le_div_of_le_left {a b c : α} (ha : 0 ≤ a) (hb : 0 < b) (hc : 0 < c) (h : c ≤ b) :
  a / b ≤ a / c :=
by haveI := classical.dec_eq α; exact
if ha0 : a = 0 then by simp [ha0]
else (div_le_div_left (lt_of_le_of_ne ha (ne.symm ha0)) hb hc).2 h

end linear_ordered_field

section
variables {α : Type*} [discrete_linear_ordered_field α] (a b c : α)

lemma inv_pos' {a : α} : 0 < a⁻¹ ↔ 0 < a :=
⟨by rw [inv_eq_one_div]; exact pos_of_one_div_pos, inv_pos⟩

lemma inv_neg' {a : α} : a⁻¹ < 0 ↔ a < 0 :=
⟨by rw [inv_eq_one_div]; exact neg_of_one_div_neg, inv_lt_zero⟩

lemma inv_nonneg {a : α} : 0 ≤ a⁻¹ ↔ 0 ≤ a :=
le_iff_le_iff_lt_iff_lt.2 inv_neg'

lemma inv_nonpos {a : α} : a⁻¹ ≤ 0 ↔ a ≤ 0 :=
le_iff_le_iff_lt_iff_lt.2 inv_pos'

lemma abs_inv : abs a⁻¹ = (abs a)⁻¹ :=
have h : abs (1 / a) = 1 / abs a,
  begin rw [abs_div, abs_of_nonneg], exact zero_le_one end,
by simp [*] at *

lemma inv_neg : (-a)⁻¹ = -(a⁻¹) :=
if h : a = 0
then by simp [h, inv_zero]
else by rwa [inv_eq_one_div, inv_eq_one_div, div_neg_eq_neg_div]

lemma inv_le_inv_of_le {a b : α} (hb : 0 < b) (h : b ≤ a) : a⁻¹ ≤ b⁻¹ :=
begin
  rw [inv_eq_one_div, inv_eq_one_div],
  exact one_div_le_one_div_of_le hb h
end

lemma div_nonneg' {a b : α} (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a / b :=
(lt_or_eq_of_le hb).elim (div_nonneg ha) (λ h, by simp [h.symm])

end


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

! This file was ported from Lean 3 source module ring_theory.jacobson
! leanprover-community/mathlib commit 6ca1a09bc9aa75824bf97388c9e3b441fc4ccf3f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.Localization.Away
import Mathbin.RingTheory.Ideal.Over
import Mathbin.RingTheory.JacobsonIdeal

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

section IsJacobson

variable {R S : Type _} [CommRing R] [CommRing 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 IsJacobson (R : Type _) [CommRing R] : Prop where
  out' : ∀ I : Ideal R, I.IsRadical → I.jacobson = I
#align ideal.is_jacobson Ideal.IsJacobson

theorem isJacobson_iff {R} [CommRing R] :
    IsJacobson R ↔ ∀ I : Ideal R, I.IsRadical → I.jacobson = I :=
  ⟨fun h => h.1, fun h => ⟨h⟩⟩
#align ideal.is_jacobson_iff Ideal.isJacobson_iff

theorem IsJacobson.out {R} [CommRing R] :
    IsJacobson R → ∀ {I : Ideal R}, I.IsRadical → I.jacobson = I :=
  isJacobson_iff.1
#align ideal.is_jacobson.out Ideal.IsJacobson.out

/-- A ring is a Jacobson ring if and only if for all prime ideals `P`,
 the Jacobson radical of `P` is equal to `P`. -/
theorem isJacobson_iff_prime_eq : IsJacobson R ↔ ∀ P : Ideal R, IsPrime P → P.jacobson = P :=
  by
  refine' is_jacobson_iff.trans ⟨fun h I hI => h I hI.IsRadical, _⟩
  refine' fun h I hI => le_antisymm (fun x hx => _) fun x hx => mem_Inf.mpr fun _ hJ => hJ.left hx
  rw [← hI.radical, radical_eq_Inf I, mem_Inf]
  intro P hP
  rw [Set.mem_setOf_eq] at hP
  erw [mem_Inf] at hx
  erw [← h P hP.right, mem_Inf]
  exact fun J hJ => hx ⟨le_trans hP.left hJ.left, hJ.right⟩
#align ideal.is_jacobson_iff_prime_eq Ideal.isJacobson_iff_prime_eq

/-- 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. -/
theorem isJacobson_iff_infₛ_maximal :
    IsJacobson R ↔
      ∀ {I : Ideal R},
        I.IsPrime → ∃ M : Set (Ideal R), (∀ J ∈ M, IsMaximal J ∨ J = ⊤) ∧ I = infₛ M :=
  ⟨fun H I h => eq_jacobson_iff_infₛ_maximal.1 (H.out h.IsRadical), fun H =>
    isJacobson_iff_prime_eq.2 fun P hP => eq_jacobson_iff_infₛ_maximal.2 (H hP)⟩
#align ideal.is_jacobson_iff_Inf_maximal Ideal.isJacobson_iff_infₛ_maximal

theorem isJacobson_iff_infₛ_maximal' :
    IsJacobson R ↔
      ∀ {I : Ideal R},
        I.IsPrime → ∃ M : Set (Ideal R), (∀ J ∈ M, ∀ (K : Ideal R), J < K → K = ⊤) ∧ I = infₛ M :=
  ⟨fun H I h => eq_jacobson_iff_infₛ_maximal'.1 (H.out h.IsRadical), fun H =>
    isJacobson_iff_prime_eq.2 fun P hP => eq_jacobson_iff_infₛ_maximal'.2 (H hP)⟩
#align ideal.is_jacobson_iff_Inf_maximal' Ideal.isJacobson_iff_infₛ_maximal'

theorem radical_eq_jacobson [H : IsJacobson R] (I : Ideal R) : I.radical = I.jacobson :=
  le_antisymm (le_infₛ fun J ⟨hJ, hJ_max⟩ => (IsPrime.radical_le_iff hJ_max.IsPrime).mpr hJ)
    (H.out (radical_isRadical I) ▸ jacobson_mono le_radical)
#align ideal.radical_eq_jacobson Ideal.radical_eq_jacobson

/-- Fields have only two ideals, and the condition holds for both of them.  -/
instance (priority := 100) isJacobson_field {K : Type _} [Field K] : IsJacobson K :=
  ⟨fun I hI =>
    Or.rec_on (eq_bot_or_top I)
      (fun h => le_antisymm (infₛ_le ⟨le_rfl, h.symm ▸ bot_isMaximal⟩) (h.symm ▸ bot_le)) fun h =>
      by rw [h, jacobson_eq_top_iff]⟩
#align ideal.is_jacobson_field Ideal.isJacobson_field

theorem isJacobson_of_surjective [H : IsJacobson R] :
    (∃ f : R →+* S, Function.Surjective f) → IsJacobson S :=
  by
  rintro ⟨f, hf⟩
  rw [is_jacobson_iff_Inf_maximal]
  intro p hp
  use map f '' { J : Ideal R | comap f p ≤ J ∧ J.IsMaximal }
  use fun 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 fun J ⟨hJ, _⟩ => le_trans (Ideal.ker_le_comap f) hJ)
#align ideal.is_jacobson_of_surjective Ideal.isJacobson_of_surjective

instance (priority := 100) isJacobson_quotient [IsJacobson R] : IsJacobson (R ⧸ I) :=
  isJacobson_of_surjective ⟨Quotient.mk I, by rintro ⟨x⟩ <;> use x <;> rfl⟩
#align ideal.is_jacobson_quotient Ideal.isJacobson_quotient

theorem isJacobson_iso (e : R ≃+* S) : IsJacobson R ↔ IsJacobson S :=
  ⟨fun h => @isJacobson_of_surjective _ _ _ _ h ⟨(e : R →+* S), e.Surjective⟩, fun h =>
    @isJacobson_of_surjective _ _ _ _ h ⟨(e.symm : S →+* R), e.symm.Surjective⟩⟩
#align ideal.is_jacobson_iso Ideal.isJacobson_iso

theorem isJacobson_of_isIntegral [Algebra R S] (hRS : Algebra.IsIntegral R S) (hR : IsJacobson R) :
    IsJacobson S := by
  rw [is_jacobson_iff_prime_eq]
  intro P hP
  by_cases hP_top : comap (algebraMap R S) P = ⊤
  · simp [comap_eq_top_iff.1 hP_top]
  · haveI : Nontrivial (R ⧸ comap (algebraMap R S) P) := quotient.nontrivial hP_top
    rw [jacobson_eq_iff_jacobson_quotient_eq_bot]
    refine' eq_bot_of_comap_eq_bot (isIntegral_quotient_of_isIntegral hRS) _
    rw [eq_bot_iff, ←
      jacobson_eq_iff_jacobson_quotient_eq_bot.1
        ((is_jacobson_iff_prime_eq.1 hR) (comap (algebraMap R S) P) (comap_is_prime _ _)),
      comap_jacobson]
    refine' infₛ_le_infₛ fun J hJ => _
    simp only [true_and_iff, Set.mem_image, bot_le, Set.mem_setOf_eq]
    have : J.is_maximal := by simpa using hJ
    exact
      exists_ideal_over_maximal_of_is_integral (isIntegral_quotient_of_isIntegral hRS) J
        (comap_bot_le_of_injective _ algebra_map_quotient_injective)
#align ideal.is_jacobson_of_is_integral Ideal.isJacobson_of_isIntegral

theorem isJacobson_of_is_integral' (f : R →+* S) (hf : f.IsIntegral) (hR : IsJacobson R) :
    IsJacobson S :=
  @isJacobson_of_isIntegral _ _ _ _ f.toAlgebra hf hR
#align ideal.is_jacobson_of_is_integral' Ideal.isJacobson_of_is_integral'

end IsJacobson

section Localization

open IsLocalization Submonoid

variable {R S : Type _} [CommRing R] [CommRing S] {I : Ideal R}

variable (y : R) [Algebra R S] [IsLocalization.Away y S]

theorem disjoint_powers_iff_not_mem (hI : I.IsRadical) :
    Disjoint (Submonoid.powers y : Set R) ↑I ↔ y ∉ I.1 :=
  by
  refine'
    ⟨fun h => Set.disjoint_left.1 h (mem_powers _), fun h => disjoint_iff.mpr (eq_bot_iff.mpr _)⟩
  rintro x ⟨⟨n, rfl⟩, hx'⟩
  exact h (hI <| mem_radical_of_pow_mem <| le_radical hx')
#align ideal.disjoint_powers_iff_not_mem Ideal.disjoint_powers_iff_not_mem

variable (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 -/
theorem isMaximal_iff_isMaximal_disjoint [H : IsJacobson R] (J : Ideal S) :
    J.IsMaximal ↔ (comap (algebraMap R S) J).IsMaximal ∧ y ∉ Ideal.comap (algebraMap R S) J :=
  by
  constructor
  · refine' fun h =>
      ⟨_, fun hy =>
        h.ne_top (Ideal.eq_top_of_isUnit_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 (algebraMap 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 (algebraMap 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 (algebraMap R S) I).IsPrime :=
        by
        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 (algebraMap 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' fun h => ⟨⟨fun hJ => h.1.ne_top (eq_top_iff.2 _), fun I hI => _⟩⟩
    · rwa [eq_top_iff, ← (IsLocalization.orderEmbedding (powers y) S).le_iff_le] at hJ
    · have := congr_arg (map (algebraMap R S)) (h.1.1.2 _ ⟨comap_mono (le_of_lt hI), _⟩)
      rwa [map_comap (powers y) S I, map_top] at this
      refine' fun hI' => hI.right _
      rw [← map_comap (powers y) S I, ← map_comap (powers y) S J]
      exact map_mono hI'
#align ideal.is_maximal_iff_is_maximal_disjoint Ideal.isMaximal_iff_isMaximal_disjoint

variable {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 -/
theorem isMaximal_of_isMaximal_disjoint [IsJacobson R] (I : Ideal R) (hI : I.IsMaximal)
    (hy : y ∉ I) : (map (algebraMap R S) I).IsMaximal :=
  by
  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⟩
#align ideal.is_maximal_of_is_maximal_disjoint Ideal.isMaximal_of_isMaximal_disjoint

/-- 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 orderIsoOfMaximal [IsJacobson R] :
    { p : Ideal S // p.IsMaximal } ≃o { p : Ideal R // p.IsMaximal ∧ y ∉ p }
    where
  toFun p := ⟨Ideal.comap (algebraMap R S) p.1, (isMaximal_iff_isMaximal_disjoint S y p.1).1 p.2⟩
  invFun p := ⟨Ideal.map (algebraMap R S) p.1, isMaximal_of_isMaximal_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_isPrime_disjoint _ _ I.1 (IsMaximal.isPrime I.2.1)
        ((disjoint_powers_iff_not_mem y I.2.1.IsPrime.IsRadical).2 I.2.2))
  map_rel_iff' I I' :=
    ⟨fun 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,
      fun h x hx => h hx⟩
#align ideal.order_iso_of_maximal Ideal.orderIsoOfMaximal

include y

/-- If `S` is the localization of the Jacobson ring `R` at the submonoid generated by `y : R`, then
`S` is Jacobson. -/
theorem isJacobson_localization [H : IsJacobson R] : IsJacobson S :=
  by
  rw [is_jacobson_iff_prime_eq]
  refine' fun P' hP' => le_antisymm _ le_jacobson
  obtain ⟨hP', hPM⟩ := (IsLocalization.isPrime_iff_isPrime_disjoint (powers y) S P').mp hP'
  have hP := H.out hP'.is_radical
  refine'
    (IsLocalization.map_comap (powers y) S P'.jacobson).ge.trans
      ((map_mono _).trans (IsLocalization.map_comap (powers y) S P').le)
  have :
    Inf { I : Ideal R | comap (algebraMap R S) P' ≤ I ∧ I.IsMaximal ∧ y ∉ I } ≤
      comap (algebraMap R S) P' :=
    by
    intro x hx
    have hxy : x * y ∈ (comap (algebraMap R S) P').jacobson :=
      by
      rw [Ideal.jacobson, mem_Inf]
      intro 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_infᵢ]
  refine' infᵢ_le_infᵢ_of_subset fun I hI => ⟨map (algebraMap R S) I, ⟨_, _⟩⟩
  ·
    exact
      ⟨le_trans (le_of_eq (IsLocalization.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
      IsLocalization.comap_map_of_isPrime_disjoint _ S I (is_maximal.is_prime hI.2.1)
        ((disjoint_powers_iff_not_mem y hI.2.1.IsPrime.IsRadical).2 hI.2.2)
#align ideal.is_jacobson_localization Ideal.isJacobson_localization

end Localization

namespace Polynomial

open Polynomial

section CommRing

variable {R S : Type _} [CommRing R] [CommRing S] [IsDomain S]

variable {Rₘ Sₘ : Type _} [CommRing Rₘ] [CommRing 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. -/
theorem isIntegral_isLocalization_polynomial_quotient (P : Ideal R[X]) (pX : R[X]) (hpX : pX ∈ P)
    [Algebra (R ⧸ P.comap (C : R →+* _)) Rₘ]
    [IsLocalization.Away (pX.map (Quotient.mk (P.comap (C : R →+* R[X])))).leadingCoeff Rₘ]
    [Algebra (R[X] ⧸ P) Sₘ]
    [IsLocalization
        ((Submonoid.powers (pX.map (Quotient.mk (P.comap (C : R →+* R[X])))).leadingCoeff).map
            (quotientMap P C le_rfl) :
          Submonoid (R[X] ⧸ P))
        Sₘ] :
    (IsLocalization.map Sₘ (quotientMap P C le_rfl)
          (Submonoid.powers
              (pX.map (Quotient.mk (P.comap (C : R →+* R[X])))).leadingCoeff).le_comap_map :
        Rₘ →+* _).IsIntegral :=
  by
  let P' : Ideal R := P.comap C
  let M : Submonoid (R ⧸ P') :=
    Submonoid.powers (pX.map (Quotient.mk' (P.comap (C : R →+* R[X])))).leadingCoeff
  let M' : Submonoid (R[X] ⧸ P) :=
    (Submonoid.powers (pX.map (Quotient.mk' (P.comap (C : R →+* R[X])))).leadingCoeff).map
      (QuotientMap P C le_rfl)
  let φ : R ⧸ P' →+* R[X] ⧸ P := QuotientMap P C le_rfl
  let φ' : Rₘ →+* Sₘ := IsLocalization.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⟩ := IsLocalization.surj M' p
  suffices φ'.is_integral_elem (algebraMap _ _ p')
    by
    obtain ⟨q', hq', rfl⟩ := hq
    obtain ⟨q'', hq''⟩ := isUnit_iff_exists_inv'.1 (IsLocalization.map_units Rₘ (⟨q', hq'⟩ : M))
    refine' φ'.is_integral_of_is_integral_mul_unit p (algebraMap _ _ (φ q')) q'' _ (hp.symm ▸ this)
    convert trans (trans (φ'.map_mul _ _).symm (congr_arg φ' hq'')) φ'.map_one using 2
    rw [← φ'.comp_apply, IsLocalization.map_comp, RingHom.comp_apply, Subtype.coe_mk]
  refine'
    is_integral_of_mem_closure''
      ((algebraMap _ Sₘ).comp (Quotient.mk' P) '' insert X { p | p.degree ≤ 0 }) _ _ _
  · rintro x ⟨p, hp, rfl⟩
    refine' hp.rec_on (fun hy => _) fun 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_setOf_eq, degree_le_zero_iff] at hy
      refine' hy.symm ▸ ⟨X - C (algebraMap _ _ ((Quotient.mk' P') (p.coeff 0))), monic_X_sub_C _, _⟩
      simp only [eval₂_sub, eval₂_C, eval₂_X]
      rw [sub_eq_zero, ← φ'.comp_apply, IsLocalization.map_comp]
      rfl
  · obtain ⟨p, rfl⟩ := quotient.mk_surjective p'
    refine'
      Polynomial.induction_on p
        (fun r => Subring.subset_closure <| Set.mem_image_of_mem _ (Or.inr degree_C_le))
        (fun _ _ h1 h2 => _) fun n _ hr => _
    · convert Subring.add_mem _ h1 h2
      rw [RingHom.map_add, RingHom.map_add]
    · rw [pow_succ X n, mul_comm X, ← mul_assoc, RingHom.map_mul, RingHom.map_mul]
      exact Subring.mul_mem _ hr (Subring.subset_closure (Set.mem_image_of_mem _ (Or.inl rfl)))
#align ideal.polynomial.is_integral_is_localization_polynomial_quotient Ideal.Polynomial.isIntegral_isLocalization_polynomial_quotient

/-- 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 -/
theorem jacobson_bot_of_integral_localization {R : Type _} [CommRing R] [IsDomain R] [IsJacobson R]
    (Rₘ Sₘ : Type _) [CommRing Rₘ] [CommRing Sₘ] (φ : R →+* S) (hφ : Function.Injective φ) (x : R)
    (hx : x ≠ 0) [Algebra R Rₘ] [IsLocalization.Away x Rₘ] [Algebra S Sₘ]
    [IsLocalization ((Submonoid.powers x).map φ : Submonoid S) Sₘ]
    (hφ' :
      RingHom.IsIntegral (IsLocalization.map Sₘ φ (Submonoid.powers x).le_comap_map : Rₘ →+* Sₘ)) :
    (⊥ : Ideal S).jacobson = (⊥ : Ideal S) :=
  by
  have hM : ((Submonoid.powers x).map φ : Submonoid S) ≤ nonZeroDivisors S :=
    map_le_nonZeroDivisors_of_injective φ hφ (powers_le_nonZeroDivisors_of_noZeroDivisors hx)
  letI : IsDomain Sₘ := IsLocalization.isDomain_of_le_nonZeroDivisors _ hM
  let φ' : Rₘ →+* Sₘ := IsLocalization.map _ φ (Submonoid.powers x).le_comap_map
  suffices ∀ I : Ideal Sₘ, I.IsMaximal → (I.comap (algebraMap S Sₘ)).IsMaximal
    by
    have hϕ' : comap (algebraMap S Sₘ) (⊥ : Ideal Sₘ) = (⊥ : Ideal S) :=
      by
      rw [← RingHom.ker_eq_comap_bot, ← RingHom.injective_iff_ker_eq_bot]
      exact IsLocalization.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ₛ fun j hj =>
        ⟨bot_le,
          let ⟨J, hJ⟩ := hj
          hJ.2 ▸ this J hJ.1.2⟩
  intro I hI
  -- Remainder of the proof is pulling and pushing ideals around the square and the quotient square
  haveI : (I.comap (algebraMap S Sₘ)).IsPrime := comap_is_prime _ I
  haveI : (I.comap φ').IsPrime := comap_is_prime φ' I
  haveI : (⊥ : Ideal (S ⧸ I.comap (algebraMap S Sₘ))).IsPrime := bot_prime
  have hcomm : φ'.comp (algebraMap R Rₘ) = (algebraMap S Sₘ).comp φ := IsLocalization.map_comp _
  let f := QuotientMap (I.comap (algebraMap S Sₘ)) φ le_rfl
  let g := QuotientMap I (algebraMap 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 (algebraMap S Sₘ)).comap φ).IsMaximal := by
    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 ▸
        RingHom.isIntegral_trans _ _
          (RingHom.isIntegral_of_surjective _
            (IsLocalization.surjective_quotientMap_of_maximal_of_localization (Submonoid.powers x)
              Rₘ (by rwa [comap_comap, hcomm, ← bot_quotient_is_maximal_iff])))
          (RingHom.isIntegral_quotient_of_isIntegral _ hφ'))
#align ideal.polynomial.jacobson_bot_of_integral_localization Ideal.Polynomial.jacobson_bot_of_integral_localization

/-- 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 theorem is_jacobson_polynomial_of_domain (R : Type _) [CommRing R] [IsDomain R]
    [hR : IsJacobson R] (P : Ideal R[X]) [IsPrime P] (hP : ∀ x : R, C x ∈ P → x = 0) :
    P.jacobson = P := by
  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])).IsPrime := 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).leadingCoeff
    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)))
        (QuotientMap 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
#align ideal.polynomial.is_jacobson_polynomial_of_domain ideal.polynomial.is_jacobson_polynomial_of_domain

theorem isJacobson_polynomial_of_isJacobson (hR : IsJacobson R) : IsJacobson R[X] :=
  by
  refine' is_jacobson_iff_prime_eq.mpr fun I => _
  intro 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).rangeRestrict_surjective
  have hi' : (Polynomial.mapRingHom i : R[X] →+* R'[X]).ker ≤ I :=
    by
    refine' fun f hf => polynomial_mem_ideal_of_coeff_mem_ideal I f fun n => _
    replace hf := congr_arg (fun 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, ← RingHom.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.mapRingHom i)).jacobson = I.map (Polynomial.mapRingHom i)
    by
    replace this := congr_arg (comap (Polynomial.mapRingHom 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)
#align ideal.polynomial.is_jacobson_polynomial_of_is_jacobson Ideal.Polynomial.isJacobson_polynomial_of_isJacobson

theorem isJacobson_polynomial_iff_isJacobson : IsJacobson R[X] ↔ IsJacobson R :=
  by
  refine' ⟨_, is_jacobson_polynomial_of_is_jacobson⟩
  intro H
  exact
    is_jacobson_of_surjective
      ⟨eval₂_ring_hom (RingHom.id _) 1, fun x =>
        ⟨C x, by simp only [coe_eval₂_ring_hom, RingHom.id_apply, eval₂_C]⟩⟩
#align ideal.polynomial.is_jacobson_polynomial_iff_is_jacobson Ideal.Polynomial.isJacobson_polynomial_iff_isJacobson

instance [IsJacobson R] : IsJacobson R[X] :=
  isJacobson_polynomial_iff_isJacobson.mpr ‹IsJacobson R›

end CommRing

section

variable {R : Type _} [CommRing R] [IsJacobson R]

variable (P : Ideal R[X]) [hP : P.IsMaximal]

include P hP

theorem isMaximal_comap_c_of_isMaximal [Nontrivial R] (hP' : ∀ x : R, C x ∈ P → x = 0) :
    IsMaximal (comap (C : R →+* R[X]) P : Ideal R) :=
  by
  haveI hp'_prime : (P.comap (C : R →+* R[X]) : Ideal R).IsPrime := 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 := QuotientMap 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))).leadingCoeff
  rw [← bot_quotient_is_maximal_iff]
  have hp0 :
    ((m : R[X]).map (Quotient.mk' (P.comap (C : R →+* R[X]) : Ideal R))).leadingCoeff ≠ 0 :=
    fun 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
          fun 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 := fun ⟨n, hn⟩ => hp0 (pow_eq_zero hn)
  suffices (⊥ : Ideal (Localization M)).IsMaximal
    by
    rw [←
      IsLocalization.comap_map_of_isPrime_disjoint M (Localization M) ⊥ bot_prime
        (disjoint_iff_inf_le.mpr fun 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.isLocalization
  let M' : Submonoid (R[X] ⧸ P) := M.map φ
  have hM' : (0 : R[X] ⧸ P) ∉ M' := fun ⟨z, hz⟩ =>
    hM (quotient_map_injective (trans hz.2 φ.map_zero.symm) ▸ hz.1)
  haveI : IsDomain (Localization M') :=
    IsLocalization.isDomain_localization (le_nonZeroDivisors_of_noZeroDivisors hM')
  suffices (⊥ : Ideal (Localization M')).IsMaximal
    by
    rw [le_antisymm bot_le
        (comap_bot_le_of_injective _
          (IsLocalization.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 (algebraMap (R[X] ⧸ P) (Localization M')) ⊥)]
  let bot_maximal := (bot_quotient_is_maximal_iff _).mpr hP
  refine' map.is_maximal (algebraMap _ _) (IsField.localization_map_bijective hM' _) bot_maximal
  rwa [← quotient.maximal_ideal_iff_is_field_quotient, ← bot_quotient_is_maximal_iff]
#align ideal.polynomial.is_maximal_comap_C_of_is_maximal Ideal.Polynomial.isMaximal_comap_c_of_isMaximal

/-- Used to bootstrap the more general `quotient_mk_comp_C_is_integral_of_jacobson` -/
private theorem quotient_mk_comp_C_is_integral_of_jacobson' [Nontrivial R] (hR : IsJacobson R)
    (hP' : ∀ x : R, C x ∈ P → x = 0) : ((Quotient.mk P).comp C : R →+* R[X] ⧸ P).IsIntegral :=
  by
  refine' (isIntegral_quotientMap_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')).leadingCoeff
  let φ : R ⧸ P' →+* R[X] ⧸ P := QuotientMap P C le_rfl
  haveI hp'_prime : P'.is_prime := comap_is_prime C P
  have hM : (0 : R ⧸ P') ∉ M := fun ⟨n, hn⟩ => hp0 <| leading_coeff_eq_zero.mp (pow_eq_zero hn)
  let M' : Submonoid (R[X] ⧸ P) := M.map (QuotientMap P C le_rfl)
  refine'
    (QuotientMap P C le_rfl).isIntegral_tower_bot_of_isIntegral (algebraMap _ (Localization M')) _ _
  · refine'
      IsLocalization.injective (Localization M')
        (show M' ≤ _ from le_nonZeroDivisors_of_noZeroDivisors fun hM' => hM _)
    exact
      let ⟨z, zM, z0⟩ := hM'
      quotient_map_injective (trans z0 φ.map_zero.symm) ▸ zM
  · rw [← IsLocalization.map_comp M.le_comap_map]
    refine'
      RingHom.isIntegral_trans (algebraMap (R ⧸ P') (Localization M))
        (IsLocalization.map (Localization M') _ M.le_comap_map) _ _
    ·
      exact
        (algebraMap (R ⧸ P') (Localization M)).isIntegral_of_surjective
          (IsField.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
#align ideal.polynomial.quotient_mk_comp_C_is_integral_of_jacobson' ideal.polynomial.quotient_mk_comp_C_is_integral_of_jacobson'

/-- If `R` is a Jacobson ring, and `P` is a maximal ideal of `R[X]`,
  then `R → R[X]/P` is an integral map. -/
theorem quotient_mk_comp_c_isIntegral_of_jacobson :
    ((Quotient.mk P).comp C : R →+* R[X] ⧸ P).IsIntegral :=
  by
  let P' : Ideal R := P.comap C
  haveI : P'.is_prime := comap_is_prime C P
  let f : R[X] →+* Polynomial (R ⧸ P') := Polynomial.mapRingHom (Quotient.mk' P')
  have hf : Function.Surjective f := map_surjective (Quotient.mk' P') quotient.mk_surjective
  have hPJ : P = (P.map f).comap f :=
    by
    rw [comap_map_of_surjective _ hf]
    refine' le_antisymm (le_sup_of_le_left le_rfl) (sup_le le_rfl _)
    refine' fun p hp =>
      polynomial_mem_ideal_of_coeff_mem_ideal P p fun n => quotient.eq_zero_iff_mem.mp _
    simpa only [coeff_map, coe_map_ring_hom] using (polynomial.ext_iff.mp hp) n
  refine' RingHom.isIntegral_tower_bot_of_isIntegral _ _ (injective_quotient_le_comap_map P) _
  rw [← quotient_mk_maps_eq]
  refine'
    RingHom.isIntegral_trans _ _ ((Quotient.mk' P').isIntegral_of_surjective quotient.mk_surjective)
      _
  apply quotient_mk_comp_C_is_integral_of_jacobson' _ _ fun x hx => _
  any_goals exact Ideal.isJacobson_quotient
  ·
    exact
      Or.rec_on (map_eq_top_or_is_maximal_of_surjective f hf hP)
        (fun h => absurd (trans (h ▸ hPJ : P = comap f ⊤) comap_top : P = ⊤) hP.ne_top) id
  · infer_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]
#align ideal.polynomial.quotient_mk_comp_C_is_integral_of_jacobson Ideal.Polynomial.quotient_mk_comp_c_isIntegral_of_jacobson

theorem isMaximal_comap_c_of_isJacobson : (P.comap (C : R →+* R[X])).IsMaximal :=
  by
  rw [← @mk_ker _ _ P, RingHom.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)
#align ideal.polynomial.is_maximal_comap_C_of_is_jacobson Ideal.Polynomial.isMaximal_comap_c_of_isJacobson

omit P hP

theorem comp_c_integral_of_surjective_of_jacobson {S : Type _} [Field S] (f : R[X] →+* S)
    (hf : Function.Surjective f) : (f.comp C).IsIntegral :=
  by
  haveI : f.ker.IsMaximal := RingHom.ker_isMaximal_of_surjective f hf
  let g : R[X] ⧸ f.ker →+* S := Ideal.Quotient.lift f.ker f fun _ h => h
  have hfg : g.comp (Quotient.mk' f.ker) = f := ring_hom_ext' rfl rfl
  rw [← hfg, RingHom.comp_assoc]
  refine'
    RingHom.isIntegral_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
#align ideal.polynomial.comp_C_integral_of_surjective_of_jacobson Ideal.Polynomial.comp_c_integral_of_surjective_of_jacobson

end

end Polynomial

open MvPolynomial RingHom

namespace MvPolynomial

theorem isJacobson_mvPolynomial_fin {R : Type _} [CommRing R] [H : IsJacobson R] :
    ∀ n : ℕ, IsJacobson (MvPolynomial (Fin n) R)
  | 0 =>
    (isJacobson_iso
          ((renameEquiv R (Equiv.equivPEmpty (Fin 0))).toRingEquiv.trans
            (isEmptyRingEquiv R PEmpty))).mpr
      H
  | n + 1 =>
    (isJacobson_iso (finSuccEquiv R n).toRingEquiv).2
      (Polynomial.isJacobson_polynomial_iff_isJacobson.2 (is_jacobson_mv_polynomial_fin n))
#align ideal.mv_polynomial.is_jacobson_mv_polynomial_fin Ideal.MvPolynomial.isJacobson_mvPolynomial_fin

/-- 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 isJacobson {R : Type _} [CommRing R] {ι : Type _} [Finite ι] [IsJacobson R] :
    IsJacobson (MvPolynomial ι R) := by
  cases nonempty_fintype ι
  haveI := Classical.decEq ι
  let e := Fintype.equivFin ι
  rw [is_jacobson_iso (rename_equiv R e).toRingEquiv]
  exact is_jacobson_mv_polynomial_fin _
#align ideal.mv_polynomial.is_jacobson Ideal.MvPolynomial.isJacobson

variable {n : ℕ}

theorem quotient_mk_comp_c_isIntegral_of_jacobson {R : Type _} [CommRing R] [IsJacobson R]
    (P : Ideal (MvPolynomial (Fin n) R)) [P.IsMaximal] :
    ((Quotient.mk P).comp MvPolynomial.C : R →+* MvPolynomial _ R ⧸ P).IsIntegral :=
  by
  induction' n with n IH
  · refine' RingHom.isIntegral_of_surjective _ (Function.Surjective.comp quotient.mk_surjective _)
    exact C_surjective (Fin 0)
  · rw [← fin_succ_equiv_comp_C_eq_C, ← RingHom.comp_assoc, ← RingHom.comp_assoc, ←
      quotient_map_comp_mk le_rfl, RingHom.comp_assoc Polynomial.C, ← quotient_map_comp_mk le_rfl,
      RingHom.comp_assoc, RingHom.comp_assoc, ← quotient_map_comp_mk le_rfl, ←
      RingHom.comp_assoc (Quotient.mk' _)]
    refine' RingHom.isIntegral_trans _ _ _ _
    · refine' RingHom.isIntegral_trans _ _ (isIntegral_of_surjective _ quotient.mk_surjective) _
      refine' RingHom.isIntegral_trans _ _ _ _
      · apply (isIntegral_quotientMap_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 (finSuccEquiv R n).symm.Surjective
      · refine' (isIntegral_quotientMap_iff _).mpr _
        rw [← quotient_map_comp_mk le_rfl]
        refine' RingHom.isIntegral_trans _ _ _ ((isIntegral_quotientMap_iff _).mpr _)
        · exact RingHom.isIntegral_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 _ (finSuccEquiv R n).symm.Surjective
    · refine' (isIntegral_quotientMap_iff _).mpr _
      refine' RingHom.isIntegral_trans _ _ _ (isIntegral_of_surjective _ quotient.mk_surjective)
      exact RingHom.isIntegral_of_surjective _ (finSuccEquiv R n).symm.Surjective
#align ideal.mv_polynomial.quotient_mk_comp_C_is_integral_of_jacobson Ideal.MvPolynomial.quotient_mk_comp_c_isIntegral_of_jacobson

theorem comp_c_integral_of_surjective_of_jacobson {R : Type _} [CommRing R] [IsJacobson R]
    {σ : Type _} [Finite σ] {S : Type _} [Field S] (f : MvPolynomial σ R →+* S)
    (hf : Function.Surjective f) : (f.comp C).IsIntegral :=
  by
  cases nonempty_fintype σ
  have e := (Fintype.equivFin σ).symm
  let f' : MvPolynomial (Fin _) R →+* S := f.comp (rename_equiv R e).toRingEquiv.toRingHom
  have hf' : Function.Surjective f' := Function.Surjective.comp hf (rename_equiv R e).Surjective
  have : (f'.comp C).IsIntegral :=
    by
    haveI : f'.ker.IsMaximal := ker_is_maximal_of_surjective f' hf'
    let g : MvPolynomial _ R ⧸ f'.ker →+* S := Ideal.Quotient.lift f'.ker f' fun _ h => h
    have hfg : g.comp (Quotient.mk' f'.ker) = f' := ring_hom_ext (fun r => rfl) fun i => rfl
    rw [← hfg, RingHom.comp_assoc]
    refine'
      RingHom.isIntegral_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 [RingHom.comp_assoc] at this
  convert this
  refine' RingHom.ext fun x => _
  exact ((rename_equiv R e).commutes' x).symm
#align ideal.mv_polynomial.comp_C_integral_of_surjective_of_jacobson Ideal.MvPolynomial.comp_c_integral_of_surjective_of_jacobson

end MvPolynomial

end Ideal


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

/-!
# Spectral maps

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

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

## Main declarations

* `is_spectral_map`: Predicate for a map to be spectral.
* `spectral_map`: Bundled spectral maps.
* `spectral_map_class`: Typeclass for a type to be a type of spectral maps.

## TODO

Once we have `spectral_space`, `is_spectral_map` should move to `topology.spectral.basic`.
-/

open function order_dual

variables {F α β γ δ : Type*}

section unbundled
variables [topological_space α] [topological_space β] [topological_space γ] {f : α → β} {s : set β}

/-- A function between topological spaces is spectral if it is continuous and the preimage of every
compact open set is compact open. -/
structure is_spectral_map (f : α → β) extends continuous f : Prop :=
(is_compact_preimage_of_is_open ⦃s : set β⦄ : is_open s → is_compact s → is_compact (f ⁻¹' s))

lemma is_compact.preimage_of_is_open (hf : is_spectral_map f) (h₀ : is_compact s) (h₁ : is_open s) :
  is_compact (f ⁻¹' s) :=
hf.is_compact_preimage_of_is_open h₁ h₀

lemma is_spectral_map.continuous {f : α → β} (hf : is_spectral_map f) : continuous f :=
hf.to_continuous

lemma is_spectral_map_id : is_spectral_map (@id α) := ⟨continuous_id, λ s _, id⟩

lemma is_spectral_map.comp {f : β → γ} {g : α → β} (hf : is_spectral_map f)
  (hg : is_spectral_map g) :
  is_spectral_map (f ∘ g) :=
⟨hf.continuous.comp hg.continuous,
  λ s hs₀ hs₁, (hs₁.preimage_of_is_open hf hs₀).preimage_of_is_open hg (hs₀.preimage hf.continuous)⟩

end unbundled

/-- The type of spectral maps from `α` to `β`. -/
structure spectral_map (α β : Type*) [topological_space α] [topological_space β] :=
(to_fun : α → β)
(spectral' : is_spectral_map to_fun)

section
set_option old_structure_cmd true

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

You should extend this class when you extend `spectral_map`. -/
class spectral_map_class (F : Type*) (α β : out_param $ Type*) [topological_space α]
  [topological_space β]
  extends fun_like F α (λ _, β) :=
(map_spectral (f : F) : is_spectral_map f)

end

export spectral_map_class (map_spectral)

attribute [simp] map_spectral

@[priority 100] -- See note [lower instance priority]
instance spectral_map_class.to_continuous_map_class [topological_space α] [topological_space β]
  [spectral_map_class F α β] :
  continuous_map_class F α β :=
{ map_continuous := λ f, (map_spectral f).continuous,
  ..‹spectral_map_class F α β› }

instance [topological_space α] [topological_space β] [spectral_map_class F α β] :
  has_coe_t F (spectral_map α β) :=
⟨λ f, ⟨_, map_spectral f⟩⟩

/-! ### Spectral maps -/

namespace spectral_map
variables [topological_space α] [topological_space β] [topological_space γ] [topological_space δ]

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

instance : spectral_map_class (spectral_map α β) α β :=
{ coe := spectral_map.to_fun,
  coe_injective' := λ f g h, by { cases f, cases g, congr' },
  map_spectral := λ f, f.spectral' }

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
instance : has_coe_to_fun (spectral_map α β) (λ _, α → β) := fun_like.has_coe_to_fun

@[simp] lemma to_fun_eq_coe {f : spectral_map α β} : f.to_fun = (f : α → β) := rfl

@[ext] lemma ext {f g : spectral_map α β} (h : ∀ a, f a = g a) : f = g := fun_like.ext f g h

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

@[simp] lemma coe_copy (f : spectral_map α β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' := rfl
lemma copy_eq (f : spectral_map α β) (f' : α → β) (h : f' = f) : f.copy f' h = f := fun_like.ext' h

variables (α)

/-- `id` as a `spectral_map`. -/
protected def id : spectral_map α α := ⟨id, is_spectral_map_id⟩

instance : inhabited (spectral_map α α) := ⟨spectral_map.id α⟩

@[simp] lemma coe_id : ⇑(spectral_map.id α) = id := rfl

variables {α}

@[simp] lemma id_apply (a : α) : spectral_map.id α a = a := rfl

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

@[simp] lemma coe_comp (f : spectral_map β γ) (g : spectral_map α β) : (f.comp g : α → γ) = f ∘ g :=
rfl
@[simp] lemma comp_apply (f : spectral_map β γ) (g : spectral_map α β) (a : α) :
  (f.comp g) a = f (g a) := rfl
@[simp] lemma coe_comp_continuous_map (f : spectral_map β γ) (g : spectral_map α β) :
  (f.comp g : continuous_map α γ) = (f : continuous_map β γ).comp g := rfl
@[simp] lemma comp_assoc (f : spectral_map γ δ) (g : spectral_map β γ) (h : spectral_map α β) :
  (f.comp g).comp h = f.comp (g.comp h) := rfl
@[simp] lemma comp_id (f : spectral_map α β) : f.comp (spectral_map.id α) = f :=
ext $ λ a, rfl
@[simp] lemma id_comp (f : spectral_map α β) : (spectral_map.id β).comp f = f :=
ext $ λ a, rfl

lemma cancel_left {g : spectral_map β γ} {f₁ f₂ : spectral_map α β} (hg : injective g) :
  g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
⟨λ h, ext $ λ a, hg $ by rw [←comp_apply, h, comp_apply], congr_arg _⟩

end spectral_map