/-
Copyright (c) 2022 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa, Yuyang Zhao
-/
import algebra.covariant_and_contravariant
import algebra.group_with_zero.defs

/-!
# Multiplication by ·positive· elements is monotonic

Let `α` be a type with `<` and `0`.  We use the type `{x : α // 0 < x}` of positive elements of `α`
to prove results about monotonicity of multiplication.  We also introduce the local notation `α>0`
for the subtype `{x : α // 0 < x}`:

*  the notation `α>0` to stands for `{x : α // 0 < x}`.

If the type `α` also has a multiplication, then we combine this with (`contravariant_`)
`covariant_class`es to assume that multiplication by positive elements is (strictly) monotone on a
`mul_zero_class`, `monoid_with_zero`,...
More specifically, we use extensively the following typeclasses:

* monotone left
* * `covariant_class α>0 α (λ x y, x * y) (≤)`, abbreviated `pos_mul_mono α`,
    expressing that multiplication by positive elements on the left is monotone;
* * `covariant_class α>0 α (λ x y, x * y) (<)`, abbreviated `pos_mul_strict_mono α`,
    expressing that multiplication by positive elements on the left is strictly monotone;
* monotone right
* * `covariant_class α>0 α (λ x y, y * x) (≤)`, abbreviated `mul_pos_mono α`,
    expressing that multiplication by positive elements on the right is monotone;
* * `covariant_class α>0 α (λ x y, y * x) (<)`, abbreviated `mul_pos_strict_mono α`,
    expressing that multiplication by positive elements on the right is strictly monotone.
* reverse monotone left
* * `contravariant_class α>0 α (λ x y, x * y) (≤)`, abbreviated `pos_mul_mono_rev α`,
    expressing that multiplication by positive elements on the left is reverse monotone;
* * `contravariant_class α>0 α (λ x y, x * y) (<)`, abbreviated `pos_mul_reflect_lt α`,
    expressing that multiplication by positive elements on the left is strictly reverse monotone;
* reverse reverse monotone right
* * `contravariant_class α>0 α (λ x y, y * x) (≤)`, abbreviated `mul_pos_mono_rev α`,
    expressing that multiplication by positive elements on the right is reverse monotone;
* * `contravariant_class α>0 α (λ x y, y * x) (<)`, abbreviated `mul_pos_reflect_lt α`,
    expressing that multiplication by positive elements on the right is strictly reverse monotone.

##  Formalization comments

We use `α>0 = {x : α // 0 < x}` with a strict inequality since in most cases what happens with `0`
is clear.  This creates a few bumps in the first couple of proofs, where we have to split cases on
whether an element is `0` or not, but goes smoothly after that.  A further advantage is that we
only introduce notation for the positive elements and we do not need also the non-negative ones.

Some lemmas for `partial_order` also have a variant for `preorder`, where the `preorder` version has
stronger hypotheses.  In this case we put the `preorder` lemma in the `preorder` namespace.
-/

/- I am changing the file `algebra/order/monoid_lemmas` incrementally, with the idea of
reproducing almost all of the proofs in `algebra/order/ring` with weaker assumptions. -/

universe u
variable {α : Type u}

/-  Notation for positive elements
https://
leanprover.zulipchat.com/#narrow/stream/113488-general/topic/notation.20for.20positive.20elements
-/
local notation `α>0` := {x : α // 0 < x}

namespace zero_lt

section abbreviations_strict_mono
variables (X : Type u) [has_mul X] [has_zero X] [has_lt X]

/--  `zero_lt.pos_mul_strict_mono α` is an abbreviation for
`covariant_class α>0 α (λ x y, x * y) (<)`,
expressing that multiplication by positive elements on the left is strictly monotone. -/
abbreviation pos_mul_strict_mono : Prop :=
covariant_class {x : X // 0 < x} X (λ x y, x * y) (<)

/--  `zero_lt.mul_pos_strict_mono α` is an abbreviation for
`covariant_class α>0 α (λ x y, y * x) (<)`,
expressing that multiplication by positive elements on the right is strictly monotone. -/
abbreviation mul_pos_strict_mono : Prop :=
covariant_class {x : X // 0 < x} X (λ x y, y * x) (<)

/--  `zero_lt.pos_mul_reflect_lt α` is an abbreviation for
`contravariant_class α>0 α (λ x y, x * y) (<)`,
expressing that multiplication by positive elements on the left is strictly reverse monotone. -/
abbreviation pos_mul_reflect_lt : Prop :=
contravariant_class {x : X // 0 < x} X (λ x y, x * y) (<)

/--  `zero_lt.mul_pos_reflect_lt α` is an abbreviation for
`contravariant_class α>0 α (λ x y, y * x) (<)`,
expressing that multiplication by positive elements on the right is strictly reverse monotone. -/
abbreviation mul_pos_reflect_lt : Prop :=
contravariant_class {x : X // 0 < x} X (λ x y, y * x) (<)

end abbreviations_strict_mono

section abbreviations_mono
variables (X : Type*) [has_mul X] [has_zero X] [has_lt X] [has_le X]

/--  `zero_lt.pos_mul_mono α` is an abbreviation for
`covariant_class α>0 α (λ x y, x * y) (≤)`,
expressing that multiplication by positive elements on the left is monotone. -/
abbreviation pos_mul_mono : Prop :=
covariant_class {x : X // 0 < x} X (λ x y, x * y) (≤)

/--  `zero_lt.mul_pos_mono α` is an abbreviation for
`covariant_class α>0 α (λ x y, y * x) (≤)`,
expressing that multiplication by positive elements on the right is monotone. -/
abbreviation mul_pos_mono : Prop :=
covariant_class {x : X // 0 < x} X (λ x y, y * x) (≤)

/--  `zero_lt.pos_mul_mono_rev α` is an abbreviation for
`contravariant_class α>0 α (λ x y, x * y) (≤)`,
expressing that multiplication by positive elements on the left is reverse monotone. -/
abbreviation pos_mul_mono_rev : Prop :=
contravariant_class {x : X // 0 < x} X (λ x y, x * y) (≤)

/--  `zero_lt.mul_pos_mono_rev α` is an abbreviation for
`contravariant_class α>0 α (λ x y, y * x) (≤)`,
expressing that multiplication by positive elements on the right is reverse monotone. -/
abbreviation mul_pos_mono_rev : Prop :=
contravariant_class {x : X // 0 < x} X (λ x y, y * x) (≤)

end abbreviations_mono

variables {a b c d : α}

section has_mul_zero
variables [has_mul α] [has_zero α]

section has_lt
variables [has_lt α]

lemma mul_lt_mul_left' [pos_mul_strict_mono α]
  (bc : b < c) (a0 : 0 < a) :
  a * b < a * c :=
@covariant_class.elim α>0 α (λ x y, x * y) (<) _ ⟨a, a0⟩ _ _ bc

lemma mul_lt_mul_right' [mul_pos_strict_mono α]
  (bc : b < c) (a0 : 0 < a) :
  b * a < c * a :=
@covariant_class.elim α>0 α (λ x y, y * x) (<) _ ⟨a, a0⟩ _ _ bc

-- proven with `a0 : 0 ≤ a` as `lt_of_mul_lt_mul_left`
lemma lt_of_mul_lt_mul_left' [pos_mul_reflect_lt α]
  (bc : a * b < a * c) (a0 : 0 < a) :
  b < c :=
@contravariant_class.elim α>0 α (λ x y, x * y) (<) _ ⟨a, a0⟩ _ _ bc

-- proven with `a0 : 0 ≤ a` as `lt_of_mul_lt_mul_right`
lemma lt_of_mul_lt_mul_right' [mul_pos_reflect_lt α]
  (bc : b * a < c * a) (a0 : 0 < a) :
  b < c :=
@contravariant_class.elim α>0 α (λ x y, y * x) (<) _ ⟨a, a0⟩ _ _ bc

@[simp]
lemma mul_lt_mul_iff_left [pos_mul_strict_mono α] [pos_mul_reflect_lt α]
  (a0 : 0 < a) :
  a * b < a * c ↔ b < c :=
@rel_iff_cov α>0 α (λ x y, x * y) (<) _ _ ⟨a, a0⟩ _ _

@[simp]
lemma mul_lt_mul_iff_right [mul_pos_strict_mono α] [mul_pos_reflect_lt α]
  (a0 : 0 < a) :
  b * a < c * a ↔ b < c :=
@rel_iff_cov α>0 α (λ x y, y * x) (<) _ _ ⟨a, a0⟩ _ _

end has_lt

section has_lt_le
variables [has_lt α] [has_le α]

-- proven with `a0 : 0 ≤ a` as `mul_le_mul_left`
lemma mul_le_mul_left' [pos_mul_mono α]
  (bc : b ≤ c) (a0 : 0 < a) :
  a * b ≤ a * c :=
@covariant_class.elim α>0 α (λ x y, x * y) (≤) _ ⟨a, a0⟩ _ _ bc

-- proven with `a0 : 0 ≤ a` as `mul_le_mul_right`
lemma mul_le_mul_right' [mul_pos_mono α]
  (bc : b ≤ c) (a0 : 0 < a) :
  b * a ≤ c * a :=
@covariant_class.elim α>0 α (λ x y, y * x) (≤) _ ⟨a, a0⟩ _ _ bc

lemma le_of_mul_le_mul_left' [pos_mul_mono_rev α]
  (bc : a * b ≤ a * c) (a0 : 0 < a) :
  b ≤ c :=
@contravariant_class.elim α>0 α (λ x y, x * y) (≤) _ ⟨a, a0⟩ _ _ bc

lemma le_of_mul_le_mul_right' [mul_pos_mono_rev α]
  (bc : b * a ≤ c * a) (a0 : 0 < a) :
  b ≤ c :=
@contravariant_class.elim α>0 α (λ x y, y * x) (≤) _ ⟨a, a0⟩ _ _ bc

@[simp]
lemma mul_le_mul_iff_left [pos_mul_mono α] [pos_mul_mono_rev α]
  (a0 : 0 < a) :
  a * b ≤ a * c ↔ b ≤ c :=
@rel_iff_cov α>0 α (λ x y, x * y) (≤) _ _ ⟨a, a0⟩ _ _

@[simp]
lemma mul_le_mul_iff_right [mul_pos_mono α] [mul_pos_mono_rev α]
  (a0 : 0 < a) :
  b * a ≤ c * a ↔ b ≤ c :=
@rel_iff_cov α>0 α (λ x y, y * x) (≤) _ _ ⟨a, a0⟩ _ _

end has_lt_le

section preorder
variables [preorder α]

-- proven with `a0 : 0 ≤ a` `d0 : 0 ≤ d` as `mul_le_mul_of_le_of_le`
lemma preorder.mul_le_mul_of_le_of_le [pos_mul_mono α] [mul_pos_mono α]
  (h₁ : a ≤ b) (h₂ : c ≤ d) (a0 : 0 < a) (d0 : 0 < d) : a * c ≤ b * d :=
(mul_le_mul_left' h₂ a0).trans (mul_le_mul_right' h₁ d0)

-- proven with `b0 : 0 ≤ b` `c0 : 0 ≤ c` as `mul_le_mul_of_le_of_le'`
lemma preorder.mul_le_mul_of_le_of_le' [pos_mul_mono α] [mul_pos_mono α]
  (h₁ : a ≤ b) (h₂ : c ≤ d) (b0 : 0 < b) (c0 : 0 < c) : a * c ≤ b * d :=
(mul_le_mul_right' h₁ c0).trans (mul_le_mul_left' h₂ b0)

lemma mul_lt_mul_of_le_of_lt [pos_mul_strict_mono α] [mul_pos_mono α]
  (h₁ : a ≤ b) (h₂ : c < d) (a0 : 0 < a) (d0 : 0 < d) : a * c < b * d :=
(mul_lt_mul_left' h₂ a0).trans_le (mul_le_mul_right' h₁ d0)

lemma mul_lt_mul_of_le_of_lt' [pos_mul_strict_mono α] [mul_pos_mono α]
  (h₁ : a ≤ b) (h₂ : c < d) (b0 : 0 < b) (c0 : 0 < c) : a * c < b * d :=
(mul_le_mul_right' h₁ c0).trans_lt (mul_lt_mul_left' h₂ b0)

lemma mul_lt_mul_of_lt_of_le [pos_mul_mono α] [mul_pos_strict_mono α]
  (h₁ : a < b) (h₂ : c ≤ d) (a0 : 0 < a) (d0 : 0 < d) : a * c < b * d :=
(mul_le_mul_left' h₂ a0).trans_lt (mul_lt_mul_right' h₁ d0)

lemma mul_lt_mul_of_lt_of_le' [pos_mul_mono α] [mul_pos_strict_mono α]
  (h₁ : a < b) (h₂ : c ≤ d) (b0 : 0 < b) (c0 : 0 < c) : a * c < b * d :=
(mul_lt_mul_right' h₁ c0).trans_le (mul_le_mul_left' h₂ b0)

lemma mul_lt_mul_of_lt_of_lt [pos_mul_strict_mono α] [mul_pos_strict_mono α]
  (h₁ : a < b) (h₂ : c < d) (a0 : 0 < a) (d0 : 0 < d) : a * c < b * d :=
(mul_lt_mul_left' h₂ a0).trans (mul_lt_mul_right' h₁ d0)

lemma mul_lt_mul_of_lt_of_lt' [pos_mul_strict_mono α] [mul_pos_strict_mono α]
  (h₁ : a < b) (h₂ : c < d) (b0 : 0 < b) (c0 : 0 < c) : a * c < b * d :=
(mul_lt_mul_right' h₁ c0).trans (mul_lt_mul_left' h₂ b0)

-- proven with `a0 : 0 ≤ a` as `mul_le_of_mul_le_left`
lemma preorder.mul_le_of_mul_le_left [pos_mul_mono α]
  (h : a * b ≤ c) (hle : d ≤ b) (a0 : 0 < a) :
  a * d ≤ c :=
(mul_le_mul_left' hle a0).trans h

lemma mul_lt_of_mul_lt_left [pos_mul_mono α]
  (h : a * b < c) (hle : d ≤ b) (a0 : 0 < a) :
  a * d < c :=
(mul_le_mul_left' hle a0).trans_lt h

-- proven with `b0 : 0 ≤ b` as `le_mul_of_le_mul_left`
lemma preorder.le_mul_of_le_mul_left [pos_mul_mono α]
  (h : a ≤ b * c) (hle : c ≤ d) (b0 : 0 < b) :
  a ≤ b * d :=
h.trans (mul_le_mul_left' hle b0)

lemma lt_mul_of_lt_mul_left [pos_mul_mono α]
  (h : a < b * c) (hle : c ≤ d) (b0 : 0 < b) :
  a < b * d :=
h.trans_le (mul_le_mul_left' hle b0)

-- proven with `b0 : 0 ≤ b` as `mul_le_of_mul_le_right`
lemma preorder.mul_le_of_mul_le_right [mul_pos_mono α]
  (h : a * b ≤ c) (hle : d ≤ a) (b0 : 0 < b) :
  d * b ≤ c :=
(mul_le_mul_right' hle b0).trans h

lemma mul_lt_of_mul_lt_right [mul_pos_mono α]
  (h : a * b < c) (hle : d ≤ a) (b0 : 0 < b) :
  d * b < c :=
(mul_le_mul_right' hle b0).trans_lt h

-- proven with `c0 : 0 ≤ c` as `le_mul_of_le_mul_right`
lemma preorder.le_mul_of_le_mul_right [mul_pos_mono α]
  (h : a ≤ b * c) (hle : b ≤ d) (c0 : 0 < c) :
  a ≤ d * c :=
h.trans (mul_le_mul_right' hle c0)

lemma lt_mul_of_lt_mul_right [mul_pos_mono α]
  (h : a < b * c) (hle : b ≤ d) (c0 : 0 < c) :
  a < d * c :=
h.trans_le (mul_le_mul_right' hle c0)

end preorder

section partial_order
variables [partial_order α]

@[priority 100] -- see Note [lower instance priority]
instance pos_mul_strict_mono.to_pos_mul_mono [pos_mul_strict_mono α] : pos_mul_mono α :=
⟨λ x a b h, h.eq_or_lt.elim (λ h', h' ▸ le_rfl) (λ h', (mul_lt_mul_left' h' x.prop).le)⟩

@[priority 100] -- see Note [lower instance priority]
instance mul_pos_strict_mono.to_mul_pos_mono [mul_pos_strict_mono α] : mul_pos_mono α :=
⟨λ x a b h, h.eq_or_lt.elim (λ h', h' ▸ le_rfl) (λ h', (mul_lt_mul_right' h' x.prop).le)⟩

@[priority 100] -- see Note [lower instance priority]
instance pos_mul_mono_rev.to_pos_mul_reflect_lt [pos_mul_mono_rev α] : pos_mul_reflect_lt α :=
⟨λ x a b h, lt_of_le_of_ne (le_of_mul_le_mul_left' h.le x.prop) (λ h', by simpa [h'] using h)⟩

@[priority 100] -- see Note [lower instance priority]
instance mul_pos_mono_rev.to_mul_pos_reflect_lt [mul_pos_mono_rev α] : mul_pos_reflect_lt α :=
⟨λ x a b h, lt_of_le_of_ne (le_of_mul_le_mul_right' h.le x.prop) (λ h', by simpa [h'] using h)⟩

end partial_order

section linear_order
variables [linear_order α]

@[priority 100] -- see Note [lower instance priority]
instance pos_mul_strict_mono.to_pos_mul_mono_rev [pos_mul_strict_mono α] : pos_mul_mono_rev α :=
⟨λ x a b h, le_of_not_lt $ λ h', h.not_lt (mul_lt_mul_left' h' x.prop)⟩

@[priority 100] -- see Note [lower instance priority]
instance mul_pos_strict_mono.to_mul_pos_mono_rev [mul_pos_strict_mono α] : mul_pos_mono_rev α :=
⟨λ x a b h, le_of_not_lt $ λ h', h.not_lt (mul_lt_mul_right' h' x.prop)⟩

end linear_order

end has_mul_zero

section mul_zero_class
variables [mul_zero_class α]

section preorder
variables [preorder α]

/-- Assumes left covariance. -/
lemma left.mul_pos [pos_mul_strict_mono α]
  (ha : 0 < a) (hb : 0 < b) :
  0 < a * b :=
have h : a * 0 < a * b, from mul_lt_mul_left' hb ha,
by rwa [mul_zero] at h

lemma mul_neg_of_pos_of_neg [pos_mul_strict_mono α]
  (ha : 0 < a) (hb : b < 0) :
  a * b < 0 :=
have h : a * b < a * 0, from mul_lt_mul_left' hb ha,
by rwa [mul_zero] at h

/-- Assumes right covariance. -/
lemma right.mul_pos [mul_pos_strict_mono α]
  (ha : 0 < a) (hb : 0 < b) :
  0 < a * b :=
have h : 0 * b < a * b, from mul_lt_mul_right' ha hb,
by rwa [zero_mul] at h

lemma mul_neg_of_neg_of_pos [mul_pos_strict_mono α]
  (ha : a < 0) (hb : 0 < b) :
  a * b < 0 :=
have h : a * b < 0 * b, from mul_lt_mul_right' ha hb,
by rwa [zero_mul] at h

end preorder

section partial_order
variables [partial_order α]

lemma mul_le_mul_left [pos_mul_mono α]
  (bc : b ≤ c) (a0 : 0 ≤ a) :
  a * b ≤ a * c :=
a0.lt_or_eq.elim (mul_le_mul_left' bc) (λ h, by simp only [← h, zero_mul])

lemma mul_le_mul_right [mul_pos_mono α]
  (bc : b ≤ c) (a0 : 0 ≤ a) :
  b * a ≤ c * a :=
a0.lt_or_eq.elim (mul_le_mul_right' bc) (λ h, by simp only [← h, mul_zero])

/-- Assumes left covariance. -/
lemma left.mul_nonneg [pos_mul_mono α]
  (ha : 0 ≤ a) (hb : 0 ≤ b) :
  0 ≤ a * b :=
have h : a * 0 ≤ a * b, from mul_le_mul_left hb ha,
by rwa [mul_zero] at h

lemma mul_nonpos_of_nonneg_of_nonpos [pos_mul_mono α]
  (ha : 0 ≤ a) (hb : b ≤ 0) :
  a * b ≤ 0 :=
have h : a * b ≤ a * 0, from mul_le_mul_left hb ha,
by rwa [mul_zero] at h

/-- Assumes right covariance. -/
lemma right.mul_nonneg [mul_pos_mono α]
  (ha : 0 ≤ a) (hb : 0 ≤ b) :
  0 ≤ a * b :=
have h : 0 * b ≤ a * b, from mul_le_mul_right ha hb,
by rwa [zero_mul] at h

lemma mul_nonpos_of_nonpos_of_nonneg [mul_pos_mono α]
  (ha : a ≤ 0) (hb : 0 ≤ b) :
  a * b ≤ 0 :=
have h : a * b ≤ 0 * b, from mul_le_mul_right ha hb,
by rwa [zero_mul] at h

lemma lt_of_mul_lt_mul_left [pos_mul_reflect_lt α]
  (bc : a * b < a * c) (a0 : 0 ≤ a) :
  b < c :=
begin
  by_cases a₀ : a = 0,
  { exact (lt_irrefl (0 : α) (by simpa only [a₀, zero_mul] using bc)).elim },
  { exact lt_of_mul_lt_mul_left' bc ((ne.symm a₀).le_iff_lt.mp a0) }
end

lemma pos_of_mul_pos_left [pos_mul_reflect_lt α] (h : 0 < a * b) (ha : 0 ≤ a) :
  0 < b :=
lt_of_mul_lt_mul_left ((mul_zero a).symm ▸ h : a * 0 < a * b) ha

lemma lt_of_mul_lt_mul_right [mul_pos_reflect_lt α]
  (bc : b * a < c * a) (a0 : 0 ≤ a) :
  b < c :=
begin
  by_cases a₀ : a = 0,
  { exact (lt_irrefl (0 : α) (by simpa only [a₀, mul_zero] using bc)).elim },
  { exact lt_of_mul_lt_mul_right' bc ((ne.symm a₀).le_iff_lt.mp a0) }
end

lemma pos_of_mul_pos_right [mul_pos_reflect_lt α] (h : 0 < a * b) (hb : 0 ≤ b) :
  0 < a :=
lt_of_mul_lt_mul_right ((zero_mul b).symm ▸ h : 0 * b < a * b) hb

lemma pos_iff_pos_of_mul_pos [pos_mul_reflect_lt α] [mul_pos_reflect_lt α] (hab : 0 < a * b) :
  0 < a ↔ 0 < b :=
⟨pos_of_mul_pos_left hab ∘ le_of_lt, pos_of_mul_pos_right hab ∘ le_of_lt⟩

lemma mul_le_mul_of_le_of_le [pos_mul_mono α] [mul_pos_mono α]
  (h₁ : a ≤ b) (h₂ : c ≤ d) (a0 : 0 ≤ a) (d0 : 0 ≤ d) : a * c ≤ b * d :=
(mul_le_mul_left h₂ a0).trans $ mul_le_mul_right h₁ d0

lemma mul_le_mul_of_le_of_le' [pos_mul_mono α] [mul_pos_mono α]
  (h₁ : a ≤ b) (h₂ : c ≤ d) (b0 : 0 ≤ b) (c0 : 0 ≤ c) : a * c ≤ b * d :=
(mul_le_mul_right h₁ c0).trans $ mul_le_mul_left h₂ b0

lemma mul_le_of_mul_le_left [pos_mul_mono α]
  (h : a * b ≤ c) (hle : d ≤ b) (a0 : 0 ≤ a) :
  a * d ≤ c :=
(mul_le_mul_left hle a0).trans h

lemma le_mul_of_le_mul_left [pos_mul_mono α]
  (h : a ≤ b * c) (hle : c ≤ d) (b0 : 0 ≤ b) :
  a ≤ b * d :=
h.trans (mul_le_mul_left hle b0)

lemma mul_le_of_mul_le_right [mul_pos_mono α]
  (h : a * b ≤ c) (hle : d ≤ a) (b0 : 0 ≤ b) :
  d * b ≤ c :=
(mul_le_mul_right hle b0).trans h

lemma le_mul_of_le_mul_right [mul_pos_mono α]
  (h : a ≤ b * c) (hle : b ≤ d) (c0 : 0 ≤ c) :
  a ≤ d * c :=
h.trans (mul_le_mul_right hle c0)

lemma mul_left_cancel_iff [pos_mul_mono_rev α]
  (a0 : 0 < a) :
  a * b = a * c ↔ b = c :=
⟨λ h, (le_of_mul_le_mul_left' h.le a0).antisymm (le_of_mul_le_mul_left' h.ge a0), congr_arg _⟩

lemma mul_right_cancel_iff [mul_pos_mono_rev α]
  (b0 : 0 < b) :
  a * b = c * b ↔ a = c :=
⟨λ h, (le_of_mul_le_mul_right' h.le b0).antisymm (le_of_mul_le_mul_right' h.ge b0), congr_arg _⟩

lemma mul_eq_mul_iff_eq_and_eq [pos_mul_strict_mono α] [mul_pos_strict_mono α]
  [pos_mul_mono_rev α] [mul_pos_mono_rev α]
  (hac : a ≤ b) (hbd : c ≤ d) (a0 : 0 < a) (d0 : 0 < d) :
  a * c = b * d ↔ a = b ∧ c = d :=
begin
  refine ⟨λ h, _, λ h, congr_arg2 (*) h.1 h.2⟩,
  rcases hac.eq_or_lt with rfl | hac,
  { exact ⟨rfl, (mul_left_cancel_iff a0).mp h⟩ },
  rcases eq_or_lt_of_le hbd with rfl | hbd,
  { exact ⟨(mul_right_cancel_iff d0).mp h, rfl⟩ },
  exact ((mul_lt_mul_of_lt_of_lt hac hbd a0 d0).ne h).elim,
end

lemma mul_eq_mul_iff_eq_and_eq' [pos_mul_strict_mono α] [mul_pos_strict_mono α]
  [pos_mul_mono_rev α] [mul_pos_mono_rev α]
  (hac : a ≤ b) (hbd : c ≤ d) (b0 : 0 < b) (c0 : 0 < c) :
  a * c = b * d ↔ a = b ∧ c = d :=
begin
  refine ⟨λ h, _, λ h, congr_arg2 (*) h.1 h.2⟩,
  rcases hac.eq_or_lt with rfl | hac,
  { exact ⟨rfl, (mul_left_cancel_iff b0).mp h⟩ },
  rcases eq_or_lt_of_le hbd with rfl | hbd,
  { exact ⟨(mul_right_cancel_iff c0).mp h, rfl⟩ },
  exact ((mul_lt_mul_of_lt_of_lt' hac hbd b0 c0).ne h).elim,
end

end partial_order

section linear_order
variables [linear_order α]

lemma pos_and_pos_or_neg_and_neg_of_mul_pos [pos_mul_mono α] [mul_pos_mono α]
  (hab : 0 < a * b) :
  (0 < a ∧ 0 < b) ∨ (a < 0 ∧ b < 0) :=
begin
  rcases lt_trichotomy 0 a with ha | rfl | ha,
  { refine or.inl ⟨ha, lt_imp_lt_of_le_imp_le (λ hb, _) hab⟩,
    exact mul_nonpos_of_nonneg_of_nonpos ha.le hb },
  { rw [zero_mul] at hab, exact hab.false.elim },
  { refine or.inr ⟨ha, lt_imp_lt_of_le_imp_le (λ hb, _) hab⟩,
    exact mul_nonpos_of_nonpos_of_nonneg ha.le hb }
end

lemma neg_of_mul_pos_left [pos_mul_mono α] [mul_pos_mono α]
  (h : 0 < a * b) (ha : a ≤ 0) :
  b < 0 :=
((pos_and_pos_or_neg_and_neg_of_mul_pos h).resolve_left $ λ h, h.1.not_le ha).2

lemma neg_of_mul_pos_right [pos_mul_mono α] [mul_pos_mono α]
  (h : 0 < a * b) (ha : b ≤ 0) :
  a < 0 :=
((pos_and_pos_or_neg_and_neg_of_mul_pos h).resolve_left $ λ h, h.2.not_le ha).1

lemma neg_iff_neg_of_mul_pos [pos_mul_mono α] [mul_pos_mono α]
  (hab : 0 < a * b) :
  a < 0 ↔ b < 0 :=
⟨neg_of_mul_pos_left hab ∘ le_of_lt, neg_of_mul_pos_right hab ∘ le_of_lt⟩

lemma left.neg_of_mul_neg_left [pos_mul_mono α]
  (h : a * b < 0) (h1 : 0 ≤ a) :
  b < 0 :=
lt_of_not_ge (assume h2 : b ≥ 0, (left.mul_nonneg h1 h2).not_lt h)

lemma right.neg_of_mul_neg_left [mul_pos_mono α]
  (h : a * b < 0) (h1 : 0 ≤ a) :
  b < 0 :=
lt_of_not_ge (assume h2 : b ≥ 0, (right.mul_nonneg h1 h2).not_lt h)

lemma left.neg_of_mul_neg_right [pos_mul_mono α]
  (h : a * b < 0) (h1 : 0 ≤ b) : a < 0 :=
lt_of_not_ge (assume h2 : a ≥ 0, (left.mul_nonneg h2 h1).not_lt h)

lemma right.neg_of_mul_neg_right [mul_pos_mono α]
  (h : a * b < 0) (h1 : 0 ≤ b) : a < 0 :=
lt_of_not_ge (assume h2 : a ≥ 0, (right.mul_nonneg h2 h1).not_lt h)

end linear_order

end mul_zero_class

section mul_one_class
variables [mul_one_class α] [has_zero α]

section preorder
variables [preorder α]

/-! Lemmas of the form `a ≤ a * b ↔ 1 ≤ b` and `a * b ≤ a ↔ b ≤ 1`,
which assume left covariance. -/

@[simp]
lemma le_mul_iff_one_le_right
  [pos_mul_mono α] [pos_mul_mono_rev α]
  (a0 : 0 < a) :
  a ≤ a * b ↔ 1 ≤ b :=
iff.trans (by rw [mul_one]) (mul_le_mul_iff_left a0)

@[simp]
lemma lt_mul_iff_one_lt_right
  [pos_mul_strict_mono α] [pos_mul_reflect_lt α]
  (a0 : 0 < a) :
  a < a * b ↔ 1 < b :=
iff.trans (by rw [mul_one]) (mul_lt_mul_iff_left a0)

@[simp]
lemma mul_le_iff_le_one_right
  [pos_mul_mono α] [pos_mul_mono_rev α]
  (a0 : 0 < a) :
  a * b ≤ a ↔ b ≤ 1 :=
iff.trans (by rw [mul_one]) (mul_le_mul_iff_left a0)

@[simp]
lemma mul_lt_iff_lt_one_right
  [pos_mul_strict_mono α] [pos_mul_reflect_lt α]
  (a0 : 0 < a) :
  a * b < a ↔ b < 1 :=
iff.trans (by rw [mul_one]) (mul_lt_mul_iff_left a0)

/-! Lemmas of the form `a ≤ b * a ↔ 1 ≤ b` and `a * b ≤ b ↔ a ≤ 1`,
which assume right covariance. -/

@[simp]
lemma le_mul_iff_one_le_left
  [mul_pos_mono α] [mul_pos_mono_rev α]
  (a0 : 0 < a) :
  a ≤ b * a ↔ 1 ≤ b :=
iff.trans (by rw [one_mul]) (mul_le_mul_iff_right a0)

@[simp]
lemma lt_mul_iff_one_lt_left
  [mul_pos_strict_mono α] [mul_pos_reflect_lt α]
  (a0 : 0 < a) :
  a < b * a ↔ 1 < b :=
iff.trans (by rw [one_mul]) (mul_lt_mul_iff_right a0)

@[simp]
lemma mul_le_iff_le_one_left
  [mul_pos_mono α] [mul_pos_mono_rev α]
  (b0 : 0 < b) :
  a * b ≤ b ↔ a ≤ 1 :=
iff.trans (by rw [one_mul]) (mul_le_mul_iff_right b0)

@[simp]
lemma mul_lt_iff_lt_one_left
  [mul_pos_strict_mono α] [mul_pos_reflect_lt α]
  (b0 : 0 < b) :
  a * b < b ↔ a < 1 :=
iff.trans (by rw [one_mul]) (mul_lt_mul_iff_right b0)

/-! Lemmas of the form `b ≤ c → a ≤ 1 → 0 < b → b * a ≤ c`,
which assume left covariance. -/

-- proven with `b0 : 0 ≤ b` as `mul_le_of_le_of_le_one`
lemma preorder.mul_le_of_le_of_le_one [pos_mul_mono α]
  (bc : b ≤ c) (ha : a ≤ 1) (b0 : 0 < b) : b * a ≤ c :=
calc  b * a ≤ b * 1 : mul_le_mul_left' ha b0
        ... = b     : mul_one b
        ... ≤ c     : bc

lemma mul_lt_of_le_of_lt_one [pos_mul_strict_mono α]
  (bc : b ≤ c) (ha : a < 1) (b0 : 0 < b) : b * a < c :=
calc  b * a < b * 1 : mul_lt_mul_left' ha b0
        ... = b     : mul_one b
        ... ≤ c     : bc

lemma mul_lt_of_lt_of_le_one [pos_mul_mono α]
  (bc : b < c) (ha : a ≤ 1) (b0 : 0 < b) : b * a < c :=
calc  b * a ≤ b * 1 : mul_le_mul_left' ha b0
        ... = b     : mul_one b
        ... < c     : bc

lemma mul_lt_of_lt_of_lt_one [pos_mul_strict_mono α]
  (bc : b < c) (ha : a < 1) (b0 : 0 < b) : b * a < c :=
calc  b * a < b * 1 : mul_lt_mul_left' ha b0
        ... = b     : mul_one b
        ... < c     : bc

-- proven with `a0 : 0 ≤ a` as `left.mul_le_one_of_le_of_le`
/-- Assumes left covariance. -/
lemma preorder.left.mul_le_one_of_le_of_le' [pos_mul_mono α]
  (ha : a ≤ 1) (hb : b ≤ 1) (a0 : 0 < a) : a * b ≤ 1 :=
preorder.mul_le_of_le_of_le_one ha hb a0

/-- Assumes left covariance. -/
lemma left.mul_lt_one_of_le_of_lt [pos_mul_strict_mono α]
  (ha : a ≤ 1) (hb : b < 1) (a0 : 0 < a) : a * b < 1 :=
mul_lt_of_le_of_lt_one ha hb a0

/-- Assumes left covariance. -/
lemma left.mul_lt_one_of_lt_of_le [pos_mul_mono α]
  (ha : a < 1) (hb : b ≤ 1) (a0 : 0 < a) : a * b < 1 :=
mul_lt_of_lt_of_le_one ha hb a0

/-- Assumes left covariance. -/
lemma left.mul_lt_one_of_lt_of_lt [pos_mul_strict_mono α]
  (ha : a < 1) (hb : b < 1) (a0 : 0 < a) : a * b < 1 :=
mul_lt_of_lt_of_lt_one ha hb a0

/-! Lemmas of the form `b ≤ c → 1 ≤ a → 0 < c → b ≤ c * a`,
which assume left covariance. -/

-- proven with `c0 : 0 ≤ c` as `le_mul_of_le_of_one_le`
lemma preorder.le_mul_of_le_of_one_le [pos_mul_mono α]
  (bc : b ≤ c) (ha : 1 ≤ a) (c0 : 0 < c) : b ≤ c * a :=
calc  b ≤ c     : bc
    ... = c * 1 : (mul_one c).symm
    ... ≤ c * a : mul_le_mul_left' ha c0

lemma lt_mul_of_le_of_one_lt [pos_mul_strict_mono α]
  (bc : b ≤ c) (ha : 1 < a) (c0 : 0 < c) : b < c * a :=
calc  b ≤ c     : bc
    ... = c * 1 : (mul_one c).symm
    ... < c * a : mul_lt_mul_left' ha c0

lemma lt_mul_of_lt_of_one_le [pos_mul_mono α]
  (bc : b < c) (ha : 1 ≤ a) (c0 : 0 < c) : b < c * a :=
calc  b < c     : bc
    ... = c * 1 : (mul_one c).symm
    ... ≤ c * a : mul_le_mul_left' ha c0

lemma lt_mul_of_lt_of_one_lt [pos_mul_strict_mono α]
  (bc : b < c) (ha : 1 < a) (c0 : 0 < c) : b < c * a :=
calc  b < c     : bc
    ... = c * 1 : (mul_one _).symm
    ... < c * a : mul_lt_mul_left' ha c0

-- proven with `a0 : 0 ≤ a` as `left.one_le_mul_of_le_of_le`
/-- Assumes left covariance. -/
lemma preorder.left.one_le_mul_of_le_of_le [pos_mul_mono α]
  (ha : 1 ≤ a) (hb : 1 ≤ b) (a0 : 0 < a) : 1 ≤ a * b :=
preorder.le_mul_of_le_of_one_le ha hb a0

/-- Assumes left covariance. -/
lemma left.one_lt_mul_of_le_of_lt [pos_mul_strict_mono α]
  (ha : 1 ≤ a) (hb : 1 < b) (a0 : 0 < a) : 1 < a * b :=
lt_mul_of_le_of_one_lt ha hb a0

/-- Assumes left covariance. -/
lemma left.one_lt_mul_of_lt_of_le [pos_mul_mono α]
  (ha : 1 < a) (hb : 1 ≤ b) (a0 : 0 < a) : 1 < a * b :=
lt_mul_of_lt_of_one_le ha hb a0

/-- Assumes left covariance. -/
lemma left.one_lt_mul_of_lt_of_lt [pos_mul_strict_mono α]
  (ha : 1 < a) (hb : 1 < b) (a0 : 0 < a) : 1 < a * b :=
lt_mul_of_lt_of_one_lt ha hb a0

/-! Lemmas of the form `a ≤ 1 → b ≤ c → 0 < b → a * b ≤ c`,
which assume right covariance. -/

-- proven with `b0 : 0 ≤ b` as `mul_le_of_le_one_of_le`
lemma preorder.mul_le_of_le_one_of_le [mul_pos_mono α]
  (ha : a ≤ 1) (bc : b ≤ c) (b0 : 0 < b) : a * b ≤ c :=
calc  a * b ≤ 1 * b : mul_le_mul_right' ha b0
        ... = b     : one_mul b
        ... ≤ c     : bc

lemma mul_lt_of_lt_one_of_le [mul_pos_strict_mono α]
  (ha : a < 1) (bc : b ≤ c) (b0 : 0 < b) : a * b < c :=
calc  a * b < 1 * b : mul_lt_mul_right' ha b0
        ... = b     : one_mul b
        ... ≤ c     : bc

lemma mul_lt_of_le_one_of_lt [mul_pos_mono α]
  (ha : a ≤ 1) (hb : b < c) (b0 : 0 < b) : a * b < c :=
calc  a * b ≤ 1 * b : mul_le_mul_right' ha b0
        ... = b     : one_mul b
        ... < c     : hb

lemma mul_lt_of_lt_one_of_lt [mul_pos_strict_mono α]
  (ha : a < 1) (bc : b < c) (b0 : 0 < b) : a * b < c :=
calc  a * b < 1 * b : mul_lt_mul_right' ha b0
        ... = b     : one_mul b
        ... < c     : bc

-- proven with `b0 : 0 ≤ b` as `right.mul_le_one_of_le_of_le`
/-- Assumes right covariance. -/
lemma preorder.right.mul_le_one_of_le_of_le [mul_pos_mono α]
  (ha : a ≤ 1) (hb : b ≤ 1) (b0 : 0 < b) : a * b ≤ 1 :=
preorder.mul_le_of_le_one_of_le ha hb b0

/-- Assumes right covariance. -/
lemma right.mul_lt_one_of_lt_of_le [mul_pos_strict_mono α]
  (ha : a < 1) (hb : b ≤ 1) (b0 : 0 < b) : a * b < 1 :=
mul_lt_of_lt_one_of_le ha hb b0

/-- Assumes right covariance. -/
lemma right.mul_lt_one_of_le_of_lt [mul_pos_mono α]
  (ha : a ≤ 1) (hb : b < 1) (b0 : 0 < b) : a * b < 1 :=
mul_lt_of_le_one_of_lt ha hb b0

/-- Assumes right covariance. -/
lemma right.mul_lt_one_of_lt_of_lt [mul_pos_strict_mono α]
  (ha : a < 1) (hb : b < 1) (b0 : 0 < b) : a * b < 1 :=
mul_lt_of_lt_one_of_lt ha hb b0

/-! Lemmas of the form `1 ≤ a → b ≤ c → 0 < c → b ≤ a * c`,
which assume right covariance. -/

-- proven with `c0 : 0 ≤ c` as `le_mul_of_one_le_of_le`
lemma preorder.le_mul_of_one_le_of_le [mul_pos_mono α]
  (ha : 1 ≤ a) (bc : b ≤ c) (c0 : 0 < c) : b ≤ a * c :=
calc  b ≤ c     : bc
    ... = 1 * c : (one_mul c).symm
    ... ≤ a * c : mul_le_mul_right' ha c0

lemma lt_mul_of_one_lt_of_le [mul_pos_strict_mono α]
  (ha : 1 < a) (bc : b ≤ c) (c0 : 0 < c) : b < a * c :=
calc  b ≤ c     : bc
    ... = 1 * c : (one_mul c).symm
    ... < a * c : mul_lt_mul_right' ha c0

lemma lt_mul_of_one_le_of_lt [mul_pos_mono α]
  (ha : 1 ≤ a) (bc : b < c) (c0 : 0 < c) : b < a * c :=
calc  b < c     : bc
    ... = 1 * c : (one_mul c).symm
    ... ≤ a * c : mul_le_mul_right' ha c0

lemma lt_mul_of_one_lt_of_lt [mul_pos_strict_mono α]
  (ha : 1 < a) (bc : b < c) (c0 : 0 < c) : b < a * c :=
calc  b < c     : bc
    ... = 1 * c : (one_mul c).symm
    ... < a * c : mul_lt_mul_right' ha c0

-- proven with `b0 : 0 ≤ b` as `right.one_le_mul_of_le_of_le`
/-- Assumes right covariance. -/
lemma preorder.right.one_le_mul_of_le_of_le [mul_pos_mono α]
  (ha : 1 ≤ a) (hb : 1 ≤ b) (b0 : 0 < b) : 1 ≤ a * b :=
preorder.le_mul_of_one_le_of_le ha hb b0

/-- Assumes right covariance. -/
lemma right.one_lt_mul_of_lt_of_le [mul_pos_strict_mono α]
  (ha : 1 < a) (hb : 1 ≤ b) (b0 : 0 < b) : 1 < a * b :=
lt_mul_of_one_lt_of_le ha hb b0

/-- Assumes right covariance. -/
lemma right.one_lt_mul_of_le_of_lt [mul_pos_mono α]
  (ha : 1 ≤ a) (hb : 1 < b) (b0 : 0 < b) : 1 < a * b :=
lt_mul_of_one_le_of_lt ha hb b0

/-- Assumes right covariance. -/
lemma right.one_lt_mul_of_lt_of_lt [mul_pos_strict_mono α]
  (ha : 1 < a) (hb : 1 < b) (b0 : 0 < b) : 1 < a * b :=
lt_mul_of_one_lt_of_lt ha hb b0

-- proven with `a0 : 0 ≤ a` as `mul_le_of_le_one_right`
lemma preorder.mul_le_of_le_one_right [pos_mul_mono α] (h : b ≤ 1) (a0 : 0 < a) :
  a * b ≤ a :=
preorder.mul_le_of_le_of_le_one le_rfl h a0

-- proven with `a0 : 0 ≤ a` as `le_mul_of_one_le_right`
lemma preorder.le_mul_of_one_le_right [pos_mul_mono α] (h : 1 ≤ b) (a0 : 0 < a) :
  a ≤ a * b :=
preorder.le_mul_of_le_of_one_le le_rfl h a0

-- proven with `b0 : 0 ≤ b` as `mul_le_of_le_one_left`
lemma preorder.mul_le_of_le_one_left [mul_pos_mono α] (h : a ≤ 1) (b0 : 0 < b) :
  a * b ≤ b :=
preorder.mul_le_of_le_one_of_le h le_rfl b0

-- proven with `b0 : 0 ≤ b` as `le_mul_of_one_le_left`
lemma preorder.le_mul_of_one_le_left [mul_pos_mono α] (h : 1 ≤ a) (b0 : 0 < b) :
  b ≤ a * b :=
preorder.le_mul_of_one_le_of_le h le_rfl b0

-- proven with `a0 : 0 ≤ a` as `le_of_mul_le_of_one_le_left`
lemma preorder.le_of_mul_le_of_one_le_left [pos_mul_mono α]
  (h : a * b ≤ c) (hle : 1 ≤ b) (a0 : 0 < a) :
  a ≤ c :=
(preorder.le_mul_of_one_le_right hle a0).trans h

lemma lt_of_mul_lt_of_one_le_left [pos_mul_mono α]
  (h : a * b < c) (hle : 1 ≤ b) (a0 : 0 < a) :
  a < c :=
(preorder.le_mul_of_one_le_right hle a0).trans_lt h

-- proven with `b0 : 0 ≤ b` as `le_of_le_mul_of_le_one_left`
lemma preorder.le_of_le_mul_of_le_one_left [pos_mul_mono α]
  (h : a ≤ b * c) (hle : c ≤ 1) (b0 : 0 < b) :
  a ≤ b :=
h.trans (preorder.mul_le_of_le_one_right hle b0)

lemma lt_of_lt_mul_of_le_one_left [pos_mul_mono α]
  (h : a < b * c) (hle : c ≤ 1) (b0 : 0 < b) :
  a < b :=
h.trans_le (preorder.mul_le_of_le_one_right hle b0)

-- proven with `b0 : 0 ≤ b` as `le_of_mul_le_of_one_le_right`
lemma preorder.le_of_mul_le_of_one_le_right [mul_pos_mono α]
  (h : a * b ≤ c) (hle : 1 ≤ a) (b0 : 0 < b) :
  b ≤ c :=
(preorder.le_mul_of_one_le_left hle b0).trans h

lemma lt_of_mul_lt_of_one_le_right [mul_pos_mono α]
  (h : a * b < c) (hle : 1 ≤ a) (b0 : 0 < b) :
  b < c :=
(preorder.le_mul_of_one_le_left hle b0).trans_lt h

-- proven with `c0 : 0 ≤ b` as `le_of_le_mul_of_le_one_right`
lemma le_of_le_mul_of_le_one_right' [mul_pos_mono α]
  (h : a ≤ b * c) (hle : b ≤ 1) (c0 : 0 < c) :
  a ≤ c :=
h.trans (preorder.mul_le_of_le_one_left hle c0)

lemma lt_of_lt_mul_of_le_one_right [mul_pos_mono α]
  (h : a < b * c) (hle : b ≤ 1) (c0 : 0 < c) :
  a < c :=
h.trans_le (preorder.mul_le_of_le_one_left hle c0)

end preorder

section linear_order
variables [linear_order α]

-- proven with `a0 : 0 ≤ a` as `exists_square_le`
lemma exists_square_le' [pos_mul_strict_mono α]
  (a0 : 0 < a) : ∃ (b : α), b * b ≤ a :=
begin
  by_cases h : a < 1,
  { use a,
    have : a*a < a*1,
    exact mul_lt_mul_left' h a0,
    rw mul_one at this,
    exact le_of_lt this },
  { use 1,
    push_neg at h,
    rwa mul_one }
end

end linear_order

end mul_one_class

section mul_zero_one_class
variables [mul_zero_one_class α]

section partial_order
variables [partial_order α]

lemma mul_le_of_le_of_le_one [pos_mul_mono α]
  (bc : b ≤ c) (ha : a ≤ 1) (b0 : 0 ≤ b) : b * a ≤ c :=
b0.lt_or_eq.elim (preorder.mul_le_of_le_of_le_one bc ha)
  (λ h, by rw [← h, zero_mul]; exact b0.trans bc)

/-- Assumes left covariance. -/
lemma left.mul_le_one_of_le_of_le [pos_mul_mono α]
  (ha : a ≤ 1) (hb : b ≤ 1) (a0 : 0 ≤ a) : a * b ≤ 1 :=
mul_le_of_le_of_le_one ha hb a0

lemma le_mul_of_le_of_one_le [pos_mul_mono α]
  (bc : b ≤ c) (ha : 1 ≤ a) (c0 : 0 ≤ c) : b ≤ c * a :=
c0.lt_or_eq.elim (preorder.le_mul_of_le_of_one_le bc ha)
  (λ h, by rw [← h, zero_mul] at *; exact bc)

/-- Assumes left covariance. -/
lemma left.one_le_mul_of_le_of_le [pos_mul_mono α]
  (ha : 1 ≤ a) (hb : 1 ≤ b) (a0 : 0 ≤ a) : 1 ≤ a * b :=
le_mul_of_le_of_one_le ha hb a0

lemma mul_le_of_le_one_of_le [mul_pos_mono α]
  (ha : a ≤ 1) (bc : b ≤ c) (b0 : 0 ≤ b) : a * b ≤ c :=
b0.lt_or_eq.elim (preorder.mul_le_of_le_one_of_le ha bc)
  (λ h, by rw [← h, mul_zero] at *; exact bc)

/-- Assumes right covariance. -/
lemma right.mul_le_one_of_le_of_le [mul_pos_mono α]
  (ha : a ≤ 1) (hb : b ≤ 1) (b0 : 0 < b) : a * b ≤ 1 :=
preorder.mul_le_of_le_one_of_le ha hb b0

lemma le_mul_of_one_le_of_le [mul_pos_mono α]
  (ha : 1 ≤ a) (bc : b ≤ c) (c0 : 0 ≤ c) : b ≤ a * c :=
c0.lt_or_eq.elim (preorder.le_mul_of_one_le_of_le ha bc)
  (λ h, by rw [← h, mul_zero] at *; exact bc)

/-- Assumes right covariance. -/
lemma right.one_le_mul_of_le_of_le [mul_pos_mono α]
  (ha : 1 ≤ a) (hb : 1 ≤ b) (b0 : 0 ≤ b) : 1 ≤ a * b :=
le_mul_of_one_le_of_le ha hb b0

lemma mul_le_of_le_one_right [pos_mul_mono α] (h : b ≤ 1) (a0 : 0 ≤ a) :
  a * b ≤ a :=
mul_le_of_le_of_le_one le_rfl h a0

lemma le_mul_of_one_le_right [pos_mul_mono α] (h : 1 ≤ b) (a0 : 0 ≤ a) :
  a ≤ a * b :=
le_mul_of_le_of_one_le le_rfl h a0

lemma mul_le_of_le_one_left [mul_pos_mono α] (h : a ≤ 1) (b0 : 0 ≤ b) :
  a * b ≤ b :=
mul_le_of_le_one_of_le h le_rfl b0

lemma le_mul_of_one_le_left [mul_pos_mono α] (h : 1 ≤ a) (b0 : 0 ≤ b) :
  b ≤ a * b :=
le_mul_of_one_le_of_le h le_rfl b0

lemma le_of_mul_le_of_one_le_left [pos_mul_mono α]
  (h : a * b ≤ c) (hle : 1 ≤ b) (a0 : 0 ≤ a) :
  a ≤ c :=
a0.lt_or_eq.elim (preorder.le_of_mul_le_of_one_le_left h hle)
  (λ ha, by simpa only [← ha, zero_mul] using h)

lemma le_of_le_mul_of_le_one_left [pos_mul_mono α]
  (h : a ≤ b * c) (hle : c ≤ 1) (b0 : 0 ≤ b) :
  a ≤ b :=
b0.lt_or_eq.elim (preorder.le_of_le_mul_of_le_one_left h hle)
  (λ hb, by simpa only [← hb, zero_mul] using h)

lemma le_of_mul_le_of_one_le_right [mul_pos_mono α]
  (h : a * b ≤ c) (hle : 1 ≤ a) (b0 : 0 ≤ b) :
  b ≤ c :=
b0.lt_or_eq.elim (preorder.le_of_mul_le_of_one_le_right h hle)
  (λ ha, by simpa only [← ha, mul_zero] using h)

lemma le_of_le_mul_of_le_one_right [mul_pos_mono α]
  (h : a ≤ b * c) (hle : b ≤ 1) (c0 : 0 ≤ c) :
  a ≤ c :=
c0.lt_or_eq.elim (le_of_le_mul_of_le_one_right' h hle)
  (λ ha, by simpa only [← ha, mul_zero] using h)

end partial_order

section linear_order
variables [linear_order α]

lemma exists_square_le [pos_mul_strict_mono α]
  (a0 : 0 ≤ a) : ∃ (b : α), b * b ≤ a :=
a0.lt_or_eq.elim exists_square_le' (λ h, by rw [← h]; exact ⟨0, by simp⟩)

end linear_order

end mul_zero_one_class

end zero_lt


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Chris Hughes
-/
import ring_theory.coprime
import ring_theory.ideal.basic

/-!
# Lemmas about Euclidean domains

Various about Euclidean domains are proved; all of them seem to be true
more generally for principal ideal domains, so these lemmas should
probably be reproved in more generality and this file perhaps removed?

## Tags

euclidean domain
-/

noncomputable theory
open_locale classical
open euclidean_domain set ideal

-- TODO -- this should surely be proved for PIDs instead?

theorem span_gcd {α} [euclidean_domain α] (x y : α) :
  span ({gcd x y} : set α) = span ({x, y} : set α) :=
begin
  apply le_antisymm,
  { refine span_le.2 (λ x, _),
    simp only [set.mem_singleton_iff, set_like.mem_coe, mem_span_pair],
    rintro rfl,
    exact ⟨gcd_a x y, gcd_b x y, by simp [gcd_eq_gcd_ab, mul_comm]⟩ },
  { assume z ,
    simp [mem_span_singleton, euclidean_domain.gcd_dvd_left, mem_span_pair,
      @eq_comm _ _ z] {contextual := tt},
    assume a b h,
    exact dvd_add (dvd_mul_of_dvd_right (gcd_dvd_left _ _) _)
      (dvd_mul_of_dvd_right (gcd_dvd_right _ _) _) }
end
-- this should be proved for PIDs?
theorem gcd_is_unit_iff {α} [euclidean_domain α] {x y : α} :
  is_unit (gcd x y) ↔ is_coprime x y :=
⟨λ h, let ⟨b, hb⟩ := is_unit_iff_exists_inv'.1 h in ⟨b * gcd_a x y, b * gcd_b x y,
  by rw [← hb, gcd_eq_gcd_ab, mul_comm x, mul_comm y, mul_add, mul_assoc, mul_assoc]⟩,
λ ⟨a, b, h⟩, is_unit_iff_dvd_one.2 $ h ▸ dvd_add (dvd_mul_of_dvd_right (gcd_dvd_left x y) _)
  (dvd_mul_of_dvd_right (gcd_dvd_right x y) _)⟩

-- this should be proved for UFDs surely?
theorem is_coprime_of_dvd {α} [euclidean_domain α] {x y : α}
  (z : ¬ (x = 0 ∧ y = 0)) (H : ∀ z ∈ nonunits α, z ≠ 0 → z ∣ x → ¬ z ∣ y) :
  is_coprime x y :=
begin
  rw [← gcd_is_unit_iff],
  by_contra h,
  refine H _ h _ (gcd_dvd_left _ _) (gcd_dvd_right _ _),
  rwa [ne, euclidean_domain.gcd_eq_zero_iff]
end

-- this should be proved for UFDs surely?
theorem dvd_or_coprime {α} [euclidean_domain α] (x y : α)
  (h : irreducible x) : x ∣ y ∨ is_coprime x y :=
begin
  refine or_iff_not_imp_left.2 (λ h', _),
  apply is_coprime_of_dvd,
  { unfreezingI { rintro ⟨rfl, rfl⟩ }, simpa using h },
  { unfreezingI { rintro z nu nz ⟨w, rfl⟩ dy },
    refine h' (dvd.trans _ dy),
    simpa using mul_dvd_mul_left z (is_unit_iff_dvd_one.1 $
      (of_irreducible_mul h).resolve_left nu) }
end


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

! This file was ported from Lean 3 source module topology.algebra.nonarchimedean.adic_topology
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.Ideal.Operations
import Mathbin.Topology.Algebra.Nonarchimedean.Bases
import Mathbin.Topology.Algebra.UniformRing

/-!
# Adic topology

Given a commutative ring `R` and an ideal `I` in `R`, this file constructs the unique
topology on `R` which is compatible with the ring structure and such that a set is a neighborhood
of zero if and only if it contains a power of `I`. This topology is non-archimedean: every
neighborhood of zero contains an open subgroup, namely a power of `I`.

It also studies the predicate `is_adic` which states that a given topological ring structure is
adic, proving a characterization and showing that raising an ideal to a positive power does not
change the associated topology.

Finally, it defines `with_ideal`, a class registering an ideal in a ring and providing the
corresponding adic topology to the type class inference system.

## Main definitions and results

* `ideal.adic_basis`: the basis of submodules given by powers of an ideal.
* `ideal.adic_topology`: the adic topology associated to an ideal. It has the above basis
  for neighborhoods of zero.
* `ideal.nonarchimedean`: the adic topology is non-archimedean
* `is_ideal_adic_iff`: A topological ring is `J`-adic if and only if it admits the powers of `J` as
  a basis of open neighborhoods of zero.
* `with_ideal`: a class registering an ideal in a ring.

## Implementation notes

The `I`-adic topology on a ring `R` has a contrived definition using `I^n • ⊤` instead of `I`
to make sure it is definitionally equal to the `I`-topology on `R` seen as a `R`-module.

-/

variable {R : Type _} [CommRing R]

open Set TopologicalAddGroup Submodule Filter

open Topology Pointwise

namespace Ideal

theorem adicBasis (I : Ideal R) : SubmodulesRingBasis fun n : ℕ => (I ^ n • ⊤ : Ideal R) :=
  { inter := by
      suffices ∀ i j : ℕ, ∃ k, I ^ k ≤ I ^ i ∧ I ^ k ≤ I ^ j by simpa
      intro i j
      exact ⟨max i j, pow_le_pow (le_max_left i j), pow_le_pow (le_max_right i j)⟩
    leftMul := by
      suffices ∀ (a : R) (i : ℕ), ∃ j : ℕ, a • I ^ j ≤ I ^ i by simpa
      intro r n
      use n
      rintro a ⟨x, hx, rfl⟩
      exact (I ^ n).smul_mem r hx
    mul := by
      suffices ∀ i : ℕ, ∃ j : ℕ, ↑(I ^ j) * ↑(I ^ j) ⊆ ↑(I ^ i) by simpa
      intro n
      use n
      rintro a ⟨x, b, hx, hb, rfl⟩
      exact (I ^ n).smul_mem x hb }
#align ideal.adic_basis Ideal.adicBasis

/-- The adic ring filter basis associated to an ideal `I` is made of powers of `I`. -/
def ringFilterBasis (I : Ideal R) :=
  I.adicBasis.toRing_subgroups_basis.toRingFilterBasis
#align ideal.ring_filter_basis Ideal.ringFilterBasis

/-- The adic topology associated to an ideal `I`. This topology admits powers of `I` as a basis of
neighborhoods of zero. It is compatible with the ring structure and is non-archimedean. -/
def adicTopology (I : Ideal R) : TopologicalSpace R :=
  (adicBasis I).topology
#align ideal.adic_topology Ideal.adicTopology

theorem nonarchimedean (I : Ideal R) : @NonarchimedeanRing R _ I.adicTopology :=
  I.adicBasis.toRing_subgroups_basis.nonarchimedean
#align ideal.nonarchimedean Ideal.nonarchimedean

/-- For the `I`-adic topology, the neighborhoods of zero has basis given by the powers of `I`. -/
theorem hasBasis_nhds_zero_adic (I : Ideal R) :
    HasBasis (@nhds R I.adicTopology (0 : R)) (fun n : ℕ => True) fun n =>
      ((I ^ n : Ideal R) : Set R) :=
  ⟨by
    intro U
    rw [I.ring_filter_basis.to_add_group_filter_basis.nhds_zero_has_basis.mem_iff]
    constructor
    · rintro ⟨-, ⟨i, rfl⟩, h⟩
      replace h : ↑(I ^ i) ⊆ U := by simpa using h
      use i, trivial, h
    · rintro ⟨i, -, h⟩
      exact ⟨(I ^ i : Ideal R), ⟨i, by simp⟩, h⟩⟩
#align ideal.has_basis_nhds_zero_adic Ideal.hasBasis_nhds_zero_adic

theorem hasBasis_nhds_adic (I : Ideal R) (x : R) :
    HasBasis (@nhds R I.adicTopology x) (fun n : ℕ => True) fun n =>
      (fun y => x + y) '' (I ^ n : Ideal R) :=
  by
  letI := I.adic_topology
  have := I.has_basis_nhds_zero_adic.map fun y => x + y
  rwa [map_add_left_nhds_zero x] at this
#align ideal.has_basis_nhds_adic Ideal.hasBasis_nhds_adic

variable (I : Ideal R) (M : Type _) [AddCommGroup M] [Module R M]

theorem adicModuleBasis :
    I.RingFilterBasis.SubmodulesBasis fun n : ℕ => I ^ n • (⊤ : Submodule R M) :=
  { inter := fun i j =>
      ⟨max i j,
        le_inf_iff.mpr
          ⟨smul_mono_left <| pow_le_pow (le_max_left i j),
            smul_mono_left <| pow_le_pow (le_max_right i j)⟩⟩
    smul := fun m i =>
      ⟨(I ^ i • ⊤ : Ideal R), ⟨i, rfl⟩, fun a a_in =>
        by
        replace a_in : a ∈ I ^ i := by simpa [(I ^ i).mul_top] using a_in
        exact smul_mem_smul a_in mem_top⟩ }
#align ideal.adic_module_basis Ideal.adicModuleBasis

/-- The topology on a `R`-module `M` associated to an ideal `M`. Submodules $I^n M$,
written `I^n • ⊤` form a basis of neighborhoods of zero. -/
def adicModuleTopology : TopologicalSpace M :=
  @ModuleFilterBasis.topology R M _ I.adicBasis.topology _ _
    (I.RingFilterBasis.ModuleFilterBasis (I.adicModuleBasis M))
#align ideal.adic_module_topology Ideal.adicModuleTopology

/-- The elements of the basis of neighborhoods of zero for the `I`-adic topology
on a `R`-module `M`, seen as open additive subgroups of `M`. -/
def openAddSubgroup (n : ℕ) : @OpenAddSubgroup R _ I.adicTopology :=
  { (I ^ n).toAddSubgroup with
    is_open' := by
      letI := I.adic_topology
      convert(I.adic_basis.to_ring_subgroups_basis.open_add_subgroup n).IsOpen
      simp }
#align ideal.open_add_subgroup Ideal.openAddSubgroup

end Ideal

section IsAdic

/-- Given a topology on a ring `R` and an ideal `J`, `is_adic J` means the topology is the
`J`-adic one. -/
def IsAdic [H : TopologicalSpace R] (J : Ideal R) : Prop :=
  H = J.adicTopology
#align is_adic IsAdic

/-- A topological ring is `J`-adic if and only if it admits the powers of `J` as a basis of
open neighborhoods of zero. -/
theorem isAdic_iff [top : TopologicalSpace R] [TopologicalRing R] {J : Ideal R} :
    IsAdic J ↔
      (∀ n : ℕ, IsOpen ((J ^ n : Ideal R) : Set R)) ∧
        ∀ s ∈ 𝓝 (0 : R), ∃ n : ℕ, ((J ^ n : Ideal R) : Set R) ⊆ s :=
  by
  constructor
  · intro H
    change _ = _ at H
    rw [H]
    letI := J.adic_topology
    constructor
    · intro n
      exact (J.open_add_subgroup n).is_open'
    · intro s hs
      simpa using J.has_basis_nhds_zero_adic.mem_iff.mp hs
  · rintro ⟨H₁, H₂⟩
    apply TopologicalAddGroup.ext
    · apply @TopologicalRing.to_topologicalAddGroup
    · apply (RingSubgroupsBasis.toRingFilterBasis _).toAddGroupFilterBasis.is_topological_add_group
    · ext s
      letI := Ideal.adicBasis J
      rw [J.has_basis_nhds_zero_adic.mem_iff]
      constructor <;> intro H
      · rcases H₂ s H with ⟨n, h⟩
        use n, trivial, h
      · rcases H with ⟨n, -, hn⟩
        rw [mem_nhds_iff]
        refine' ⟨_, hn, H₁ n, (J ^ n).zero_mem⟩
#align is_adic_iff isAdic_iff

variable [TopologicalSpace R] [TopologicalRing R]

theorem is_ideal_adic_pow {J : Ideal R} (h : IsAdic J) {n : ℕ} (hn : 0 < n) : IsAdic (J ^ n) :=
  by
  rw [isAdic_iff] at h⊢
  constructor
  · intro m
    rw [← pow_mul]
    apply h.left
  · intro V hV
    cases' h.right V hV with m hm
    use m
    refine' Set.Subset.trans _ hm
    cases n
    · exfalso
      exact Nat.not_succ_le_zero 0 hn
    rw [← pow_mul, Nat.succ_mul]
    apply Ideal.pow_le_pow
    apply Nat.le_add_left
#align is_ideal_adic_pow is_ideal_adic_pow

theorem is_bot_adic_iff {A : Type _} [CommRing A] [TopologicalSpace A] [TopologicalRing A] :
    IsAdic (⊥ : Ideal A) ↔ DiscreteTopology A :=
  by
  rw [isAdic_iff]
  constructor
  · rintro ⟨h, h'⟩
    rw [discreteTopology_iff_open_singleton_zero]
    simpa using h 1
  · intros
    constructor
    · simp
    · intro U U_nhds
      use 1
      simp [mem_of_mem_nhds U_nhds]
#align is_bot_adic_iff is_bot_adic_iff

end IsAdic

/-- The ring `R` is equipped with a preferred ideal. -/
class WithIdeal (R : Type _) [CommRing R] where
  i : Ideal R
#align with_ideal WithIdeal

namespace WithIdeal

variable (R) [WithIdeal R]

instance (priority := 100) : TopologicalSpace R :=
  i.adicTopology

instance (priority := 100) : NonarchimedeanRing R :=
  RingSubgroupsBasis.nonarchimedean _

instance (priority := 100) : UniformSpace R :=
  TopologicalAddGroup.toUniformSpace R

instance (priority := 100) : UniformAddGroup R :=
  comm_topologicalAddGroup_is_uniform

/-- The adic topology on a `R` module coming from the ideal `with_ideal.I`.
This cannot be an instance because `R` cannot be inferred from `M`. -/
def topologicalSpaceModule (M : Type _) [AddCommGroup M] [Module R M] : TopologicalSpace M :=
  (i : Ideal R).adicModuleTopology M
#align with_ideal.topological_space_module WithIdeal.topologicalSpaceModule

/-
The next examples are kept to make sure potential future refactors won't break the instance
chaining.
-/
example : NonarchimedeanRing R := by infer_instance

example : TopologicalRing (UniformSpace.Completion R) := by infer_instance

example (M : Type _) [AddCommGroup M] [Module R M] :
    @TopologicalAddGroup M (WithIdeal.topologicalSpaceModule R M) _ := by infer_instance

example (M : Type _) [AddCommGroup M] [Module R M] :
    @ContinuousSMul R M _ _ (WithIdeal.topologicalSpaceModule R M) := by infer_instance

example (M : Type _) [AddCommGroup M] [Module R M] :
    @NonarchimedeanAddGroup M _ (WithIdeal.topologicalSpaceModule R M) :=
  SubmodulesBasis.nonarchimedean _

end WithIdeal


import for_mathlib.nonarchimedean.is_subgroups_basis
import for_mathlib.uniform_space.group_basis
import valuation.basic

/-!
# The topology on a valued ring

In this file, we define the topology induced by a valuation on a ring.
-/

open_locale classical topological_space
noncomputable theory

local attribute [instance, priority 0] classical.DLO

open set valuation linear_ordered_structure

section
variables {Γ₀ : Type*} [linear_ordered_comm_group_with_zero Γ₀]
variables {R : Type*} [ring R]

/-- The subgroup of elements whose valuation is less than a certain unit.-/
def valuation.subgroup (v : valuation R Γ₀) (γ : units Γ₀) : set R := {x | v x < γ}

lemma valuation.lt_is_add_subgroup (v : valuation R Γ₀) (γ : units Γ₀) :
  is_add_subgroup {x | v x < γ} :=
{ zero_mem := by { have h := group_with_zero.unit_ne_zero γ, contrapose! h, simpa using h },
  add_mem := λ x y x_in y_in, lt_of_le_of_lt (v.map_add x y) (max_lt x_in y_in),
  neg_mem := λ x x_in, by rwa [mem_set_of_eq, map_neg] }

-- is this an OK place to put this?
lemma valuation.le_is_add_subgroup (v : valuation R Γ₀) (γ : units Γ₀) : is_add_subgroup {x | v x ≤ γ} :=
{ zero_mem := by simp,
  add_mem := λ x y x_in y_in, le_trans (v.map_add x y) (max_le x_in y_in),
  neg_mem := λ x x_in, by rwa [mem_set_of_eq, map_neg] }

end

local attribute [instance] valuation.lt_is_add_subgroup

universe u

/-- A valued ring is a ring that comes equipped with a distinguished valuation.-/
class valued (R : Type u) [ring R] :=
(Γ₀ : Type u)
[grp : linear_ordered_comm_group_with_zero Γ₀]
(v : valuation R Γ₀)

attribute [instance] valued.grp

open valued

namespace valued
variables {R : Type*} [ring R] [valued R]

/-- The function underlying the valuation of a valued ring.-/
def value : R → (valued.Γ₀ R) := (valued.v R)

local notation `v` := valued.value

-- The following four lemmas are restatements that seem to be unfortunately needed

lemma map_zero : v (0 : R) = 0 :=
valuation.map_zero _

lemma map_one : v (1 : R) = 1 :=
valuation.map_one _

lemma map_mul (x y : R) : v (x*y) = v x * v y :=
valuation.map_mul _ _ _

lemma map_add (x y : R) : v (x+y) ≤ max (v x) (v y) :=
valuation.map_add _ _ _

/-- The basis of open subgroups for the topology on a valued ring.-/
def subgroups_basis : subgroups_basis R :=
{ sets := range (valued.v R).subgroup,
  ne_empty := ⟨_, mem_range_self 1⟩,
  directed := begin
    rintros _ _ ⟨γ₀, rfl⟩ ⟨γ₁, rfl⟩,
    rw exists_mem_range,
    use min γ₀ γ₁,
    simp only [set_of_subset_set_of, subset_inter_iff, valuation.subgroup],
    split ; intros x x_lt ;  rw coe_min at x_lt,
    { exact lt_of_lt_of_le x_lt (min_le_left _ _) },
    { exact lt_of_lt_of_le x_lt (min_le_right _ _) }
  end,
  sub_groups := by { rintros _ ⟨γ, rfl⟩, exact (valued.v R).lt_is_add_subgroup γ },
  h_mul := begin
    rintros _ ⟨γ, rfl⟩,
    rw set.exists_mem_range',
    cases linear_ordered_structure.exists_square_le γ with γ₀ h,
    replace h : (γ₀*γ₀ : valued.Γ₀ R) ≤ γ, exact_mod_cast h,
    use γ₀,
    rintro x ⟨r, r_in, s, s_in, rfl⟩,
    refine lt_of_lt_of_le _ h,
    rw valuation.map_mul,
    exact mul_lt_mul' r_in s_in
  end,
  h_left_mul := begin
      rintros x _ ⟨γ, rfl⟩,
      rw exists_mem_range',
     dsimp [valuation.subgroup],
      by_cases Hx : ∃ γx : units (Γ₀ R), v x = (γx : Γ₀ R),
      { cases Hx with γx Hx,
        simp only [image_subset_iff, set_of_subset_set_of, preimage_set_of_eq, valuation.map_mul],
        use γx⁻¹*γ,
        intros y vy_lt,
        change  v y < ↑(γx⁻¹ * γ) at vy_lt,
        change v x * v y < ↑γ,
        rw Hx,
        rw units.coe_mul at vy_lt,
        apply actual_ordered_comm_monoid.lt_of_mul_lt_mul_left (γx⁻¹ : Γ₀ R),
        rwa [← mul_assoc, inv_mul_cancel' _ (group_with_zero.unit_ne_zero _), one_mul,
          ← group_with_zero.coe_inv_unit] },
      { rw [← ne_zero_iff_exists, not_not] at Hx,
        use 1,
        intros y y_in,
        erw [mem_set_of_eq, valuation.map_mul],
        change v x * v y < _,
        erw [Hx, zero_mul],
        exact zero_lt_unit _ }
  end,
  h_right_mul := begin
    rintros x _ ⟨γ, rfl⟩,
    rw exists_mem_range',
    dsimp [valuation.subgroup],
    by_cases Hx : ∃ γx : units (Γ₀ R), v x = γx,
    { cases Hx with γx Hx,
      simp only [image_subset_iff, set_of_subset_set_of, preimage_set_of_eq, valuation.map_mul],
      use γ * γx⁻¹,
      intros y vy_lt,
      change v y * v x < _,
      rw Hx,
      apply actual_ordered_comm_monoid.lt_of_mul_lt_mul_right' (γx⁻¹ : Γ₀ R),
      rwa [mul_assoc, mul_inv_cancel' _ (group_with_zero.unit_ne_zero _), mul_one,
        ← group_with_zero.coe_inv_unit], },
    { rw [← ne_zero_iff_exists, not_not] at Hx,
      use 1,
      intros y y_in,
      rw [mem_set_of_eq, valuation.map_mul],
      change v y * v x < _,
      erw [Hx, mul_zero],
      exact zero_lt_unit _ }
  end }

local attribute [instance] valued.subgroups_basis subgroups_basis.topology ring_filter_basis.topological_ring

lemma mem_basis_zero {s : set R} :
  s ∈ filter_basis.sets R ↔ ∃ γ : units (valued.Γ₀ R), {x | valued.v R x < (γ : valued.Γ₀ R)} = s :=
iff.rfl

lemma mem_nhds {s : set R} {x : R} :
  (s ∈ 𝓝 x) ↔ ∃ γ : units (valued.Γ₀ R), {y | v (y - x) < γ } ⊆ s :=
begin
  erw [subgroups_basis.mem_nhds, exists_mem_range],
  exact iff.rfl,
end

lemma mem_nhds_zero {s : set R} :
  (s ∈ 𝓝 (0 : R)) ↔ ∃ γ : units (Γ₀ R), {x | v x < (γ : Γ₀ R) } ⊆ s :=
by simp [valued.mem_nhds, sub_zero]

lemma loc_const {x : R} (h : v x ≠ 0) : {y : R | v y = v x} ∈ 𝓝 x :=
begin
  rw valued.mem_nhds,
  rcases ne_zero_iff_exists.mp h with ⟨γ, hx⟩,
  use γ,
  rw ← hx,
  intros y y_in,
  exact valuation.map_eq_of_sub_lt _ y_in
end

/-- The uniform structure on a valued ring.-/
def uniform_space : uniform_space R :=
topological_add_group.to_uniform_space R

local attribute [instance] valued.uniform_space

/-- A valued ring is a uniform additive group.-/
lemma uniform_add_group : uniform_add_group R :=
topological_add_group_is_uniform

local attribute [instance] valued.uniform_add_group

lemma cauchy_iff {F : filter R} :
  cauchy F ↔ F ≠ ⊥ ∧ ∀ γ : units (valued.Γ₀ R), ∃ M ∈ F,
    ∀ x y, x ∈ M → y ∈ M → y - x ∈ {x : R | valued.v R x < ↑γ} :=
begin
    rw add_group_filter_basis.cauchy_iff R rfl,
    apply and_congr iff.rfl,
    split,
    { intros h γ,
      apply h,
      erw valued.mem_basis_zero,
      use γ },
    { intros h U U_in,
      rcases valued.mem_basis_zero.mp U_in with ⟨γ, rfl⟩, clear U_in,
      apply h }
end
end valued


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Chris Hughes, Mario Carneiro

! This file was ported from Lean 3 source module ring_theory.ideal.basic
! leanprover-community/mathlib commit dc6c365e751e34d100e80fe6e314c3c3e0fd2988
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Associated
import Mathlib.LinearAlgebra.Basic
import Mathlib.Order.Atoms
import Mathlib.Order.CompactlyGenerated
import Mathlib.Tactic.Abel
import Mathlib.Data.Nat.Choose.Sum
import Mathlib.LinearAlgebra.Finsupp

/-!

# Ideals over a ring

This file defines `Ideal R`, the type of (left) ideals over a ring `R`.
Note that over commutative rings, left ideals and two-sided ideals are equivalent.

## Implementation notes

`Ideal R` is implemented using `Submodule R R`, where `•` is interpreted as `*`.

## TODO

Support right ideals, and two-sided ideals over non-commutative rings.
-/

universe u v w

variable {α : Type u} {β : Type v}

open Set Function

open Classical BigOperators Pointwise

/-- A (left) ideal in a semiring `R` is an additive submonoid `s` such that
`a * b ∈ s` whenever `b ∈ s`. If `R` is a ring, then `s` is an additive subgroup.  -/
@[reducible]
def Ideal (R : Type u) [Semiring R] :=
  Submodule R R
#align ideal Ideal

section Semiring

namespace Ideal

variable [Semiring α] (I : Ideal α) {a b : α}

protected theorem zero_mem : (0 : α) ∈ I :=
  Submodule.zero_mem I
#align ideal.zero_mem Ideal.zero_mem

protected theorem add_mem : a ∈ I → b ∈ I → a + b ∈ I :=
  Submodule.add_mem I
#align ideal.add_mem Ideal.add_mem

variable (a)

theorem mul_mem_left : b ∈ I → a * b ∈ I :=
  Submodule.smul_mem I a
#align ideal.mul_mem_left Ideal.mul_mem_left

variable {a}

@[ext]

theorem sum_mem (I : Ideal α) {ι : Type _} {t : Finset ι} {f : ι → α} :
    (∀ c ∈ t, f c ∈ I) → (∑ i in t, f i) ∈ I :=
  Submodule.sum_mem I
#align ideal.sum_mem Ideal.sum_mem

theorem eq_top_of_unit_mem (x y : α) (hx : x ∈ I) (h : y * x = 1) : I = ⊤ :=
  eq_top_iff.2 fun z _ =>
    calc
      z = z * (y * x) := by simp [h]
      _ = z * y * x := Eq.symm <| mul_assoc z y x
      _ ∈ I := I.mul_mem_left _ hx

#align ideal.eq_top_of_unit_mem Ideal.eq_top_of_unit_mem

theorem eq_top_of_isUnit_mem {x} (hx : x ∈ I) (h : IsUnit x) : I = ⊤ :=
  let ⟨y, hy⟩ := h.exists_left_inv
  eq_top_of_unit_mem I x y hx hy
#align ideal.eq_top_of_is_unit_mem Ideal.eq_top_of_isUnit_mem

theorem eq_top_iff_one : I = ⊤ ↔ (1 : α) ∈ I :=
  ⟨by rintro rfl; trivial, fun h => eq_top_of_unit_mem _ _ 1 h (by simp)⟩
#align ideal.eq_top_iff_one Ideal.eq_top_iff_one

theorem ne_top_iff_one : I ≠ ⊤ ↔ (1 : α) ∉ I :=
  not_congr I.eq_top_iff_one
#align ideal.ne_top_iff_one Ideal.ne_top_iff_one

@[simp]
theorem unit_mul_mem_iff_mem {x y : α} (hy : IsUnit y) : y * x ∈ I ↔ x ∈ I := by
  refine' ⟨fun h => _, fun h => I.mul_mem_left y h⟩
  obtain ⟨y', hy'⟩ := hy.exists_left_inv
  have := I.mul_mem_left y' h
  rwa [← mul_assoc, hy', one_mul] at this
#align ideal.unit_mul_mem_iff_mem Ideal.unit_mul_mem_iff_mem

/-- The ideal generated by a subset of a ring -/
def span (s : Set α) : Ideal α :=
  Submodule.span α s
#align ideal.span Ideal.span

@[simp]
theorem submodule_span_eq {s : Set α} : Submodule.span α s = Ideal.span s :=
  rfl
#align ideal.submodule_span_eq Ideal.submodule_span_eq

@[simp]
theorem span_empty : span (∅ : Set α) = ⊥ :=
  Submodule.span_empty
#align ideal.span_empty Ideal.span_empty

@[simp]
theorem span_univ : span (Set.univ : Set α) = ⊤ :=
  Submodule.span_univ
#align ideal.span_univ Ideal.span_univ

theorem span_union (s t : Set α) : span (s ∪ t) = span s ⊔ span t :=
  Submodule.span_union _ _
#align ideal.span_union Ideal.span_union

theorem span_unionᵢ {ι} (s : ι → Set α) : span (⋃ i, s i) = ⨆ i, span (s i) :=
  Submodule.span_unionᵢ _
#align ideal.span_Union Ideal.span_unionᵢ

theorem mem_span {s : Set α} (x) : x ∈ span s ↔ ∀ p : Ideal α, s ⊆ p → x ∈ p :=
  mem_interᵢ₂
#align ideal.mem_span Ideal.mem_span

theorem subset_span {s : Set α} : s ⊆ span s :=
  Submodule.subset_span
#align ideal.subset_span Ideal.subset_span

theorem span_le {s : Set α} {I} : span s ≤ I ↔ s ⊆ I :=
  Submodule.span_le
#align ideal.span_le Ideal.span_le

theorem span_mono {s t : Set α} : s ⊆ t → span s ≤ span t :=
  Submodule.span_mono
#align ideal.span_mono Ideal.span_mono

@[simp]
theorem span_eq : span (I : Set α) = I :=
  Submodule.span_eq _
#align ideal.span_eq Ideal.span_eq

@[simp]
theorem span_singleton_one : span ({1} : Set α) = ⊤ :=
  (eq_top_iff_one _).2 <| subset_span <| mem_singleton _
#align ideal.span_singleton_one Ideal.span_singleton_one

theorem mem_span_insert {s : Set α} {x y} :
    x ∈ span (insert y s) ↔ ∃ a, ∃ z ∈ span s, x = a * y + z :=
  Submodule.mem_span_insert
#align ideal.mem_span_insert Ideal.mem_span_insert

theorem mem_span_singleton' {x y : α} : x ∈ span ({y} : Set α) ↔ ∃ a, a * y = x :=
  Submodule.mem_span_singleton
#align ideal.mem_span_singleton' Ideal.mem_span_singleton'

theorem span_singleton_le_iff_mem {x : α} : span {x} ≤ I ↔ x ∈ I :=
  Submodule.span_singleton_le_iff_mem _ _
#align ideal.span_singleton_le_iff_mem Ideal.span_singleton_le_iff_mem

theorem span_singleton_mul_left_unit {a : α} (h2 : IsUnit a) (x : α) :
    span ({a * x} : Set α) = span {x} := by
  apply le_antisymm <;> rw [span_singleton_le_iff_mem, mem_span_singleton']
  exacts[⟨a, rfl⟩, ⟨_, h2.unit.inv_mul_cancel_left x⟩]
#align ideal.span_singleton_mul_left_unit Ideal.span_singleton_mul_left_unit

theorem span_insert (x) (s : Set α) : span (insert x s) = span ({x} : Set α) ⊔ span s :=
  Submodule.span_insert x s
#align ideal.span_insert Ideal.span_insert

theorem span_eq_bot {s : Set α} : span s = ⊥ ↔ ∀ x ∈ s, (x : α) = 0 :=
  Submodule.span_eq_bot
#align ideal.span_eq_bot Ideal.span_eq_bot

@[simp]
theorem span_singleton_eq_bot {x} : span ({x} : Set α) = ⊥ ↔ x = 0 :=
  Submodule.span_singleton_eq_bot
#align ideal.span_singleton_eq_bot Ideal.span_singleton_eq_bot

theorem span_singleton_ne_top {α : Type _} [CommSemiring α] {x : α} (hx : ¬IsUnit x) :
    Ideal.span ({x} : Set α) ≠ ⊤ :=
  (Ideal.ne_top_iff_one _).mpr fun h1 =>
    let ⟨y, hy⟩ := Ideal.mem_span_singleton'.mp h1
    hx ⟨⟨x, y, mul_comm y x ▸ hy, hy⟩, rfl⟩
#align ideal.span_singleton_ne_top Ideal.span_singleton_ne_top

@[simp]
theorem span_zero : span (0 : Set α) = ⊥ := by rw [← Set.singleton_zero, span_singleton_eq_bot]
#align ideal.span_zero Ideal.span_zero

@[simp]
theorem span_one : span (1 : Set α) = ⊤ := by rw [← Set.singleton_one, span_singleton_one]
#align ideal.span_one Ideal.span_one

theorem span_eq_top_iff_finite (s : Set α) :
    span s = ⊤ ↔ ∃ s' : Finset α, ↑s' ⊆ s ∧ span (s' : Set α) = ⊤ := by
  simp_rw [eq_top_iff_one]
  exact ⟨Submodule.mem_span_finite_of_mem_span, fun ⟨s', h₁, h₂⟩ => span_mono h₁ h₂⟩
#align ideal.span_eq_top_iff_finite Ideal.span_eq_top_iff_finite

theorem mem_span_singleton_sup {S : Type _} [CommSemiring S] {x y : S} {I : Ideal S} :
    x ∈ Ideal.span {y} ⊔ I ↔ ∃ a : S, ∃ b ∈ I, a * y + b = x := by
  rw [Submodule.mem_sup]
  constructor
  · rintro ⟨ya, hya, b, hb, rfl⟩
    obtain ⟨a, rfl⟩ := mem_span_singleton'.mp hya
    exact ⟨a, b, hb, rfl⟩
  · rintro ⟨a, b, hb, rfl⟩
    exact ⟨a * y, Ideal.mem_span_singleton'.mpr ⟨a, rfl⟩, b, hb, rfl⟩
#align ideal.mem_span_singleton_sup Ideal.mem_span_singleton_sup

/-- The ideal generated by an arbitrary binary relation.
-/
def ofRel (r : α → α → Prop) : Ideal α :=
  Submodule.span α { x | ∃ (a b : _)(_h : r a b), x + b = a }
#align ideal.of_rel Ideal.ofRel

/-- An ideal `P` of a ring `R` is prime if `P ≠ R` and `xy ∈ P → x ∈ P ∨ y ∈ P` -/
class IsPrime (I : Ideal α) : Prop where
  /-- The prime ideal is not the entire ring. -/
  ne_top' : I ≠ ⊤
  /-- If a product lies in the prime ideal, then at least one element lies in the prime ideal. -/
  mem_or_mem' : ∀ {x y : α}, x * y ∈ I → x ∈ I ∨ y ∈ I
#align ideal.is_prime Ideal.IsPrime

theorem isPrime_iff {I : Ideal α} : IsPrime I ↔ I ≠ ⊤ ∧ ∀ {x y : α}, x * y ∈ I → x ∈ I ∨ y ∈ I :=
  ⟨fun h => ⟨h.1, h.2⟩, fun h => ⟨h.1, h.2⟩⟩
#align ideal.is_prime_iff Ideal.isPrime_iff

theorem IsPrime.ne_top {I : Ideal α} (hI : I.IsPrime) : I ≠ ⊤ :=
  hI.1
#align ideal.is_prime.ne_top Ideal.IsPrime.ne_top

theorem IsPrime.mem_or_mem {I : Ideal α} (hI : I.IsPrime) {x y : α} : x * y ∈ I → x ∈ I ∨ y ∈ I :=
  hI.2
#align ideal.is_prime.mem_or_mem Ideal.IsPrime.mem_or_mem

theorem IsPrime.mem_or_mem_of_mul_eq_zero {I : Ideal α} (hI : I.IsPrime) {x y : α} (h : x * y = 0) :
    x ∈ I ∨ y ∈ I :=
  hI.mem_or_mem (h.symm ▸ I.zero_mem)
#align ideal.is_prime.mem_or_mem_of_mul_eq_zero Ideal.IsPrime.mem_or_mem_of_mul_eq_zero

theorem IsPrime.mem_of_pow_mem {I : Ideal α} (hI : I.IsPrime) {r : α} (n : ℕ) (H : r ^ n ∈ I) :
    r ∈ I := by
  induction' n with n ih
  · rw [pow_zero] at H
    exact (mt (eq_top_iff_one _).2 hI.1).elim H
  · rw [pow_succ] at H
    exact Or.casesOn (hI.mem_or_mem H) id ih
#align ideal.is_prime.mem_of_pow_mem Ideal.IsPrime.mem_of_pow_mem

theorem not_isPrime_iff {I : Ideal α} :
    ¬I.IsPrime ↔ I = ⊤ ∨ ∃ (x : α) (_hx : x ∉ I) (y : α) (_hy : y ∉ I), x * y ∈ I := by
  simp_rw [Ideal.isPrime_iff, not_and_or, Ne.def, Classical.not_not, not_forall, not_or]
  exact
    or_congr Iff.rfl
      ⟨fun ⟨x, y, hxy, hx, hy⟩ => ⟨x, hx, y, hy, hxy⟩, fun ⟨x, hx, y, hy, hxy⟩ =>
        ⟨x, y, hxy, hx, hy⟩⟩
#align ideal.not_is_prime_iff Ideal.not_isPrime_iff

theorem zero_ne_one_of_proper {I : Ideal α} (h : I ≠ ⊤) : (0 : α) ≠ 1 := fun hz =>
  I.ne_top_iff_one.1 h <| hz ▸ I.zero_mem
#align ideal.zero_ne_one_of_proper Ideal.zero_ne_one_of_proper

theorem bot_prime {R : Type _} [Ring R] [IsDomain R] : (⊥ : Ideal R).IsPrime :=
  ⟨fun h => one_ne_zero (by rwa [Ideal.eq_top_iff_one, Submodule.mem_bot] at h), fun h =>
    mul_eq_zero.mp (by simpa only [Submodule.mem_bot] using h)⟩
#align ideal.bot_prime Ideal.bot_prime

/-- An ideal is maximal if it is maximal in the collection of proper ideals. -/
class IsMaximal (I : Ideal α) : Prop where
  /-- The maximal ideal is a coatom in the ordering on ideals; that is, it is not the entire ring,
  and there are no other proper ideals strictly containing it. -/
  out : IsCoatom I
#align ideal.is_maximal Ideal.IsMaximal

theorem isMaximal_def {I : Ideal α} : I.IsMaximal ↔ IsCoatom I :=
  ⟨fun h => h.1, fun h => ⟨h⟩⟩
#align ideal.is_maximal_def Ideal.isMaximal_def

theorem IsMaximal.ne_top {I : Ideal α} (h : I.IsMaximal) : I ≠ ⊤ :=
  (isMaximal_def.1 h).1
#align ideal.is_maximal.ne_top Ideal.IsMaximal.ne_top

theorem isMaximal_iff {I : Ideal α} :
    I.IsMaximal ↔ (1 : α) ∉ I ∧ ∀ (J : Ideal α) (x), I ≤ J → x ∉ I → x ∈ J → (1 : α) ∈ J :=
  isMaximal_def.trans <|
    and_congr I.ne_top_iff_one <|
      forall_congr' fun J => by
        rw [lt_iff_le_not_le];
          exact
            ⟨fun H x h hx₁ hx₂ => J.eq_top_iff_one.1 <| H ⟨h, not_subset.2 ⟨_, hx₂, hx₁⟩⟩,
              fun H ⟨h₁, h₂⟩ =>
              let ⟨x, xJ, xI⟩ := not_subset.1 h₂
              J.eq_top_iff_one.2 <| H x h₁ xI xJ⟩
#align ideal.is_maximal_iff Ideal.isMaximal_iff

theorem IsMaximal.eq_of_le {I J : Ideal α} (hI : I.IsMaximal) (hJ : J ≠ ⊤) (IJ : I ≤ J) : I = J :=
  eq_iff_le_not_lt.2 ⟨IJ, fun h => hJ (hI.1.2 _ h)⟩
#align ideal.is_maximal.eq_of_le Ideal.IsMaximal.eq_of_le

instance : IsCoatomic (Ideal α) := by
  apply CompleteLattice.coatomic_of_top_compact
  rw [← span_singleton_one]
  exact Submodule.singleton_span_isCompactElement 1

theorem IsMaximal.coprime_of_ne {M M' : Ideal α} (hM : M.IsMaximal) (hM' : M'.IsMaximal)
    (hne : M ≠ M') : M ⊔ M' = ⊤ := by
  contrapose! hne with h
  exact hM.eq_of_le hM'.ne_top (le_sup_left.trans_eq (hM'.eq_of_le h le_sup_right).symm)
#align ideal.is_maximal.coprime_of_ne Ideal.IsMaximal.coprime_of_ne

/-- **Krull's theorem**: if `I` is an ideal that is not the whole ring, then it is included in some
    maximal ideal. -/
theorem exists_le_maximal (I : Ideal α) (hI : I ≠ ⊤) : ∃ M : Ideal α, M.IsMaximal ∧ I ≤ M :=
  let ⟨m, hm⟩ := (eq_top_or_exists_le_coatom I).resolve_left hI
  ⟨m, ⟨⟨hm.1⟩, hm.2⟩⟩
#align ideal.exists_le_maximal Ideal.exists_le_maximal

variable (α)

/-- Krull's theorem: a nontrivial ring has a maximal ideal. -/
theorem exists_maximal [Nontrivial α] : ∃ M : Ideal α, M.IsMaximal :=
  let ⟨I, ⟨hI, _⟩⟩ := exists_le_maximal (⊥ : Ideal α) bot_ne_top
  ⟨I, hI⟩
#align ideal.exists_maximal Ideal.exists_maximal

variable {α}

instance [Nontrivial α] : Nontrivial (Ideal α) := by
  rcases@exists_maximal α _ _ with ⟨M, hM, _⟩
  exact nontrivial_of_ne M ⊤ hM

/-- If P is not properly contained in any maximal ideal then it is not properly contained
  in any proper ideal -/
theorem maximal_of_no_maximal {R : Type u} [Semiring R] {P : Ideal R}
    (hmax : ∀ m : Ideal R, P < m → ¬IsMaximal m) (J : Ideal R) (hPJ : P < J) : J = ⊤ := by
  by_contra hnonmax
  rcases exists_le_maximal J hnonmax with ⟨M, hM1, hM2⟩
  exact hmax M (lt_of_lt_of_le hPJ hM2) hM1
#align ideal.maximal_of_no_maximal Ideal.maximal_of_no_maximal

theorem span_pair_comm {x y : α} : (span {x, y} : Ideal α) = span {y, x} := by
  simp only [span_insert, sup_comm]
#align ideal.span_pair_comm Ideal.span_pair_comm

theorem mem_span_pair {x y z : α} : z ∈ span ({x, y} : Set α) ↔ ∃ a b, a * x + b * y = z :=
  Submodule.mem_span_pair
#align ideal.mem_span_pair Ideal.mem_span_pair

@[simp]
theorem span_pair_add_mul_left {R : Type u} [CommRing R] {x y : R} (z : R) :
    (span {x + y * z, y} : Ideal R) = span {x, y} := by
  ext
  rw [mem_span_pair, mem_span_pair]
  exact
    ⟨fun ⟨a, b, h⟩ =>
      ⟨a, b + a * z, by
        rw [← h]
        ring1⟩,
      fun ⟨a, b, h⟩ =>
      ⟨a, b - a * z, by
        rw [← h]
        ring1⟩⟩
#align ideal.span_pair_add_mul_left Ideal.span_pair_add_mul_left

@[simp]
theorem span_pair_add_mul_right {R : Type u} [CommRing R] {x y : R} (z : R) :
    (span {x, y + x * z} : Ideal R) = span {x, y} := by
  rw [span_pair_comm, span_pair_add_mul_left, span_pair_comm]
#align ideal.span_pair_add_mul_right Ideal.span_pair_add_mul_right

theorem IsMaximal.exists_inv {I : Ideal α} (hI : I.IsMaximal) {x} (hx : x ∉ I) :
    ∃ y, ∃ i ∈ I, y * x + i = 1 := by
  cases' isMaximal_iff.1 hI with H₁ H₂
  rcases mem_span_insert.1
      (H₂ (span (insert x I)) x (Set.Subset.trans (subset_insert _ _) subset_span) hx
        (subset_span (mem_insert _ _))) with
    ⟨y, z, hz, hy⟩
  refine' ⟨y, z, _, hy.symm⟩
  rwa [← span_eq I]
#align ideal.is_maximal.exists_inv Ideal.IsMaximal.exists_inv

section Lattice

variable {R : Type u} [Semiring R]

-- porting note: is this the right approach? or is there a better way to prove? (next 4 decls)
theorem mem_sup_left {S T : Ideal R} : ∀ {x : R}, x ∈ S → x ∈ S ⊔ T :=
  @le_sup_left _ _ S T
#align ideal.mem_sup_left Ideal.mem_sup_left

theorem mem_sup_right {S T : Ideal R} : ∀ {x : R}, x ∈ T → x ∈ S ⊔ T :=
  @le_sup_right _ _ S T
#align ideal.mem_sup_right Ideal.mem_sup_right

theorem mem_supᵢ_of_mem {ι : Sort _} {S : ι → Ideal R} (i : ι) : ∀ {x : R}, x ∈ S i → x ∈ supᵢ S :=
  @le_supᵢ _ _ _ S _
#align ideal.mem_supr_of_mem Ideal.mem_supᵢ_of_mem

theorem mem_supₛ_of_mem {S : Set (Ideal R)} {s : Ideal R} (hs : s ∈ S) :
    ∀ {x : R}, x ∈ s → x ∈ supₛ S :=
  @le_supₛ _ _ _ _ hs
#align ideal.mem_Sup_of_mem Ideal.mem_supₛ_of_mem

theorem mem_infₛ {s : Set (Ideal R)} {x : R} : x ∈ infₛ s ↔ ∀ ⦃I⦄, I ∈ s → x ∈ I :=
  ⟨fun hx I his => hx I ⟨I, infᵢ_pos his⟩, fun H _I ⟨_J, hij⟩ => hij ▸ fun _S ⟨hj, hS⟩ => hS ▸ H hj⟩
#align ideal.mem_Inf Ideal.mem_infₛ

@[simp 1001] -- porting note: increased priority to appease `simpNF`
theorem mem_inf {I J : Ideal R} {x : R} : x ∈ I ⊓ J ↔ x ∈ I ∧ x ∈ J :=
  Iff.rfl
#align ideal.mem_inf Ideal.mem_inf

@[simp 1001] -- porting note: increased priority to appease `simpNF`
theorem mem_infᵢ {ι : Sort _} {I : ι → Ideal R} {x : R} : x ∈ infᵢ I ↔ ∀ i, x ∈ I i :=
  Submodule.mem_infᵢ _
#align ideal.mem_infi Ideal.mem_infᵢ

@[simp 1001] -- porting note: increased priority to appease `simpNF`
theorem mem_bot {x : R} : x ∈ (⊥ : Ideal R) ↔ x = 0 :=
  Submodule.mem_bot _
#align ideal.mem_bot Ideal.mem_bot

end Lattice

section Pi

variable (ι : Type v)

/-- `I^n` as an ideal of `R^n`. -/
def pi : Ideal (ι → α) where
  carrier := { x | ∀ i, x i ∈ I }
  zero_mem' _i := I.zero_mem
  add_mem' ha hb i := I.add_mem (ha i) (hb i)
  smul_mem' a _b hb i := I.mul_mem_left (a i) (hb i)
#align ideal.pi Ideal.pi

theorem mem_pi (x : ι → α) : x ∈ I.pi ι ↔ ∀ i, x i ∈ I :=
  Iff.rfl
#align ideal.mem_pi Ideal.mem_pi

end Pi

theorem infₛ_isPrime_of_isChain {s : Set (Ideal α)} (hs : s.Nonempty) (hs' : IsChain (· ≤ ·) s)
    (H : ∀ p ∈ s, Ideal.IsPrime p) : (infₛ s).IsPrime :=
  ⟨fun e =>
    let ⟨x, hx⟩ := hs
    (H x hx).ne_top (eq_top_iff.mpr (e.symm.trans_le (infₛ_le hx))),
    fun e =>
    or_iff_not_imp_left.mpr fun hx =>
      by
      rw [Ideal.mem_infₛ] at hx e⊢
      push_neg  at hx
      obtain ⟨I, hI, hI'⟩ := hx
      intro J hJ
      cases' hs'.total hI hJ with h h
      · exact h (((H I hI).mem_or_mem (e hI)).resolve_left hI')
      · exact ((H J hJ).mem_or_mem (e hJ)).resolve_left fun x => hI' <| h x⟩
#align ideal.Inf_is_prime_of_is_chain Ideal.infₛ_isPrime_of_isChain

end Ideal

end Semiring

section CommSemiring

variable {a b : α}

-- A separate namespace definition is needed because the variables were historically in a different
-- order.
namespace Ideal

variable [CommSemiring α] (I : Ideal α)

@[simp]
theorem mul_unit_mem_iff_mem {x y : α} (hy : IsUnit y) : x * y ∈ I ↔ x ∈ I :=
  mul_comm y x ▸ unit_mul_mem_iff_mem I hy
#align ideal.mul_unit_mem_iff_mem Ideal.mul_unit_mem_iff_mem

theorem mem_span_singleton {x y : α} : x ∈ span ({y} : Set α) ↔ y ∣ x :=
  mem_span_singleton'.trans <| exists_congr fun _ => by rw [eq_comm, mul_comm]
#align ideal.mem_span_singleton Ideal.mem_span_singleton

theorem mem_span_singleton_self (x : α) : x ∈ span ({x} : Set α) :=
  mem_span_singleton.mpr dvd_rfl
#align ideal.mem_span_singleton_self Ideal.mem_span_singleton_self

theorem span_singleton_le_span_singleton {x y : α} :
    span ({x} : Set α) ≤ span ({y} : Set α) ↔ y ∣ x :=
  span_le.trans <| singleton_subset_iff.trans mem_span_singleton
#align ideal.span_singleton_le_span_singleton Ideal.span_singleton_le_span_singleton

theorem span_singleton_eq_span_singleton {α : Type u} [CommRing α] [IsDomain α] {x y : α} :
    span ({x} : Set α) = span ({y} : Set α) ↔ Associated x y := by
  rw [← dvd_dvd_iff_associated, le_antisymm_iff, and_comm]
  apply and_congr <;> rw [span_singleton_le_span_singleton]
#align ideal.span_singleton_eq_span_singleton Ideal.span_singleton_eq_span_singleton

theorem span_singleton_mul_right_unit {a : α} (h2 : IsUnit a) (x : α) :
    span ({x * a} : Set α) = span {x} := by rw [mul_comm, span_singleton_mul_left_unit h2]
#align ideal.span_singleton_mul_right_unit Ideal.span_singleton_mul_right_unit

theorem span_singleton_eq_top {x} : span ({x} : Set α) = ⊤ ↔ IsUnit x := by
  rw [isUnit_iff_dvd_one, ← span_singleton_le_span_singleton, span_singleton_one, eq_top_iff]
#align ideal.span_singleton_eq_top Ideal.span_singleton_eq_top

theorem span_singleton_prime {p : α} (hp : p ≠ 0) : IsPrime (span ({p} : Set α)) ↔ Prime p := by
  simp [isPrime_iff, Prime, span_singleton_eq_top, hp, mem_span_singleton]
#align ideal.span_singleton_prime Ideal.span_singleton_prime

theorem IsMaximal.isPrime {I : Ideal α} (H : I.IsMaximal) : I.IsPrime :=
  ⟨H.1.1, @fun x y hxy =>
    or_iff_not_imp_left.2 fun hx =>
      by
      let J : Ideal α := Submodule.span α (insert x ↑I)
      have IJ : I ≤ J := Set.Subset.trans (subset_insert _ _) subset_span
      have xJ : x ∈ J := Ideal.subset_span (Set.mem_insert x I)
      cases' isMaximal_iff.1 H with _ oJ
      specialize oJ J x IJ hx xJ
      rcases Submodule.mem_span_insert.mp oJ with ⟨a, b, h, oe⟩
      obtain F : y * 1 = y * (a • x + b) := congr_arg (fun g : α => y * g) oe
      rw [← mul_one y, F, mul_add, mul_comm, smul_eq_mul, mul_assoc]
      refine' Submodule.add_mem I (I.mul_mem_left a hxy) (Submodule.smul_mem I y _)
      rwa [Submodule.span_eq] at h⟩
#align ideal.is_maximal.is_prime Ideal.IsMaximal.isPrime

-- see Note [lower instance priority]
instance (priority := 100) IsMaximal.isPrime' (I : Ideal α) : ∀ [_H : I.IsMaximal], I.IsPrime :=
  @IsMaximal.isPrime _ _ _
#align ideal.is_maximal.is_prime' Ideal.IsMaximal.isPrime'

theorem span_singleton_lt_span_singleton [CommRing β] [IsDomain β] {x y : β} :
    span ({x} : Set β) < span ({y} : Set β) ↔ DvdNotUnit y x := by
  rw [lt_iff_le_not_le, span_singleton_le_span_singleton, span_singleton_le_span_singleton,
    dvd_and_not_dvd_iff]
#align ideal.span_singleton_lt_span_singleton Ideal.span_singleton_lt_span_singleton

theorem factors_decreasing [CommRing β] [IsDomain β] (b₁ b₂ : β) (h₁ : b₁ ≠ 0) (h₂ : ¬IsUnit b₂) :
    span ({b₁ * b₂} : Set β) < span {b₁} :=
  lt_of_le_not_le
    (Ideal.span_le.2 <| singleton_subset_iff.2 <| Ideal.mem_span_singleton.2 ⟨b₂, rfl⟩) fun h =>
    h₂ <| isUnit_of_dvd_one <|
        (mul_dvd_mul_iff_left h₁).1 <| by rwa [mul_one, ← Ideal.span_singleton_le_span_singleton]
#align ideal.factors_decreasing Ideal.factors_decreasing

variable (b)

theorem mul_mem_right (h : a ∈ I) : a * b ∈ I :=
  mul_comm b a ▸ I.mul_mem_left b h
#align ideal.mul_mem_right Ideal.mul_mem_right

variable {b}

theorem pow_mem_of_mem (ha : a ∈ I) (n : ℕ) (hn : 0 < n) : a ^ n ∈ I :=
  Nat.casesOn n (Not.elim (by decide))
    (fun m _hm => (pow_succ a m).symm ▸ I.mul_mem_right (a ^ m) ha) hn
#align ideal.pow_mem_of_mem Ideal.pow_mem_of_mem

theorem IsPrime.mul_mem_iff_mem_or_mem {I : Ideal α} (hI : I.IsPrime) :
    ∀ {x y : α}, x * y ∈ I ↔ x ∈ I ∨ y ∈ I := @fun x y =>
  ⟨hI.mem_or_mem, by
    rintro (h | h)
    exacts[I.mul_mem_right y h, I.mul_mem_left x h]⟩
#align ideal.is_prime.mul_mem_iff_mem_or_mem Ideal.IsPrime.mul_mem_iff_mem_or_mem

theorem IsPrime.pow_mem_iff_mem {I : Ideal α} (hI : I.IsPrime) {r : α} (n : ℕ) (hn : 0 < n) :
    r ^ n ∈ I ↔ r ∈ I :=
  ⟨hI.mem_of_pow_mem n, fun hr => I.pow_mem_of_mem hr n hn⟩
#align ideal.is_prime.pow_mem_iff_mem Ideal.IsPrime.pow_mem_iff_mem

theorem pow_multiset_sum_mem_span_pow (s : Multiset α) (n : ℕ) :
    s.sum ^ (Multiset.card s * n + 1) ∈ span ((s.map fun (x:α) ↦ x ^ (n + 1)).toFinset : Set α) :=
  by
  induction' s using Multiset.induction_on with a s hs
  · simp
  simp only [Finset.coe_insert, Multiset.map_cons, Multiset.toFinset_cons, Multiset.sum_cons,
    Multiset.card_cons, add_pow]
  refine' Submodule.sum_mem _ _
  intro c _hc
  rw [mem_span_insert]
  by_cases h : n + 1 ≤ c
  · refine' ⟨a ^ (c - (n + 1)) * s.sum ^ ((Multiset.card s + 1) * n + 1 - c) *
      ((Multiset.card s + 1) * n + 1).choose c, 0, Submodule.zero_mem _, _⟩
    rw [mul_comm _ (a ^ (n + 1))]
    simp_rw [← mul_assoc]
    rw [← pow_add, add_zero, add_tsub_cancel_of_le h]
  · use 0
    simp_rw [zero_mul, zero_add]
    refine' ⟨_, _, rfl⟩
    replace h : c ≤ n := Nat.lt_succ_iff.mp (not_le.mp h)
    have : (Multiset.card s + 1) * n + 1 - c = Multiset.card s * n + 1 + (n - c) := by
      rw [add_mul, one_mul, add_assoc, add_comm n 1, ← add_assoc, add_tsub_assoc_of_le h]
    rw [this, pow_add]
    simp_rw [mul_assoc, mul_comm (s.sum ^ (Multiset.card s * n + 1)), ← mul_assoc]
    exact mul_mem_left _ _ hs
#align ideal.pow_multiset_sum_mem_span_pow Ideal.pow_multiset_sum_mem_span_pow

theorem sum_pow_mem_span_pow {ι} (s : Finset ι) (f : ι → α) (n : ℕ) :
    (∑ i in s, f i) ^ (s.card * n + 1) ∈ span ((fun i => f i ^ (n + 1)) '' s) := by
  simpa only [Multiset.card_map, Multiset.map_map, comp_apply, Multiset.toFinset_map,
    Finset.coe_image, Finset.val_toFinset] using pow_multiset_sum_mem_span_pow (s.1.map f) n
#align ideal.sum_pow_mem_span_pow Ideal.sum_pow_mem_span_pow

theorem span_pow_eq_top (s : Set α) (hs : span s = ⊤) (n : ℕ) :
    span ((fun (x : α) => x ^ n) '' s) = ⊤ :=
  by
  rw [eq_top_iff_one]
  cases' n with n
  · obtain rfl | ⟨x, hx⟩ := eq_empty_or_nonempty s
    · rw [Set.image_empty, hs]
      trivial
    · exact subset_span ⟨_, hx, pow_zero _⟩
  rw [eq_top_iff_one, span, Finsupp.mem_span_iff_total] at hs
  rcases hs with ⟨f, hf⟩
  have hf : (f.support.sum fun a => f a * a) = 1 := hf -- Porting note: was `change ... at hf`
  have := sum_pow_mem_span_pow f.support (fun a => f a * a) n
  rw [hf, one_pow] at this
  refine' span_le.mpr _ this
  rintro _ hx
  simp_rw [Finset.mem_coe, Set.mem_image] at hx
  rcases hx with ⟨x, _, rfl⟩
  have : span ({(x:α) ^ (n + 1)} : Set α) ≤ span ((fun x : α => x ^ (n + 1)) '' s) := by
    rw [span_le, Set.singleton_subset_iff]
    exact subset_span ⟨x, x.prop, rfl⟩
  refine' this _
  rw [mul_pow, mem_span_singleton]
  exact ⟨f x ^ (n + 1), mul_comm _ _⟩
#align ideal.span_pow_eq_top Ideal.span_pow_eq_top

end Ideal

end CommSemiring

section Ring

namespace Ideal

variable [Ring α] (I : Ideal α) {a b : α}

protected theorem neg_mem_iff : -a ∈ I ↔ a ∈ I :=
  Submodule.neg_mem_iff I
#align ideal.neg_mem_iff Ideal.neg_mem_iff

protected theorem add_mem_iff_left : b ∈ I → (a + b ∈ I ↔ a ∈ I) :=
  Submodule.add_mem_iff_left I
#align ideal.add_mem_iff_left Ideal.add_mem_iff_left

protected theorem add_mem_iff_right : a ∈ I → (a + b ∈ I ↔ b ∈ I) :=
  Submodule.add_mem_iff_right I
#align ideal.add_mem_iff_right Ideal.add_mem_iff_right

protected theorem sub_mem : a ∈ I → b ∈ I → a - b ∈ I :=
  Submodule.sub_mem I
#align ideal.sub_mem Ideal.sub_mem

example : Module α α := Semiring.toModule

theorem mem_span_insert' {s : Set α} {x y} : x ∈ span (insert y s) ↔ ∃ a, x + a * y ∈ span s :=
  @Submodule.mem_span_insert' α α _ _ Semiring.toModule _ _ _
-- porting note: Lean 4 issue #2074: Lean can't infer `Module R R` from `Ring R` on its own.
#align ideal.mem_span_insert' Ideal.mem_span_insert'

@[simp]
theorem span_singleton_neg (x : α) : (span {-x} : Ideal α) = span {x} := by
  ext
  simp only [mem_span_singleton']
  exact ⟨fun ⟨y, h⟩ => ⟨-y, h ▸ neg_mul_comm y x⟩, fun ⟨y, h⟩ => ⟨-y, h ▸ neg_mul_neg y x⟩⟩
#align ideal.span_singleton_neg Ideal.span_singleton_neg

end Ideal

end Ring

section DivisionSemiring

variable {K : Type u} [DivisionSemiring K] (I : Ideal K)

namespace Ideal

/-- All ideals in a division (semi)ring are trivial. -/
theorem eq_bot_or_top : I = ⊥ ∨ I = ⊤ := by
  rw [or_iff_not_imp_right]
  change _ ≠ _ → _
  rw [Ideal.ne_top_iff_one]
  intro h1
  rw [eq_bot_iff]
  intro r hr
  by_cases H : r = 0; · simpa
  simpa [H, h1] using I.mul_mem_left r⁻¹ hr
#align ideal.eq_bot_or_top Ideal.eq_bot_or_top

/-- Ideals of a `DivisionSemiring` are a simple order. Thanks to the way abbreviations work,
this automatically gives a `IsSimpleModule K` instance. -/
instance isSimpleOrder : IsSimpleOrder (Ideal K) :=
  ⟨eq_bot_or_top⟩
#align ideal.is_simple_order Ideal.isSimpleOrder

theorem eq_bot_of_prime [h : I.IsPrime] : I = ⊥ :=
  or_iff_not_imp_right.mp I.eq_bot_or_top h.1
#align ideal.eq_bot_of_prime Ideal.eq_bot_of_prime

theorem bot_isMaximal : IsMaximal (⊥ : Ideal K) :=
  ⟨⟨fun h => absurd ((eq_top_iff_one (⊤ : Ideal K)).mp rfl) (by rw [← h]; simp), fun I hI =>
      or_iff_not_imp_left.mp (eq_bot_or_top I) (ne_of_gt hI)⟩⟩
#align ideal.bot_is_maximal Ideal.bot_isMaximal

end Ideal

end DivisionSemiring

section CommRing

namespace Ideal

theorem mul_sub_mul_mem {R : Type _} [CommRing R] (I : Ideal R) {a b c d : R} (h1 : a - b ∈ I)
    (h2 : c - d ∈ I) : a * c - b * d ∈ I := by
  rw [show a * c - b * d = (a - b) * c + b * (c - d)
      by
      rw [sub_mul, mul_sub]
      abel]
  exact I.add_mem (I.mul_mem_right _ h1) (I.mul_mem_left _ h2)
#align ideal.mul_sub_mul_mem Ideal.mul_sub_mul_mem

end Ideal

end CommRing

-- TODO: consider moving the lemmas below out of the `Ring` namespace since they are
-- about `CommSemiring`s.
namespace Ring

variable {R : Type _} [CommSemiring R]

theorem exists_not_isUnit_of_not_isField [Nontrivial R] (hf : ¬IsField R) :
    ∃ (x : R) (_hx : x ≠ (0 : R)), ¬IsUnit x := by
  have : ¬_ := fun h => hf ⟨exists_pair_ne R, mul_comm, h⟩
  simp_rw [isUnit_iff_exists_inv]
  push_neg  at this⊢
  obtain ⟨x, hx, not_unit⟩ := this
  exact ⟨x, hx, not_unit⟩
#align ring.exists_not_is_unit_of_not_is_field Ring.exists_not_isUnit_of_not_isField

theorem not_isField_iff_exists_ideal_bot_lt_and_lt_top [Nontrivial R] :
    ¬IsField R ↔ ∃ I : Ideal R, ⊥ < I ∧ I < ⊤ := by
  constructor
  · intro h
    obtain ⟨x, nz, nu⟩ := exists_not_isUnit_of_not_isField h
    use Ideal.span {x}
    rw [bot_lt_iff_ne_bot, lt_top_iff_ne_top]
    exact ⟨mt Ideal.span_singleton_eq_bot.mp nz, mt Ideal.span_singleton_eq_top.mp nu⟩
  · rintro ⟨I, bot_lt, lt_top⟩ hf
    obtain ⟨x, mem, ne_zero⟩ := SetLike.exists_of_lt bot_lt
    rw [Submodule.mem_bot] at ne_zero
    obtain ⟨y, hy⟩ := hf.mul_inv_cancel ne_zero
    rw [lt_top_iff_ne_top, Ne.def, Ideal.eq_top_iff_one, ← hy] at lt_top
    exact lt_top (I.mul_mem_right _ mem)
#align ring.not_is_field_iff_exists_ideal_bot_lt_and_lt_top Ring.not_isField_iff_exists_ideal_bot_lt_and_lt_top

theorem not_isField_iff_exists_prime [Nontrivial R] :
    ¬IsField R ↔ ∃ p : Ideal R, p ≠ ⊥ ∧ p.IsPrime :=
  not_isField_iff_exists_ideal_bot_lt_and_lt_top.trans
    ⟨fun ⟨I, bot_lt, lt_top⟩ =>
      let ⟨p, hp, le_p⟩ := I.exists_le_maximal (lt_top_iff_ne_top.mp lt_top)
      ⟨p, bot_lt_iff_ne_bot.mp (lt_of_lt_of_le bot_lt le_p), hp.isPrime⟩,
      fun ⟨p, ne_bot, Prime⟩ => ⟨p, bot_lt_iff_ne_bot.mpr ne_bot, lt_top_iff_ne_top.mpr Prime.1⟩⟩
#align ring.not_is_field_iff_exists_prime Ring.not_isField_iff_exists_prime

/-- Also see `Ideal.isSimpleOrder` for the forward direction as an instance when `R` is a
division (semi)ring.

This result actually holds for all division semirings, but we lack the predicate to state it. -/
theorem isField_iff_isSimpleOrder_ideal : IsField R ↔ IsSimpleOrder (Ideal R) := by
  cases subsingleton_or_nontrivial R
  ·
    exact
      ⟨fun h => (not_isField_of_subsingleton _ h).elim, fun h =>
        (false_of_nontrivial_of_subsingleton <| Ideal R).elim⟩
  rw [← not_iff_not, Ring.not_isField_iff_exists_ideal_bot_lt_and_lt_top, ← not_iff_not]
  push_neg
  simp_rw [lt_top_iff_ne_top, bot_lt_iff_ne_bot, ← or_iff_not_imp_left, not_ne_iff]
  exact ⟨fun h => ⟨h⟩, fun h => h.2⟩
#align ring.is_field_iff_is_simple_order_ideal Ring.isField_iff_isSimpleOrder_ideal

/-- When a ring is not a field, the maximal ideals are nontrivial. -/
theorem ne_bot_of_isMaximal_of_not_isField [Nontrivial R] {M : Ideal R} (max : M.IsMaximal)
    (not_field : ¬IsField R) : M ≠ ⊥ := by
  rintro h
  rw [h] at max
  rcases max with ⟨⟨_h1, h2⟩⟩
  obtain ⟨I, hIbot, hItop⟩ := not_isField_iff_exists_ideal_bot_lt_and_lt_top.mp not_field
  exact ne_of_lt hItop (h2 I hIbot)
#align ring.ne_bot_of_is_maximal_of_not_is_field Ring.ne_bot_of_isMaximal_of_not_isField

end Ring

namespace Ideal

variable {R : Type u} [CommRing R] [Nontrivial R]

theorem bot_lt_of_maximal (M : Ideal R) [hm : M.IsMaximal] (non_field : ¬IsField R) : ⊥ < M := by
  rcases Ring.not_isField_iff_exists_ideal_bot_lt_and_lt_top.1 non_field with ⟨I, Ibot, Itop⟩
  constructor; · simp
  intro mle
  apply lt_irrefl (⊤ : Ideal R)
  have : M = ⊥ := eq_bot_iff.mpr mle
  rw [←this] at Ibot
  rwa [hm.1.2 I Ibot] at Itop
#align ideal.bot_lt_of_maximal Ideal.bot_lt_of_maximal

end Ideal

variable {a b : α}

/-- The set of non-invertible elements of a monoid. -/
def nonunits (α : Type u) [Monoid α] : Set α :=
  { a | ¬IsUnit a }
#align nonunits nonunits

@[simp]
theorem mem_nonunits_iff [Monoid α] : a ∈ nonunits α ↔ ¬IsUnit a :=
  Iff.rfl
#align mem_nonunits_iff mem_nonunits_iff

theorem mul_mem_nonunits_right [CommMonoid α] : b ∈ nonunits α → a * b ∈ nonunits α :=
  mt isUnit_of_mul_isUnit_right
#align mul_mem_nonunits_right mul_mem_nonunits_right

theorem mul_mem_nonunits_left [CommMonoid α] : a ∈ nonunits α → a * b ∈ nonunits α :=
  mt isUnit_of_mul_isUnit_left
#align mul_mem_nonunits_left mul_mem_nonunits_left

theorem zero_mem_nonunits [Semiring α] : 0 ∈ nonunits α ↔ (0 : α) ≠ 1 :=
  not_congr isUnit_zero_iff
#align zero_mem_nonunits zero_mem_nonunits

@[simp 1001] -- increased priority to appease `simpNF`
theorem one_not_mem_nonunits [Monoid α] : (1 : α) ∉ nonunits α :=
  not_not_intro isUnit_one
#align one_not_mem_nonunits one_not_mem_nonunits

theorem coe_subset_nonunits [Semiring α] {I : Ideal α} (h : I ≠ ⊤) : (I : Set α) ⊆ nonunits α :=
  fun _x hx hu => h <| I.eq_top_of_isUnit_mem hx hu
#align coe_subset_nonunits coe_subset_nonunits

theorem exists_max_ideal_of_mem_nonunits [CommSemiring α] (h : a ∈ nonunits α) :
    ∃ I : Ideal α, I.IsMaximal ∧ a ∈ I := by
  have : Ideal.span ({a} : Set α) ≠ ⊤ := by
    intro H
    rw [Ideal.span_singleton_eq_top] at H
    contradiction
  rcases Ideal.exists_le_maximal _ this with ⟨I, Imax, H⟩
  use I, Imax
  apply H
  apply Ideal.subset_span
  exact Set.mem_singleton a
#align exists_max_ideal_of_mem_nonunits exists_max_ideal_of_mem_nonunits