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

! This file was ported from Lean 3 source module topology.algebra.open_subgroup
! leanprover-community/mathlib commit 83f81aea33931a1edb94ce0f32b9a5d484de6978
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.RingTheory.Ideal.Basic
import Mathlib.Topology.Algebra.Ring.Basic
import Mathlib.Topology.Sets.Opens

/-!
# Open subgroups of a topological groups

This files builds the lattice `OpenSubgroup G` of open subgroups in a topological group `G`,
and its additive version `OpenAddSubgroup`.  This lattice has a top element, the subgroup of all
elements, but no bottom element in general. The trivial subgroup which is the natural candidate
bottom has no reason to be open (this happens only in discrete groups).

Note that this notion is especially relevant in a non-archimedean context, for instance for
`p`-adic groups.

## Main declarations

* `OpenSubgroup.isClosed`: An open subgroup is automatically closed.
* `Subgroup.isOpen_mono`: A subgroup containing an open subgroup is open.
                           There are also versions for additive groups, submodules and ideals.
* `OpenSubgroup.comap`: Open subgroups can be pulled back by a continuous group morphism.

## TODO
* Prove that the identity component of a locally path connected group is an open subgroup.
  Up to now this file is really geared towards non-archimedean algebra, not Lie groups.
-/

open TopologicalSpace Topology Function

/-- The type of open subgroups of a topological additive group. -/
structure OpenAddSubgroup (G : Type _) [AddGroup G] [TopologicalSpace G] extends AddSubgroup G where
  isOpen' : IsOpen carrier
#align open_add_subgroup OpenAddSubgroup

/-- The type of open subgroups of a topological group. -/
@[to_additive]
structure OpenSubgroup (G : Type _) [Group G] [TopologicalSpace G] extends Subgroup G where
  isOpen' : IsOpen carrier
#align open_subgroup OpenSubgroup

/-- Reinterpret an `OpenSubgroup` as a `Subgroup`. -/
add_decl_doc OpenSubgroup.toSubgroup

/-- Reinterpret an `OpenAddSubgroup` as an `AddSubgroup`. -/
add_decl_doc OpenAddSubgroup.toAddSubgroup

attribute [coe] OpenSubgroup.toSubgroup OpenAddSubgroup.toAddSubgroup

namespace OpenSubgroup

variable {G : Type _} [Group G] [TopologicalSpace G]
variable {U V : OpenSubgroup G} {g : G}

@[to_additive]
instance hasCoeSubgroup : CoeTC (OpenSubgroup G) (Subgroup G) :=
  ⟨toSubgroup⟩
#align open_subgroup.has_coe_subgroup OpenSubgroup.hasCoeSubgroup
#align open_add_subgroup.has_coe_add_subgroup OpenAddSubgroup.hasCoeAddSubgroup

@[to_additive]
theorem toSubgroup_injective : Injective ((↑) : OpenSubgroup G → Subgroup G)
  | ⟨_, _⟩, ⟨_, _⟩, rfl => rfl
#align open_subgroup.coe_subgroup_injective OpenSubgroup.toSubgroup_injective
#align open_add_subgroup.coe_add_subgroup_injective OpenAddSubgroup.toAddSubgroup_injective

@[to_additive]
instance : SetLike (OpenSubgroup G) G where
  coe U := U.1
  coe_injective' _ _ h := toSubgroup_injective <| SetLike.ext' h

@[to_additive]
instance : SubgroupClass (OpenSubgroup G) G where
  mul_mem := Subsemigroup.mul_mem' _
  one_mem U := U.one_mem'
  inv_mem := Subgroup.inv_mem' _

/-- Coercion from `OpenSubgroup G` to `Opens G`. -/
@[to_additive (attr := coe) "Coercion from `OpenAddSubgroup G` to `Opens G`."]
def toOpens (U : OpenSubgroup G) : Opens G := ⟨U, U.isOpen'⟩

@[to_additive]
instance hasCoeOpens : CoeTC (OpenSubgroup G) (Opens G) := ⟨toOpens⟩
#align open_subgroup.has_coe_opens OpenSubgroup.hasCoeOpens
#align open_add_subgroup.has_coe_opens OpenAddSubgroup.hasCoeOpens

@[to_additive (attr := simp, norm_cast)]
theorem coe_toOpens : ((U : Opens G) : Set G) = U :=
  rfl
#align open_subgroup.coe_coe_opens OpenSubgroup.coe_toOpens
#align open_add_subgroup.coe_coe_opens OpenAddSubgroup.coe_toOpens

@[to_additive (attr := simp, norm_cast)]
theorem coe_toSubgroup : ((U : Subgroup G) : Set G) = U := rfl
#align open_subgroup.coe_coe_subgroup OpenSubgroup.coe_toSubgroup
#align open_add_subgroup.coe_coe_add_subgroup OpenAddSubgroup.coe_toAddSubgroup

@[to_additive (attr := simp, norm_cast)]
theorem mem_toOpens : g ∈ (U : Opens G) ↔ g ∈ U := Iff.rfl
#align open_subgroup.mem_coe_opens OpenSubgroup.mem_toOpens
#align open_add_subgroup.mem_coe_opens OpenAddSubgroup.mem_toOpens

@[to_additive (attr := simp, norm_cast)]
theorem mem_toSubgroup : g ∈ (U : Subgroup G) ↔ g ∈ U := Iff.rfl
#align open_subgroup.mem_coe_subgroup OpenSubgroup.mem_toSubgroup
#align open_add_subgroup.mem_coe_add_subgroup OpenAddSubgroup.mem_toAddSubgroup

@[to_additive (attr := ext)]
theorem ext (h : ∀ x, x ∈ U ↔ x ∈ V) : U = V :=
  SetLike.ext h
#align open_subgroup.ext OpenSubgroup.ext
#align open_add_subgroup.ext OpenAddSubgroup.ext

variable (U)

@[to_additive]
protected theorem isOpen : IsOpen (U : Set G) :=
  U.isOpen'
#align open_subgroup.is_open OpenSubgroup.isOpen
#align open_add_subgroup.is_open OpenAddSubgroup.isOpen

@[to_additive]
theorem mem_nhds_one : (U : Set G) ∈ 𝓝 (1 : G) :=
  U.isOpen.mem_nhds U.one_mem
#align open_subgroup.mem_nhds_one OpenSubgroup.mem_nhds_one
#align open_add_subgroup.mem_nhds_zero OpenAddSubgroup.mem_nhds_zero

variable {U}

@[to_additive] instance : Top (OpenSubgroup G) := ⟨⟨⊤, isOpen_univ⟩⟩

@[to_additive (attr := simp)]
theorem mem_top (x : G) : x ∈ (⊤ : OpenSubgroup G) :=
  trivial
#align open_subgroup.mem_top OpenSubgroup.mem_top
#align open_add_subgroup.mem_top OpenAddSubgroup.mem_top

@[to_additive (attr := simp, norm_cast)]

@[to_additive (attr := simp, norm_cast)]
theorem toSubgroup_top : ((⊤ : OpenSubgroup G) : Subgroup G) = ⊤ :=
  rfl
#align open_subgroup.coe_subgroup_top OpenSubgroup.toSubgroup_top
#align open_add_subgroup.coe_add_subgroup_top OpenAddSubgroup.toAddSubgroup_top

@[to_additive (attr := simp, norm_cast)]
theorem toOpens_top : ((⊤ : OpenSubgroup G) : Opens G) = ⊤ :=
  rfl
#align open_subgroup.coe_opens_top OpenSubgroup.toOpens_top
#align open_add_subgroup.coe_opens_top OpenAddSubgroup.toOpens_top

@[to_additive]
instance : Inhabited (OpenSubgroup G) :=
  ⟨⊤⟩

@[to_additive]
theorem isClosed [ContinuousMul G] (U : OpenSubgroup G) : IsClosed (U : Set G) := by
  apply isOpen_compl_iff.1
  refine' isOpen_iff_forall_mem_open.2 fun x hx => ⟨(fun y => y * x⁻¹) ⁻¹' U, _, _, _⟩
  · refine' fun u hux hu => hx _
    simp only [Set.mem_preimage, SetLike.mem_coe] at hux hu ⊢
    convert U.mul_mem (U.inv_mem hux) hu
    simp
  · exact U.isOpen.preimage (continuous_mul_right _)
  · simp [one_mem]
#align open_subgroup.is_closed OpenSubgroup.isClosed
#align open_add_subgroup.is_closed OpenAddSubgroup.isClosed

@[to_additive]
theorem isClopen [ContinuousMul G] (U : OpenSubgroup G) : IsClopen (U : Set G) :=
  ⟨U.isOpen, U.isClosed⟩
#align open_subgroup.is_clopen OpenSubgroup.isClopen
#align open_add_subgroup.is_clopen OpenAddSubgroup.isClopen

section

variable {H : Type _} [Group H] [TopologicalSpace H]

/-- The product of two open subgroups as an open subgroup of the product group. -/
@[to_additive "The product of two open subgroups as an open subgroup of the product group."]
def prod (U : OpenSubgroup G) (V : OpenSubgroup H) : OpenSubgroup (G × H) :=
  ⟨.prod U V, U.isOpen.prod V.isOpen⟩
#align open_subgroup.prod OpenSubgroup.prod
#align open_add_subgroup.sum OpenAddSubgroup.sum

@[to_additive (attr := simp, norm_cast)]
theorem coe_prod (U : OpenSubgroup G) (V : OpenSubgroup H) : (U.prod V : Set (G × H)) = U ×ˢ V :=
  rfl
#align open_subgroup.coe_prod OpenSubgroup.coe_prod
#align open_add_subgroup.coe_sum OpenAddSubgroup.coe_sum

@[to_additive (attr := simp, norm_cast)]
theorem toSubgroup_prod (U : OpenSubgroup G) (V : OpenSubgroup H) :
    (U.prod V : Subgroup (G × H)) = (U : Subgroup G).prod V :=
  rfl
#align open_subgroup.coe_subgroup_prod OpenSubgroup.toSubgroup_prod
#align open_add_subgroup.coe_add_subgroup_sum OpenAddSubgroup.toAddSubgroup_sum

end

@[to_additive]
instance : Inf (OpenSubgroup G) :=
  ⟨fun U V => ⟨U ⊓ V, U.isOpen.inter V.isOpen⟩⟩

@[to_additive (attr := simp, norm_cast)]
theorem coe_inf : (↑(U ⊓ V) : Set G) = (U : Set G) ∩ V :=
  rfl
#align open_subgroup.coe_inf OpenSubgroup.coe_inf
#align open_add_subgroup.coe_inf OpenAddSubgroup.coe_inf

@[to_additive (attr := simp, norm_cast)]
theorem toSubgroup_inf : (↑(U ⊓ V) : Subgroup G) = ↑U ⊓ ↑V :=
  rfl
#align open_subgroup.coe_subgroup_inf OpenSubgroup.toSubgroup_inf
#align open_add_subgroup.coe_add_subgroup_inf OpenAddSubgroup.toAddSubgroup_inf

@[to_additive (attr := simp, norm_cast)]
theorem toOpens_inf : (↑(U ⊓ V) : Opens G) = ↑U ⊓ ↑V :=
  rfl
#align open_subgroup.coe_opens_inf OpenSubgroup.toOpens_inf
#align open_add_subgroup.coe_opens_inf OpenAddSubgroup.toOpens_inf

@[to_additive (attr := simp)]
theorem mem_inf {x} : x ∈ U ⊓ V ↔ x ∈ U ∧ x ∈ V :=
  Iff.rfl
#align open_subgroup.mem_inf OpenSubgroup.mem_inf
#align open_add_subgroup.mem_inf OpenAddSubgroup.mem_inf

@[to_additive]
instance : PartialOrder (OpenSubgroup G) := inferInstance

-- porting note: we override `toPartialorder` to get better `le`
@[to_additive]
instance : SemilatticeInf (OpenSubgroup G) :=
  { SetLike.coe_injective.semilatticeInf ((↑) : OpenSubgroup G → Set G) fun _ _ => rfl with
    toInf := instInfOpenSubgroup
    toPartialOrder := instPartialOrderOpenSubgroup }

@[to_additive]
instance : OrderTop (OpenSubgroup G) where
  top := ⊤
  le_top _ := Set.subset_univ _

@[to_additive (attr := simp, norm_cast)]
theorem toSubgroup_le : (U : Subgroup G) ≤ (V : Subgroup G) ↔ U ≤ V :=
  Iff.rfl
#align open_subgroup.coe_subgroup_le OpenSubgroup.toSubgroup_le
#align open_add_subgroup.coe_add_subgroup_le OpenAddSubgroup.toAddSubgroup_le

variable {N : Type _} [Group N] [TopologicalSpace N]

/-- The preimage of an `OpenSubgroup` along a continuous `Monoid` homomorphism
  is an `OpenSubgroup`. -/
@[to_additive "The preimage of an `OpenAddSubgroup` along a continuous `AddMonoid` homomorphism
is an `OpenAddSubgroup`."]
def comap (f : G →* N) (hf : Continuous f) (H : OpenSubgroup N) : OpenSubgroup G :=
  ⟨.comap f H, H.isOpen.preimage hf⟩
#align open_subgroup.comap OpenSubgroup.comap
#align open_add_subgroup.comap OpenAddSubgroup.comap

@[to_additive (attr := simp, norm_cast)]
theorem coe_comap (H : OpenSubgroup N) (f : G →* N) (hf : Continuous f) :
    (H.comap f hf : Set G) = f ⁻¹' H :=
  rfl
#align open_subgroup.coe_comap OpenSubgroup.coe_comap
#align open_add_subgroup.coe_comap OpenAddSubgroup.coe_comap

@[to_additive (attr := simp, norm_cast)]
theorem toSubgroup_comap (H : OpenSubgroup N) (f : G →* N) (hf : Continuous f) :
    (H.comap f hf : Subgroup G) = (H : Subgroup N).comap f :=
  rfl
#align open_subgroup.coe_subgroup_comap OpenSubgroup.toSubgroup_comap
#align open_add_subgroup.coe_add_subgroup_comap OpenAddSubgroup.toAddSubgroup_comap

@[to_additive (attr := simp)]
theorem mem_comap {H : OpenSubgroup N} {f : G →* N} {hf : Continuous f} {x : G} :
    x ∈ H.comap f hf ↔ f x ∈ H :=
  Iff.rfl
#align open_subgroup.mem_comap OpenSubgroup.mem_comap
#align open_add_subgroup.mem_comap OpenAddSubgroup.mem_comap

@[to_additive]
theorem comap_comap {P : Type _} [Group P] [TopologicalSpace P] (K : OpenSubgroup P) (f₂ : N →* P)
    (hf₂ : Continuous f₂) (f₁ : G →* N) (hf₁ : Continuous f₁) :
    (K.comap f₂ hf₂).comap f₁ hf₁ = K.comap (f₂.comp f₁) (hf₂.comp hf₁) :=
  rfl
#align open_subgroup.comap_comap OpenSubgroup.comap_comap
#align open_add_subgroup.comap_comap OpenAddSubgroup.comap_comap

end OpenSubgroup

namespace Subgroup

variable {G : Type _} [Group G] [TopologicalSpace G] [ContinuousMul G] (H : Subgroup G)

@[to_additive]
theorem isOpen_of_mem_nhds {g : G} (hg : (H : Set G) ∈ 𝓝 g) : IsOpen (H : Set G) := by
  refine' isOpen_iff_mem_nhds.2 fun x hx => _
  have hg' : g ∈ H := SetLike.mem_coe.1 (mem_of_mem_nhds hg)
  have : Filter.Tendsto (fun y => y * (x⁻¹ * g)) (𝓝 x) (𝓝 g) :=
    (continuous_id.mul continuous_const).tendsto' _ _ (mul_inv_cancel_left _ _)
  simpa only [SetLike.mem_coe, Filter.mem_map',
    H.mul_mem_cancel_right (H.mul_mem (H.inv_mem hx) hg')] using this hg
#align subgroup.is_open_of_mem_nhds Subgroup.isOpen_of_mem_nhds
#align add_subgroup.is_open_of_mem_nhds AddSubgroup.isOpen_of_mem_nhds

@[to_additive]
theorem isOpen_mono {H₁ H₂ : Subgroup G} (h : H₁ ≤ H₂) (h₁ : IsOpen (H₁ : Set G)) :
    IsOpen (H₂ : Set G) :=
  isOpen_of_mem_nhds _ <| Filter.mem_of_superset (h₁.mem_nhds <| one_mem H₁) h
#align subgroup.is_open_mono Subgroup.isOpen_mono
#align add_subgroup.is_open_mono AddSubgroup.isOpen_mono

@[to_additive]
theorem isOpen_of_openSubgroup {U : OpenSubgroup G} (h : ↑U ≤ H) : IsOpen (H : Set G) :=
  isOpen_mono h U.isOpen
#align subgroup.is_open_of_open_subgroup Subgroup.isOpen_of_openSubgroup
#align add_subgroup.is_open_of_open_add_subgroup AddSubgroup.isOpen_of_openAddSubgroup

/-- If a subgroup of a topological group has `1` in its interior, then it is open. -/
@[to_additive "If a subgroup of an additive topological group has `0` in its interior, then it is
open."]
theorem isOpen_of_one_mem_interior (h_1_int : (1 : G) ∈ interior (H : Set G)) :
    IsOpen (H : Set G) :=
  isOpen_of_mem_nhds H <| mem_interior_iff_mem_nhds.1 h_1_int
#align subgroup.is_open_of_one_mem_interior Subgroup.isOpen_of_one_mem_interior
#align add_subgroup.is_open_of_zero_mem_interior AddSubgroup.isOpen_of_zero_mem_interior

end Subgroup

namespace OpenSubgroup

variable {G : Type _} [Group G] [TopologicalSpace G] [ContinuousMul G]

@[to_additive]
instance : Sup (OpenSubgroup G) :=
  ⟨fun U V => ⟨U ⊔ V, Subgroup.isOpen_mono (le_sup_left : U.1 ≤ U.1 ⊔ V.1) U.isOpen⟩⟩

@[to_additive (attr := simp, norm_cast)]
theorem toSubgroup_sup (U V : OpenSubgroup G) : (↑(U ⊔ V) : Subgroup G) = ↑U ⊔ ↑V := rfl
#align open_subgroup.coe_subgroup_sup OpenSubgroup.toSubgroup_sup
#align open_add_subgroup.coe_add_subgroup_sup OpenAddSubgroup.toAddSubgroup_sup

-- porting note: we override `toPartialorder` to get better `le`
@[to_additive]
instance : Lattice (OpenSubgroup G) :=
  { instSemilatticeInfOpenSubgroup,
    toSubgroup_injective.semilatticeSup ((↑) : OpenSubgroup G → Subgroup G) fun _ _ => rfl with
    toPartialOrder := instPartialOrderOpenSubgroup }

end OpenSubgroup

namespace Submodule

open OpenAddSubgroup

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

variable [AddCommGroup M] [TopologicalSpace M] [TopologicalAddGroup M] [Module R M]

theorem isOpen_mono {U P : Submodule R M} (h : U ≤ P) (hU : IsOpen (U : Set M)) :
    IsOpen (P : Set M) :=
  @AddSubgroup.isOpen_mono M _ _ _ U.toAddSubgroup P.toAddSubgroup h hU
#align submodule.is_open_mono Submodule.isOpen_mono

end Submodule

namespace Ideal

variable {R : Type _} [CommRing R]

variable [TopologicalSpace R] [TopologicalRing R]

theorem isOpen_of_open_subideal {U I : Ideal R} (h : U ≤ I) (hU : IsOpen (U : Set R)) :
    IsOpen (I : Set R) :=
  @Submodule.isOpen_mono R R _ _ _ _ Semiring.toModule _ _ h hU
#align ideal.is_open_of_open_subideal Ideal.isOpen_of_open_subideal

end Ideal


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import group_theory.group_action.defs

/-! # Group actions on and by `units M`

This file provides the action of a unit on a type `α`, `has_scalar (units M) α`, in the presence of
`has_scalar M α`, with the obvious definition stated in `units.smul_def`. This definition preserves
`mul_action` and `distrib_mul_action` structures too.

Additionally, a `mul_action G M` for some group `G` satisfying some additional properties admits a
`mul_action G (units M)` structure, again with the obvious definition stated in `units.coe_smul`.
These instances use a primed name.

The results are repeated for `add_units` and `has_vadd` where relevant.
-/

variables {G H M N : Type*} {α : Type*}

namespace units

/-! ### Action of the units of `M` on a type `α` -/

@[to_additive]
instance [monoid M] [has_scalar M α] : has_scalar (units M) α :=
{ smul := λ m a, (m : M) • a }

@[to_additive]
lemma smul_def [monoid M] [has_scalar M α] (m : units M) (a : α) :
  m • a = (m : M) • a := rfl

lemma _root_.is_unit.inv_smul [monoid α] {a : α} (h : is_unit a) :
  (h.unit)⁻¹ • a = 1 :=
h.coe_inv_mul

@[to_additive]
instance [monoid M] [has_scalar M α] [has_faithful_scalar M α] : has_faithful_scalar (units M) α :=
{ eq_of_smul_eq_smul := λ u₁ u₂ h, units.ext $ eq_of_smul_eq_smul h, }

@[to_additive]
instance [monoid M] [mul_action M α] : mul_action (units M) α :=
{ one_smul := (one_smul M : _),
  mul_smul := λ m n, mul_smul (m : M) n, }

instance [monoid M] [add_monoid α] [distrib_mul_action M α] : distrib_mul_action (units M) α :=
{ smul_add := λ m, smul_add (m : M),
  smul_zero := λ m, smul_zero m, }

instance [monoid M] [monoid α] [mul_distrib_mul_action M α] : mul_distrib_mul_action (units M) α :=
{ smul_mul := λ m, smul_mul' (m : M),
  smul_one := λ m, smul_one m, }

instance smul_comm_class_left [monoid M] [has_scalar M α] [has_scalar N α]
  [smul_comm_class M N α] : smul_comm_class (units M) N α :=
{ smul_comm := λ m n, (smul_comm (m : M) n : _)}

instance smul_comm_class_right [monoid N] [has_scalar M α] [has_scalar N α]
  [smul_comm_class M N α] : smul_comm_class M (units N) α :=
{ smul_comm := λ m n, (smul_comm m (n : N) : _)}

instance [monoid M] [has_scalar M N] [has_scalar M α] [has_scalar N α] [is_scalar_tower M N α] :
  is_scalar_tower (units M) N α :=
{ smul_assoc := λ m n, (smul_assoc (m : M) n : _)}

/-! ### Action of a group `G` on units of `M` -/

/-- If an action `G` associates and commutes with multiplication on `M`, then it lifts to an
action on `units M`. Notably, this provides `mul_action (units M) (units N)` under suitable
conditions.
-/
instance mul_action' [group G] [monoid M] [mul_action G M] [smul_comm_class G M M]
  [is_scalar_tower G M M] : mul_action G (units M) :=
{ smul := λ g m, ⟨g • (m : M), g⁻¹ • ↑(m⁻¹),
    by rw [smul_mul_smul, units.mul_inv, mul_right_inv, one_smul],
    by rw [smul_mul_smul, units.inv_mul, mul_left_inv, one_smul]⟩,
  one_smul := λ m, units.ext $ one_smul _ _,
  mul_smul := λ g₁ g₂ m, units.ext $ mul_smul _ _ _ }

@[simp] lemma coe_smul [group G] [monoid M] [mul_action G M] [smul_comm_class G M M]
  [is_scalar_tower G M M] (g : G) (m : units M) : ↑(g • m) = g • (m : M) := rfl

/-- Note that this lemma exists more generally as the global `smul_inv` -/
@[simp] lemma smul_inv [group G] [monoid M] [mul_action G M] [smul_comm_class G M M]
  [is_scalar_tower G M M] (g : G) (m : units M) : (g • m)⁻¹ = g⁻¹ • m⁻¹ := ext rfl

/-- Transfer `smul_comm_class G H M` to `smul_comm_class G H (units M)` -/
instance smul_comm_class' [group G] [group H] [monoid M]
  [mul_action G M] [smul_comm_class G M M]
  [mul_action H M] [smul_comm_class H M M]
  [is_scalar_tower G M M] [is_scalar_tower H M M]
  [smul_comm_class G H M] : smul_comm_class G H (units M) :=
{ smul_comm := λ g h m, units.ext $ smul_comm g h (m : M) }

/-- Transfer `is_scalar_tower G H M` to `is_scalar_tower G H (units M)` -/
instance is_scalar_tower' [has_scalar G H] [group G] [group H] [monoid M]
  [mul_action G M] [smul_comm_class G M M]
  [mul_action H M] [smul_comm_class H M M]
  [is_scalar_tower G M M] [is_scalar_tower H M M]
  [is_scalar_tower G H M] : is_scalar_tower G H (units M) :=
{ smul_assoc := λ g h m, units.ext $ smul_assoc g h (m : M) }

/-- Transfer `is_scalar_tower G M α` to `is_scalar_tower G (units M) α` -/
instance is_scalar_tower'_left [group G] [monoid M] [mul_action G M] [has_scalar M α]
  [has_scalar G α] [smul_comm_class G M M] [is_scalar_tower G M M]
  [is_scalar_tower G M α] :
  is_scalar_tower G (units M) α :=
{ smul_assoc := λ g m, (smul_assoc g (m : M) : _)}

-- Just to prove this transfers a particularly useful instance.
example [monoid M] [monoid N] [mul_action M N] [smul_comm_class M N N]
  [is_scalar_tower M N N] : mul_action (units M) (units N) := units.mul_action'

/-- A stronger form of `units.mul_action'`. -/
instance mul_distrib_mul_action' [group G] [monoid M] [mul_distrib_mul_action G M]
  [smul_comm_class G M M] [is_scalar_tower G M M] : mul_distrib_mul_action G (units M) :=
{ smul := (•),
  smul_one := λ m, units.ext $ smul_one _,
  smul_mul := λ g m₁ m₂, units.ext $ smul_mul' _ _ _,
  .. units.mul_action' }

end units

lemma is_unit.smul [group G] [monoid M] [mul_action G M]
  [smul_comm_class G M M] [is_scalar_tower G M M] {m : M} (g : G) (h : is_unit m) :
  is_unit (g • m) :=
let ⟨u, hu⟩ := h in hu ▸ ⟨g • u, units.coe_smul _ _⟩


variables p q : Prop

theorem t1 : p → q → p := λ (hp : p) (hq : q), hp
#check t1

variable hp : p

theorem t1' : q → p := λ hq : q, hp
#check t1'
#print t1'

variables r s : Prop

#check t1 p q
#check t1 r s
#check t1 (r → s) (s → r)

variable h : r → s
#check t1 (r → s) (s → r) h

theorem t2 (h₁ : q → r) (h₂ : p → q) : p → r :=
assume h₃ : p,
show r, from h₁ (h₂ h₃)

-- t2 says that implication is a transitive binary relation on the set of propositions


import algebra.big_operators
import data.finset
import data.nat.basic

import nat

section tactics
open tactic.interactive («apply» cases contradiction «have» «intro» «intros» «suffices»)
open interactive (parse)
open interactive.types (texpr)
open lean.parser (ident many tk)

meta def tactic.interactive.decide : parse (prod.mk <$> ident <* tk ":" <*> texpr) -> tactic unit
| ⟨h , p⟩ := do
  «have» (some h) (some ``(%%p ∨ ¬ %%p)) ``(dec_em %%p),
  local_h <- tactic.get_local h,
  cases (none, ``(%%local_h)) [h]
end tactics

namespace nat.divisor
open nat

open finset (range)
def divisors : ℕ -> finset ℕ := λ n, (range (n+1)).filter (λ d, d ∣ n)
def σ : ℕ -> ℕ := λ n, (divisors n).sum id
def perfect : ℕ -> Prop := λ n, σ n = 2 * n

def divisor_iff_dvd {d n : ℕ} : n > 0 → (d ∣ n ↔ d ∈ divisors n) := begin
  intro n_pos,
  split;
  intro h,
  { rw [divisors, finset.mem_filter, finset.mem_range],
    have : d < n + 1 := lt_succ_iff.mpr (nat.le_of_dvd n_pos h),
    finish
    },
  { unfold divisors at h,
    rw [finset.mem_filter] at h,
    finish }
end

lemma divisors_pow_succ {p k : ℕ} : prime p -> divisors (p^(k + 1)) = insert (p^(k + 1)) (divisors (p^k)) := begin
  intro pr,
  have : p^k > 0 := nat.prime_pow_ge_one pr,
  unfold divisors,
  rw [finset.range_succ, finset.filter_insert],
  simp,
  congr' 1,
  ext,
  rw [finset.mem_filter, finset.mem_filter],
  rw [finset.mem_range, finset.mem_range],
  constructor;
  rintros ⟨bound, divides⟩,
  { cases dvd_pow_succ pr divides,
    { by_contra, exact ne_of_lt bound h },
    have : a < 1 + p^k := calc
      a ≤ p^k : nat.le_of_dvd this h
      ... < nat.succ (p^k) : lt_add_one (p^k)
      ... = 1 + p^k : symm (nat.one_add _),
    finish },
  split,
  { exact calc
  a ≤ p^k : nat.le_of_dvd this divides
  ... = 1 * p^k : symm (nat.one_mul _)
  ... < p * p^k : mul_lt_mul (nat.prime.two_le pr) (refl _) (by assumption) (by linarith)
  ... = p^(k + 1) : by simp [mul_comm, nat.pow_succ] },
  exact dvd_mul_of_dvd_left divides p
end

lemma divisor_sum_prime_power {p k : ℕ} : prime p -> σ (p ^ k) = (range (k+1)).sum (λ n, p^n) := begin
  intro pr,
  induction k,
  { simp, refl },
  suffices : σ (p^(k_n+1)) = σ (p^k_n) + p^(k_n+1),
  { simp [this, k_ih, finset.sum_range_succ] },
  have : p^(k_n + 1) ∉ divisors (p^k_n),
  { unfold divisors,
    rw [finset.mem_filter],
    rintro ⟨in_range, divides⟩,
    have : p^k_n > p^k_n := calc
    p^k_n ≥ p^(k_n + 1) : nat.le_of_dvd (nat.prime_pow_ge_one pr) divides
    ... = p * p^k_n: by rw [nat.pow_succ, mul_comm]
    ... > 1 * p^k_n : mul_lt_mul (nat.prime.two_le pr) (refl _) (nat.prime_pow_ge_one pr) (by linarith)
    ... = p^k_n : one_mul _,
    linarith },
  unfold σ,
  simp [divisors_pow_succ pr, finset.sum_insert this]
end

lemma divisor_sum_prime {p : ℕ} : prime p -> σ p = 1 + p := λ pr, calc
  σ p = σ (p ^ 1) : by simp
  ... = (range (1+1)).sum (λ n, p^n) : divisor_sum_prime_power pr
  ... = 1 + p^1 : refl _
  ... = 1 + p : by simp

lemma mul_gt_one {a b : ℕ} : a > 1 -> b > 0 -> a * b > b := λ a_gt_one b_pos,
  calc b = 1 * b : symm (one_mul _)
  ... < a * b : nat.mul_lt_mul_of_pos_right a_gt_one b_pos

lemma divide_out_factors (p : ℕ) (pr : prime p) : Π (n : ℕ), n > 0 → ∃ k l : ℕ, p^k * l = n ∧ nat.coprime p l
| n n_pos := begin
  decide h : p ∣ n,
  { have p_pos : p > 0 := (have this : p ≥ 2 := nat.prime.two_le pr, by linarith),
    have : n ≥ p := nat.le_of_dvd n_pos h,
    have next_pos : n / p > 0 := nat.div_pos this p_pos,
    let recursion_helper : n / p < n := nat.div_lt_of_lt_mul (mul_gt_one (nat.prime.two_le pr) n_pos),
    rcases divide_out_factors (n / p) next_pos with ⟨k, l, prod, copr⟩,
    use (nat.succ k),
    use l,
    split,
    { rw [nat.pow_succ, mul_comm (p^k) p, mul_assoc, prod, ←nat.mul_div_assoc _ h, nat.mul_div_cancel_left _ p_pos] },
    assumption },
  use 0,
  use n,
  simp,
  exact (nat.prime.coprime_iff_not_dvd pr).mpr h,
end using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf psigma.fst⟩]}

lemma divisor_sum_ge {n : ℕ} (ds : list ℕ) : n > 0 -> (∀ d ∈ ds, d ∣ n) -> multiset.nodup ds -> σ n ≥ ds.sum := begin
  unfold σ,
  intros n_pos divs nd,
  let ds' : finset ℕ := ⟨ds, nd⟩,
  have : ds' ⊆ (divisors n) := finset.subset_iff.mpr (λ d d_in, (divisor_iff_dvd n_pos).mp (divs d d_in)),
  exact calc
    finset.sum (divisors n) id ≥ finset.sum ds' id : finset.sum_le_sum_of_subset this
    ... = (ds.map id).sum : multiset.coe_sum _
    ... = ds.sum : by rw [list.map_id]
end

lemma divisor_sum_is_sum {a b : ℕ} : a > 1 -> b > 0 -> σ (a * b) = a * b + b -> b = 1 := begin
  intros a_gt_1 b_pos eq,
  have ab_pos := calc 1 ≤ b : b_pos ... < a * b : mul_gt_one a_gt_1 b_pos,
  by_contra,
  suffices : σ (a * b) ≥ a * b + b + 1,
  { linarith },
  have divs : ∀ d ∈ [a * b, b, 1], d ∣ a * b := by { rintros d (h | h | h | h); rcases h; norm_num },
  suffices : multiset.nodup [a * b, b, 1],
  { exact calc
      σ (a * b) ≥ [a * b, b, 1].sum : divisor_sum_ge _ (by linarith) divs this
      ... = a * b + b + 1 : by simp },
  have : a * b ≠ b := ne_of_gt (mul_gt_one a_gt_1 b_pos),
  have : a * b ≠ 1 := ne_of_gt (by assumption),
  finish
end

lemma prime_from_divisor_sum {p : ℕ} : p > 1 → σ (p) = p + 1 -> prime p := begin
  intros p_gt_1 eq,
  by_contra np,
  rcases nat.exists_dvd_of_not_prime p_gt_1 np with ⟨d, d_div_p, d_ne_one, d_ne_p⟩,
  have : d > 0 := begin
    suffices : d ≠ 0, { cases d, contradiction, exact nat.succ_pos _ },
    rcases d_div_p with ⟨k, prod⟩, rintro rfl, apply d_ne_p, simp [prod]
  end,
  suffices : σ p ≥ p + d + 1, { linarith },
  have : multiset.nodup [p, d, 1],
  { have : p ≠ 1 := ne_of_gt p_gt_1,
    finish
  },
  have divs : ∀ d' ∈ [p, d, 1], d' ∣ p := by { rintros d' (h | h | h | h); rcases h; repeat {norm_num}, assumption },
  exact calc
    σ p ≥ [p, d, 1].sum : divisor_sum_ge _ (by linarith) divs this
    ... = p + d + 1 : by simp
end

end nat.divisor


import .Cantor_Bendixson

variables {α : Type*}

open topological_space
open set

theorem image_Inter' {β γ: Type*} [inhabited γ] {f : α → β}
  (hf : function.injective f) (s : γ → set α) :
  f '' (⋂ i : γ, s i) = ⋂ i : γ, f '' (s i) :=
begin
  apply subset_antisymm,
  { apply image_Inter_subset, },
  intros y hy,
  rw mem_Inter at hy,
  rcases hy default with ⟨x,hx,rfl⟩,
  refine ⟨x,_,rfl⟩,
  rw mem_Inter,
  intro i,
  rcases hy i with ⟨z,hz1,hz2⟩,
  convert hz1,
  symmetry,
  exact hf hz2,
end

instance polish_of_countable [h : countable α] [topological_space α] [discrete_topology α]
  : polish_space α :=
begin
  rw countable_iff_exists_injective at h,
  cases h with f hf,
  have : closed_embedding f, {
    apply closed_embedding_of_continuous_injective_closed,
    { apply continuous_of_discrete_topology},
    { exact hf,},
    intros t ht,
    apply is_closed_discrete,
  },
  apply this.polish_space,
end

instance second_countable_of_polish [topological_space α] [polish_space α] :
  second_countable_topology α :=
  polish_space.second_countable _

section ctble_gen

variable [s : measurable_space α]
include s

open measurable_space

variable (α)

--Say a measurable space is countably generated if
--the sigma algebra can be generated by a countable set
class countable_generated : Prop :=
  (is_generated_countable : ∃ b : set (set α), b.countable ∧ s = generate_from b)

lemma nat_gen [h : countable_generated α] : ∃ f : ℕ → (set α), s = generate_from (range f) :=
begin
  obtain ⟨b,bct,hb⟩ := h.is_generated_countable,
  let c := b ∪ {univ},
  have cct : c.countable,
  { apply countable.union bct,
    apply countable_singleton, },
  have cnonempty : c.nonempty,
  { use univ,
    right,
    simp, },
  obtain ⟨f,hf⟩ := (set.countable_iff_exists_surjective cnonempty).mp cct,
  use (λ n, (f n).val),
  rw hb,
  apply le_antisymm, {
    apply measurable_space.generate_from_mono,
    intros s sb,
    cases hf ⟨s, or.inl sb⟩ with n hn,
    use n,
    simp[hn],
  },
  apply generate_from_le,
  rintros t ⟨n,hn⟩,
  have : t ∈ c, {rw ← hn, exact (f n).property},
  cases this with q q, {
    exact measurable_set_generate_from q,
  },
  rw mem_singleton_iff at q,
  rw q,
  exact measurable_set.univ,
end

variable {α}

namespace countable_generated

--The borel sets are countably generated if a space is second countable
instance borel_countable_generated_of_second_countable [topological_space α] [borel_space α] [second_countable_topology α] : countable_generated α :=
begin
  constructor,
  have := topological_space.exists_countable_basis α,
  rcases this with ⟨b,bct,bnontrivial,bbasis⟩,
  use [b,bct],
  borelize α,
  apply bbasis.borel_eq_generate_from,
end

#check @measurable_set_generate_from

open_locale classical
--Any countably generated measurably space for which singeltons are measurable
--admits a measurable injection to the Cantor space ℕ → bool
--Note : bool is probably not the right type to use here.
variable (α)
theorem measurable_inj_cantor_of_countable_generated_of_singleton_measurable
[countable_generated α] [measurable_singleton_class α] :
∃ f : α → (ℕ → bool), measurable f ∧ function.injective f :=
begin
  --obtain ⟨b,bct,hb⟩ := h.is_generated_countable,
  obtain ⟨e,hb⟩ := nat_gen α,
  let f : α → ℕ → bool := begin
    intros x n,
    exact (x ∈ e n),
  end,
  use f, split,
  { rw measurable_pi_iff,
    intros n,
    apply measurable_to_countable,
    intros y,
    cases f y n; rw hb; simp[preimage,f],
    { apply measurable_set.compl,
      apply measurable_set_generate_from,
      simp, },
    apply measurable_set_generate_from,
    simp, },
  intros x y hxy,
  --have := @measurable_set_eq _ _ _ y,
  --let p : set α → Prop := λ C, C y → C x,
  have : ∀ B : set α, measurable_set B → (x ∈ B ↔ y ∈ B),
  { intros B,
    rw hb,
    apply generate_from_induction (λ C, x ∈ C ↔ y ∈ C) (range e),
    { intros t ht,
      obtain ⟨n, rfl⟩ := ht,
      have : f x n = f y n := by rw hxy,
      dsimp[f] at this,
      simp only [bool.to_bool_eq] at this,
      exact this, }, { tauto },

    { intros t ht,
      tauto, },
    intros t ht,
    rw[mem_Union,mem_Union],
    dsimp at ht,
    split; rintros ⟨n,hn⟩; use n, { rwa ← ht n, }, rwa ht n, },
  specialize this _ (@measurable_set_eq _ _ _ y),
  dsimp at this,
  rw this,
end
variable {α}

end countable_generated
end ctble_gen

section csb

variables {β : Type*}
variables [measurable_space α] [measurable_space β]

namespace measurable_embedding

open measurable_equiv
open measurable_space

--set_option pp.implicit true
open_locale classical
noncomputable
--If A is a measurable set in a measurable space α,
--Then α is measurably equivalent to A ⊕ Aᶜ via the natural map
def subtype_sum_compl {A : set α} (hA : measurable_set A) : A ⊕ (Aᶜ : set α) ≃ᵐ α :=
{ to_fun := sum.elim (λ x, x.val) (λ x, x.val),
  inv_fun := begin
    intros x,
    by_cases x ∈ A, { left, exact ⟨x,h⟩, },
    right, exact ⟨x,h⟩,
  end,
  left_inv := begin
    intros x,
    cases x; simp,
    intros h,
    apply x.property,
    exact h,
  end,
  right_inv := begin
    intros x,
    by_cases x ∈ A; dsimp, {rw dif_pos h, simp,},
    rw dif_neg h, simp,
  end,
  measurable_to_fun := begin
    dsimp,
    apply measurable.sum_elim; apply measurable_subtype_coe,
  end,
  measurable_inv_fun := begin
    dsimp,
    apply measurable.dite; measurability,
  end }

noncomputable
--A measurable embedding induces a measurable equivalence between any subset of the domain
--and its image
--Essentially already in mathlib, but the hypothesis does not used the bundled name
--"measurable_embedding"
def set_image {f : α → β} (hf : measurable_embedding f) (A : set α) : A ≃ᵐ f '' A :=
begin
  apply measurable_equiv.set.image, {exact hf.injective}, {exact hf.measurable},
  exact hf.measurable_set_image',
end

noncomputable
--The Cantor-Schroeder-Bernstein Theorem for measurable spaces :
--If two spaces have measurable embeddings to eachother,
--then they are measurably equivalent.
def schroeder_bernstein {f : α → β} {g : β → α}
  (hf : measurable_embedding f)(hg : measurable_embedding g) : (α ≃ᵐ β) :=
begin
  let F : set α → set α := λ A, (g '' (f '' A)ᶜ)ᶜ,
  --We follow the proof of CSB in mathlib, the crux of which is finding a fixed point of this F.
  --However, we must find this fixed point manually instead of invoking Knaster-Tarski
  --in order to make sure it is measurable.
  suffices : Σ' A : set α, measurable_set A ∧ F A = A,
  { rcases this with ⟨A,Ameas,Afp⟩,
    let B := f '' A,
    have Bmeas : measurable_set B := by {rw hf.measurable_set_image, exact Ameas,},
    apply (subtype_sum_compl Ameas).symm.trans,
    apply measurable_equiv.trans _ (subtype_sum_compl Bmeas),
    apply sum_congr,
    { apply hf.set_image, },
    have : Aᶜ = g '' Bᶜ,
    { apply compl_injective,
      rw ← Afp,
      simp, },
    rw this,
    apply measurable_equiv.symm,
    apply hg.set_image,  },
  have Fmono : ∀ {A B}, A ⊆ B → F A ⊆ F B,
  { intros A B hAB,
    rw compl_subset_compl,
    apply image_subset,
    rw compl_subset_compl,
    apply image_subset,
    assumption, },
  let X : ℕ → set α := begin
    intro n,
    induction n with n ih,
    { exact univ, },
    exact F ih,
  end,
  use ⋂ n : ℕ, X n, split,
  { apply measurable_set.Inter,
    intros n,
    induction n with n ih,
    {  exact measurable_set.univ, },
    apply measurable_set.compl,
    apply hg.measurable_set_image',
    apply measurable_set.compl,
    apply hf.measurable_set_image',
    exact ih, },
  apply subset_antisymm,
  { apply subset_Inter,
    intros n,
    cases n,
    {  apply subset_univ, },
    apply Fmono,
    apply Inter_subset, },
  rintros x hx ⟨y,hy,rfl⟩,
  rw mem_Inter at hx,
  apply hy,
  rw image_Inter' hf.injective, swap, {apply_instance},
  rw mem_Inter, intro n,
  by_contradiction, --!
  apply (hx n.succ),
  exact ⟨y,h,rfl⟩,
end

end measurable_embedding

noncomputable
--The Cantor-Schroeder-Bernstein theorem for Polish spaces:
--If two Polish spaces admit Borel injections to eachother, they are Borel isomorphic.
def borel_schroeder_bernstein [topological_space α] [polish_space α] [borel_space α]
  [topological_space β] [polish_space β] [borel_space β] {f : α → β} {g : β → α}
  (fmeas : measurable f) (finj : function.injective f)
  (gmeas : measurable g) (ginj : function.injective g) :
  α ≃ᵐ β :=
begin
  have hf' := fmeas.measurable_embedding finj,
  have hg' := gmeas.measurable_embedding ginj,
  exact hf'.schroeder_bernstein hg',
end

end csb

section borel_iso

variables { β : Type*}
variables [measurable_space α] [topological_space α] [borel_space α]
variables [measurable_space β] [topological_space β] [borel_space β]

--a continuous function is Borel
--version of continuous.borel_measurable which uses the borel_space class
theorem borel_of_continuous {f : α → β} (hf : continuous f) : measurable f :=
begin
  borelize[α, β],
  apply hf.borel_measurable,
end

variables [polish_space α] [polish_space β]

--The Borel Isomorphism Theorem : Every uncountable polish space is
--Borel isomorphic to the reals (or Cantor space)
lemma equiv_cantor_of_uncountable (ha : ¬ countable α) : nonempty (α ≃ᵐ (ℕ → bool)) :=
begin
  obtain ⟨f,hf1,hf2⟩ :=
  countable_generated.measurable_inj_cantor_of_countable_generated_of_singleton_measurable α,
  obtain ⟨g,-,hg1,hg2⟩ := @cantor_of_closed_unc α _ _ univ (is_closed_univ) _, swap,
  { intro h,
    apply ha,
    have := h.to_subtype,
    apply @countable.of_equiv _ _ this,
    exact equiv.set.univ α, },
  have := borel_schroeder_bernstein hf1 hf2 (borel_of_continuous hg1) hg2,
  use this,
end

--The Borel Isomorphism Theorem : Any two uncountable Polish spaces are
--Borel isomorphic
theorem borel_equiv_of_uncountable (ha : ¬countable α) (hb : ¬countable β)
  : nonempty (α ≃ᵐ β) :=
begin
  have := (equiv_cantor_of_uncountable ha).some.trans (equiv_cantor_of_uncountable hb).some.symm,
  use this,
end

--The Borel Isomorphism Theorem : Two Polish spaces are Borel isomorphic
--if and only if they have the same cardinality.
theorem borel_equiv_iff_equiv : nonempty (α ≃ᵐ β) ↔ nonempty (α ≃ β) :=
begin
  split; rintros ⟨f⟩,
  { use f.to_equiv },
  by_cases (countable α),
  { have : countable β := @countable.of_equiv _ _ h f,
    use f; rintros s -; apply countable.measurable_set;
    apply countable.mono (subset_univ _); apply @set.countable_univ _ _; assumption},
  have : ¬ countable β,
  { intros H, apply h,
    exact @countable.of_equiv _ _ H f.symm, },
  apply borel_equiv_of_uncountable h this,
end

end borel_iso


-- vim: ts=2 sw=0 sts=-1 et ai tw=70

import .lt

namespace hidden

namespace mynat

def divides (m n: mynat) := ∃ k: mynat, n = k * m
instance: has_dvd mynat := ⟨divides⟩

-- gosh, how do you define gcd?
-- you should be able to define it using Euclid's algorithm and total
-- ordering of ≤
/- def gcd: mynat → mynat → mynat
| m 0 := m
| m n := if m ≤ n then gcd m (n - m)
 -/

variables {m n k p: mynat}

@[trans]
theorem dvd_trans: m ∣ n → n ∣ k → m ∣ k :=
begin
  assume hmn hnk,
  cases hmn with a ha,
  cases hnk with b hb,
  existsi a * b,
  rw [hb, ha, ←mul_assoc, mul_comm b a],
end

theorem dvd_zero: m ∣ 0 :=
begin
  existsi (0: mynat),
  rw zero_mul,
end

theorem zero_dvd: 0 ∣ m → m=0 :=
begin
  assume h,
  cases h with k hk,
  rw mul_zero at hk,
  from hk,
end

theorem one_dvd: 1 ∣ m :=
begin
  existsi m,
  refl,
end

-- Allows resolving goals of form m ∣ m by writing refl
@[refl]
theorem dvd_refl: m ∣ m :=
begin
  existsi (1: mynat),
  rw one_mul,
end

-- basically just a massive case bash to show that m and n can't be 0 or succ
-- succ of something
theorem one_unit: m * n = 1 → m = 1 :=
begin
  cases m,
  repeat {rw zz},
  rw zero_mul,
  assume h01,
  from h01,
  cases n,
  repeat {rw zz},
  rw [succ_mul, mul_zero, add_zero],
  assume h01,
  cases h01,
  cases m,
  repeat {rw zz},
  rw [mul_succ, succ_mul, zero_mul, zero_add],
  assume _,
  refl,
  cases n,
  repeat {rw zz},
  rw [mul_succ, succ_mul, succ_mul, mul_zero],
  repeat {rw add_zero},
  assume hssm, from hssm,
  -- this is the most contradictory thing I've ever seen in my life. surely
  -- there's a less overkill way
  repeat {rw succ_mul},
  repeat {rw mul_succ},
  repeat {rw add_succ},
  rw ←one_eq_succ_zero,
  assume hssssssss,
  exfalso, from succ_ne_zero (succ_inj hssssssss),
end

theorem dvd_antisymm: m ∣ n → n ∣ m → m = n :=
begin
  assume hmn hnm,
  cases hmn with a ha,
  cases hnm with b hb,
  cases n,
  rw hb,
  refl,
  have hab1: a * b = 1,
  rw hb at ha,
  rw ←mul_assoc at ha,
  -- arghh
  rw ←mul_one (succ n) at ha,
  rw mul_comm (a * b) _ at ha,
  rw mul_assoc at ha,
  have hab := mul_cancel succ_ne_zero ha,
  rw one_mul at hab,
  symmetry, assumption,
  have ha1 := one_unit hab1,
  rw [ha, ha1, one_mul],
end

theorem dvd_mul (n: mynat): k ∣ m → k ∣ m * n :=
begin
  assume hkm,
  cases hkm with a ha,
  existsi a * n,
  rw ha,
  repeat {rw mul_assoc},
  rw mul_comm k n,
end

theorem dvd_multiple: k ∣ n * k :=
begin
  rw mul_comm,
  apply dvd_mul,
  refl,
end

theorem dvd_add: k ∣ m → k ∣ m + k :=
begin
  assume hkm,
  cases hkm with n hn,
  rw hn,
  existsi n + 1,
  simp,
end

theorem dvd_cancel: k ∣ m + k → k ∣ m :=
begin
  assume hkmk,
  cases hkmk with n hn,
  cases n,
  cases k,
  rw zz at *,
  simp at hn,
  rw hn,
  rw zz at *,
  rw [zero_mul, add_comm] at hn,
  exfalso, from succ_ne_zero (add_integral hn),
  existsi n,
  rw succ_mul at hn,
  repeat {rw add_comm _ k at hn},
  from add_cancel hn,
end

theorem dvd_add_lots: k ∣ m → k ∣ m + k * n :=
begin
  induction n with n_n n_ih,
  simp,
  cc,
  simp,
  assume hkm,
  rw [add_comm k _, ←add_assoc],
  apply dvd_add _,
  from n_ih hkm,
end

theorem dvd_cancel_lots: k ∣ m + k * n → k ∣ m :=
begin
  induction n with n_n n_ih,
  simp,
  cc,
  simp,
  rw [add_comm k _, ←add_assoc],
  assume hkmksn,
  apply n_ih,
  from dvd_cancel hkmksn,
end

theorem dvd_sum: k ∣ m → k ∣ n → k ∣ m + n :=
begin
  assume hm hn,
  cases hn with a ha,
  rw [ha, mul_comm],
  apply dvd_add_lots,
  assumption,
end

theorem lt_ndvd: m ≠ 0 → m < n → ¬n ∣ m :=
begin
  assume hmnz hmn hndm,
  cases (le_total_order m n),
  cases h with d hd,
  cases d,
    rw [zz, add_zero] at hd,
    rw hd at hmn,
    from hmn le_refl,

    rw hd at hndm,
    cases hndm with a ha,
    cases a,
      simp at ha,
      from hmnz ha,
    rw succ_mul at ha,
    rw (by ac_refl : a * (m + d.succ) + (m + d.succ) =
                     m + (d.succ + a * (m + d.succ))) at ha,
    have hs0 := add_cancel_to_zero ha,
    rw succ_add at hs0,
    from succ_ne_zero hs0,

  cases h with d hd,
  cases d,
  simp at hd,
  rw hd at hmn,
  from hmn le_refl,
  rw hd at hmn,
  simp at hmn,
  have hcontr: n ≤ succ (n + d),
  existsi succ d,
  simp,
  from hmn hcontr,
end

theorem dvd_le: n ≠ 0 → m ∣ n → m ≤ n :=
begin
  assume hnn0 hmdvdn,
  cases (le_total_order m n),
  assumption,
  cases hmdvdn with k hk,
  cases h with a ha,
  rw ha at hk,
  cases a,
  existsi (0: mynat),
  simp [ha],
  simp at hk,
  cases k,
    simp at hk,
    contradiction,
  rw succ_mul at hk,
  rw (by ac_refl : k.succ + (k * n + n + k.succ * a) =
                   n + (k.succ + (k * n + k.succ * a))) at hk,
  rw succ_add at hk,
  exfalso,
  from succ_ne_zero (add_cancel_to_zero hk),
end

theorem dvd_one: m ∣ 1 → m = 1 :=
begin
  assume hm1,
  from dvd_antisymm hm1 one_dvd,
end

-- Reorder variables
-- have decided not to make implicit because it's too much of a headache
theorem dvd_remainder (m k n j : mynat):
j ∣ m → j ∣ n → m + k = n → j ∣ k :=
begin
  assume hjm hjn hmkn,
  rw ←hmkn at hjn,
  cases hjm with a ha,
  rw ha at hjn,
  rw add_comm at hjn,
  rw mul_comm at hjn,
  from dvd_cancel_lots hjn,
end

-- Useful for e.g. infinitude of primes
theorem dvd_succ_too: k ∣ m → k ∣ succ m → k=1 :=
begin
  assume hm hsucc,
  cases hm with a ha,
  cases hsucc with b hb,
  rw [←add_one_succ, ha] at hb,
  rw mul_comm a at hb,
  rw mul_comm b at hb,
  suffices : k ∣ 1,
    exact dvd_one this,
  apply dvd_remainder (k * a) 1 (k * b) k,
    apply dvd_mul a,
    refl,
    apply dvd_mul b,
    refl,
  assumption,
end

theorem dvd_succ: m ∣ succ m → m=1 :=
begin
  assume h,
  have : m ∣ m, refl,
  apply dvd_succ_too,
    refl,
  assumption,
end

end mynat

end hidden


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

universes v u

namespace Mathlib

/-!
# The two morphisms `λ_ (𝟙_ C)` and `ρ_ (𝟙_ C)` from `𝟙_ C ⊗ 𝟙_ C` to `𝟙_ C` are equal.

This is suprisingly difficult to prove directly from the usual axioms for a monoidal category!

This proof follows the diagram given at
https://people.math.osu.edu/penneys.2/QS2019/VicaryHandout.pdf

It should be a consequence of the coherence theorem for monoidal categories
(although quite possibly it is a necessary building block of any proof).
-/

namespace category_theory.monoidal_category

namespace unitors_equal

theorem cells_1_2 {C : Type u} [category C] [monoidal_category C] : iso.hom ρ_ = iso.inv λ_ ≫ (𝟙 ⊗ iso.hom ρ_) ≫ iso.hom λ_ := sorry

theorem cells_4 {C : Type u} [category C] [monoidal_category C] : iso.inv λ_ ≫ (𝟙 ⊗ iso.hom λ_) = iso.hom λ_ ≫ iso.inv λ_ := sorry

theorem cells_4' {C : Type u} [category C] [monoidal_category C] : iso.inv λ_ = iso.hom λ_ ≫ iso.inv λ_ ≫ (𝟙 ⊗ iso.inv λ_) := sorry

theorem cells_3_4 {C : Type u} [category C] [monoidal_category C] : iso.inv λ_ = 𝟙 ⊗ iso.inv λ_ := sorry

theorem cells_1_4 {C : Type u} [category C] [monoidal_category C] : iso.hom ρ_ = (𝟙 ⊗ iso.inv λ_) ≫ (𝟙 ⊗ iso.hom ρ_) ≫ iso.hom λ_ := sorry

theorem cells_6 {C : Type u} [category C] [monoidal_category C] : (iso.inv ρ_ ⊗ 𝟙) ≫ iso.hom ρ_ = iso.hom ρ_ ≫ iso.inv ρ_ := sorry

theorem cells_6' {C : Type u} [category C] [monoidal_category C] : iso.inv ρ_ ⊗ 𝟙 = iso.hom ρ_ ≫ iso.inv ρ_ ≫ iso.inv ρ_ := sorry

theorem cells_5_6 {C : Type u} [category C] [monoidal_category C] : iso.inv ρ_ ⊗ 𝟙 = iso.inv ρ_ := sorry

theorem cells_7 {C : Type u} [category C] [monoidal_category C] : 𝟙 ⊗ iso.inv λ_ = (iso.inv ρ_ ⊗ 𝟙) ≫ iso.hom α_ := sorry

theorem cells_1_7 {C : Type u} [category C] [monoidal_category C] : iso.hom ρ_ = iso.inv ρ_ ≫ iso.hom α_ ≫ (𝟙 ⊗ iso.hom ρ_) ≫ iso.hom λ_ := sorry

theorem cells_8 {C : Type u} [category C] [monoidal_category C] : iso.hom α_ = iso.inv ρ_ ≫ (iso.hom α_ ⊗ 𝟙) ≫ iso.hom ρ_ := sorry

theorem cells_14 {C : Type u} [category C] [monoidal_category C] : iso.inv ρ_ ≫ iso.inv ρ_ = iso.inv ρ_ ≫ (iso.inv ρ_ ⊗ 𝟙) := sorry

theorem cells_9 {C : Type u} [category C] [monoidal_category C] : iso.hom α_ ⊗ 𝟙 = iso.hom α_ ≫ iso.hom α_ ≫ (𝟙 ⊗ iso.inv α_) ≫ iso.inv α_ := sorry

theorem cells_10_13 {C : Type u} [category C] [monoidal_category C] : (iso.inv ρ_ ⊗ 𝟙) ≫ iso.hom α_ ≫ iso.hom α_ ≫ (𝟙 ⊗ iso.inv α_) ≫ iso.inv α_ = (𝟙 ⊗ iso.inv ρ_) ⊗ 𝟙 := sorry

theorem cells_9_13 {C : Type u} [category C] [monoidal_category C] : (iso.inv ρ_ ⊗ 𝟙) ≫ (iso.hom α_ ⊗ 𝟙) = (𝟙 ⊗ iso.inv ρ_) ⊗ 𝟙 := sorry

theorem cells_15 {C : Type u} [category C] [monoidal_category C] : iso.inv ρ_ ≫ ((𝟙 ⊗ iso.inv ρ_) ⊗ 𝟙) ≫ iso.hom ρ_ ≫ (𝟙 ⊗ iso.hom ρ_) = 𝟙 := sorry

end unitors_equal

theorem unitors_equal {C : Type u} [category C] [monoidal_category C] : iso.hom λ_ = iso.hom ρ_ := sorry


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

! This file was ported from Lean 3 source module algebra.order.ring.lemmas
! leanprover-community/mathlib commit c4658a649d216f57e99621708b09dcb3dcccbd23
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.CovariantAndContravariant
import Mathlib.Algebra.GroupWithZero.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}`:

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

* monotone left
* * `CovariantClass α>0 α (λ x y, x * y) (≤)`, abbreviated `PosMulMono α`,
    expressing that multiplication by positive elements on the left is monotone;
* * `CovariantClass α>0 α (λ x y, x * y) (<)`, abbreviated `PosMulStrictMono α`,
    expressing that multiplication by positive elements on the left is strictly monotone;
* monotone right
* * `CovariantClass α>0 α (λ x y, y * x) (≤)`, abbreviated `MulPosMono α`,
    expressing that multiplication by positive elements on the right is monotone;
* * `CovariantClass α>0 α (λ x y, y * x) (<)`, abbreviated `MulPosStrictMono α`,
    expressing that multiplication by positive elements on the right is strictly monotone.
* reverse monotone left
* * `ContravariantClass α>0 α (λ x y, x * y) (≤)`, abbreviated `PosMulMonoRev α`,
    expressing that multiplication by positive elements on the left is reverse monotone;
* * `ContravariantClass α>0 α (λ x y, x * y) (<)`, abbreviated `PosMulReflectLT α`,
    expressing that multiplication by positive elements on the left is strictly reverse monotone;
* reverse reverse monotone right
* * `ContravariantClass α>0 α (λ x y, y * x) (≤)`, abbreviated `MulPosMonoRev α`,
    expressing that multiplication by positive elements on the right is reverse monotone;
* * `ContravariantClass α>0 α (λ x y, y * x) (<)`, abbreviated `MulPosReflectLT α`,
    expressing that multiplication by positive elements on the right is strictly reverse monotone.

## Notation

The following is local notation in this file:
* `α≥0`: `{x : α // 0 ≤ x}`
* `α>0`: `{x : α // 0 < x}`
-/

variable (α : Type _)

-- mathport name: «exprα≥0»
/- Notations for nonnegative and positive elements
https://
leanprover.zulipchat.com/#narrow/stream/113488-general/topic/notation.20for.20positive.20elements
-/
section Abbreviations

variable [Mul α] [Zero α] [Preorder α]

set_option quotPrecheck false in
/-- Local notation for the nonnegative elements of a type `α`. TODO: actually make local. -/
notation "α≥0" => { x : α // 0 ≤ x }

-- mathport name: «exprα>0»
set_option quotPrecheck false in
/-- Local notation for the positive elements of a type `α`. TODO: actually make local. -/
notation "α>0" => { x : α // 0 < x }

/-- `PosMulMono α` is an abbreviation for `CovariantClass α≥0 α (λ x y, x * y) (≤)`,
expressing that multiplication by nonnegative elements on the left is monotone. -/
abbrev PosMulMono : Prop :=
  CovariantClass α≥0 α (fun x y => x * y) (· ≤ ·)
#align pos_mul_mono PosMulMono

/-- `MulPosMono α` is an abbreviation for `CovariantClass α≥0 α (λ x y, y * x) (≤)`,
expressing that multiplication by nonnegative elements on the right is monotone. -/
abbrev MulPosMono : Prop :=
  CovariantClass α≥0 α (fun x y => y * x) (· ≤ ·)
#align mul_pos_mono MulPosMono

/-- `PosMulStrictMono α` is an abbreviation for `CovariantClass α>0 α (λ x y, x * y) (<)`,
expressing that multiplication by positive elements on the left is strictly monotone. -/
abbrev PosMulStrictMono : Prop :=
  CovariantClass α>0 α (fun x y => x * y) (· < ·)
#align pos_mul_strict_mono PosMulStrictMono

/-- `MulPosStrictMono α` is an abbreviation for `CovariantClass α>0 α (λ x y, y * x) (<)`,
expressing that multiplication by positive elements on the right is strictly monotone. -/
abbrev MulPosStrictMono : Prop :=
  CovariantClass α>0 α (fun x y => y * x) (· < ·)
#align mul_pos_strict_mono MulPosStrictMono

/-- `PosMulReflectLT α` is an abbreviation for `ContravariantClas α≥0 α (λ x y, x * y) (<)`,
expressing that multiplication by nonnegative elements on the left is strictly reverse monotone. -/
abbrev PosMulReflectLT : Prop :=
  ContravariantClass α≥0 α (fun x y => x * y) (· < ·)
#align pos_mul_reflect_lt PosMulReflectLT

/-- `MulPosReflectLT α` is an abbreviation for `ContravariantClas α≥0 α (λ x y, y * x) (<)`,
expressing that multiplication by nonnegative elements on the right is strictly reverse monotone. -/
abbrev MulPosReflectLT : Prop :=
  ContravariantClass α≥0 α (fun x y => y * x) (· < ·)
#align mul_pos_reflect_lt MulPosReflectLT

/-- `PosMulMonoRev α` is an abbreviation for `ContravariantClas α>0 α (λ x y, x * y) (≤)`,
expressing that multiplication by positive elements on the left is reverse monotone. -/
abbrev PosMulMonoRev : Prop :=
  ContravariantClass α>0 α (fun x y => x * y) (· ≤ ·)
#align pos_mul_mono_rev PosMulMonoRev

/-- `MulPosMonoRev α` is an abbreviation for `ContravariantClas α>0 α (λ x y, y * x) (≤)`,
expressing that multiplication by positive elements on the right is reverse monotone. -/
abbrev MulPosMonoRev : Prop :=
  ContravariantClass α>0 α (fun x y => y * x) (· ≤ ·)
#align mul_pos_mono_rev MulPosMonoRev

end Abbreviations

variable {α} {a b c d : α}

section MulZero

variable [Mul α] [Zero α]

section Preorder

variable [Preorder α]

instance PosMulMono.to_covariantClass_pos_mul_le [PosMulMono α] :
    CovariantClass α>0 α (fun x y => x * y) (· ≤ ·) :=
  ⟨fun a _ _ bc => @CovariantClass.elim α≥0 α (fun x y => x * y) (· ≤ ·) _ ⟨_, a.2.le⟩ _ _ bc⟩
#align pos_mul_mono.to_covariant_class_pos_mul_le PosMulMono.to_covariantClass_pos_mul_le

instance MulPosMono.to_covariantClass_pos_mul_le [MulPosMono α] :
    CovariantClass α>0 α (fun x y => y * x) (· ≤ ·) :=
  ⟨fun a _ _ bc => @CovariantClass.elim α≥0 α (fun x y => y * x) (· ≤ ·) _ ⟨_, a.2.le⟩ _ _ bc⟩
#align mul_pos_mono.to_covariant_class_pos_mul_le MulPosMono.to_covariantClass_pos_mul_le

instance PosMulReflectLT.to_contravariantClass_pos_mul_lt [PosMulReflectLT α] :
    ContravariantClass α>0 α (fun x y => x * y) (· < ·) :=
  ⟨fun a _ _ bc => @ContravariantClass.elim α≥0 α (fun x y => x * y) (· < ·) _ ⟨_, a.2.le⟩ _ _ bc⟩
#align pos_mul_reflect_lt.to_contravariant_class_pos_mul_lt PosMulReflectLT.to_contravariantClass_pos_mul_lt

instance MulPosReflectLT.to_contravariantClass_pos_mul_lt [MulPosReflectLT α] :
    ContravariantClass α>0 α (fun x y => y * x) (· < ·) :=
  ⟨fun a _ _ bc => @ContravariantClass.elim α≥0 α (fun x y => y * x) (· < ·) _ ⟨_, a.2.le⟩ _ _ bc⟩
#align mul_pos_reflect_lt.to_contravariant_class_pos_mul_lt MulPosReflectLT.to_contravariantClass_pos_mul_lt

theorem mul_le_mul_of_nonneg_left [PosMulMono α] (h : b ≤ c) (a0 : 0 ≤ a) : a * b ≤ a * c :=
  @CovariantClass.elim α≥0 α (fun x y => x * y) (· ≤ ·) _ ⟨a, a0⟩ _ _ h
#align mul_le_mul_of_nonneg_left mul_le_mul_of_nonneg_left

theorem mul_le_mul_of_nonneg_right [MulPosMono α] (h : b ≤ c) (a0 : 0 ≤ a) : b * a ≤ c * a :=
  @CovariantClass.elim α≥0 α (fun x y => y * x) (· ≤ ·) _ ⟨a, a0⟩ _ _ h
#align mul_le_mul_of_nonneg_right mul_le_mul_of_nonneg_right

theorem mul_lt_mul_of_pos_left [PosMulStrictMono α] (bc : b < c) (a0 : 0 < a) : a * b < a * c :=
  @CovariantClass.elim α>0 α (fun x y => x * y) (· < ·) _ ⟨a, a0⟩ _ _ bc
#align mul_lt_mul_of_pos_left mul_lt_mul_of_pos_left

theorem mul_lt_mul_of_pos_right [MulPosStrictMono α] (bc : b < c) (a0 : 0 < a) : b * a < c * a :=
  @CovariantClass.elim α>0 α (fun x y => y * x) (· < ·) _ ⟨a, a0⟩ _ _ bc
#align mul_lt_mul_of_pos_right mul_lt_mul_of_pos_right

theorem lt_of_mul_lt_mul_left [PosMulReflectLT α] (h : a * b < a * c) (a0 : 0 ≤ a) : b < c :=
  @ContravariantClass.elim α≥0 α (fun x y => x * y) (· < ·) _ ⟨a, a0⟩ _ _ h
#align lt_of_mul_lt_mul_left lt_of_mul_lt_mul_left

theorem lt_of_mul_lt_mul_right [MulPosReflectLT α] (h : b * a < c * a) (a0 : 0 ≤ a) : b < c :=
  @ContravariantClass.elim α≥0 α (fun x y => y * x) (· < ·) _ ⟨a, a0⟩ _ _ h
#align lt_of_mul_lt_mul_right lt_of_mul_lt_mul_right

theorem le_of_mul_le_mul_left [PosMulMonoRev α] (bc : a * b ≤ a * c) (a0 : 0 < a) : b ≤ c :=
  @ContravariantClass.elim α>0 α (fun x y => x * y) (· ≤ ·) _ ⟨a, a0⟩ _ _ bc
#align le_of_mul_le_mul_left le_of_mul_le_mul_left

theorem le_of_mul_le_mul_right [MulPosMonoRev α] (bc : b * a ≤ c * a) (a0 : 0 < a) : b ≤ c :=
  @ContravariantClass.elim α>0 α (fun x y => y * x) (· ≤ ·) _ ⟨a, a0⟩ _ _ bc
#align le_of_mul_le_mul_right le_of_mul_le_mul_right

alias lt_of_mul_lt_mul_left ← lt_of_mul_lt_mul_of_nonneg_left
#align lt_of_mul_lt_mul_of_nonneg_left lt_of_mul_lt_mul_of_nonneg_left

alias lt_of_mul_lt_mul_right ← lt_of_mul_lt_mul_of_nonneg_right
#align lt_of_mul_lt_mul_of_nonneg_right lt_of_mul_lt_mul_of_nonneg_right

alias le_of_mul_le_mul_left ← le_of_mul_le_mul_of_pos_left
#align le_of_mul_le_mul_of_pos_left le_of_mul_le_mul_of_pos_left

alias le_of_mul_le_mul_right ← le_of_mul_le_mul_of_pos_right
#align le_of_mul_le_mul_of_pos_right le_of_mul_le_mul_of_pos_right

@[simp]
theorem mul_lt_mul_left [PosMulStrictMono α] [PosMulReflectLT α] (a0 : 0 < a) :
    a * b < a * c ↔ b < c :=
  @rel_iff_cov α>0 α (fun x y => x * y) (· < ·) _ _ ⟨a, a0⟩ _ _
#align mul_lt_mul_left mul_lt_mul_left

@[simp]
theorem mul_lt_mul_right [MulPosStrictMono α] [MulPosReflectLT α] (a0 : 0 < a) :
    b * a < c * a ↔ b < c :=
  @rel_iff_cov α>0 α (fun x y => y * x) (· < ·) _ _ ⟨a, a0⟩ _ _
#align mul_lt_mul_right mul_lt_mul_right

@[simp]
theorem mul_le_mul_left [PosMulMono α] [PosMulMonoRev α] (a0 : 0 < a) : a * b ≤ a * c ↔ b ≤ c :=
  @rel_iff_cov α>0 α (fun x y => x * y) (· ≤ ·) _ _ ⟨a, a0⟩ _ _
#align mul_le_mul_left mul_le_mul_left

@[simp]
theorem mul_le_mul_right [MulPosMono α] [MulPosMonoRev α] (a0 : 0 < a) : b * a ≤ c * a ↔ b ≤ c :=
  @rel_iff_cov α>0 α (fun x y => y * x) (· ≤ ·) _ _ ⟨a, a0⟩ _ _
#align mul_le_mul_right mul_le_mul_right

theorem mul_lt_mul_of_pos_of_nonneg [PosMulStrictMono α] [MulPosMono α] (h₁ : a ≤ b) (h₂ : c < d)
    (a0 : 0 < a) (d0 : 0 ≤ d) : a * c < b * d :=
  (mul_lt_mul_of_pos_left h₂ a0).trans_le (mul_le_mul_of_nonneg_right h₁ d0)
#align mul_lt_mul_of_pos_of_nonneg mul_lt_mul_of_pos_of_nonneg

theorem mul_lt_mul_of_le_of_le' [PosMulStrictMono α] [MulPosMono α] (h₁ : a ≤ b) (h₂ : c < d)
    (b0 : 0 < b) (c0 : 0 ≤ c) : a * c < b * d :=
  (mul_le_mul_of_nonneg_right h₁ c0).trans_lt (mul_lt_mul_of_pos_left h₂ b0)
#align mul_lt_mul_of_le_of_le' mul_lt_mul_of_le_of_le'

theorem mul_lt_mul_of_nonneg_of_pos [PosMulMono α] [MulPosStrictMono α] (h₁ : a < b) (h₂ : c ≤ d)
    (a0 : 0 ≤ a) (d0 : 0 < d) : a * c < b * d :=
  (mul_le_mul_of_nonneg_left h₂ a0).trans_lt (mul_lt_mul_of_pos_right h₁ d0)
#align mul_lt_mul_of_nonneg_of_pos mul_lt_mul_of_nonneg_of_pos

theorem mul_lt_mul_of_le_of_lt' [PosMulMono α] [MulPosStrictMono α] (h₁ : a < b) (h₂ : c ≤ d)
    (b0 : 0 ≤ b) (c0 : 0 < c) : a * c < b * d :=
  (mul_lt_mul_of_pos_right h₁ c0).trans_le (mul_le_mul_of_nonneg_left h₂ b0)
#align mul_lt_mul_of_le_of_lt' mul_lt_mul_of_le_of_lt'

theorem mul_lt_mul_of_pos_of_pos [PosMulStrictMono α] [MulPosStrictMono α] (h₁ : a < b) (h₂ : c < d)
    (a0 : 0 < a) (d0 : 0 < d) : a * c < b * d :=
  (mul_lt_mul_of_pos_left h₂ a0).trans (mul_lt_mul_of_pos_right h₁ d0)
#align mul_lt_mul_of_pos_of_pos mul_lt_mul_of_pos_of_pos

theorem mul_lt_mul_of_lt_of_lt' [PosMulStrictMono α] [MulPosStrictMono α] (h₁ : a < b) (h₂ : c < d)
    (b0 : 0 < b) (c0 : 0 < c) : a * c < b * d :=
  (mul_lt_mul_of_pos_right h₁ c0).trans (mul_lt_mul_of_pos_left h₂ b0)
#align mul_lt_mul_of_lt_of_lt' mul_lt_mul_of_lt_of_lt'

theorem mul_lt_of_mul_lt_of_nonneg_left [PosMulMono α] (h : a * b < c) (hdb : d ≤ b) (ha : 0 ≤ a) :
    a * d < c :=
  (mul_le_mul_of_nonneg_left hdb ha).trans_lt h
#align mul_lt_of_mul_lt_of_nonneg_left mul_lt_of_mul_lt_of_nonneg_left

theorem lt_mul_of_lt_mul_of_nonneg_left [PosMulMono α] (h : a < b * c) (hcd : c ≤ d) (hb : 0 ≤ b) :
    a < b * d :=
  h.trans_le <| mul_le_mul_of_nonneg_left hcd hb
#align lt_mul_of_lt_mul_of_nonneg_left lt_mul_of_lt_mul_of_nonneg_left

theorem mul_lt_of_mul_lt_of_nonneg_right [MulPosMono α] (h : a * b < c) (hda : d ≤ a) (hb : 0 ≤ b) :
    d * b < c :=
  (mul_le_mul_of_nonneg_right hda hb).trans_lt h
#align mul_lt_of_mul_lt_of_nonneg_right mul_lt_of_mul_lt_of_nonneg_right

theorem lt_mul_of_lt_mul_of_nonneg_right [MulPosMono α] (h : a < b * c) (hbd : b ≤ d) (hc : 0 ≤ c) :
    a < d * c :=
  h.trans_le <| mul_le_mul_of_nonneg_right hbd hc
#align lt_mul_of_lt_mul_of_nonneg_right lt_mul_of_lt_mul_of_nonneg_right

end Preorder

section LinearOrder

variable [LinearOrder α]

-- see Note [lower instance priority]
instance (priority := 100) PosMulStrictMono.toPosMulMonoRev [PosMulStrictMono α] :
    PosMulMonoRev α :=
  ⟨fun x _ _ h => le_of_not_lt fun h' => h.not_lt <| mul_lt_mul_of_pos_left h' x.prop⟩

-- see Note [lower instance priority]
instance (priority := 100) MulPosStrictMono.toMulPosMonoRev [MulPosStrictMono α] :
    MulPosMonoRev α :=
  ⟨fun x _ _ h => le_of_not_lt fun h' => h.not_lt <| mul_lt_mul_of_pos_right h' x.prop⟩

theorem PosMulMonoRev.toPosMulStrictMono [PosMulMonoRev α] : PosMulStrictMono α :=
  ⟨fun x _ _ h => lt_of_not_ge fun h' => h.not_le <| le_of_mul_le_mul_of_pos_left h' x.prop⟩
#align pos_mul_mono_rev.to_pos_mul_strict_mono PosMulMonoRev.toPosMulStrictMono

theorem MulPosMonoRev.toMulPosStrictMono [MulPosMonoRev α] : MulPosStrictMono α :=
  ⟨fun x _ _ h => lt_of_not_ge fun h' => h.not_le <| le_of_mul_le_mul_of_pos_right h' x.prop⟩
#align mul_pos_mono_rev.to_mul_pos_strict_mono MulPosMonoRev.toMulPosStrictMono

theorem posMulStrictMono_iff_posMulMonoRev : PosMulStrictMono α ↔ PosMulMonoRev α :=
  ⟨@PosMulStrictMono.toPosMulMonoRev _ _ _ _, @PosMulMonoRev.toPosMulStrictMono _ _ _ _⟩
#align pos_mul_strict_mono_iff_pos_mul_mono_rev posMulStrictMono_iff_posMulMonoRev

theorem mulPosStrictMono_iff_mulPosMonoRev : MulPosStrictMono α ↔ MulPosMonoRev α :=
  ⟨@MulPosStrictMono.toMulPosMonoRev _ _ _ _, @MulPosMonoRev.toMulPosStrictMono _ _ _ _⟩
#align mul_pos_strict_mono_iff_mul_pos_mono_rev mulPosStrictMono_iff_mulPosMonoRev

theorem PosMulReflectLT.toPosMulMono [PosMulReflectLT α] : PosMulMono α :=
  ⟨fun x _ _ h => le_of_not_lt fun h' => h.not_lt <| lt_of_mul_lt_mul_left h' x.prop⟩
#align pos_mul_reflect_lt.to_pos_mul_mono PosMulReflectLT.toPosMulMono

theorem MulPosReflectLT.toMulPosMono [MulPosReflectLT α] : MulPosMono α :=
  ⟨fun x _ _ h => le_of_not_lt fun h' => h.not_lt <| lt_of_mul_lt_mul_right h' x.prop⟩
#align mul_pos_reflect_lt.to_mul_pos_mono MulPosReflectLT.toMulPosMono

theorem PosMulMono.toPosMulReflectLT [PosMulMono α] : PosMulReflectLT α :=
  ⟨fun x _ _ h => lt_of_not_ge fun h' => h.not_le <| mul_le_mul_of_nonneg_left h' x.prop⟩
#align pos_mul_mono.to_pos_mul_reflect_lt PosMulMono.toPosMulReflectLT

theorem MulPosMono.toMulPosReflectLT [MulPosMono α] : MulPosReflectLT α :=
  ⟨fun x _ _ h => lt_of_not_ge fun h' => h.not_le <| mul_le_mul_of_nonneg_right h' x.prop⟩
#align mul_pos_mono.to_mul_pos_reflect_lt MulPosMono.toMulPosReflectLT

theorem posMulMono_iff_posMulReflectLT : PosMulMono α ↔ PosMulReflectLT α :=
  ⟨@PosMulMono.toPosMulReflectLT _ _ _ _, @PosMulReflectLT.toPosMulMono _ _ _ _⟩
#align pos_mul_mono_iff_pos_mul_reflect_lt posMulMono_iff_posMulReflectLT

theorem mulPosMono_iff_mulPosReflectLT : MulPosMono α ↔ MulPosReflectLT α :=
  ⟨@MulPosMono.toMulPosReflectLT _ _ _ _, @MulPosReflectLT.toMulPosMono _ _ _ _⟩
#align mul_pos_mono_iff_mul_pos_reflect_lt mulPosMono_iff_mulPosReflectLT

end LinearOrder

end MulZero

section MulZeroClass

variable [MulZeroClass α]

section Preorder

variable [Preorder α]

/-- Assumes left covariance. -/
theorem Left.mul_pos [PosMulStrictMono α] (ha : 0 < a) (hb : 0 < b) : 0 < a * b := by
  simpa only [mul_zero] using mul_lt_mul_of_pos_left hb ha
#align left.mul_pos Left.mul_pos

alias Left.mul_pos ← mul_pos
#align mul_pos mul_pos

theorem mul_neg_of_pos_of_neg [PosMulStrictMono α] (ha : 0 < a) (hb : b < 0) : a * b < 0 := by
  simpa only [mul_zero] using mul_lt_mul_of_pos_left hb ha
#align mul_neg_of_pos_of_neg mul_neg_of_pos_of_neg

@[simp]
theorem zero_lt_mul_left [PosMulStrictMono α] [PosMulReflectLT α] (h : 0 < c) :
    0 < c * b ↔ 0 < b := by
  rw [←mul_zero c, mul_lt_mul_left h]
  simp
#align zero_lt_mul_left zero_lt_mul_left

/-- Assumes right covariance. -/
theorem Right.mul_pos [MulPosStrictMono α] (ha : 0 < a) (hb : 0 < b) : 0 < a * b := by
  simpa only [zero_mul] using mul_lt_mul_of_pos_right ha hb
#align right.mul_pos Right.mul_pos

theorem mul_neg_of_neg_of_pos [MulPosStrictMono α] (ha : a < 0) (hb : 0 < b) : a * b < 0 := by
  simpa only [zero_mul] using mul_lt_mul_of_pos_right ha hb
#align mul_neg_of_neg_of_pos mul_neg_of_neg_of_pos

@[simp]
theorem zero_lt_mul_right [MulPosStrictMono α] [MulPosReflectLT α] (h : 0 < c) :
    0 < b * c ↔ 0 < b := by
  rw [←zero_mul c, mul_lt_mul_right h]
  simp
#align zero_lt_mul_right zero_lt_mul_right

/-- Assumes left covariance. -/
theorem Left.mul_nonneg [PosMulMono α] (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a * b := by
  simpa only [mul_zero] using mul_le_mul_of_nonneg_left hb ha
#align left.mul_nonneg Left.mul_nonneg

alias Left.mul_nonneg ← mul_nonneg
#align mul_nonneg mul_nonneg

theorem mul_nonpos_of_nonneg_of_nonpos [PosMulMono α] (ha : 0 ≤ a) (hb : b ≤ 0) : a * b ≤ 0 := by
  simpa only [mul_zero] using mul_le_mul_of_nonneg_left hb ha
#align mul_nonpos_of_nonneg_of_nonpos mul_nonpos_of_nonneg_of_nonpos

/-- Assumes right covariance. -/
theorem Right.mul_nonneg [MulPosMono α] (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a * b := by
  simpa only [zero_mul] using mul_le_mul_of_nonneg_right ha hb
#align right.mul_nonneg Right.mul_nonneg

theorem mul_nonpos_of_nonpos_of_nonneg [MulPosMono α] (ha : a ≤ 0) (hb : 0 ≤ b) : a * b ≤ 0 := by
  simpa only [zero_mul] using mul_le_mul_of_nonneg_right ha hb
#align mul_nonpos_of_nonpos_of_nonneg mul_nonpos_of_nonpos_of_nonneg

theorem pos_of_mul_pos_right [PosMulReflectLT α] (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
#align pos_of_mul_pos_right pos_of_mul_pos_right

theorem pos_of_mul_pos_left [MulPosReflectLT α] (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
#align pos_of_mul_pos_left pos_of_mul_pos_left

theorem pos_iff_pos_of_mul_pos [PosMulReflectLT α] [MulPosReflectLT α] (hab : 0 < a * b) :
    0 < a ↔ 0 < b :=
  ⟨pos_of_mul_pos_right hab ∘ le_of_lt, pos_of_mul_pos_left hab ∘ le_of_lt⟩
#align pos_iff_pos_of_mul_pos pos_iff_pos_of_mul_pos

theorem mul_le_mul_of_le_of_le [PosMulMono α] [MulPosMono α] (h₁ : a ≤ b) (h₂ : c ≤ d) (a0 : 0 ≤ a)
    (d0 : 0 ≤ d) : a * c ≤ b * d :=
  (mul_le_mul_of_nonneg_left h₂ a0).trans <| mul_le_mul_of_nonneg_right h₁ d0
#align mul_le_mul_of_le_of_le mul_le_mul_of_le_of_le

theorem mul_le_mul [PosMulMono α] [MulPosMono α] (h₁ : a ≤ b) (h₂ : c ≤ d) (c0 : 0 ≤ c)
    (b0 : 0 ≤ b) : a * c ≤ b * d :=
  (mul_le_mul_of_nonneg_right h₁ c0).trans <| mul_le_mul_of_nonneg_left h₂ b0
#align mul_le_mul mul_le_mul

theorem mul_self_le_mul_self [PosMulMono α] [MulPosMono α] (ha : 0 ≤ a) (hab : a ≤ b) :
    a * a ≤ b * b :=
  mul_le_mul hab hab ha <| ha.trans hab
#align mul_self_le_mul_self mul_self_le_mul_self

theorem mul_le_of_mul_le_of_nonneg_left [PosMulMono α] (h : a * b ≤ c) (hle : d ≤ b)
    (a0 : 0 ≤ a) : a * d ≤ c :=
  (mul_le_mul_of_nonneg_left hle a0).trans h
#align mul_le_of_mul_le_of_nonneg_left mul_le_of_mul_le_of_nonneg_left

theorem le_mul_of_le_mul_of_nonneg_left [PosMulMono α] (h : a ≤ b * c) (hle : c ≤ d)
    (b0 : 0 ≤ b) : a ≤ b * d :=
  h.trans (mul_le_mul_of_nonneg_left hle b0)
#align le_mul_of_le_mul_of_nonneg_left le_mul_of_le_mul_of_nonneg_left

theorem mul_le_of_mul_le_of_nonneg_right [MulPosMono α] (h : a * b ≤ c) (hle : d ≤ a)
    (b0 : 0 ≤ b) : d * b ≤ c :=
  (mul_le_mul_of_nonneg_right hle b0).trans h
#align mul_le_of_mul_le_of_nonneg_right mul_le_of_mul_le_of_nonneg_right

theorem le_mul_of_le_mul_of_nonneg_right [MulPosMono α] (h : a ≤ b * c) (hle : b ≤ d)
    (c0 : 0 ≤ c) : a ≤ d * c :=
  h.trans (mul_le_mul_of_nonneg_right hle c0)
#align le_mul_of_le_mul_of_nonneg_right le_mul_of_le_mul_of_nonneg_right

end Preorder

section PartialOrder

variable [PartialOrder α]

theorem posMulMono_iff_covariant_pos :
    PosMulMono α ↔ CovariantClass α>0 α (fun x y => x * y) (· ≤ ·) :=
  ⟨@PosMulMono.to_covariantClass_pos_mul_le _ _ _ _, fun h =>
    ⟨fun a b c h => by
      obtain ha | ha := a.prop.eq_or_lt
      · simp [←ha]
      · exact @CovariantClass.elim α>0 α (fun x y => x * y) (· ≤ ·) _ ⟨_, ha⟩ _ _ h ⟩⟩
#align pos_mul_mono_iff_covariant_pos posMulMono_iff_covariant_pos

theorem mulPosMono_iff_covariant_pos :
    MulPosMono α ↔ CovariantClass α>0 α (fun x y => y * x) (· ≤ ·) :=
  ⟨@MulPosMono.to_covariantClass_pos_mul_le _ _ _ _, fun h =>
    ⟨fun a b c h => by
      obtain ha | ha := a.prop.eq_or_lt
      · simp [←ha]
      · exact @CovariantClass.elim α>0 α (fun x y => y * x) (· ≤ ·) _ ⟨_, ha⟩ _ _ h ⟩⟩
#align mul_pos_mono_iff_covariant_pos mulPosMono_iff_covariant_pos

theorem posMulReflectLT_iff_contravariant_pos :
    PosMulReflectLT α ↔ ContravariantClass α>0 α (fun x y => x * y) (· < ·) :=
  ⟨@PosMulReflectLT.to_contravariantClass_pos_mul_lt _ _ _ _, fun h =>
    ⟨fun a b c h => by
      obtain ha | ha := a.prop.eq_or_lt
      · simp [←ha] at h
      · exact @ContravariantClass.elim α>0 α (fun x y => x * y) (· < ·) _ ⟨_, ha⟩ _ _ h ⟩⟩
#align pos_mul_reflect_lt_iff_contravariant_pos posMulReflectLT_iff_contravariant_pos

theorem mulPosReflectLT_iff_contravariant_pos :
    MulPosReflectLT α ↔ ContravariantClass α>0 α (fun x y => y * x) (· < ·) :=
  ⟨@MulPosReflectLT.to_contravariantClass_pos_mul_lt _ _ _ _, fun h =>
    ⟨fun a b c h => by
      obtain ha | ha := a.prop.eq_or_lt
      · simp [←ha] at h
      · exact @ContravariantClass.elim α>0 α (fun x y => y * x) (· < ·) _ ⟨_, ha⟩ _ _ h ⟩⟩
#align mul_pos_reflect_lt_iff_contravariant_pos mulPosReflectLT_iff_contravariant_pos

-- Porting note: mathlib3 proofs would look like `StrictMono.monotone <| @CovariantClass.elim ..`
-- but implicit argument handling causes that to break
-- see Note [lower instance priority]
instance (priority := 100) PosMulStrictMono.toPosMulMono [PosMulStrictMono α] : PosMulMono α :=
  posMulMono_iff_covariant_pos.2 <|
    ⟨fun a _ _ h => StrictMono.monotone (λ _ _ h' => mul_lt_mul_of_pos_left h' a.prop) h⟩
#align pos_mul_strict_mono.to_pos_mul_mono PosMulStrictMono.toPosMulMono

-- Porting note: mathlib3 proofs would look like `StrictMono.monotone <| @CovariantClass.elim ..`
-- but implicit argument handling causes that to break
-- see Note [lower instance priority]
instance (priority := 100) MulPosStrictMono.toMulPosMono [MulPosStrictMono α] : MulPosMono α :=
  mulPosMono_iff_covariant_pos.2 <|
    ⟨fun a _ _ h => StrictMono.monotone (λ _ _ h' => mul_lt_mul_of_pos_right h' a.prop) h⟩
#align mul_pos_strict_mono.to_mul_pos_mono MulPosStrictMono.toMulPosMono

-- see Note [lower instance priority]
instance (priority := 100) PosMulMonoRev.toPosMulReflectLT [PosMulMonoRev α] :
    PosMulReflectLT α :=
  posMulReflectLT_iff_contravariant_pos.2
    ⟨fun a b c h =>
      (le_of_mul_le_mul_of_pos_left h.le a.2).lt_of_ne <| by
        rintro rfl
        simp at h⟩
#align pos_mul_mono_rev.to_pos_mul_reflect_lt PosMulMonoRev.toPosMulReflectLT

-- see Note [lower instance priority]
instance (priority := 100) MulPosMonoRev.toMulPosReflectLT [MulPosMonoRev α] :
    MulPosReflectLT α :=
  mulPosReflectLT_iff_contravariant_pos.2
    ⟨fun a b c h =>
      (le_of_mul_le_mul_of_pos_right h.le a.2).lt_of_ne <| by
        rintro rfl
        simp at h⟩
#align mul_pos_mono_rev.to_mul_pos_reflect_lt MulPosMonoRev.toMulPosReflectLT

theorem mul_left_cancel_iff_of_pos [PosMulMonoRev α] (a0 : 0 < a) : a * b = a * c ↔ b = c :=
  ⟨fun h => (le_of_mul_le_mul_of_pos_left h.le a0).antisymm <|
    le_of_mul_le_mul_of_pos_left h.ge a0, congr_arg _⟩
#align mul_left_cancel_iff_of_pos mul_left_cancel_iff_of_pos

theorem mul_right_cancel_iff_of_pos [MulPosMonoRev α] (b0 : 0 < b) : a * b = c * b ↔ a = c :=
  ⟨fun h => (le_of_mul_le_mul_of_pos_right h.le b0).antisymm <|
    le_of_mul_le_mul_of_pos_right h.ge b0, congr_arg (· * b)⟩
#align mul_right_cancel_iff_of_pos mul_right_cancel_iff_of_pos

theorem mul_eq_mul_iff_eq_and_eq_of_pos [PosMulStrictMono α] [MulPosStrictMono α] [PosMulMonoRev α]
    [MulPosMonoRev α] (hac : a ≤ b) (hbd : c ≤ d) (a0 : 0 < a) (d0 : 0 < d) :
    a * c = b * d ↔ a = b ∧ c = d := by
  refine' ⟨fun h => _, fun h => congr_arg₂ (· * ·) h.1 h.2⟩
  rcases hac.eq_or_lt with (rfl | hac)
  · exact ⟨rfl, (mul_left_cancel_iff_of_pos a0).mp h⟩
  rcases eq_or_lt_of_le hbd with (rfl | hbd)
  · exact ⟨(mul_right_cancel_iff_of_pos d0).mp h, rfl⟩
  exact ((mul_lt_mul_of_pos_of_pos hac hbd a0 d0).ne h).elim
#align mul_eq_mul_iff_eq_and_eq_of_pos mul_eq_mul_iff_eq_and_eq_of_pos

theorem mul_eq_mul_iff_eq_and_eq_of_pos' [PosMulStrictMono α] [MulPosStrictMono α] [PosMulMonoRev α]
    [MulPosMonoRev α] (hac : a ≤ b) (hbd : c ≤ d) (b0 : 0 < b) (c0 : 0 < c) :
    a * c = b * d ↔ a = b ∧ c = d := by
  refine' ⟨fun h => _, fun h => congr_arg₂ (· * ·) h.1 h.2⟩
  rcases hac.eq_or_lt with (rfl | hac)
  · exact ⟨rfl, (mul_left_cancel_iff_of_pos b0).mp h⟩
  rcases eq_or_lt_of_le hbd with (rfl | hbd)
  · exact ⟨(mul_right_cancel_iff_of_pos c0).mp h, rfl⟩
  exact ((mul_lt_mul_of_lt_of_lt' hac hbd b0 c0).ne h).elim
#align mul_eq_mul_iff_eq_and_eq_of_pos' mul_eq_mul_iff_eq_and_eq_of_pos'

end PartialOrder

section LinearOrder

variable [LinearOrder α]

theorem pos_and_pos_or_neg_and_neg_of_mul_pos [PosMulMono α] [MulPosMono α] (hab : 0 < a * b) :
    0 < a ∧ 0 < b ∨ a < 0 ∧ b < 0 := by
  rcases lt_trichotomy a 0 with (ha | rfl | ha)
  · refine' Or.inr ⟨ha, lt_imp_lt_of_le_imp_le (fun hb => _) hab⟩
    exact mul_nonpos_of_nonpos_of_nonneg ha.le hb
  · rw [zero_mul] at hab
    exact hab.false.elim
  · refine' Or.inl ⟨ha, lt_imp_lt_of_le_imp_le (fun hb => _) hab⟩
    exact mul_nonpos_of_nonneg_of_nonpos ha.le hb
#align pos_and_pos_or_neg_and_neg_of_mul_pos pos_and_pos_or_neg_and_neg_of_mul_pos

theorem neg_of_mul_pos_right [PosMulMono α] [MulPosMono α] (h : 0 < a * b) (ha : a ≤ 0) : b < 0 :=
  ((pos_and_pos_or_neg_and_neg_of_mul_pos h).resolve_left fun h => h.1.not_le ha).2
#align neg_of_mul_pos_right neg_of_mul_pos_right

theorem neg_of_mul_pos_left [PosMulMono α] [MulPosMono α] (h : 0 < a * b) (ha : b ≤ 0) : a < 0 :=
  ((pos_and_pos_or_neg_and_neg_of_mul_pos h).resolve_left fun h => h.2.not_le ha).1
#align neg_of_mul_pos_left neg_of_mul_pos_left

theorem neg_iff_neg_of_mul_pos [PosMulMono α] [MulPosMono α] (hab : 0 < a * b) : a < 0 ↔ b < 0 :=
  ⟨neg_of_mul_pos_right hab ∘ le_of_lt, neg_of_mul_pos_left hab ∘ le_of_lt⟩
#align neg_iff_neg_of_mul_pos neg_iff_neg_of_mul_pos

theorem Left.neg_of_mul_neg_left [PosMulMono α] (h : a * b < 0) (h1 : 0 ≤ a) : b < 0 :=
  lt_of_not_ge fun h2 : b ≥ 0 => (Left.mul_nonneg h1 h2).not_lt h
#align left.neg_of_mul_neg_left Left.neg_of_mul_neg_left

theorem Right.neg_of_mul_neg_left [MulPosMono α] (h : a * b < 0) (h1 : 0 ≤ a) : b < 0 :=
  lt_of_not_ge fun h2 : b ≥ 0 => (Right.mul_nonneg h1 h2).not_lt h
#align right.neg_of_mul_neg_left Right.neg_of_mul_neg_left

theorem Left.neg_of_mul_neg_right [PosMulMono α] (h : a * b < 0) (h1 : 0 ≤ b) : a < 0 :=
  lt_of_not_ge fun h2 : a ≥ 0 => (Left.mul_nonneg h2 h1).not_lt h
#align left.neg_of_mul_neg_right Left.neg_of_mul_neg_right

theorem Right.neg_of_mul_neg_right [MulPosMono α] (h : a * b < 0) (h1 : 0 ≤ b) : a < 0 :=
  lt_of_not_ge fun h2 : a ≥ 0 => (Right.mul_nonneg h2 h1).not_lt h
#align right.neg_of_mul_neg_right Right.neg_of_mul_neg_right

end LinearOrder

end MulZeroClass

section MulOneClass

variable [MulOneClass α] [Zero α]

section Preorder

variable [Preorder α]

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

@[simp]
theorem le_mul_iff_one_le_right [PosMulMono α] [PosMulMonoRev α] (a0 : 0 < a) : a ≤ a * b ↔ 1 ≤ b :=
  Iff.trans (by rw [mul_one]) (mul_le_mul_left a0)
#align le_mul_iff_one_le_right le_mul_iff_one_le_right

@[simp]
theorem lt_mul_iff_one_lt_right [PosMulStrictMono α] [PosMulReflectLT α] (a0 : 0 < a) :
    a < a * b ↔ 1 < b :=
  Iff.trans (by rw [mul_one]) (mul_lt_mul_left a0)
#align lt_mul_iff_one_lt_right lt_mul_iff_one_lt_right

@[simp]
theorem mul_le_iff_le_one_right [PosMulMono α] [PosMulMonoRev α] (a0 : 0 < a) : a * b ≤ a ↔ b ≤ 1 :=
  Iff.trans (by rw [mul_one]) (mul_le_mul_left a0)
#align mul_le_iff_le_one_right mul_le_iff_le_one_right

@[simp]
theorem mul_lt_iff_lt_one_right [PosMulStrictMono α] [PosMulReflectLT α] (a0 : 0 < a) :
    a * b < a ↔ b < 1 :=
  Iff.trans (by rw [mul_one]) (mul_lt_mul_left a0)
#align mul_lt_iff_lt_one_right mul_lt_iff_lt_one_right

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

@[simp]
theorem le_mul_iff_one_le_left [MulPosMono α] [MulPosMonoRev α] (a0 : 0 < a) : a ≤ b * a ↔ 1 ≤ b :=
  Iff.trans (by rw [one_mul]) (mul_le_mul_right a0)
#align le_mul_iff_one_le_left le_mul_iff_one_le_left

@[simp]
theorem lt_mul_iff_one_lt_left [MulPosStrictMono α] [MulPosReflectLT α] (a0 : 0 < a) :
    a < b * a ↔ 1 < b :=
  Iff.trans (by rw [one_mul]) (mul_lt_mul_right a0)
#align lt_mul_iff_one_lt_left lt_mul_iff_one_lt_left

@[simp]
theorem mul_le_iff_le_one_left [MulPosMono α] [MulPosMonoRev α] (b0 : 0 < b) : a * b ≤ b ↔ a ≤ 1 :=
  Iff.trans (by rw [one_mul]) (mul_le_mul_right b0)
#align mul_le_iff_le_one_left mul_le_iff_le_one_left

@[simp]
theorem mul_lt_iff_lt_one_left [MulPosStrictMono α] [MulPosReflectLT α] (b0 : 0 < b) :
    a * b < b ↔ a < 1 :=
  Iff.trans (by rw [one_mul]) (mul_lt_mul_right b0)
#align mul_lt_iff_lt_one_left mul_lt_iff_lt_one_left

/-! Lemmas of the form `1 ≤ b → a ≤ a * b`. -/

theorem mul_le_of_le_one_left [MulPosMono α] (hb : 0 ≤ b) (h : a ≤ 1) : a * b ≤ b := by
  simpa only [one_mul] using mul_le_mul_of_nonneg_right h hb
#align mul_le_of_le_one_left mul_le_of_le_one_left

theorem le_mul_of_one_le_left [MulPosMono α] (hb : 0 ≤ b) (h : 1 ≤ a) : b ≤ a * b := by
  simpa only [one_mul] using mul_le_mul_of_nonneg_right h hb
#align le_mul_of_one_le_left le_mul_of_one_le_left

theorem mul_le_of_le_one_right [PosMulMono α] (ha : 0 ≤ a) (h : b ≤ 1) : a * b ≤ a := by
  simpa only [mul_one] using mul_le_mul_of_nonneg_left h ha
#align mul_le_of_le_one_right mul_le_of_le_one_right

theorem le_mul_of_one_le_right [PosMulMono α] (ha : 0 ≤ a) (h : 1 ≤ b) : a ≤ a * b := by
  simpa only [mul_one] using mul_le_mul_of_nonneg_left h ha
#align le_mul_of_one_le_right le_mul_of_one_le_right

theorem mul_lt_of_lt_one_left [MulPosStrictMono α] (hb : 0 < b) (h : a < 1) : a * b < b := by
  simpa only [one_mul] using mul_lt_mul_of_pos_right h hb
#align mul_lt_of_lt_one_left mul_lt_of_lt_one_left

theorem lt_mul_of_one_lt_left [MulPosStrictMono α] (hb : 0 < b) (h : 1 < a) : b < a * b := by
  simpa only [one_mul] using mul_lt_mul_of_pos_right h hb
#align lt_mul_of_one_lt_left lt_mul_of_one_lt_left

theorem mul_lt_of_lt_one_right [PosMulStrictMono α] (ha : 0 < a) (h : b < 1) : a * b < a := by
  simpa only [mul_one] using mul_lt_mul_of_pos_left h ha
#align mul_lt_of_lt_one_right mul_lt_of_lt_one_right

theorem lt_mul_of_one_lt_right [PosMulStrictMono α] (ha : 0 < a) (h : 1 < b) : a < a * b := by
  simpa only [mul_one] using mul_lt_mul_of_pos_left h ha
#align lt_mul_of_one_lt_right lt_mul_of_one_lt_right

/-! Lemmas of the form `b ≤ c → a ≤ 1 → b * a ≤ c`. -/

/- Yaël: What's the point of these lemmas? They just chain an existing lemma with an assumption in
all possible ways, thereby artificially inflating the API and making the truly relevant lemmas hard
to find -/
theorem mul_le_of_le_of_le_one_of_nonneg [PosMulMono α] (h : b ≤ c) (ha : a ≤ 1) (hb : 0 ≤ b) :
    b * a ≤ c :=
  (mul_le_of_le_one_right hb ha).trans h
#align mul_le_of_le_of_le_one_of_nonneg mul_le_of_le_of_le_one_of_nonneg

theorem mul_lt_of_le_of_lt_one_of_pos [PosMulStrictMono α] (bc : b ≤ c) (ha : a < 1) (b0 : 0 < b) :
    b * a < c :=
  (mul_lt_of_lt_one_right b0 ha).trans_le bc
#align mul_lt_of_le_of_lt_one_of_pos mul_lt_of_le_of_lt_one_of_pos

theorem mul_lt_of_lt_of_le_one_of_nonneg [PosMulMono α] (h : b < c) (ha : a ≤ 1) (hb : 0 ≤ b) :
    b * a < c :=
  (mul_le_of_le_one_right hb ha).trans_lt h
#align mul_lt_of_lt_of_le_one_of_nonneg mul_lt_of_lt_of_le_one_of_nonneg

/-- Assumes left covariance. -/
theorem Left.mul_le_one_of_le_of_le [PosMulMono α] (ha : a ≤ 1) (hb : b ≤ 1) (a0 : 0 ≤ a) :
    a * b ≤ 1 :=
  mul_le_of_le_of_le_one_of_nonneg ha hb a0
#align left.mul_le_one_of_le_of_le Left.mul_le_one_of_le_of_le

/-- Assumes left covariance. -/
theorem Left.mul_lt_of_le_of_lt_one_of_pos [PosMulStrictMono α] (ha : a ≤ 1) (hb : b < 1)
    (a0 : 0 < a) : a * b < 1 :=
  _root_.mul_lt_of_le_of_lt_one_of_pos ha hb a0
#align left.mul_lt_of_le_of_lt_one_of_pos Left.mul_lt_of_le_of_lt_one_of_pos

/-- Assumes left covariance. -/
theorem Left.mul_lt_of_lt_of_le_one_of_nonneg [PosMulMono α] (ha : a < 1) (hb : b ≤ 1)
    (a0 : 0 ≤ a) : a * b < 1 :=
  _root_.mul_lt_of_lt_of_le_one_of_nonneg ha hb a0
#align left.mul_lt_of_lt_of_le_one_of_nonneg Left.mul_lt_of_lt_of_le_one_of_nonneg

theorem mul_le_of_le_of_le_one' [PosMulMono α] [MulPosMono α] (bc : b ≤ c) (ha : a ≤ 1) (a0 : 0 ≤ a)
    (c0 : 0 ≤ c) : b * a ≤ c :=
  (mul_le_mul_of_nonneg_right bc a0).trans <| mul_le_of_le_one_right c0 ha
#align mul_le_of_le_of_le_one' mul_le_of_le_of_le_one'

theorem mul_lt_of_lt_of_le_one' [PosMulMono α] [MulPosStrictMono α] (bc : b < c) (ha : a ≤ 1)
    (a0 : 0 < a) (c0 : 0 ≤ c) : b * a < c :=
  (mul_lt_mul_of_pos_right bc a0).trans_le <| mul_le_of_le_one_right c0 ha
#align mul_lt_of_lt_of_le_one' mul_lt_of_lt_of_le_one'

theorem mul_lt_of_le_of_lt_one' [PosMulStrictMono α] [MulPosMono α] (bc : b ≤ c) (ha : a < 1)
    (a0 : 0 ≤ a) (c0 : 0 < c) : b * a < c :=
  (mul_le_mul_of_nonneg_right bc a0).trans_lt <| mul_lt_of_lt_one_right c0 ha
#align mul_lt_of_le_of_lt_one' mul_lt_of_le_of_lt_one'

theorem mul_lt_of_lt_of_lt_one_of_pos [PosMulMono α] [MulPosStrictMono α] (bc : b < c) (ha : a ≤ 1)
    (a0 : 0 < a) (c0 : 0 ≤ c) : b * a < c :=
  (mul_lt_mul_of_pos_right bc a0).trans_le <| mul_le_of_le_one_right c0 ha
#align mul_lt_of_lt_of_lt_one_of_pos mul_lt_of_lt_of_lt_one_of_pos

/-! Lemmas of the form `b ≤ c → 1 ≤ a → b ≤ c * a`. -/

theorem le_mul_of_le_of_one_le_of_nonneg [PosMulMono α] (h : b ≤ c) (ha : 1 ≤ a) (hc : 0 ≤ c) :
    b ≤ c * a :=
  h.trans <| le_mul_of_one_le_right hc ha
#align le_mul_of_le_of_one_le_of_nonneg le_mul_of_le_of_one_le_of_nonneg

theorem lt_mul_of_le_of_one_lt_of_pos [PosMulStrictMono α] (bc : b ≤ c) (ha : 1 < a) (c0 : 0 < c) :
    b < c * a :=
  bc.trans_lt <| lt_mul_of_one_lt_right c0 ha
#align lt_mul_of_le_of_one_lt_of_pos lt_mul_of_le_of_one_lt_of_pos

theorem lt_mul_of_lt_of_one_le_of_nonneg [PosMulMono α] (h : b < c) (ha : 1 ≤ a) (hc : 0 ≤ c) :
    b < c * a :=
  h.trans_le <| le_mul_of_one_le_right hc ha
#align lt_mul_of_lt_of_one_le_of_nonneg lt_mul_of_lt_of_one_le_of_nonneg

/-- Assumes left covariance. -/
theorem Left.one_le_mul_of_le_of_le [PosMulMono α] (ha : 1 ≤ a) (hb : 1 ≤ b) (a0 : 0 ≤ a) :
    1 ≤ a * b :=
  le_mul_of_le_of_one_le_of_nonneg ha hb a0
#align left.one_le_mul_of_le_of_le Left.one_le_mul_of_le_of_le

/-- Assumes left covariance. -/
theorem Left.one_lt_mul_of_le_of_lt_of_pos [PosMulStrictMono α] (ha : 1 ≤ a) (hb : 1 < b)
    (a0 : 0 < a) : 1 < a * b :=
  lt_mul_of_le_of_one_lt_of_pos ha hb a0
#align left.one_lt_mul_of_le_of_lt_of_pos Left.one_lt_mul_of_le_of_lt_of_pos

/-- Assumes left covariance. -/
theorem Left.lt_mul_of_lt_of_one_le_of_nonneg [PosMulMono α] (ha : 1 < a) (hb : 1 ≤ b)
    (a0 : 0 ≤ a) : 1 < a * b :=
  _root_.lt_mul_of_lt_of_one_le_of_nonneg ha hb a0
#align left.lt_mul_of_lt_of_one_le_of_nonneg Left.lt_mul_of_lt_of_one_le_of_nonneg

theorem le_mul_of_le_of_one_le' [PosMulMono α] [MulPosMono α] (bc : b ≤ c) (ha : 1 ≤ a)
    (a0 : 0 ≤ a) (b0 : 0 ≤ b) : b ≤ c * a :=
  (le_mul_of_one_le_right b0 ha).trans <| mul_le_mul_of_nonneg_right bc a0
#align le_mul_of_le_of_one_le' le_mul_of_le_of_one_le'

theorem lt_mul_of_le_of_one_lt' [PosMulStrictMono α] [MulPosMono α] (bc : b ≤ c) (ha : 1 < a)
    (a0 : 0 ≤ a) (b0 : 0 < b) : b < c * a :=
  (lt_mul_of_one_lt_right b0 ha).trans_le <| mul_le_mul_of_nonneg_right bc a0
#align lt_mul_of_le_of_one_lt' lt_mul_of_le_of_one_lt'

theorem lt_mul_of_lt_of_one_le' [PosMulMono α] [MulPosStrictMono α] (bc : b < c) (ha : 1 ≤ a)
    (a0 : 0 < a) (b0 : 0 ≤ b) : b < c * a :=
  (le_mul_of_one_le_right b0 ha).trans_lt <| mul_lt_mul_of_pos_right bc a0
#align lt_mul_of_lt_of_one_le' lt_mul_of_lt_of_one_le'

theorem lt_mul_of_lt_of_one_lt_of_pos [PosMulStrictMono α] [MulPosStrictMono α] (bc : b < c)
    (ha : 1 < a) (a0 : 0 < a) (b0 : 0 < b) : b < c * a :=
  (lt_mul_of_one_lt_right b0 ha).trans <| mul_lt_mul_of_pos_right bc a0
#align lt_mul_of_lt_of_one_lt_of_pos lt_mul_of_lt_of_one_lt_of_pos

/-! Lemmas of the form `a ≤ 1 → b ≤ c → a * b ≤ c`. -/

theorem mul_le_of_le_one_of_le_of_nonneg [MulPosMono α] (ha : a ≤ 1) (h : b ≤ c) (hb : 0 ≤ b)
    : a * b ≤ c :=
  (mul_le_of_le_one_left hb ha).trans h
#align mul_le_of_le_one_of_le_of_nonneg mul_le_of_le_one_of_le_of_nonneg

theorem mul_lt_of_lt_one_of_le_of_pos [MulPosStrictMono α] (ha : a < 1) (h : b ≤ c) (hb : 0 < b) :
    a * b < c :=
  (mul_lt_of_lt_one_left hb ha).trans_le h
#align mul_lt_of_lt_one_of_le_of_pos mul_lt_of_lt_one_of_le_of_pos

theorem mul_lt_of_le_one_of_lt_of_nonneg [MulPosMono α] (ha : a ≤ 1) (h : b < c) (hb : 0 ≤ b) :
    a * b < c :=
  (mul_le_of_le_one_left hb ha).trans_lt h
#align mul_lt_of_le_one_of_lt_of_nonneg mul_lt_of_le_one_of_lt_of_nonneg

/-- Assumes right covariance. -/
theorem Right.mul_lt_one_of_lt_of_le_of_pos [MulPosStrictMono α] (ha : a < 1) (hb : b ≤ 1)
    (b0 : 0 < b) : a * b < 1 :=
  mul_lt_of_lt_one_of_le_of_pos ha hb b0
#align right.mul_lt_one_of_lt_of_le_of_pos Right.mul_lt_one_of_lt_of_le_of_pos

/-- Assumes right covariance. -/
theorem Right.mul_lt_one_of_le_of_lt_of_nonneg [MulPosMono α] (ha : a ≤ 1) (hb : b < 1)
    (b0 : 0 ≤ b) : a * b < 1 :=
  mul_lt_of_le_one_of_lt_of_nonneg ha hb b0
#align right.mul_lt_one_of_le_of_lt_of_nonneg Right.mul_lt_one_of_le_of_lt_of_nonneg

theorem mul_lt_of_lt_one_of_lt_of_pos [PosMulStrictMono α] [MulPosStrictMono α] (ha : a < 1)
    (bc : b < c) (a0 : 0 < a) (c0 : 0 < c) : a * b < c :=
  (mul_lt_mul_of_pos_left bc a0).trans <| mul_lt_of_lt_one_left c0 ha
#align mul_lt_of_lt_one_of_lt_of_pos mul_lt_of_lt_one_of_lt_of_pos

/-- Assumes right covariance. -/
theorem Right.mul_le_one_of_le_of_le [MulPosMono α] (ha : a ≤ 1) (hb : b ≤ 1) (b0 : 0 ≤ b) :
    a * b ≤ 1 :=
  mul_le_of_le_one_of_le_of_nonneg ha hb b0
#align right.mul_le_one_of_le_of_le Right.mul_le_one_of_le_of_le

theorem mul_le_of_le_one_of_le' [PosMulMono α] [MulPosMono α] (ha : a ≤ 1) (bc : b ≤ c) (a0 : 0 ≤ a)
    (c0 : 0 ≤ c) : a * b ≤ c :=
  (mul_le_mul_of_nonneg_left bc a0).trans <| mul_le_of_le_one_left c0 ha
#align mul_le_of_le_one_of_le' mul_le_of_le_one_of_le'

theorem mul_lt_of_lt_one_of_le' [PosMulMono α] [MulPosStrictMono α] (ha : a < 1) (bc : b ≤ c)
    (a0 : 0 ≤ a) (c0 : 0 < c) : a * b < c :=
  (mul_le_mul_of_nonneg_left bc a0).trans_lt <| mul_lt_of_lt_one_left c0 ha
#align mul_lt_of_lt_one_of_le' mul_lt_of_lt_one_of_le'

theorem mul_lt_of_le_one_of_lt' [PosMulStrictMono α] [MulPosMono α] (ha : a ≤ 1) (bc : b < c)
    (a0 : 0 < a) (c0 : 0 ≤ c) : a * b < c :=
  (mul_lt_mul_of_pos_left bc a0).trans_le <| mul_le_of_le_one_left c0 ha
#align mul_lt_of_le_one_of_lt' mul_lt_of_le_one_of_lt'

/-! Lemmas of the form `1 ≤ a → b ≤ c → b ≤ a * c`. -/

theorem lt_mul_of_one_lt_of_le_of_pos [MulPosStrictMono α] (ha : 1 < a) (h : b ≤ c) (hc : 0 < c) :
    b < a * c :=
  h.trans_lt <| lt_mul_of_one_lt_left hc ha
#align lt_mul_of_one_lt_of_le_of_pos lt_mul_of_one_lt_of_le_of_pos

theorem lt_mul_of_one_le_of_lt_of_nonneg [MulPosMono α] (ha : 1 ≤ a) (h : b < c) (hc : 0 ≤ c) :
    b < a * c :=
  h.trans_le <| le_mul_of_one_le_left hc ha
#align lt_mul_of_one_le_of_lt_of_nonneg lt_mul_of_one_le_of_lt_of_nonneg

theorem lt_mul_of_one_lt_of_lt_of_pos [MulPosStrictMono α] (ha : 1 < a) (h : b < c) (hc : 0 < c) :
    b < a * c :=
  h.trans <| lt_mul_of_one_lt_left hc ha
#align lt_mul_of_one_lt_of_lt_of_pos lt_mul_of_one_lt_of_lt_of_pos

/-- Assumes right covariance. -/
theorem Right.one_lt_mul_of_lt_of_le_of_pos [MulPosStrictMono α] (ha : 1 < a) (hb : 1 ≤ b)
    (b0 : 0 < b) : 1 < a * b :=
  lt_mul_of_one_lt_of_le_of_pos ha hb b0
#align right.one_lt_mul_of_lt_of_le_of_pos Right.one_lt_mul_of_lt_of_le_of_pos

/-- Assumes right covariance. -/
theorem Right.one_lt_mul_of_le_of_lt_of_nonneg [MulPosMono α] (ha : 1 ≤ a) (hb : 1 < b)
    (b0 : 0 ≤ b) : 1 < a * b :=
  lt_mul_of_one_le_of_lt_of_nonneg ha hb b0
#align right.one_lt_mul_of_le_of_lt_of_nonneg Right.one_lt_mul_of_le_of_lt_of_nonneg

/-- Assumes right covariance. -/
theorem Right.one_lt_mul_of_lt_of_lt [MulPosStrictMono α] (ha : 1 < a) (hb : 1 < b) (b0 : 0 < b) :
    1 < a * b :=
  lt_mul_of_one_lt_of_lt_of_pos ha hb b0
#align right.one_lt_mul_of_lt_of_lt Right.one_lt_mul_of_lt_of_lt

theorem lt_mul_of_one_lt_of_lt_of_nonneg [MulPosMono α] (ha : 1 ≤ a) (h : b < c) (hc : 0 ≤ c) :
    b < a * c :=
  h.trans_le <| le_mul_of_one_le_left hc ha
#align lt_mul_of_one_lt_of_lt_of_nonneg lt_mul_of_one_lt_of_lt_of_nonneg

theorem lt_of_mul_lt_of_one_le_of_nonneg_left [PosMulMono α] (h : a * b < c) (hle : 1 ≤ b)
    (ha : 0 ≤ a) : a < c :=
  (le_mul_of_one_le_right ha hle).trans_lt h
#align lt_of_mul_lt_of_one_le_of_nonneg_left lt_of_mul_lt_of_one_le_of_nonneg_left

theorem lt_of_lt_mul_of_le_one_of_nonneg_left [PosMulMono α] (h : a < b * c) (hc : c ≤ 1)
    (hb : 0 ≤ b) : a < b :=
  h.trans_le <| mul_le_of_le_one_right hb hc
#align lt_of_lt_mul_of_le_one_of_nonneg_left lt_of_lt_mul_of_le_one_of_nonneg_left

theorem lt_of_lt_mul_of_le_one_of_nonneg_right [MulPosMono α] (h : a < b * c) (hb : b ≤ 1)
    (hc : 0 ≤ c) : a < c :=
  h.trans_le <| mul_le_of_le_one_left hc hb
#align lt_of_lt_mul_of_le_one_of_nonneg_right lt_of_lt_mul_of_le_one_of_nonneg_right

theorem le_mul_of_one_le_of_le_of_nonneg [MulPosMono α] (ha : 1 ≤ a) (bc : b ≤ c) (c0 : 0 ≤ c)
    : b ≤ a * c :=
  bc.trans <| le_mul_of_one_le_left c0 ha
#align le_mul_of_one_le_of_le_of_nonneg le_mul_of_one_le_of_le_of_nonneg

/-- Assumes right covariance. -/
theorem Right.one_le_mul_of_le_of_le [MulPosMono α] (ha : 1 ≤ a) (hb : 1 ≤ b) (b0 : 0 ≤ b) :
    1 ≤ a * b :=
  le_mul_of_one_le_of_le_of_nonneg ha hb b0
#align right.one_le_mul_of_le_of_le Right.one_le_mul_of_le_of_le

theorem le_of_mul_le_of_one_le_of_nonneg_left [PosMulMono α] (h : a * b ≤ c) (hb : 1 ≤ b)
    (ha : 0 ≤ a) : a ≤ c :=
  (le_mul_of_one_le_right ha hb).trans h
#align le_of_mul_le_of_one_le_of_nonneg_left le_of_mul_le_of_one_le_of_nonneg_left

theorem le_of_le_mul_of_le_one_of_nonneg_left [PosMulMono α] (h : a ≤ b * c) (hc : c ≤ 1)
    (hb : 0 ≤ b) : a ≤ b :=
  h.trans <| mul_le_of_le_one_right hb hc
#align le_of_le_mul_of_le_one_of_nonneg_left le_of_le_mul_of_le_one_of_nonneg_left

theorem le_of_mul_le_of_one_le_nonneg_right [MulPosMono α] (h : a * b ≤ c) (ha : 1 ≤ a)
    (hb : 0 ≤ b) : b ≤ c :=
  (le_mul_of_one_le_left hb ha).trans h
#align le_of_mul_le_of_one_le_nonneg_right le_of_mul_le_of_one_le_nonneg_right

theorem le_of_le_mul_of_le_one_of_nonneg_right [MulPosMono α] (h : a ≤ b * c) (hb : b ≤ 1)
    (hc : 0 ≤ c) : a ≤ c :=
  h.trans <| mul_le_of_le_one_left hc hb
#align le_of_le_mul_of_le_one_of_nonneg_right le_of_le_mul_of_le_one_of_nonneg_right

end Preorder

section LinearOrder

variable [LinearOrder α]

-- Yaël: What's the point of this lemma? If we have `0 * 0 = 0`, then we can just take `b = 0`.
-- proven with `a0 : 0 ≤ a` as `exists_square_le`
theorem exists_square_le' [PosMulStrictMono α] (a0 : 0 < a) : ∃ b : α, b * b ≤ a := by
  obtain ha | ha := lt_or_le a 1
  · exact ⟨a, (mul_lt_of_lt_one_right a0 ha).le⟩
  · exact ⟨1, by rwa [mul_one]⟩
#align exists_square_le' exists_square_le'

end LinearOrder

end MulOneClass

section CancelMonoidWithZero

variable [CancelMonoidWithZero α]

section PartialOrder

variable [PartialOrder α]

theorem PosMulMono.toPosMulStrictMono [PosMulMono α] : PosMulStrictMono α :=
  ⟨fun x _ _ h => (mul_le_mul_of_nonneg_left h.le x.2.le).lt_of_ne
    (h.ne ∘ mul_left_cancel₀ x.2.ne')⟩
#align pos_mul_mono.to_pos_mul_strict_mono PosMulMono.toPosMulStrictMono

theorem posMulMono_iff_posMulStrictMono : PosMulMono α ↔ PosMulStrictMono α :=
  ⟨@PosMulMono.toPosMulStrictMono α _ _, @PosMulStrictMono.toPosMulMono α _ _⟩
#align pos_mul_mono_iff_pos_mul_strict_mono posMulMono_iff_posMulStrictMono

theorem MulPosMono.toMulPosStrictMono [MulPosMono α] : MulPosStrictMono α :=
  ⟨fun x _ _ h => (mul_le_mul_of_nonneg_right h.le x.2.le).lt_of_ne
    (h.ne ∘ mul_right_cancel₀ x.2.ne')⟩
#align mul_pos_mono.to_mul_pos_strict_mono MulPosMono.toMulPosStrictMono

theorem mulPosMono_iff_mulPosStrictMono : MulPosMono α ↔ MulPosStrictMono α :=
  ⟨@MulPosMono.toMulPosStrictMono α _ _, @MulPosStrictMono.toMulPosMono α _ _⟩
#align mul_pos_mono_iff_mul_pos_strict_mono mulPosMono_iff_mulPosStrictMono

theorem PosMulReflectLT.toPosMulMonoRev [PosMulReflectLT α] : PosMulMonoRev α :=
  ⟨fun x _ _ h =>
    h.eq_or_lt.elim (le_of_eq ∘ mul_left_cancel₀ x.2.ne.symm) fun h' =>
      (lt_of_mul_lt_mul_left h' x.2.le).le⟩
#align pos_mul_reflect_lt.to_pos_mul_mono_rev PosMulReflectLT.toPosMulMonoRev

theorem posMulMonoRev_iff_posMulReflectLT : PosMulMonoRev α ↔ PosMulReflectLT α :=
  ⟨@PosMulMonoRev.toPosMulReflectLT α _ _, @PosMulReflectLT.toPosMulMonoRev α _ _⟩
#align pos_mul_mono_rev_iff_pos_mul_reflect_lt posMulMonoRev_iff_posMulReflectLT

theorem MulPosReflectLT.toMulPosMonoRev [MulPosReflectLT α] : MulPosMonoRev α :=
  ⟨fun x _ _ h => h.eq_or_lt.elim (le_of_eq ∘ mul_right_cancel₀ x.2.ne.symm) fun h' =>
    (lt_of_mul_lt_mul_right h' x.2.le).le⟩
#align mul_pos_reflect_lt.to_mul_pos_mono_rev MulPosReflectLT.toMulPosMonoRev

theorem mulPosMonoRev_iff_mulPosReflectLT : MulPosMonoRev α ↔ MulPosReflectLT α :=
  ⟨@MulPosMonoRev.toMulPosReflectLT α _ _, @MulPosReflectLT.toMulPosMonoRev α _ _⟩
#align mul_pos_mono_rev_iff_mul_pos_reflect_lt mulPosMonoRev_iff_mulPosReflectLT

end PartialOrder

end CancelMonoidWithZero

section CommSemigroupHasZero

variable [CommSemigroup α] [Zero α] [Preorder α]

theorem posMulStrictMono_iff_mulPosStrictMono : PosMulStrictMono α ↔ MulPosStrictMono α := by
  simp only [PosMulStrictMono, MulPosStrictMono, mul_comm]
#align pos_mul_strict_mono_iff_mul_pos_strict_mono posMulStrictMono_iff_mulPosStrictMono

theorem posMulReflectLT_iff_mulPosReflectLT : PosMulReflectLT α ↔ MulPosReflectLT α := by
  simp only [PosMulReflectLT, MulPosReflectLT, mul_comm]
#align pos_mul_reflect_lt_iff_mul_pos_reflect_lt posMulReflectLT_iff_mulPosReflectLT

theorem posMulMono_iff_mulPosMono : PosMulMono α ↔ MulPosMono α := by
  simp only [PosMulMono, MulPosMono, mul_comm]
#align pos_mul_mono_iff_mul_pos_mono posMulMono_iff_mulPosMono

theorem posMulMonoRev_iff_mulPosMonoRev : PosMulMonoRev α ↔ MulPosMonoRev α := by
  simp only [PosMulMonoRev, MulPosMonoRev, mul_comm]
#align pos_mul_mono_rev_iff_mul_pos_mono_rev posMulMonoRev_iff_mulPosMonoRev

end CommSemigroupHasZero