/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Kenny Lau, Johan Commelin, Mario Carneiro, Kevin Buzzard,
Amelia Livingston, Yury Kudryashov

! This file was ported from Lean 3 source module group_theory.submonoid.membership
! leanprover-community/mathlib commit 2ec920d35348cb2d13ac0e1a2ad9df0fdf1a76b4
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.GroupTheory.Submonoid.Operations
import Mathlib.Algebra.BigOperators.Basic
import Mathlib.Algebra.FreeMonoid.Basic
import Mathlib.Data.Finset.NoncommProd

/-!
# Submonoids: membership criteria

In this file we prove various facts about membership in a submonoid:

* `list_prod_mem`, `multiset_prod_mem`, `prod_mem`: if each element of a collection belongs
  to a multiplicative submonoid, then so does their product;
* `list_sum_mem`, `multiset_sum_mem`, `sum_mem`: if each element of a collection belongs
  to an additive submonoid, then so does their sum;
* `pow_mem`, `nsmul_mem`: if `x ∈ S` where `S` is a multiplicative (resp., additive) submonoid and
  `n` is a natural number, then `x^n` (resp., `n • x`) belongs to `S`;
* `mem_supᵢ_of_directed`, `coe_supᵢ_of_directed`, `mem_supₛ_of_directedOn`,
  `coe_supₛ_of_directedOn`: the supremum of a directed collection of submonoid is their union.
* `sup_eq_range`, `mem_sup`: supremum of two submonoids `S`, `T` of a commutative monoid is the set
  of products;
* `closure_singleton_eq`, `mem_closure_singleton`, `mem_closure_pair`: the multiplicative (resp.,
  additive) closure of `{x}` consists of powers (resp., natural multiples) of `x`, and a similar
  result holds for the closure of `{x, y}`.

## Tags
submonoid, submonoids
-/

open BigOperators

variable {M A B : Type _}

section Assoc

variable [Monoid M] [SetLike B M] [SubmonoidClass B M] {S : B}

namespace SubmonoidClass

@[to_additive (attr := norm_cast, simp)]
theorem coe_list_prod (l : List S) : (l.prod : M) = (l.map (↑)).prod :=
  (SubmonoidClass.Subtype S : _ →* M).map_list_prod l
#align submonoid_class.coe_list_prod SubmonoidClass.coe_list_prod
#align add_submonoid_class.coe_list_sum AddSubmonoidClass.coe_list_sum

@[to_additive (attr := norm_cast, simp)]
theorem coe_multiset_prod {M} [CommMonoid M] [SetLike B M] [SubmonoidClass B M] (m : Multiset S) :
    (m.prod : M) = (m.map (↑)).prod :=
  (SubmonoidClass.Subtype S : _ →* M).map_multiset_prod m
#align submonoid_class.coe_multiset_prod SubmonoidClass.coe_multiset_prod
#align add_submonoid_class.coe_multiset_sum AddSubmonoidClass.coe_multiset_sum

@[to_additive (attr := norm_cast)] --Porting note: removed `simp`, `simp` can prove it
theorem coe_finset_prod {ι M} [CommMonoid M] [SetLike B M] [SubmonoidClass B M] (f : ι → S)
    (s : Finset ι) : ↑(∏ i in s, f i) = (∏ i in s, f i : M) :=
  (SubmonoidClass.Subtype S : _ →* M).map_prod f s
#align submonoid_class.coe_finset_prod SubmonoidClass.coe_finset_prod
#align add_submonoid_class.coe_finset_sum AddSubmonoidClass.coe_finset_sum

end SubmonoidClass

open SubmonoidClass

/-- Product of a list of elements in a submonoid is in the submonoid. -/
@[to_additive "Sum of a list of elements in an `AddSubmonoid` is in the `AddSubmonoid`."]
theorem list_prod_mem {l : List M} (hl : ∀ x ∈ l, x ∈ S) : l.prod ∈ S := by
  lift l to List S using hl
  rw [← coe_list_prod]
  exact l.prod.coe_prop
#align list_prod_mem list_prod_mem
#align list_sum_mem list_sum_mem

/-- Product of a multiset of elements in a submonoid of a `CommMonoid` is in the submonoid. -/
@[to_additive
      "Sum of a multiset of elements in an `AddSubmonoid` of an `AddCommMonoid` is
      in the `AddSubmonoid`."]
theorem multiset_prod_mem {M} [CommMonoid M] [SetLike B M] [SubmonoidClass B M] (m : Multiset M)
    (hm : ∀ a ∈ m, a ∈ S) : m.prod ∈ S := by
  lift m to Multiset S using hm
  rw [← coe_multiset_prod]
  exact m.prod.coe_prop
#align multiset_prod_mem multiset_prod_mem
#align multiset_sum_mem multiset_sum_mem

/-- Product of elements of a submonoid of a `CommMonoid` indexed by a `Finset` is in the
    submonoid. -/
@[to_additive
      "Sum of elements in an `AddSubmonoid` of an `AddCommMonoid` indexed by a `Finset`
      is in the `AddSubmonoid`."]
theorem prod_mem {M : Type _} [CommMonoid M] [SetLike B M] [SubmonoidClass B M] {ι : Type _}
    {t : Finset ι} {f : ι → M} (h : ∀ c ∈ t, f c ∈ S) : (∏ c in t, f c) ∈ S :=
  multiset_prod_mem (t.1.map f) fun _x hx =>
    let ⟨i, hi, hix⟩ := Multiset.mem_map.1 hx
    hix ▸ h i hi
#align prod_mem prod_mem
#align sum_mem sum_mem

namespace Submonoid

variable (s : Submonoid M)

@[to_additive (attr := norm_cast)] --Porting note: removed `simp`, `simp` can prove it
theorem coe_list_prod (l : List s) : (l.prod : M) = (l.map (↑)).prod :=
  s.subtype.map_list_prod l
#align submonoid.coe_list_prod Submonoid.coe_list_prod
#align add_submonoid.coe_list_sum AddSubmonoid.coe_list_sum

@[to_additive (attr := norm_cast)] --Porting note: removed `simp`, `simp` can prove it
theorem coe_multiset_prod {M} [CommMonoid M] (S : Submonoid M) (m : Multiset S) :
    (m.prod : M) = (m.map (↑)).prod :=
  S.subtype.map_multiset_prod m
#align submonoid.coe_multiset_prod Submonoid.coe_multiset_prod
#align add_submonoid.coe_multiset_sum AddSubmonoid.coe_multiset_sum

@[to_additive (attr := norm_cast, simp)]
theorem coe_finset_prod {ι M} [CommMonoid M] (S : Submonoid M) (f : ι → S) (s : Finset ι) :
    ↑(∏ i in s, f i) = (∏ i in s, f i : M) :=
  S.subtype.map_prod f s
#align submonoid.coe_finset_prod Submonoid.coe_finset_prod
#align add_submonoid.coe_finset_sum AddSubmonoid.coe_finset_sum

/-- Product of a list of elements in a submonoid is in the submonoid. -/
@[to_additive "Sum of a list of elements in an `AddSubmonoid` is in the `AddSubmonoid`."]
theorem list_prod_mem {l : List M} (hl : ∀ x ∈ l, x ∈ s) : l.prod ∈ s := by
  lift l to List s using hl
  rw [← coe_list_prod]
  exact l.prod.coe_prop
#align submonoid.list_prod_mem Submonoid.list_prod_mem
#align add_submonoid.list_sum_mem AddSubmonoid.list_sum_mem

/-- Product of a multiset of elements in a submonoid of a `CommMonoid` is in the submonoid. -/
@[to_additive
      "Sum of a multiset of elements in an `AddSubmonoid` of an `AddCommMonoid` is
      in the `AddSubmonoid`."]
theorem multiset_prod_mem {M} [CommMonoid M] (S : Submonoid M) (m : Multiset M)
    (hm : ∀ a ∈ m, a ∈ S) : m.prod ∈ S :=
  by
  lift m to Multiset S using hm
  rw [← coe_multiset_prod]
  exact m.prod.coe_prop
#align submonoid.multiset_prod_mem Submonoid.multiset_prod_mem
#align add_submonoid.multiset_sum_mem AddSubmonoid.multiset_sum_mem

@[to_additive]
theorem multiset_noncommProd_mem (S : Submonoid M) (m : Multiset M) (comm) (h : ∀ x ∈ m, x ∈ S) :
    m.noncommProd comm ∈ S :=
  by
  induction' m using Quotient.inductionOn with l
  simp only [Multiset.quot_mk_to_coe, Multiset.noncommProd_coe]
  exact Submonoid.list_prod_mem _ h
#align submonoid.multiset_noncomm_prod_mem Submonoid.multiset_noncommProd_mem
#align add_submonoid.multiset_noncomm_sum_mem AddSubmonoid.multiset_noncommSum_mem

/-- Product of elements of a submonoid of a `CommMonoid` indexed by a `Finset` is in the
    submonoid. -/
@[to_additive
      "Sum of elements in an `AddSubmonoid` of an `AddCommMonoid` indexed by a `Finset`
      is in the `AddSubmonoid`."]
theorem prod_mem {M : Type _} [CommMonoid M] (S : Submonoid M) {ι : Type _} {t : Finset ι}
    {f : ι → M} (h : ∀ c ∈ t, f c ∈ S) : (∏ c in t, f c) ∈ S :=
  S.multiset_prod_mem (t.1.map f) fun _ hx =>
    let ⟨i, hi, hix⟩ := Multiset.mem_map.1 hx
    hix ▸ h i hi
#align submonoid.prod_mem Submonoid.prod_mem
#align add_submonoid.sum_mem AddSubmonoid.sum_mem

@[to_additive]
theorem noncommProd_mem (S : Submonoid M) {ι : Type _} (t : Finset ι) (f : ι → M) (comm)
    (h : ∀ c ∈ t, f c ∈ S) : t.noncommProd f comm ∈ S := by
  apply multiset_noncommProd_mem
  intro y
  rw [Multiset.mem_map]
  rintro ⟨x, ⟨hx, rfl⟩⟩
  exact h x hx
#align submonoid.noncomm_prod_mem Submonoid.noncommProd_mem
#align add_submonoid.noncomm_sum_mem AddSubmonoid.noncommSum_mem

end Submonoid

end Assoc

section NonAssoc

variable [MulOneClass M]

open Set

namespace Submonoid

-- TODO: this section can be generalized to `[SubmonoidClass B M] [CompleteLattice B]`
-- such that `CompleteLattice.LE` coincides with `SetLike.LE`
@[to_additive]
theorem mem_supᵢ_of_directed {ι} [hι : Nonempty ι] {S : ι → Submonoid M} (hS : Directed (· ≤ ·) S)
    {x : M} : (x ∈ ⨆ i, S i) ↔ ∃ i, x ∈ S i := by
  refine' ⟨_, fun ⟨i, hi⟩ => (SetLike.le_def.1 <| le_supᵢ S i) hi⟩
  suffices x ∈ closure (⋃ i, (S i : Set M)) → ∃ i, x ∈ S i by
    simpa only [closure_unionᵢ, closure_eq (S _)] using this
  refine' fun hx => closure_induction hx (fun _ => mem_unionᵢ.1) _ _
  · exact hι.elim fun i => ⟨i, (S i).one_mem⟩
  · rintro x y ⟨i, hi⟩ ⟨j, hj⟩
    rcases hS i j with ⟨k, hki, hkj⟩
    exact ⟨k, (S k).mul_mem (hki hi) (hkj hj)⟩
#align submonoid.mem_supr_of_directed Submonoid.mem_supᵢ_of_directed
#align add_submonoid.mem_supr_of_directed AddSubmonoid.mem_supᵢ_of_directed

@[to_additive]
theorem coe_supᵢ_of_directed {ι} [Nonempty ι] {S : ι → Submonoid M} (hS : Directed (· ≤ ·) S) :
    ((⨆ i, S i : Submonoid M) : Set M) = ⋃ i, ↑(S i) :=
  Set.ext fun x => by simp [mem_supᵢ_of_directed hS]
#align submonoid.coe_supr_of_directed Submonoid.coe_supᵢ_of_directed
#align add_submonoid.coe_supr_of_directed AddSubmonoid.coe_supᵢ_of_directed

@[to_additive]
theorem mem_supₛ_of_directedOn {S : Set (Submonoid M)} (Sne : S.Nonempty)
    (hS : DirectedOn (· ≤ ·) S) {x : M} : x ∈ supₛ S ↔ ∃ s ∈ S, x ∈ s := by
  haveI : Nonempty S := Sne.to_subtype
  simp [supₛ_eq_supᵢ', mem_supᵢ_of_directed hS.directed_val, SetCoe.exists, Subtype.coe_mk]
#align submonoid.mem_Sup_of_directed_on Submonoid.mem_supₛ_of_directedOn
#align add_submonoid.mem_Sup_of_directed_on AddSubmonoid.mem_supₛ_of_directedOn

@[to_additive]
theorem coe_supₛ_of_directedOn {S : Set (Submonoid M)} (Sne : S.Nonempty)
    (hS : DirectedOn (· ≤ ·) S) : (↑(supₛ S) : Set M) = ⋃ s ∈ S, ↑s :=
  Set.ext fun x => by simp [mem_supₛ_of_directedOn Sne hS]
#align submonoid.coe_Sup_of_directed_on Submonoid.coe_supₛ_of_directedOn
#align add_submonoid.coe_Sup_of_directed_on AddSubmonoid.coe_supₛ_of_directedOn

@[to_additive]
theorem mem_sup_left {S T : Submonoid M} : ∀ {x : M}, x ∈ S → x ∈ S ⊔ T := by
  rw [←SetLike.le_def]
  exact le_sup_left
#align submonoid.mem_sup_left Submonoid.mem_sup_left
#align add_submonoid.mem_sup_left AddSubmonoid.mem_sup_left

@[to_additive]
theorem mem_sup_right {S T : Submonoid M} : ∀ {x : M}, x ∈ T → x ∈ S ⊔ T := by
  rw [←SetLike.le_def]
  exact le_sup_right
#align submonoid.mem_sup_right Submonoid.mem_sup_right
#align add_submonoid.mem_sup_right AddSubmonoid.mem_sup_right

@[to_additive]
theorem mul_mem_sup {S T : Submonoid M} {x y : M} (hx : x ∈ S) (hy : y ∈ T) : x * y ∈ S ⊔ T :=
  (S ⊔ T).mul_mem (mem_sup_left hx) (mem_sup_right hy)
#align submonoid.mul_mem_sup Submonoid.mul_mem_sup
#align add_submonoid.add_mem_sup AddSubmonoid.add_mem_sup

@[to_additive]
theorem mem_supᵢ_of_mem {ι : Sort _} {S : ι → Submonoid M} (i : ι) :
    ∀ {x : M}, x ∈ S i → x ∈ supᵢ S := by
  rw [←SetLike.le_def]
  exact le_supᵢ _ _
#align submonoid.mem_supr_of_mem Submonoid.mem_supᵢ_of_mem
#align add_submonoid.mem_supr_of_mem AddSubmonoid.mem_supᵢ_of_mem

@[to_additive]
theorem mem_supₛ_of_mem {S : Set (Submonoid M)} {s : Submonoid M} (hs : s ∈ S) :
    ∀ {x : M}, x ∈ s → x ∈ supₛ S := by
  rw [←SetLike.le_def]
  exact le_supₛ hs
#align submonoid.mem_Sup_of_mem Submonoid.mem_supₛ_of_mem
#align add_submonoid.mem_Sup_of_mem AddSubmonoid.mem_supₛ_of_mem

/-- An induction principle for elements of `⨆ i, S i`.
If `C` holds for `1` and all elements of `S i` for all `i`, and is preserved under multiplication,
then it holds for all elements of the supremum of `S`. -/
@[to_additive (attr := elab_as_elim)
      " An induction principle for elements of `⨆ i, S i`.
      If `C` holds for `0` and all elements of `S i` for all `i`, and is preserved under addition,
      then it holds for all elements of the supremum of `S`. "]
theorem supᵢ_induction {ι : Sort _} (S : ι → Submonoid M) {C : M → Prop} {x : M} (hx : x ∈ ⨆ i, S i)
    (hp : ∀ (i), ∀ x ∈ S i, C x) (h1 : C 1) (hmul : ∀ x y, C x → C y → C (x * y)) : C x := by
  rw [supᵢ_eq_closure] at hx
  refine closure_induction hx (fun x hx => ?_) h1 hmul
  obtain ⟨i, hi⟩ := Set.mem_unionᵢ.mp hx
  exact hp _ _ hi
#align submonoid.supr_induction Submonoid.supᵢ_induction
#align add_submonoid.supr_induction AddSubmonoid.supᵢ_induction

/-- A dependent version of `Submonoid.supᵢ_induction`. -/
@[to_additive (attr := elab_as_elim) "A dependent version of `AddSubmonoid.supᵢ_induction`. "]
theorem supᵢ_induction' {ι : Sort _} (S : ι → Submonoid M) {C : ∀ x, (x ∈ ⨆ i, S i) → Prop}
    (hp : ∀ (i), ∀ (x) (hxS : x ∈ S i), C x (mem_supᵢ_of_mem i hxS)) (h1 : C 1 (one_mem _))
    (hmul : ∀ x y hx hy, C x hx → C y hy → C (x * y) (mul_mem ‹_› ‹_›)) {x : M}
    (hx : x ∈ ⨆ i, S i) : C x hx := by
  refine' Exists.elim (_ : ∃ Hx, C x Hx) fun (hx : x ∈ ⨆ i, S i) (hc : C x hx) => hc
  refine' @supᵢ_induction _ _ ι S (fun m => ∃ hm, C m hm) _ hx (fun i x hx => _) _ fun x y => _
  · exact ⟨_, hp _ _ hx⟩
  · exact ⟨_, h1⟩
  · rintro ⟨_, Cx⟩ ⟨_, Cy⟩
    refine' ⟨_, hmul _ _ _ _ Cx Cy⟩
#align submonoid.supr_induction' Submonoid.supᵢ_induction'
#align add_submonoid.supr_induction' AddSubmonoid.supᵢ_induction'

end Submonoid

end NonAssoc

namespace FreeMonoid

variable {α : Type _}

open Submonoid

@[to_additive]
theorem closure_range_of : closure (Set.range <| @of α) = ⊤ :=
  eq_top_iff.2 fun x _ =>
    FreeMonoid.recOn x (one_mem _) fun _x _xs hxs =>
      mul_mem (subset_closure <| Set.mem_range_self _) hxs
#align free_monoid.closure_range_of FreeMonoid.closure_range_of
#align free_add_monoid.closure_range_of FreeAddMonoid.closure_range_of

end FreeMonoid

namespace Submonoid

variable [Monoid M]

open MonoidHom

theorem closure_singleton_eq (x : M) : closure ({x} : Set M) = mrange (powersHom M x) :=
  closure_eq_of_le (Set.singleton_subset_iff.2 ⟨Multiplicative.ofAdd 1, pow_one x⟩) fun _ ⟨_, hn⟩ =>
    hn ▸ pow_mem (subset_closure <| Set.mem_singleton _) _
#align submonoid.closure_singleton_eq Submonoid.closure_singleton_eq

/-- The submonoid generated by an element of a monoid equals the set of natural number powers of
    the element. -/
theorem mem_closure_singleton {x y : M} : y ∈ closure ({x} : Set M) ↔ ∃ n : ℕ, x ^ n = y := by
  rw [closure_singleton_eq, mem_mrange]; rfl
#align submonoid.mem_closure_singleton Submonoid.mem_closure_singleton

theorem mem_closure_singleton_self {y : M} : y ∈ closure ({y} : Set M) :=
  mem_closure_singleton.2 ⟨1, pow_one y⟩
#align submonoid.mem_closure_singleton_self Submonoid.mem_closure_singleton_self

theorem closure_singleton_one : closure ({1} : Set M) = ⊥ := by
  simp [eq_bot_iff_forall, mem_closure_singleton]
#align submonoid.closure_singleton_one Submonoid.closure_singleton_one

@[to_additive]
theorem _root_.FreeMonoid.mrange_lift {α} (f : α → M) :
    mrange (FreeMonoid.lift f) = closure (Set.range f) := by
  rw [mrange_eq_map, ← FreeMonoid.closure_range_of, map_mclosure, ← Set.range_comp,
    FreeMonoid.lift_comp_of]
#align free_monoid.mrange_lift FreeMonoid.mrange_lift
#align free_add_monoid.mrange_lift FreeAddMonoid.mrange_lift

@[to_additive]
theorem closure_eq_mrange (s : Set M) : closure s = mrange (FreeMonoid.lift ((↑) : s → M)) := by
  rw [FreeMonoid.mrange_lift, Subtype.range_coe]
#align submonoid.closure_eq_mrange Submonoid.closure_eq_mrange
#align add_submonoid.closure_eq_mrange AddSubmonoid.closure_eq_mrange

@[to_additive]
theorem closure_eq_image_prod (s : Set M) :
    (closure s : Set M) = List.prod '' { l : List M | ∀ x ∈ l, x ∈ s } := by
  rw [closure_eq_mrange, coe_mrange, ← Set.range_list_map_coe, ← Set.range_comp]
  exact congrArg _ (funext <| FreeMonoid.lift_apply _)
#align submonoid.closure_eq_image_prod Submonoid.closure_eq_image_prod
#align add_submonoid.closure_eq_image_sum AddSubmonoid.closure_eq_image_sum

@[to_additive]
theorem exists_list_of_mem_closure {s : Set M} {x : M} (hx : x ∈ closure s) :
    ∃ (l : List M) (_ : ∀ y ∈ l, y ∈ s), l.prod = x := by
  rwa [← SetLike.mem_coe, closure_eq_image_prod, Set.mem_image_iff_bex] at hx
#align submonoid.exists_list_of_mem_closure Submonoid.exists_list_of_mem_closure
#align add_submonoid.exists_list_of_mem_closure AddSubmonoid.exists_list_of_mem_closure

@[to_additive]
theorem exists_multiset_of_mem_closure {M : Type _} [CommMonoid M] {s : Set M} {x : M}
    (hx : x ∈ closure s) : ∃ (l : Multiset M) (_ : ∀ y ∈ l, y ∈ s), l.prod = x :=
  by
  obtain ⟨l, h1, h2⟩ := exists_list_of_mem_closure hx
  exact ⟨l, h1, (Multiset.coe_prod l).trans h2⟩
#align submonoid.exists_multiset_of_mem_closure Submonoid.exists_multiset_of_mem_closure
#align add_submonoid.exists_multiset_of_mem_closure AddSubmonoid.exists_multiset_of_mem_closure

@[to_additive]
theorem closure_induction_left {s : Set M} {p : M → Prop} {x : M} (h : x ∈ closure s) (H1 : p 1)
    (Hmul : ∀ x ∈ s, ∀ (y), p y → p (x * y)) : p x :=
  by
  rw [closure_eq_mrange] at h
  obtain ⟨l, rfl⟩ := h
  induction' l using FreeMonoid.recOn with x y ih
  · exact H1
  · simpa only [map_mul, FreeMonoid.lift_eval_of] using Hmul _ x.prop _ ih
#align submonoid.closure_induction_left Submonoid.closure_induction_left
#align add_submonoid.closure_induction_left AddSubmonoid.closure_induction_left

@[to_additive (attr := elab_as_elim)]
theorem induction_of_closure_eq_top_left {s : Set M} {p : M → Prop} (hs : closure s = ⊤) (x : M)
    (H1 : p 1) (Hmul : ∀ x ∈ s, ∀ (y), p y → p (x * y)) : p x :=
  closure_induction_left
    (by
      rw [hs]
      exact mem_top _)
    H1 Hmul
#align submonoid.induction_of_closure_eq_top_left Submonoid.induction_of_closure_eq_top_left
#align add_submonoid.induction_of_closure_eq_top_left AddSubmonoid.induction_of_closure_eq_top_left

@[to_additive]
theorem closure_induction_right {s : Set M} {p : M → Prop} {x : M} (h : x ∈ closure s) (H1 : p 1)
    (Hmul : ∀ (x), ∀ y ∈ s, p x → p (x * y)) : p x :=
  @closure_induction_left _ _ (MulOpposite.unop ⁻¹' s) (p ∘ MulOpposite.unop) (MulOpposite.op x)
    (closure_induction h (fun _x hx => subset_closure hx) (one_mem _)
      fun _x _y hx hy => mul_mem hy hx)
    H1 fun _x hx _y => Hmul _ _ hx
#align submonoid.closure_induction_right Submonoid.closure_induction_right
#align add_submonoid.closure_induction_right AddSubmonoid.closure_induction_right

@[to_additive (attr := elab_as_elim)]
theorem induction_of_closure_eq_top_right {s : Set M} {p : M → Prop} (hs : closure s = ⊤) (x : M)
    (H1 : p 1) (Hmul : ∀ (x), ∀ y ∈ s, p x → p (x * y)) : p x :=
  closure_induction_right
    (by rw [hs]; exact mem_top _)
    H1 Hmul
#align submonoid.induction_of_closure_eq_top_right Submonoid.induction_of_closure_eq_top_right
#align add_submonoid.induction_of_closure_eq_top_right
  AddSubmonoid.induction_of_closure_eq_top_right

/-- The submonoid generated by an element. -/
def powers (n : M) : Submonoid M :=
  Submonoid.copy (mrange (powersHom M n)) (Set.range ((· ^ ·) n : ℕ → M)) <|
    Set.ext fun n => exists_congr fun i => by simp; rfl
#align submonoid.powers Submonoid.powers

theorem mem_powers (n : M) : n ∈ powers n :=
  ⟨1, pow_one _⟩
#align submonoid.mem_powers Submonoid.mem_powers

theorem mem_powers_iff (x z : M) : x ∈ powers z ↔ ∃ n : ℕ, z ^ n = x :=
  Iff.rfl
#align submonoid.mem_powers_iff Submonoid.mem_powers_iff

theorem powers_eq_closure (n : M) : powers n = closure {n} :=
  by
  ext
  exact mem_closure_singleton.symm
#align submonoid.powers_eq_closure Submonoid.powers_eq_closure

theorem powers_subset {n : M} {P : Submonoid M} (h : n ∈ P) : powers n ≤ P := fun x hx =>
  match x, hx with
  | _, ⟨i, rfl⟩ => pow_mem h i
#align submonoid.powers_subset Submonoid.powers_subset

theorem powers_one : powers (1 : M) = ⊥ :=
  bot_unique <| powers_subset (one_mem _)
#align submonoid.powers_one Submonoid.powers_one

/-- Exponentiation map from natural numbers to powers. -/
@[simps!]
def pow (n : M) (m : ℕ) : powers n :=
  (powersHom M n).mrangeRestrict (Multiplicative.ofAdd m)
#align submonoid.pow Submonoid.pow
#align submonoid.pow_coe Submonoid.pow_coe

theorem pow_apply (n : M) (m : ℕ) : Submonoid.pow n m = ⟨n ^ m, m, rfl⟩ :=
  rfl
#align submonoid.pow_apply Submonoid.pow_apply

/-- Logarithms from powers to natural numbers. -/
def log [DecidableEq M] {n : M} (p : powers n) : ℕ :=
  Nat.find <| (mem_powers_iff p.val n).mp p.prop
#align submonoid.log Submonoid.log

@[simp]
theorem pow_log_eq_self [DecidableEq M] {n : M} (p : powers n) : pow n (log p) = p :=
  Subtype.ext <| Nat.find_spec p.prop
#align submonoid.pow_log_eq_self Submonoid.pow_log_eq_self

theorem pow_right_injective_iff_pow_injective {n : M} :
    (Function.Injective fun m : ℕ => n ^ m) ↔ Function.Injective (pow n) :=
  Subtype.coe_injective.of_comp_iff (pow n)
#align submonoid.pow_right_injective_iff_pow_injective
  Submonoid.pow_right_injective_iff_pow_injective

@[simp]
theorem log_pow_eq_self [DecidableEq M] {n : M} (h : Function.Injective fun m : ℕ => n ^ m)
    (m : ℕ) : log (pow n m) = m :=
  pow_right_injective_iff_pow_injective.mp h <| pow_log_eq_self _
#align submonoid.log_pow_eq_self Submonoid.log_pow_eq_self

/-- The exponentiation map is an isomorphism from the additive monoid on natural numbers to powers
when it is injective. The inverse is given by the logarithms. -/
@[simps]
def powLogEquiv [DecidableEq M] {n : M} (h : Function.Injective fun m : ℕ => n ^ m) :
    Multiplicative ℕ ≃* powers n where
  toFun m := pow n (Multiplicative.toAdd m)
  invFun m := Multiplicative.ofAdd (log m)
  left_inv := log_pow_eq_self h
  right_inv := pow_log_eq_self
  map_mul' _ _ := by simp only [pow, map_mul, ofAdd_add, toAdd_mul]
#align submonoid.pow_log_equiv Submonoid.powLogEquiv
#align submonoid.pow_log_equiv_symm_apply Submonoid.powLogEquiv_symm_apply
#align submonoid.pow_log_equiv_apply Submonoid.powLogEquiv_apply

theorem log_mul [DecidableEq M] {n : M} (h : Function.Injective fun m : ℕ => n ^ m)
    (x y : powers (n : M)) : log (x * y) = log x + log y :=
  (powLogEquiv h).symm.map_mul x y
#align submonoid.log_mul Submonoid.log_mul

theorem log_pow_int_eq_self {x : ℤ} (h : 1 < x.natAbs) (m : ℕ) : log (pow x m) = m :=
  (powLogEquiv (Int.pow_right_injective h)).symm_apply_apply _
#align submonoid.log_pow_int_eq_self Submonoid.log_pow_int_eq_self

@[simp]
theorem map_powers {N : Type _} {F : Type _} [Monoid N] [MonoidHomClass F M N] (f : F) (m : M) :
    (powers m).map f = powers (f m) := by
  simp only [powers_eq_closure, map_mclosure f, Set.image_singleton]
#align submonoid.map_powers Submonoid.map_powers

/-- If all the elements of a set `s` commute, then `closure s` is a commutative monoid. -/
@[to_additive
      "If all the elements of a set `s` commute, then `closure s` forms an additive
      commutative monoid."]
def closureCommMonoidOfComm {s : Set M} (hcomm : ∀ (a) (_ : a ∈ s) (b) (_ : b ∈ s), a * b = b * a) :
    CommMonoid (closure s) :=
  { (closure s).toMonoid with
    mul_comm := fun x y => by
      ext
      simp only [Submonoid.coe_mul]
      exact
        closure_induction₂ x.prop y.prop hcomm Commute.one_left Commute.one_right
          (fun x y z => Commute.mul_left) fun x y z => Commute.mul_right }
#align submonoid.closure_comm_monoid_of_comm Submonoid.closureCommMonoidOfComm
#align add_submonoid.closure_add_comm_monoid_of_comm AddSubmonoid.closureAddCommMonoidOfComm

end Submonoid

@[to_additive]
theorem IsScalarTower.of_mclosure_eq_top {N α} [Monoid M] [MulAction M N] [SMul N α] [MulAction M α]
    {s : Set M} (htop : Submonoid.closure s = ⊤)
    (hs : ∀ x ∈ s, ∀ (y : N) (z : α), (x • y) • z = x • y • z) : IsScalarTower M N α :=
  by
  refine' ⟨fun x => Submonoid.induction_of_closure_eq_top_left htop x _ _⟩
  · intro y z
    rw [one_smul, one_smul]
  · clear x
    intro x hx x' hx' y z
    rw [mul_smul, mul_smul, hs x hx, hx']
#align is_scalar_tower.of_mclosure_eq_top IsScalarTower.of_mclosure_eq_top
#align vadd_assoc_class.of_mclosure_eq_top VAddAssocClass.of_mclosure_eq_top

@[to_additive]
theorem SMulCommClass.of_mclosure_eq_top {N α} [Monoid M] [SMul N α] [MulAction M α] {s : Set M}
    (htop : Submonoid.closure s = ⊤) (hs : ∀ x ∈ s, ∀ (y : N) (z : α), x • y • z = y • x • z) :
    SMulCommClass M N α :=
  by
  refine' ⟨fun x => Submonoid.induction_of_closure_eq_top_left htop x _ _⟩
  · intro y z
    rw [one_smul, one_smul]
  · clear x
    intro x hx x' hx' y z
    rw [mul_smul, mul_smul, hx', hs x hx]
#align smul_comm_class.of_mclosure_eq_top SMulCommClass.of_mclosure_eq_top
#align vadd_comm_class.of_mclosure_eq_top VAddCommClass.of_mclosure_eq_top

namespace Submonoid

variable {N : Type _} [CommMonoid N]

open MonoidHom

@[to_additive]
theorem sup_eq_range (s t : Submonoid N) : s ⊔ t = mrange (s.subtype.coprod t.subtype) := by
  rw [mrange_eq_map, ← mrange_inl_sup_mrange_inr, map_sup, map_mrange, coprod_comp_inl, map_mrange,
    coprod_comp_inr, range_subtype, range_subtype]
#align submonoid.sup_eq_range Submonoid.sup_eq_range
#align add_submonoid.sup_eq_range AddSubmonoid.sup_eq_range

@[to_additive]
theorem mem_sup {s t : Submonoid N} {x : N} : x ∈ s ⊔ t ↔ ∃ y ∈ s, ∃ z ∈ t, y * z = x := by
  simp only [ge_iff_le, sup_eq_range, mem_mrange, coprod_apply, coe_subtype, Prod.exists,
    Subtype.exists, exists_prop]
#align submonoid.mem_sup Submonoid.mem_sup
#align add_submonoid.mem_sup AddSubmonoid.mem_sup

end Submonoid

namespace AddSubmonoid

variable [AddMonoid A]

open Set

theorem closure_singleton_eq (x : A) :
    closure ({x} : Set A) = AddMonoidHom.mrange (multiplesHom A x) :=
  closure_eq_of_le (Set.singleton_subset_iff.2 ⟨1, one_nsmul x⟩) fun _ ⟨_n, hn⟩ =>
    hn ▸ nsmul_mem (subset_closure <| Set.mem_singleton _) _
#align add_submonoid.closure_singleton_eq AddSubmonoid.closure_singleton_eq

/-- The `AddSubmonoid` generated by an element of an `AddMonoid` equals the set of
natural number multiples of the element. -/
theorem mem_closure_singleton {x y : A} : y ∈ closure ({x} : Set A) ↔ ∃ n : ℕ, n • x = y := by
  rw [closure_singleton_eq, AddMonoidHom.mem_mrange]; rfl
#align add_submonoid.mem_closure_singleton AddSubmonoid.mem_closure_singleton

theorem closure_singleton_zero : closure ({0} : Set A) = ⊥ := by
  simp [eq_bot_iff_forall, mem_closure_singleton, nsmul_zero]
#align add_submonoid.closure_singleton_zero AddSubmonoid.closure_singleton_zero

/-- The additive submonoid generated by an element. -/
def multiples (x : A) : AddSubmonoid A :=
  AddSubmonoid.copy (AddMonoidHom.mrange (multiplesHom A x)) (Set.range (fun i => i • x : ℕ → A)) <|
    Set.ext fun n => exists_congr fun i => by simp
#align add_submonoid.multiples AddSubmonoid.multiples

attribute [to_additive existing multiples] Submonoid.powers

attribute [to_additive (attr := simp) mem_multiples] Submonoid.mem_powers
#align add_submonoid.mem_multiples AddSubmonoid.mem_multiples

attribute [to_additive mem_multiples_iff] Submonoid.mem_powers_iff
#align add_submonoid.mem_multiples_iff AddSubmonoid.mem_multiples_iff

attribute [to_additive multiples_eq_closure] Submonoid.powers_eq_closure
#align add_submonoid.multiples_eq_closure AddSubmonoid.multiples_eq_closure

attribute [to_additive multiples_subset] Submonoid.powers_subset
#align add_submonoid.multiples_subset AddSubmonoid.multiples_subset

attribute [to_additive (attr := simp) multiples_zero] Submonoid.powers_one
#align add_submonoid.multiples_zero AddSubmonoid.multiples_zero

end AddSubmonoid

/-! Lemmas about additive closures of `Subsemigroup`. -/

namespace MulMemClass

variable {R : Type _} [NonUnitalNonAssocSemiring R] [SetLike M R] [MulMemClass M R] {S : M}
  {a b : R}

/-- The product of an element of the additive closure of a multiplicative subsemigroup `M`
and an element of `M` is contained in the additive closure of `M`. -/
theorem mul_right_mem_add_closure (ha : a ∈ AddSubmonoid.closure (S : Set R)) (hb : b ∈ S) :
    a * b ∈ AddSubmonoid.closure (S : Set R) := by
  revert b
  refine' @AddSubmonoid.closure_induction _ _ _
    (fun z => ∀ (b : R), b ∈ S → z * b ∈ AddSubmonoid.closure S) _ ha _ _ _ <;> clear ha a
  · exact fun r hr b hb => AddSubmonoid.mem_closure.mpr fun y hy => hy (mul_mem hr hb)
  · exact fun b _ => by simp only [zero_mul, (AddSubmonoid.closure (S : Set R)).zero_mem]
  · simp_rw [add_mul]
    exact fun r s hr hs b hb => (AddSubmonoid.closure (S : Set R)).add_mem (hr _ hb) (hs _ hb)
#align mul_mem_class.mul_right_mem_add_closure MulMemClass.mul_right_mem_add_closure

/-- The product of two elements of the additive closure of a submonoid `M` is an element of the
additive closure of `M`. -/
theorem mul_mem_add_closure (ha : a ∈ AddSubmonoid.closure (S : Set R))
    (hb : b ∈ AddSubmonoid.closure (S : Set R)) : a * b ∈ AddSubmonoid.closure (S : Set R) := by
  revert a
  refine' @AddSubmonoid.closure_induction _ _ _
    (fun z =>  ∀ {a : R}, a ∈ AddSubmonoid.closure ↑S → a * z ∈ AddSubmonoid.closure ↑S)
      _ hb _ _ _ <;> clear hb b
  · exact fun r hr b hb => MulMemClass.mul_right_mem_add_closure hb hr
  · exact fun _ => by simp only [mul_zero, (AddSubmonoid.closure (S : Set R)).zero_mem]
  · simp_rw [mul_add]
    exact fun r s hr hs b hb => (AddSubmonoid.closure (S : Set R)).add_mem (hr hb) (hs hb)
#align mul_mem_class.mul_mem_add_closure MulMemClass.mul_mem_add_closure

/-- The product of an element of `S` and an element of the additive closure of a multiplicative
submonoid `S` is contained in the additive closure of `S`. -/
theorem mul_left_mem_add_closure (ha : a ∈ S) (hb : b ∈ AddSubmonoid.closure (S : Set R)) :
    a * b ∈ AddSubmonoid.closure (S : Set R) :=
  mul_mem_add_closure (AddSubmonoid.mem_closure.mpr fun _sT hT => hT ha) hb
#align mul_mem_class.mul_left_mem_add_closure MulMemClass.mul_left_mem_add_closure

end MulMemClass

namespace Submonoid

/-- An element is in the closure of a two-element set if it is a linear combination of those two
elements. -/
@[to_additive
      "An element is in the closure of a two-element set if it is a linear combination of
      those two elements."]
theorem mem_closure_pair {A : Type _} [CommMonoid A] (a b c : A) :
    c ∈ Submonoid.closure ({a, b} : Set A) ↔ ∃ m n : ℕ, a ^ m * b ^ n = c :=
  by
  rw [← Set.singleton_union, Submonoid.closure_union, mem_sup]
  simp_rw [exists_prop, mem_closure_singleton, exists_exists_eq_and]
#align submonoid.mem_closure_pair Submonoid.mem_closure_pair
#align add_submonoid.mem_closure_pair AddSubmonoid.mem_closure_pair

end Submonoid

section mul_add

theorem ofMul_image_powers_eq_multiples_ofMul [Monoid M] {x : M} :
    Additive.ofMul '' (Submonoid.powers x : Set M) = AddSubmonoid.multiples (Additive.ofMul x) := by
  ext
  constructor
  · rintro ⟨y, ⟨n, hy1⟩, hy2⟩
    use n
    simpa [← ofMul_pow, hy1]
  · rintro ⟨n, hn⟩
    refine' ⟨x ^ n, ⟨n, rfl⟩, _⟩
    rwa [ofMul_pow]
#align of_mul_image_powers_eq_multiples_of_mul ofMul_image_powers_eq_multiples_ofMul

theorem ofAdd_image_multiples_eq_powers_ofAdd [AddMonoid A] {x : A} :
    Multiplicative.ofAdd '' (AddSubmonoid.multiples x : Set A) =
      Submonoid.powers (Multiplicative.ofAdd x) := by
  symm
  rw [Equiv.eq_image_iff_symm_image_eq]
  exact ofMul_image_powers_eq_multiples_ofMul
#align of_add_image_multiples_eq_powers_of_add ofAdd_image_multiples_eq_powers_ofAdd

end mul_add


import «08_lib»

section
/-
Avant d'aborder les exercices de cette section, il est important de bien
lire la dernière section du chapitre 4 du cours, intitulée
« Négation des conjonctions, disjonctions et énoncés quantifiés ».

L'objectif de cette série d'exercices est de s'entraîner à utiliser à la main
la liste de formules de négation figurant dans cette section du cours.

Le cœur de chaque exercice est de compléter l'énoncé,
en écrivant que des quantificateurs sans négation et sans utiliser
la définition limite_suite. On peut ensuite vérifier son énoncé en remplaçant
le « sorry » de la démonstration par « verifie ». La commande verifie
est uniquement destinée à cette série d'exercices, elle se contente de déplier
des définitions, d'appeler push_neg et de faire un peu de nettoyage.

On rappelle aussi la définition de « u tend vers l » :

def limite_suite (u : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| ≤ ε
-/

-- Dans cette section, u désigne une suite de réels, f une fonction
-- de ℝ dans ℝ, et x₀ et l des réels.
variables (u : ℕ → ℝ) (f : ℝ → ℝ) (x₀ l : ℝ)

/- Négation de « u tend vers l » -/
example : ¬ (limite_suite u l) ↔
  sorry
:=
begin
  sorry
end

/- Négation de « f est continue en x₀ » -/
example : ¬ (∀ ε > 0, ∃ δ > 0, ∀ x, |x - x₀| ≤ δ →  |f x - f x₀| ≤ ε) ↔
  sorry
:=
begin
  sorry
end

/-
Dans l'exercice suivant, il est utile de se souvenir que « ∀ x x', ... » est
l'abréviation de « ∀ x, ∀ x', ... ». De même « ∃ x x', ... » est
l'abréviation de « ∃ x, ∃ x', ... ».
-/

/- Négation de « f est uniformément continue sur ℝ » -/
example : ¬ (∀ ε > 0, ∃ δ > 0, ∀ x x', |x' - x| ≤ δ →  |f x' - f x| ≤ ε) ↔
  sorry
:=
begin
  sorry
end

/- Négation de « f est séquentiellement continue en x₀ » -/
example : ¬ (∀ u : ℕ → ℝ, limite_suite u x₀ → limite_suite (f ∘ u) (f x₀))  ↔
  sorry
:=
begin
  sorry
end
end

/-
La suite de cette feuille explore des applications élémentaires de la négation
dans l'étude des convergences de suites de réels.

On pourra utiliser la commande linarith' qui est une version légèrement
améliorée de linarith. En particulier, il est inutile de séparer les
conjonctions avant d'appeler linarith'.
-/

example (a b : ℝ) (h : 0 < a ∧ a < b) : 0 < b :=
begin
  -- linarith échouerait ici, il faudrait écrire d'abord cases h with h₁ h₂,
  linarith',
end

/-
On rappele que linarith (ou linarith') peuvent débusquer des contradictions
faciles, comme dans l'exemple suivant.
-/

example (a b : ℝ) (h : a < b) (h' : b < a) : false :=
begin
  linarith,
end

/-
On rappelle des lemmes potentiellement utiles :

abs_inferieur_ssi (x y : ℝ) : |x| ≤ y ↔ -y ≤ x ∧ x ≤ y

superieur_max_ssi (p q r) : r ≥ max p q  ↔ r ≥ p ∧ r ≥ q

inferieur_max_gauche p q : p ≤ max p q

inferieur_max_droite p q : q ≤ max p q
-/

/-- La suite `u` tend vers `+∞`. -/
def limite_infinie_suite (u : ℕ → ℝ) := ∀ A, ∃ N, ∀ n ≥ N, u n ≥ A

-- Si u tend vers +∞ alors u ne tend vers aucune limite finie
lemma limite_infinie_pas_finie {u : ℕ → ℝ} :
  limite_infinie_suite u → ∀ l, ¬ limite_suite u l :=
begin
  sorry
end

/-- La suite `u` est croissante. -/
def suite_croissante (u : ℕ → ℝ) := ∀ n m, n ≤ m → u n ≤ u m

-- Si u est croissante et tend vers l alors tous les u_n sont inférieurs à l.
example (u : ℕ → ℝ) (l : ℝ) (h : limite_suite u l) (h' : suite_croissante u) :
  ∀ n, u n ≤ l :=
begin
  sorry
end

/-
Dans les exercices suivant, « A : set ℝ » signifie que A est un ensemble de
nombres réels. On a la notation usuelle x ∈ A pour dire qu'un réel x est
dans l'ensemble de réels A.

La notation « ∀ x ∈ A, ...» est l'abréviation de « ∀ x, x ∈ A → ... »
(analogue à l'abréviation « ∀ ε > 0, ... »).
-/

/-- Le réel `x` est un majorant de l'ensemble de réels `A`. -/
def majorant (A : set ℝ) (x : ℝ) := ∀ a ∈ A, a ≤ x

/-- Le réel `x` est une  borne supérieure de l'ensemble de réels `A`. -/
def borne_sup (A : set ℝ) (x : ℝ) := majorant A x ∧ ∀ y, majorant A y → x ≤ y

/-
Remarque : on peut montrer facilement qu'un ensemble de réels admet au plus
un borne supérieure, mais ce ne sera pas utile ici.
-/

-- Si un réel x est borne supérieure d'un ensemble de réels A alors,
-- pour tout y, si y < x alors il existe a dans A strictement plus grand que y.
lemma lt_sup {A : set ℝ} {x : ℝ} (hx : borne_sup A x) :
∀ y, y < x → ∃ a ∈ A, y < a :=
begin
  sorry
end

/-
L'exercice suivant est une variante d'un exercice de la feuille 7.
Le but ici est de montrer son application à l'étude des limites de suites
dans le dernier exercice.
-/

-- Soit x et y deux réels. Si y ≤ x + ε pour tout ε > 0 alors y ≤ x.
lemma inferieur_si_inferieur_plus_eps {x y : ℝ} :
  (∀ ε > 0, y ≤ x + ε) →  y ≤ x :=
begin
  sorry
end

-- Si u tend vers x et u_n ≤ y pour tout n alors x ≤ y.
lemma lim_le {x y : ℝ} {u : ℕ → ℝ} (hu : limite_suite u x)
  (ineg : ∀ n, u n ≤ y) : x ≤ y :=
begin
  sorry
end


/-
Apache 2, because everyone else is doing it
Written by Kevin Buzzard summer 2021 in his shed.
Powered by `mathlib`, the leanprover-community, without which nothing
would have happened.
Thanks to Leo and everyone at Microsoft Research for Lean.
-/
-- This imports all user tactics and a whole bunch of basic mathematics
import tactic
import group_theory.group_action.basic -- group actions
import data.setoid.partition -- theory of partitions
/-!

# Level 2 : Groups acting on types

In this level we demonstrate how a mathematician works with groups
acting on types in Lean. I will assume no familiarity with the
mathematics.

In technical terms, this file is an overview of the API for `mul_action`.
-/

/-

## Introduction

We know what a mathematician means when they say "let G be a group"
  or "let S be a set/type". But what do they mean when they say "Assume
  G acts on S", or "assume S is a G-set"?

Here is a precise answer.

## Section 2.1 : Definition of group actions

Let `G` be a group and let `S` be a type.

`variables (G : Type) [group G] (S : Type)`

An *action* of `G` on `S` is a function `has_scalar.smul : G → S → S`,
satisfying some axioms which we'll come to later. This function name
is rather unwieldy, but fortunately there is some notation `•` for it.
The notation and the axioms plus a bunch of theorems and constructions
all come as part of the `[mul_action G S]` typeclass.

The reason it's called an "action" is that if `g : G` then `g • _` is
a function from `S` to `S`, so it's a way of moving elements of `S` around,
or *acting* on them.

or to be super-precise a *left action* of `G` on `S`

The two axioms for `•` which make it a group action and not just a random
function are the following :

`one_smul G s : 1 • s = s`
`mul_smul g h s : (g * h) • s = g • (h • s)`

The first axiom says that `1 : G` "acts" in a completely boring way,
by not moving around anything at all.

The second axiom says that the group action on the `S` is compatible
with `G`'s internal multiplication.

## Exercise 2.1 : prove some theorems

Prove the following theorems.
-/

-- Let G be a group, let S be a type, and say G acts on S
variables {G : Type} [group G] {S : Type} [mul_action G S]
{g h : G} {s t u : S}
-- We use squiggly brackets this time because Lean's unifier will
-- always be able to guess which group and set we're
-- talking about

example : (g * g⁻¹) • s = s :=
begin
  sorry
end

example : g⁻¹ • g • s = s :=
begin
  sorry
end

/-

## Section 2.2 : Orbits

We can think of `•` as giving us a map `S → S` for each element of `G`.
The *orbit* of `s : S` is what we might informally write `G • s`,
namely the subset of `S` consisting of terms of the form `g • s` for `g : G`
Its full name is

`mul_action.orbit G s : set S`

but if we `open mul_action` we'll just be able to call it `orbit`.

-/

open mul_action

#check orbit G s -- set S

/-

### Orbits

Here is a brief API for orbits:

`mem_orbit_iff : t ∈ orbit G s ↔ ∃ (x : G), x • s = t`
`mem_orbit s g : g • s ∈ orbit G s`
`mem_orbit_self s : s ∈ orbit G s`

## Exercise 2.2

Why don't you try some orbit questions?

Tip 1 : I usually start with `rw mem_orbit_iff at *`
Tip 2 : work out the maths proof first, on a piece of paper.
-/

theorem mem_orbit_refl (s : S) : s ∈ orbit G s :=
begin
  sorry
end

theorem mem_orbit_symm : s ∈ orbit G t → t ∈ orbit G s :=
begin
  sorry
end

theorem mem_orbit_trans (hst : s ∈ orbit G t) (htu : t ∈ orbit G u) :
  s ∈ orbit G u :=
begin
  sorry
end

-- Did you just see a bijection between the three axioms
-- of an equivalence relation, and the three pieces of a structure in a group?

/-

## Section 2.3 : orbits are a partition

Equivalence classes form a partition of a type. Orbits do too. In other
words, an action of `G` on `S` breaks `S` up into a disjoint union
of distinct orbits for the action.

What is a partition? According to Lean, a collection `C` of subsets
of a type `S` satisfies the predicate `is_partition C` if none of the
subsets are empty, and furthermore every element of `S` is an element
of exactly one subset in `C`.

Here are the maths proofs. An orbit can't be empty, because `orbit G s`
contains `s`. Every element `s` of `S` is in an orbit because it's
in `orbit G s`. Uniqueness is harder.

I first establish a boring lemma saying that if `a ∈ orbit G s` and
`a ∈ orbit G t` then `s ∈ orbit G t`. This follows from symmetry
and transitivity of `mem_orbit` .

I next claim that if `s ∈ orbit G t` then `orbit G s ⊆ orbit G t`.
This follows from transitivity of `mem_orbit`.

Finally, if `a ∈ orbit G s` and `a ∈ orbit G t`
then I claim that `orbit G s = orbit G t`. This is because we have
inclusions in each direction, using the boring lemma.

Can you prove all this in Lean?

## Exercise 2.3 Prove that orbits form a partition.

-/

open set

variable (G)

theorem orbit_nonempty (s : S) : set.nonempty (orbit G s) :=
begin
  rw nonempty_def,
  sorry,
end

variable {G}
theorem mem_orbit (s : S) : ∃ (t : S), s ∈ orbit G t :=
begin
  sorry,
end

variable {a : S}

theorem boring_lemma (has : a ∈ orbit G s) (hat : a ∈ orbit G t) : s ∈ orbit G t :=
begin
  sorry,
end

theorem orbit_subset_of_mem_orbit (hst : s ∈ orbit G t) : orbit G s ⊆ orbit G t :=
begin
  -- you can just abuse definitional equality and start with `intro u`,
  sorry,
end

-- finally you can prove that if two orbits contain a common element
-- then they are equal

theorem orbit_eq_orbit_of_mem_inter (has : a ∈ orbit G s) (hat : a ∈ orbit G t) :
  orbit G s = orbit G t :=
begin
  sorry,
end

open setoid

-- This is very fiddly, I wouldn't worry too much about it, you've done
-- the maths part, the rest is plumbing. You'll have to look up the API
-- for `is_partition` yourself.
example : is_partition {𝒪 : set S | ∃ s, orbit G s = 𝒪} :=
begin
  sorry
end


/-
Copyright (c) 2021 Yourong Zang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yourong Zang
-/
import analysis.normed_space.conformal_linear_map
import analysis.calculus.fderiv

/-!
# Conformal Maps

A continuous linear map between real normed spaces `X` and `Y` is `conformal_at` some point `x`
if it is real differentiable at that point and its differential `is_conformal_linear_map`.

## Main definitions

* `conformal_at`: the main definition of conformal maps
* `conformal`: maps that are conformal at every point
* `conformal_factor_at`: the conformal factor of a conformal map at some point

## Main results
* The conformality of the composition of two conformal maps, the identity map
  and multiplications by nonzero constants
* `conformal_at_iff_is_conformal_map_fderiv`: an equivalent definition of the conformality of a map

In `analysis.calculus.conformal.inner_product`:
* `conformal_at_iff`: an equivalent definition of the conformality of a map

In `geometry.euclidean.angle.unoriented.conformal`:
* `conformal_at.preserves_angle`: if a map is conformal at `x`, then its differential
                                  preserves all angles at `x`

## Tags

conformal

## Warning

The definition of conformality in this file does NOT require the maps to be orientation-preserving.
Maps such as the complex conjugate are considered to be conformal.
-/

noncomputable theory

variables {X Y Z : Type*} [normed_add_comm_group X] [normed_add_comm_group Y]
  [normed_add_comm_group Z] [normed_space ℝ X] [normed_space ℝ Y] [normed_space ℝ Z]

section loc_conformality

open linear_isometry continuous_linear_map

/-- A map `f` is said to be conformal if it has a conformal differential `f'`. -/
def conformal_at (f : X → Y) (x : X) :=
∃ (f' : X →L[ℝ] Y), has_fderiv_at f f' x ∧ is_conformal_map f'

lemma conformal_at_id (x : X) : conformal_at id x :=
⟨id ℝ X, has_fderiv_at_id _, is_conformal_map_id⟩

lemma conformal_at_const_smul {c : ℝ} (h : c ≠ 0) (x : X) :
  conformal_at (λ (x': X), c • x') x :=
⟨c • continuous_linear_map.id ℝ X,
  (has_fderiv_at_id x).const_smul c, is_conformal_map_const_smul h⟩

@[nontriviality] lemma subsingleton.conformal_at [subsingleton X] (f : X → Y) (x : X) :
  conformal_at f x :=
⟨0, has_fderiv_at_of_subsingleton _ _, is_conformal_map_of_subsingleton _⟩

/-- A function is a conformal map if and only if its differential is a conformal linear map-/
lemma conformal_at_iff_is_conformal_map_fderiv {f : X → Y} {x : X} :
  conformal_at f x ↔ is_conformal_map (fderiv ℝ f x) :=
begin
  split,
  { rintros ⟨f', hf, hf'⟩,
    rwa hf.fderiv },
  { intros H,
    by_cases h : differentiable_at ℝ f x,
    { exact ⟨fderiv ℝ f x, h.has_fderiv_at, H⟩, },
    { nontriviality X,
      exact absurd (fderiv_zero_of_not_differentiable_at h) H.ne_zero } },
end

namespace conformal_at

lemma differentiable_at {f : X → Y} {x : X} (h : conformal_at f x) :
  differentiable_at ℝ f x :=
let ⟨_, h₁, _⟩ := h in h₁.differentiable_at

lemma congr {f g : X → Y} {x : X} {u : set X} (hx : x ∈ u) (hu : is_open u)
  (hf : conformal_at f x) (h : ∀ (x : X), x ∈ u → g x = f x) :
  conformal_at g x :=
let ⟨f', hfderiv, hf'⟩ := hf in
  ⟨f', hfderiv.congr_of_eventually_eq ((hu.eventually_mem hx).mono h), hf'⟩

lemma comp {f : X → Y} {g : Y → Z} (x : X)
  (hg : conformal_at g (f x)) (hf : conformal_at f x) : conformal_at (g ∘ f) x :=
begin
  rcases hf with ⟨f', hf₁, cf⟩,
  rcases hg with ⟨g', hg₁, cg⟩,
  exact ⟨g'.comp f', hg₁.comp x hf₁, cg.comp cf⟩,
end

lemma const_smul {f : X → Y} {x : X} {c : ℝ} (hc : c ≠ 0) (hf : conformal_at f x) :
  conformal_at (c • f) x :=
(conformal_at_const_smul hc $ f x).comp x hf

end conformal_at

end loc_conformality

section global_conformality

/-- A map `f` is conformal if it's conformal at every point. -/
def conformal (f : X → Y) :=
∀ (x : X), conformal_at f x

lemma conformal_id : conformal (id : X → X) := λ x, conformal_at_id x

lemma conformal_const_smul {c : ℝ} (h : c ≠ 0) : conformal (λ (x : X), c • x) :=
λ x, conformal_at_const_smul h x

namespace conformal

lemma conformal_at {f : X → Y} (h : conformal f) (x : X) : conformal_at f x := h x

lemma differentiable {f : X → Y} (h : conformal f) : differentiable ℝ f :=
λ x, (h x).differentiable_at

lemma comp {f : X → Y} {g : Y → Z} (hf : conformal f) (hg : conformal g) : conformal (g ∘ f) :=
λ x, (hg $ f x).comp x (hf x)

lemma const_smul {f : X → Y} (hf : conformal f) {c : ℝ} (hc : c ≠ 0) : conformal (c • f) :=
λ x, (hf x).const_smul hc

end conformal

end global_conformality


import game.world10.level8 -- hide
namespace mynat -- hide
/-
# Inequality world.

## Level 9: `le_total`
-/

/- Lemma
For all naturals $a$ and $b$, either $a\le b$ or $b\le a$.
-/
theorem le_total (a b : mynat) : a ≤ b ∨ b ≤ a :=
begin [nat_num_game]
  revert a,
  induction b with d hd,
    intro a,
    right,
    exact zero_le a,
  intro a,
  cases a with a,
    left,
    exact zero_le _,
  cases hd a,
    left,
    exact succ_le_succ a d h,
  right,
  exact succ_le_succ d a h,

end

-- Another collectible: the naturals are a linear order.
instance : linear_order mynat := by structure_helper
end mynat -- hide


/-
Copyright (c) 2021 Jireh Loreaux. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jireh Loreaux
-/
import algebra.algebra.spectrum
import analysis.calculus.deriv
import analysis.special_functions.pow
/-!
# The spectrum of elements in a complete normed algebra

This file contains the basic theory for the resolvent and spectrum of a Banach algebra.

## Main definitions

* `spectral_radius : ℝ≥0∞`: supremum of `∥k∥₊` for all `k ∈ spectrum 𝕜 a`

## Main statements

* `spectrum.is_open_resolvent_set`: the resolvent set is open.
* `spectrum.is_closed`: the spectrum is closed.
* `spectrum.subset_closed_ball_norm`: the spectrum is a subset of closed disk of radius
  equal to the norm.
* `spectrum.is_compact`: the spectrum is compact.
* `spectrum.spectral_radius_le_nnnorm`: the spectral radius is bounded above by the norm.
* `spectrum.has_deriv_at_resolvent`: the resolvent function is differentiable on the resolvent set.

## TODO

* after we have Liouville's theorem, prove that the spectrum is nonempty when the
  scalar field is ℂ.
* compute all derivatives of `resolvent a`.

-/

open_locale ennreal

/-- The *spectral radius* is the supremum of the `nnnorm` (`∥⬝∥₊`) of elements in the spectrum,
    coerced into an element of `ℝ≥0∞`. Note that it is possible for `spectrum 𝕜 a = ∅`. In this
    case, `spectral_radius a = 0`.  It is also possible that `spectrum 𝕜 a` be unbounded (though
    not for Banach algebras, see `spectrum.is_bounded`, below).  In this case,
    `spectral_radius a = ∞`. -/
noncomputable def spectral_radius (𝕜 : Type*) {A : Type*} [normed_field 𝕜] [ring A]
  [algebra 𝕜 A] (a : A) : ℝ≥0∞ :=
⨆ k ∈ spectrum 𝕜 a, ∥k∥₊

variables {𝕜 : Type*} {A : Type*}

namespace spectrum

section spectrum_compact

variables [normed_field 𝕜] [normed_ring A] [normed_algebra 𝕜 A] [complete_space A]

local notation `σ` := spectrum 𝕜
local notation `ρ` := resolvent_set 𝕜
local notation `↑ₐ` := algebra_map 𝕜 A

lemma is_open_resolvent_set (a : A) : is_open (ρ a) :=
units.is_open.preimage ((algebra_map_isometry 𝕜 A).continuous.sub continuous_const)

lemma is_closed (a : A) : is_closed (σ a) :=
(is_open_resolvent_set a).is_closed_compl

lemma mem_resolvent_of_norm_lt {a : A} {k : 𝕜} (h : ∥a∥ < ∥k∥) :
  k ∈ ρ a :=
begin
  rw [resolvent_set, set.mem_set_of_eq, algebra.algebra_map_eq_smul_one],
  have hk : k ≠ 0 := ne_zero_of_norm_ne_zero (by linarith [norm_nonneg a]),
  let ku := units.map (↑ₐ).to_monoid_hom (units.mk0 k hk),
  have hku : ∥-a∥ < ∥(↑ku⁻¹:A)∥⁻¹ := by simpa [ku, algebra_map_isometry] using h,
  simpa [ku, sub_eq_add_neg, algebra.algebra_map_eq_smul_one] using (ku.add (-a) hku).is_unit,
end

lemma norm_le_norm_of_mem {a : A} {k : 𝕜} (hk : k ∈ σ a) :
  ∥k∥ ≤ ∥a∥ :=
le_of_not_lt $ mt mem_resolvent_of_norm_lt hk

lemma subset_closed_ball_norm (a : A) :
  σ a ⊆ metric.closed_ball (0 : 𝕜) (∥a∥) :=
λ k hk, by simp [norm_le_norm_of_mem hk]

lemma is_bounded (a : A) : metric.bounded (σ a) :=
(metric.bounded_iff_subset_ball 0).mpr ⟨∥a∥, subset_closed_ball_norm a⟩

theorem is_compact [proper_space 𝕜] (a : A) : is_compact (σ a) :=
metric.is_compact_of_is_closed_bounded (is_closed a) (is_bounded a)

theorem spectral_radius_le_nnnorm (a : A) :
  spectral_radius 𝕜 a ≤ ∥a∥₊ :=
by { refine bsupr_le (λ k hk, _), exact_mod_cast norm_le_norm_of_mem hk }

open ennreal polynomial

theorem spectral_radius_le_pow_nnnorm_pow_one_div (a : A) (n : ℕ) :
  spectral_radius 𝕜 a ≤ ∥a ^ (n + 1)∥₊ ^ (1 / (n + 1) : ℝ) :=
begin
  refine bsupr_le (λ k hk, _),
  /- apply easy direction of the spectral mapping theorem for polynomials -/
  have pow_mem : k ^ (n + 1) ∈ σ (a ^ (n + 1)),
    by simpa only [one_mul, algebra.algebra_map_eq_smul_one, one_smul, aeval_monomial, one_mul,
      eval_monomial] using subset_polynomial_aeval a (monomial (n + 1) (1 : 𝕜)) ⟨k, hk, rfl⟩,
  /- power of the norm is bounded by norm of the power -/
  have nnnorm_pow_le : (↑(∥k∥₊ ^ (n + 1)) : ℝ≥0∞) ≤ ↑∥a ^ (n + 1)∥₊,
    by simpa only [norm_to_nnreal, normed_field.nnnorm_pow k (n+1)]
      using coe_mono (real.to_nnreal_mono (norm_le_norm_of_mem pow_mem)),
  /- take (n + 1)ᵗʰ roots and clean up the left-hand side -/
  have hn : 0 < ((n + 1) : ℝ), by exact_mod_cast nat.succ_pos',
  convert monotone_rpow_of_nonneg (one_div_pos.mpr hn).le nnnorm_pow_le,
  erw [coe_pow, ←rpow_nat_cast, ←rpow_mul, mul_one_div_cancel hn.ne', rpow_one],
end

end spectrum_compact

section resolvent_deriv

variables [nondiscrete_normed_field 𝕜] [normed_ring A] [normed_algebra 𝕜 A] [complete_space A]

local notation `ρ` := resolvent_set 𝕜
local notation `↑ₐ` := algebra_map 𝕜 A

theorem has_deriv_at_resolvent {a : A} {k : 𝕜} (hk : k ∈ ρ a) :
  has_deriv_at (resolvent a) (-(resolvent a k) ^ 2) k :=
begin
  have H₁ : has_fderiv_at ring.inverse _ (↑ₐk - a) := has_fderiv_at_ring_inverse hk.unit,
  have H₂ : has_deriv_at (λ k, ↑ₐk - a) 1 k,
  { simpa using (algebra.linear_map 𝕜 A).has_deriv_at.sub_const a },
  simpa [resolvent, sq, hk.unit_spec, ← ring.inverse_unit hk.unit] using H₁.comp_has_deriv_at k H₂,
end

end resolvent_deriv

end spectrum

namespace alg_hom

section normed_field
variables [normed_field 𝕜] [normed_ring A] [normed_algebra 𝕜 A] [complete_space A]
local notation `↑ₐ` := algebra_map 𝕜 A

/-- An algebra homomorphism into the base field, as a continuous linear map (since it is
automatically bounded). -/
@[simps] def to_continuous_linear_map (φ : A →ₐ[𝕜] 𝕜) : A →L[𝕜] 𝕜 :=
φ.to_linear_map.mk_continuous_of_exists_bound $
  ⟨1, λ a, (one_mul ∥a∥).symm ▸ spectrum.norm_le_norm_of_mem (φ.apply_mem_spectrum _)⟩

lemma continuous (φ : A →ₐ[𝕜] 𝕜) : continuous φ := φ.to_continuous_linear_map.continuous

end normed_field

section nondiscrete_normed_field
variables [nondiscrete_normed_field 𝕜] [normed_ring A] [normed_algebra 𝕜 A] [complete_space A]
local notation `↑ₐ` := algebra_map 𝕜 A

@[simp] lemma to_continuous_linear_map_norm [norm_one_class A] (φ : A →ₐ[𝕜] 𝕜) :
  ∥φ.to_continuous_linear_map∥ = 1 :=
continuous_linear_map.op_norm_eq_of_bounds zero_le_one
  (λ a, (one_mul ∥a∥).symm ▸ spectrum.norm_le_norm_of_mem (φ.apply_mem_spectrum _))
  (λ _ _ h, by simpa only [to_continuous_linear_map_apply, mul_one, map_one, norm_one] using h 1)

end nondiscrete_normed_field

end alg_hom


example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
begin
  apply iff.intro,
    intro h,
    cases h.right with hq hr,
      exact or.inl ⟨h.left, hq⟩,
      exact or.inr ⟨h.left, hr⟩,
    intro h,
    cases h with hpq hpr,
      exact ⟨hpq.left, or.inl hpq.right⟩,
      exact ⟨hpr.left, or.inr hpr.right⟩
end


theorem add_le_add_left {a b : mynat} (h : a ≤ b) (t : mynat) :
  t + a ≤ t + b :=
begin
rw add_comm t a,
rw add_comm t b,
exact add_le_add_right h t,
end


import algebra.hom.group
import algebra.big_operators

namespace finset

open_locale big_operators

variables {ι : Type*} (A: Type*) [comm_group A] (B : Type*) [add_comm_monoid B]

@[to_additive "neg_sum"] lemma inv_prod (a : ι → A) (s : finset ι) :
  (∏ i in s, a i)⁻¹ = ∏ i in s, (a i)⁻¹ :=
begin
  classical,
  induction s using finset.induction_on with i s hi ih,
  { simp only [finset.prod_empty, one_inv], },
  { rw [finset.prod_insert hi, mul_inv, ih, finset.prod_insert hi] },
end

end finset


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl, Damiano Testa
-/
import algebra.covariant_and_contravariant
import order.monotone

/-!
# Ordered monoids

This file develops the basics of ordered monoids.

## Implementation details

Unfortunately, the number of `'` appended to lemmas in this file
may differ between the multiplicative and the additive version of a lemma.
The reason is that we did not want to change existing names in the library.

## Remark

Almost no monoid is actually present in this file: most assumptions have been generalized to
`has_mul` or `mul_one_class`.

-/

-- TODO: If possible, uniformize lemma names, taking special care of `'`,
-- after the `ordered`-refactor is done.

open function

variables {α β : Type*}

section has_mul
variables [has_mul α]

section has_le
variables [has_le α]

/- The prime on this lemma is present only on the multiplicative version.  The unprimed version
is taken by the analogous lemma for semiring, with an extra non-negativity assumption. -/
@[to_additive add_le_add_left]
lemma mul_le_mul_left' [covariant_class α α (*) (≤)] {b c : α} (bc : b ≤ c) (a : α) :
  a * b ≤ a * c :=
covariant_class.elim _ bc

@[to_additive le_of_add_le_add_left]
lemma le_of_mul_le_mul_left' [contravariant_class α α (*) (≤)]
  {a b c : α} (bc : a * b ≤ a * c) :
  b ≤ c :=
contravariant_class.elim _ bc

/- The prime on this lemma is present only on the multiplicative version.  The unprimed version
is taken by the analogous lemma for semiring, with an extra non-negativity assumption. -/
@[to_additive add_le_add_right]
lemma mul_le_mul_right' [covariant_class α α (swap (*)) (≤)]
  {b c : α} (bc : b ≤ c) (a : α) :
  b * a ≤ c * a :=
covariant_class.elim a bc

@[to_additive le_of_add_le_add_right]
lemma le_of_mul_le_mul_right' [contravariant_class α α (swap (*)) (≤)]
  {a b c : α} (bc : b * a ≤ c * a) :
  b ≤ c :=
contravariant_class.elim a bc

@[simp, to_additive]
lemma mul_le_mul_iff_left [covariant_class α α (*) (≤)] [contravariant_class α α (*) (≤)]
  (a : α) {b c : α} :
  a * b ≤ a * c ↔ b ≤ c :=
rel_iff_cov α α (*) (≤) a

@[simp, to_additive]
lemma mul_le_mul_iff_right
  [covariant_class α α (swap (*)) (≤)] [contravariant_class α α (swap (*)) (≤)]
  (a : α) {b c : α} :
  b * a ≤ c * a ↔ b ≤ c :=
rel_iff_cov α α (swap (*)) (≤) a

end has_le

section has_lt
variables [has_lt α]

@[simp, to_additive]
lemma mul_lt_mul_iff_left [covariant_class α α (*) (<)] [contravariant_class α α (*) (<)]
  (a : α) {b c : α} :
  a * b < a * c ↔ b < c :=
rel_iff_cov α α (*) (<) a

@[simp, to_additive]
lemma mul_lt_mul_iff_right
  [covariant_class α α (swap (*)) (<)] [contravariant_class α α (swap (*)) (<)]
  (a : α) {b c : α} :
  b * a < c * a ↔ b < c :=
rel_iff_cov α α (swap (*)) (<) a

@[to_additive add_lt_add_left]
lemma mul_lt_mul_left' [covariant_class α α (*) (<)] {b c : α} (bc : b < c) (a : α) :
  a * b < a * c :=
covariant_class.elim _ bc

@[to_additive lt_of_add_lt_add_left]
lemma lt_of_mul_lt_mul_left' [contravariant_class α α (*) (<)]
  {a b c : α} (bc : a * b < a * c) :
  b < c :=
contravariant_class.elim _ bc

@[to_additive add_lt_add_right]
lemma mul_lt_mul_right' [covariant_class α α (swap (*)) (<)]
  {b c : α} (bc : b < c) (a : α) :
  b * a < c * a :=
covariant_class.elim a bc

@[to_additive lt_of_add_lt_add_right]
lemma lt_of_mul_lt_mul_right' [contravariant_class α α (swap (*)) (<)]
  {a b c : α} (bc : b * a < c * a) :
  b < c :=
contravariant_class.elim a bc

end has_lt

end has_mul

-- using one
section mul_one_class
variables [mul_one_class α]

section has_le
variables [has_le α]

@[simp, to_additive le_add_iff_nonneg_right]
lemma le_mul_iff_one_le_right'
  [covariant_class α α (*) (≤)] [contravariant_class α α (*) (≤)]
  (a : α) {b : α} : a ≤ a * b ↔ 1 ≤ b :=
iff.trans (by rw [mul_one]) (mul_le_mul_iff_left a)

@[simp, to_additive add_le_iff_nonpos_right]
lemma mul_le_iff_le_one_right'
  [covariant_class α α (*) (≤)] [contravariant_class α α (*) (≤)]
  (a : α) {b : α} :
  a * b ≤ a ↔ b ≤ 1 :=
iff.trans (by rw [mul_one]) (mul_le_mul_iff_left a)

@[simp, to_additive le_add_iff_nonneg_left]
lemma le_mul_iff_one_le_left'
  [covariant_class α α (swap (*)) (≤)] [contravariant_class α α (swap (*)) (≤)]
  (a : α) {b : α} :
  a ≤ b * a ↔ 1 ≤ b :=
iff.trans (by rw one_mul) (mul_le_mul_iff_right a)

@[simp, to_additive add_le_iff_nonpos_left]
lemma mul_le_iff_le_one_left'
  [covariant_class α α (swap (*)) (≤)] [contravariant_class α α (swap (*)) (≤)]
  {a b : α} :
  a * b ≤ b ↔ a ≤ 1 :=
iff.trans (by rw one_mul) (mul_le_mul_iff_right b)

end has_le

lemma exists_square_le {α : Type*} [mul_one_class α] [linear_order α] [covariant_class α α (*) (<)]
  (a : α) : ∃ (b : α), b * b ≤ a :=
begin
  by_cases h : a < 1,
  { use a,
    have : a*a < a*1,
    exact mul_lt_mul_left' h a,
    rw mul_one at this,
    exact le_of_lt this },
  { use 1,
    push_neg at h,
    rwa mul_one }
end

section has_lt
variable [has_lt α]

@[to_additive lt_add_of_pos_right]
lemma lt_mul_of_one_lt_right'
  [covariant_class α α (*) (<)]
  (a : α) {b : α} (h : 1 < b) : a < a * b :=
calc a = a * 1 : (mul_one _).symm
   ... < a * b : mul_lt_mul_left' h a

@[simp, to_additive lt_add_iff_pos_right]
lemma lt_mul_iff_one_lt_right'
  [covariant_class α α (*) (<)] [contravariant_class α α (*) (<)]
  (a : α) {b : α} :
  a < a * b ↔ 1 < b :=
iff.trans (by rw mul_one) (mul_lt_mul_iff_left a)

@[simp, to_additive add_lt_iff_neg_left]
lemma mul_lt_iff_lt_one_left'
  [covariant_class α α (*) (<)] [contravariant_class α α (*) (<)] {a b : α} :
  a * b < a ↔ b < 1 :=
iff.trans (by rw mul_one) (mul_lt_mul_iff_left a)

@[simp, to_additive lt_add_iff_pos_left]
lemma lt_mul_iff_one_lt_left'
  [covariant_class α α (swap (*)) (<)] [contravariant_class α α (swap (*)) (<)]
  (a : α) {b : α} : a < b * a ↔ 1 < b :=
iff.trans (by rw one_mul) (mul_lt_mul_iff_right a)

@[simp, to_additive add_lt_iff_neg_right]
lemma mul_lt_iff_lt_one_right'
  [covariant_class α α (swap (*)) (<)] [contravariant_class α α (swap (*)) (<)]
  {a : α} (b : α) :
  a * b < b ↔ a < 1 :=
iff.trans (by rw one_mul) (mul_lt_mul_iff_right b)

end has_lt

section preorder
variable [preorder α]

@[to_additive]
lemma mul_le_of_le_of_le_one [covariant_class α α (*) (≤)]
  {a b c : α} (hbc : b ≤ c) (ha : a ≤ 1) : b * a ≤ c :=
calc  b * a ≤ b * 1 : mul_le_mul_left' ha b
        ... = b     : mul_one b
        ... ≤ c     : hbc

alias mul_le_of_le_of_le_one ← mul_le_one'
attribute [to_additive add_nonpos] mul_le_one'

@[to_additive]
lemma lt_mul_of_lt_of_one_le [covariant_class α α (*) (≤)]
  {a b c : α} (hbc : b < c) (ha : 1 ≤ a) : b < c * a :=
calc  b < c     : hbc
    ... = c * 1 : (mul_one c).symm
    ... ≤ c * a : mul_le_mul_left' ha c

@[to_additive]
lemma mul_lt_of_lt_of_le_one [covariant_class α α (*) (≤)]
  {a b c : α} (hbc : b < c) (ha : a ≤ 1)  : b * a < c :=
calc  b * a ≤ b * 1 : mul_le_mul_left' ha b
        ... = b     : mul_one b
        ... < c     : hbc

@[to_additive]
lemma lt_mul_of_le_of_one_lt [covariant_class α α (*) (<)]
  {a b c : α} (hbc : b ≤ c) (ha : 1 < a) : b < c * a :=
calc  b ≤ c     : hbc
    ... = c * 1 : (mul_one c).symm
    ... < c * a : mul_lt_mul_left' ha c

@[to_additive]
lemma mul_lt_of_le_one_of_lt [covariant_class α α (swap (*)) (≤)]
  {a b c : α} (ha : a ≤ 1) (hb : b < c) : a * b < c :=
calc  a * b ≤ 1 * b : mul_le_mul_right' ha b
        ... = b     : one_mul b
        ... < c     : hb

@[to_additive]
lemma mul_le_of_le_one_of_le [covariant_class α α (swap (*)) (≤)]
  {a b c : α} (ha : a ≤ 1) (hbc : b ≤ c) :
  a * b ≤ c :=
calc  a * b ≤ 1 * b : mul_le_mul_right' ha b
        ... = b     : one_mul b
        ... ≤ c     : hbc

@[to_additive]
lemma le_mul_of_one_le_of_le [covariant_class α α (swap (*)) (≤)]
  {a b c: α} (ha : 1 ≤ a) (hbc : b ≤ c) : b ≤ a * c :=
calc  b ≤ c     : hbc
    ... = 1 * c : (one_mul c).symm
    ... ≤ a * c : mul_le_mul_right' ha c

/--
Assume monotonicity on the `left`. The lemma assuming `right` is `right.mul_lt_one`. -/
@[to_additive]
lemma left.mul_lt_one [covariant_class α α (*) (<)]
  {a b : α} (ha : a < 1) (hb : b < 1) : a * b < 1 :=
calc  a * b < a * 1 : mul_lt_mul_left' hb a
        ... = a     : mul_one a
        ... < 1     : ha

/--
Assume monotonicity on the `right`. The lemma assuming `left` is `left.mul_lt_one`. -/
@[to_additive]
lemma right.mul_lt_one [covariant_class α α (swap (*)) (<)]
  {a b : α} (ha : a < 1) (hb : b < 1) : a * b < 1 :=
calc  a * b < 1 * b : mul_lt_mul_right' ha b
        ... = b     : one_mul b
        ... < 1     : hb

@[to_additive]
lemma mul_lt_of_le_of_lt_one
  [covariant_class α α (*) (<)] [covariant_class α α (swap (*)) (≤)]
  {a b c: α} (hbc : b ≤ c) (ha : a < 1) : b * a < c :=
calc  b * a ≤ c * a : mul_le_mul_right' hbc a
        ... < c * 1 : mul_lt_mul_left' ha c
        ... = c     : mul_one c

@[to_additive]
lemma mul_lt_of_lt_one_of_le [covariant_class α α (swap (*)) (<)]
  {a b c : α} (ha : a < 1) (hbc : b ≤ c) : a * b < c :=
calc  a * b < 1 * b : mul_lt_mul_right' ha b
        ... = b     : one_mul b
        ... ≤ c     : hbc

@[to_additive]
lemma lt_mul_of_one_lt_of_le [covariant_class α α (swap (*)) (<)]
  {a b c : α} (ha : 1 < a) (hbc : b ≤ c) : b < a * c :=
calc  b ≤ c     : hbc
    ... = 1 * c : (one_mul c).symm
    ... < a * c : mul_lt_mul_right' ha c

/-- Assumes left covariance. -/
@[to_additive]
lemma le_mul_of_le_of_le_one [covariant_class α α (*) (≤)]
  {a b c : α} (ha : c ≤ a) (hb : 1 ≤ b) : c ≤ a * b :=
calc  c ≤ a     : ha
    ... = a * 1 : (mul_one a).symm
    ... ≤ a * b : mul_le_mul_left' hb a

/-  This lemma is present to mimick the name of an existing one. -/
@[to_additive add_nonneg]
lemma one_le_mul [covariant_class α α (*) (≤)]
  {a b : α} (ha : 1 ≤ a) (hb : 1 ≤ b) : 1 ≤ a * b :=
le_mul_of_le_of_le_one ha hb

/-- Assumes left covariance. -/
@[to_additive]
lemma lt_mul_of_lt_of_one_lt [covariant_class α α (*) (<)]
  {a b c : α} (ha : c < a) (hb : 1 < b) : c < a * b :=
calc  c < a     : ha
    ... = a * 1 : (mul_one _).symm
    ... < a * b : mul_lt_mul_left' hb a

/-- Assumes left covariance. -/
@[to_additive]
lemma left.mul_lt_one_of_lt_of_lt_one [covariant_class α α (*) (<)]
  {a b c : α} (ha : a < c) (hb : b < 1) : a * b < c :=
calc  a * b < a * 1 : mul_lt_mul_left' hb a
        ... = a     : mul_one a
        ... < c     : ha

/-- Assumes right covariance. -/
@[to_additive]
lemma right.mul_lt_one_of_lt_of_lt_one [covariant_class α α (swap (*)) (<)]
  {a b c : α} (ha : a < 1) (hb : b < c) : a * b < c :=
calc  a * b < 1 * b : mul_lt_mul_right' ha b
        ... = b     : one_mul b
        ... < c     : hb

/-- Assumes right covariance. -/
@[to_additive right.add_nonneg]
lemma right.one_le_mul [covariant_class α α (swap (*)) (≤)]
  {a b : α} (ha : 1 ≤ a) (hb : 1 ≤ b) : 1 ≤ a * b :=
calc  1 ≤ b     : hb
    ... = 1 * b : (one_mul b).symm
    ... ≤ a * b : mul_le_mul_right' ha b

/-- Assumes right covariance. -/
@[to_additive right.add_pos]
lemma right.one_lt_mul [covariant_class α α (swap (*)) (<)]
  {b : α} (hb : 1 < b) {a: α} (ha : 1 < a) : 1 < a * b :=
calc  1 < b     : hb
    ... = 1 * b : (one_mul _).symm
    ... < a * b : mul_lt_mul_right' ha b

end preorder

@[to_additive le_add_of_nonneg_right]
lemma le_mul_of_one_le_right' [has_le α] [covariant_class α α (*) (≤)] {a b : α} (h : 1 ≤ b) :
  a ≤ a * b :=
calc  a = a * 1  : (mul_one _).symm
    ... ≤ a * b  : mul_le_mul_left' h a

@[to_additive add_le_of_nonpos_right]
lemma mul_le_of_le_one_right' [has_le α] [covariant_class α α (*) (≤)] {a b : α} (h : b ≤ 1) :
  a * b ≤ a :=
calc  a * b ≤ a * 1 : mul_le_mul_left' h a
        ... = a     : mul_one a

end mul_one_class

@[to_additive]
lemma mul_left_cancel'' [semigroup α] [partial_order α]
  [contravariant_class α α (*) (≤)] {a b c : α} (h : a * b = a * c) : b = c :=
(le_of_mul_le_mul_left' h.le).antisymm (le_of_mul_le_mul_left' h.ge)

@[to_additive]
lemma mul_right_cancel'' [semigroup α] [partial_order α]
  [contravariant_class α α (swap (*)) (≤)] {a b c : α} (h : a * b = c * b) :
  a = c :=
le_antisymm (le_of_mul_le_mul_right' h.le) (le_of_mul_le_mul_right' h.ge)

/- This is not instance, since we want to have an instance from `left_cancel_semigroup`s
to the appropriate `covariant_class`. -/
/--  A semigroup with a partial order and satisfying `left_cancel_semigroup`
(i.e. `a * c < b * c → a < b`) is a `left_cancel semigroup`. -/
@[to_additive
"An additive semigroup with a partial order and satisfying `left_cancel_add_semigroup`
(i.e. `c + a < c + b → a < b`) is a `left_cancel add_semigroup`."]
def contravariant.to_left_cancel_semigroup [semigroup α] [partial_order α]
  [contravariant_class α α (*) (≤)] :
  left_cancel_semigroup α :=
{ mul_left_cancel := λ a b c, mul_left_cancel''
  ..‹semigroup α› }

/- This is not instance, since we want to have an instance from `right_cancel_semigroup`s
to the appropriate `covariant_class`. -/
/--  A semigroup with a partial order and satisfying `right_cancel_semigroup`
(i.e. `a * c < b * c → a < b`) is a `right_cancel semigroup`. -/
@[to_additive
"An additive semigroup with a partial order and satisfying `right_cancel_add_semigroup`
(`a + c < b + c → a < b`) is a `right_cancel add_semigroup`."]
def contravariant.to_right_cancel_semigroup [semigroup α] [partial_order α]
  [contravariant_class α α (swap (*)) (≤)] :
  right_cancel_semigroup α :=
{ mul_right_cancel := λ a b c, mul_right_cancel''
  ..‹semigroup α› }

variables {a b c d : α}

section left
variables [preorder α]

section has_mul
variables [has_mul α]

@[to_additive]
lemma mul_lt_mul_of_lt_of_lt
  [covariant_class α α (*) (<)] [covariant_class α α (swap (*)) (<)]
  (h₁ : a < b) (h₂ : c < d) : a * c < b * d :=
calc  a * c < a * d : mul_lt_mul_left' h₂ a
        ... < b * d : mul_lt_mul_right' h₁ d

section contravariant_mul_lt_left_le_right
variables [covariant_class α α (*) (<)] [covariant_class α α (swap (*)) (≤)]

@[to_additive]
lemma mul_lt_mul_of_le_of_lt
  (h₁ : a ≤ b) (h₂ : c < d) : a * c < b * d :=
(mul_le_mul_right' h₁ _).trans_lt (mul_lt_mul_left' h₂ b)

@[to_additive add_lt_add]
lemma mul_lt_mul''' (h₁ : a < b) (h₂ : c < d) : a * c < b * d :=
mul_lt_mul_of_le_of_lt h₁.le h₂

end contravariant_mul_lt_left_le_right

variable [covariant_class α α (*) (≤)]

@[to_additive]
lemma mul_lt_of_mul_lt_left (h : a * b < c) (hle : d ≤ b) :
  a * d < c :=
(mul_le_mul_left' hle a).trans_lt h

@[to_additive]
lemma mul_le_of_mul_le_left (h : a * b ≤ c) (hle : d ≤ b) :
  a * d ≤ c :=
@act_rel_of_rel_of_act_rel _ _ _ (≤) _ ⟨λ _ _ _, le_trans⟩ a _ _ _ hle h

@[to_additive]
lemma lt_mul_of_lt_mul_left (h : a < b * c) (hle : c ≤ d) :
  a < b * d :=
h.trans_le (mul_le_mul_left' hle b)

@[to_additive]
lemma le_mul_of_le_mul_left (h : a ≤ b * c) (hle : c ≤ d) :
  a ≤ b * d :=
@rel_act_of_rel_of_rel_act _ _ _ (≤) _ ⟨λ _ _ _, le_trans⟩ b _ _ _ hle h

@[to_additive]
lemma mul_lt_mul_of_lt_of_le [covariant_class α α (swap (*)) (<)]
  (h₁ : a < b) (h₂ : c ≤ d) : a * c < b * d :=
(mul_le_mul_left' h₂ _).trans_lt (mul_lt_mul_right' h₁ d)

end has_mul

/-!  Here we start using properties of one, on the left. -/
section mul_one_class
variables [mul_one_class α] [covariant_class α α (*) (≤)]

@[to_additive]
lemma lt_of_mul_lt_of_one_le_left (h : a * b < c) (hle : 1 ≤ b) : a < c :=
(le_mul_of_one_le_right' hle).trans_lt h

@[to_additive]
lemma le_of_mul_le_of_one_le_left (h : a * b ≤ c) (hle : 1 ≤ b) : a ≤ c :=
(le_mul_of_one_le_right' hle).trans h

@[to_additive]
lemma lt_of_lt_mul_of_le_one_left (h : a < b * c) (hle : c ≤ 1) : a < b :=
h.trans_le (mul_le_of_le_one_right' hle)

@[to_additive]
lemma le_of_le_mul_of_le_one_left (h : a ≤ b * c) (hle : c ≤ 1) : a ≤ b :=
h.trans (mul_le_of_le_one_right' hle)

@[to_additive]
theorem mul_lt_of_lt_of_lt_one (bc : b < c) (a1 : a < 1) :
  b * a < c :=
calc  b * a ≤ b * 1 : mul_le_mul_left' a1.le _
        ... = b     : mul_one b
        ... < c     : bc

end mul_one_class

end left

section right

section preorder
variables [preorder α]

section has_mul
variables [has_mul α]

variable [covariant_class α α (swap (*)) (≤)]

@[to_additive]
lemma mul_lt_of_mul_lt_right (h : a * b < c) (hle : d ≤ a) :
  d * b < c :=
(mul_le_mul_right' hle b).trans_lt h

@[to_additive]
lemma mul_le_of_mul_le_right (h : a * b ≤ c) (hle : d ≤ a) :
  d * b ≤ c :=
(mul_le_mul_right' hle b).trans h

@[to_additive]
lemma lt_mul_of_lt_mul_right (h : a < b * c) (hle : b ≤ d) :
  a < d * c :=
h.trans_le (mul_le_mul_right' hle c)

@[to_additive]
lemma le_mul_of_le_mul_right (h : a ≤ b * c) (hle : b ≤ d) :
  a ≤ d * c :=
h.trans (mul_le_mul_right' hle c)

variable [covariant_class α α (*) (≤)]

@[to_additive add_le_add]
lemma mul_le_mul' (h₁ : a ≤ b) (h₂ : c ≤ d) : a * c ≤ b * d :=
(mul_le_mul_left' h₂ _).trans (mul_le_mul_right' h₁ d)

@[to_additive]
lemma mul_le_mul_three {e f : α} (h₁ : a ≤ d) (h₂ : b ≤ e) (h₃ : c ≤ f) :
  a * b * c ≤ d * e * f :=
mul_le_mul' (mul_le_mul' h₁ h₂) h₃

end has_mul

/-!  Here we start using properties of one, on the right. -/
section mul_one_class
variables [mul_one_class α]

section le_right
variable [covariant_class α α (swap (*)) (≤)]

@[to_additive le_add_of_nonneg_left]
lemma le_mul_of_one_le_left' (h : 1 ≤ b) : a ≤ b * a :=
calc  a = 1 * a : (one_mul a).symm
    ... ≤ b * a : mul_le_mul_right' h a

@[to_additive add_le_of_nonpos_left]
lemma mul_le_of_le_one_left' (h : b ≤ 1) : b * a ≤ a :=
calc  b * a ≤ 1 * a : mul_le_mul_right' h a
        ... = a     : one_mul a

@[to_additive]
lemma lt_of_mul_lt_of_one_le_right (h : a * b < c) (hle : 1 ≤ a) : b < c :=
(le_mul_of_one_le_left' hle).trans_lt h

@[to_additive]
lemma le_of_mul_le_of_one_le_right (h : a * b ≤ c) (hle : 1 ≤ a) : b ≤ c :=
(le_mul_of_one_le_left' hle).trans h

@[to_additive]
lemma lt_of_lt_mul_of_le_one_right (h : a < b * c) (hle : b ≤ 1) : a < c :=
h.trans_le (mul_le_of_le_one_left' hle)

@[to_additive]
lemma le_of_le_mul_of_le_one_right (h : a ≤ b * c) (hle : b ≤ 1) : a ≤ c :=
h.trans (mul_le_of_le_one_left' hle)

theorem mul_lt_of_lt_one_of_lt (a1 : a < 1) (bc : b < c) :
  a * b < c :=
calc  a * b ≤ 1 * b : mul_le_mul_right' a1.le _
        ... = b : one_mul b
        ... < c : bc

end le_right

section lt_right

@[to_additive lt_add_of_pos_left]
lemma lt_mul_of_one_lt_left' [covariant_class α α (swap (*)) (<)]
  (a : α) {b : α} (h : 1 < b) : a < b * a :=
calc a = 1 * a : (one_mul _).symm
   ... < b * a : mul_lt_mul_right' h a

end lt_right

end mul_one_class

end preorder

end right

section preorder
variables [preorder α]

section mul_one_class
variables [mul_one_class α]

section covariant_left
variable [covariant_class α α (*) (≤)]

@[to_additive add_pos_of_pos_of_nonneg]
lemma one_lt_mul_of_lt_of_le' (ha : 1 < a) (hb : 1 ≤ b) : 1 < a * b :=
lt_of_lt_of_le ha $ le_mul_of_one_le_right' hb

@[to_additive add_pos]
lemma one_lt_mul' (ha : 1 < a) (hb : 1 < b) : 1 < a * b :=
one_lt_mul_of_lt_of_le' ha hb.le

@[to_additive]
lemma lt_mul_of_lt_of_one_le' (hbc : b < c) (ha : 1 ≤ a) :
  b < c * a :=
hbc.trans_le $ le_mul_of_one_le_right' ha

@[to_additive]
lemma lt_mul_of_lt_of_one_lt' (hbc : b < c) (ha : 1 < a) :
  b < c * a :=
lt_mul_of_lt_of_one_le' hbc ha.le

@[to_additive]
lemma le_mul_of_le_of_one_le (hbc : b ≤ c) (ha : 1 ≤ a) : b ≤ c * a :=
calc  b ≤ c : hbc
    ... = c * 1 : (mul_one c).symm
    ... ≤ c * a : mul_le_mul_left' ha c

@[to_additive add_nonneg]
lemma one_le_mul_right (ha : 1 ≤ a) (hb : 1 ≤ b) : 1 ≤ a * b :=
calc  1 ≤ a     : ha
    ... = a * 1 : (mul_one a).symm
    ... ≤ a * b : mul_le_mul_left' hb a

end covariant_left

section covariant_right
variable [covariant_class α α (swap (*)) (≤)]

@[to_additive add_pos_of_nonneg_of_pos]
lemma one_lt_mul_of_le_of_lt' (ha : 1 ≤ a) (hb : 1 < b) : 1 < a * b :=
lt_of_lt_of_le hb $ le_mul_of_one_le_left' ha

@[to_additive]
lemma lt_mul_of_one_le_of_lt (ha : 1 ≤ a) (hbc : b < c) : b < a * c :=
hbc.trans_le $ le_mul_of_one_le_left' ha

@[to_additive]
lemma lt_mul_of_one_lt_of_lt (ha : 1 < a) (hbc : b < c) : b < a * c :=
lt_mul_of_one_le_of_lt ha.le hbc

end covariant_right

end mul_one_class

end preorder

section partial_order

/-!  Properties assuming `partial_order`. -/
variables [mul_one_class α] [partial_order α]
  [covariant_class α α (*) (≤)] [covariant_class α α (swap (*)) (≤)]

@[to_additive]
lemma mul_eq_one_iff' (ha : 1 ≤ a) (hb : 1 ≤ b) : a * b = 1 ↔ a = 1 ∧ b = 1 :=
iff.intro
  (assume hab : a * b = 1,
   have a ≤ 1, from hab ▸ le_mul_of_le_of_one_le le_rfl hb,
   have a = 1, from le_antisymm this ha,
   have b ≤ 1, from hab ▸ le_mul_of_one_le_of_le ha le_rfl,
   have b = 1, from le_antisymm this hb,
   and.intro ‹a = 1› ‹b = 1›)
  (assume ⟨ha', hb'⟩, by rw [ha', hb', mul_one])

end partial_order

section mono
variables [has_mul α] [preorder α] [preorder β] {f g : β → α}

@[to_additive monotone.const_add]
lemma monotone.const_mul' [covariant_class α α (*) (≤)] (hf : monotone f) (a : α) :
  monotone (λ x, a * f x) :=
λ x y h, mul_le_mul_left' (hf h) a

@[to_additive monotone.add_const]
lemma monotone.mul_const' [covariant_class α α (swap (*)) (≤)]
  (hf : monotone f) (a : α) : monotone (λ x, f x * a) :=
λ x y h, mul_le_mul_right' (hf h) a

/--  The product of two monotone functions is monotone. -/
@[to_additive monotone.add "The sum of two monotone functions is monotone."]
lemma monotone.mul' [covariant_class α α (*) (≤)] [covariant_class α α (swap (*)) (≤)]
  (hf : monotone f) (hg : monotone g) : monotone (λ x, f x * g x) :=
λ x y h, mul_le_mul' (hf h) (hg h)

section left
variables [covariant_class α α (*) (<)]

@[to_additive strict_mono.const_add]
lemma strict_mono.const_mul' (hf : strict_mono f) (c : α) :
  strict_mono (λ x, c * f x) :=
λ a b ab, mul_lt_mul_left' (hf ab) c

end left

section right
variables [covariant_class α α (swap (*)) (<)]

@[to_additive strict_mono.add_const]
lemma strict_mono.mul_const' (hf : strict_mono f) (c : α) :
  strict_mono (λ x, f x * c) :=
λ a b ab, mul_lt_mul_right' (hf ab) c

end right

/--  The product of two strictly monotone functions is strictly monotone. -/
@[to_additive strict_mono.add
"The sum of two strictly monotone functions is strictly monotone."]
lemma strict_mono.mul' [covariant_class α α (*) (<)] [covariant_class α α (swap (*)) (<)]
  (hf : strict_mono f) (hg : strict_mono g) :
  strict_mono (λ x, f x * g x) :=
λ a b ab, mul_lt_mul_of_lt_of_lt (hf ab) (hg ab)

/--  The product of a monotone function and a strictly monotone function is strictly monotone. -/
@[to_additive monotone.add_strict_mono
"The sum of a monotone function and a strictly monotone function is strictly monotone."]
lemma monotone.mul_strict_mono' [covariant_class α α (*) (<)] [covariant_class α α (swap (*)) (≤)]
  {f g : β → α} (hf : monotone f) (hg : strict_mono g) :
  strict_mono (λ x, f x * g x) :=
λ x y h, mul_lt_mul_of_le_of_lt (hf h.le) (hg h)

variables [covariant_class α α (*) (≤)] [covariant_class α α (swap (*)) (<)]

/--  The product of a strictly monotone function and a monotone function is strictly monotone. -/
@[to_additive strict_mono.add_monotone
"The sum of a strictly monotone function and a monotone function is strictly monotone."]
lemma strict_mono.mul_monotone' (hf : strict_mono f) (hg : monotone g) :
  strict_mono (λ x, f x * g x) :=
λ x y h, mul_lt_mul_of_lt_of_le (hf h) (hg h.le)

end mono

/--
An element `a : α` is `mul_le_cancellable` if `x ↦ a * x` is order-reflecting.
We will make a separate version of many lemmas that require `[contravariant_class α α (*) (≤)]` with
`mul_le_cancellable` assumptions instead. These lemmas can then be instantiated to specific types,
like `ennreal`, where we can replace the assumption `add_le_cancellable x` by `x ≠ ∞`.
-/
@[to_additive /-" An element `a : α` is `add_le_cancellable` if `x ↦ a + x` is order-reflecting.
We will make a separate version of many lemmas that require `[contravariant_class α α (+) (≤)]` with
`mul_le_cancellable` assumptions instead. These lemmas can then be instantiated to specific types,
like `ennreal`, where we can replace the assumption `add_le_cancellable x` by `x ≠ ∞`. "-/
]
def mul_le_cancellable [has_mul α] [has_le α] (a : α) : Prop :=
∀ ⦃b c⦄, a * b ≤ a * c → b ≤ c

@[to_additive]
lemma contravariant.mul_le_cancellable [has_mul α] [has_le α] [contravariant_class α α (*) (≤)]
  {a : α} : mul_le_cancellable a :=
λ b c, le_of_mul_le_mul_left'

namespace mul_le_cancellable

@[to_additive]
protected lemma injective [has_mul α] [partial_order α] {a : α} (ha : mul_le_cancellable a) :
  injective ((*) a) :=
λ b c h, le_antisymm (ha h.le) (ha h.ge)

@[to_additive]
protected lemma inj [has_mul α] [partial_order α] {a b c : α} (ha : mul_le_cancellable a) :
  a * b = a * c ↔ b = c :=
ha.injective.eq_iff

@[to_additive]
protected lemma injective_left [comm_semigroup α] [partial_order α] {a : α}
  (ha : mul_le_cancellable a) : injective (* a) :=
λ b c h, ha.injective $ by rwa [mul_comm a, mul_comm a]

@[to_additive]
protected lemma inj_left [comm_semigroup α] [partial_order α] {a b c : α}
  (hc : mul_le_cancellable c) : a * c = b * c ↔ a = b :=
hc.injective_left.eq_iff

variable [has_le α]

@[to_additive]
protected lemma mul_le_mul_iff_left [has_mul α] [covariant_class α α (*) (≤)]
  {a b c : α} (ha : mul_le_cancellable a) : a * b ≤ a * c ↔ b ≤ c :=
⟨λ h, ha h, λ h, mul_le_mul_left' h a⟩

@[to_additive]
protected lemma mul_le_mul_iff_right [comm_semigroup α] [covariant_class α α (*) (≤)]
  {a b c : α} (ha : mul_le_cancellable a) : b * a ≤ c * a ↔ b ≤ c :=
by rw [mul_comm b, mul_comm c, ha.mul_le_mul_iff_left]

@[to_additive]
protected lemma le_mul_iff_one_le_right [mul_one_class α] [covariant_class α α (*) (≤)]
  {a b : α} (ha : mul_le_cancellable a) : a ≤ a * b ↔ 1 ≤ b :=
iff.trans (by rw [mul_one]) ha.mul_le_mul_iff_left

@[to_additive]
protected lemma mul_le_iff_le_one_right [mul_one_class α] [covariant_class α α (*) (≤)]
  {a b : α} (ha : mul_le_cancellable a) : a * b ≤ a ↔ b ≤ 1 :=
iff.trans (by rw [mul_one]) ha.mul_le_mul_iff_left

@[to_additive]
protected lemma le_mul_iff_one_le_left [comm_monoid α] [covariant_class α α (*) (≤)]
  {a b : α} (ha : mul_le_cancellable a) : a ≤ b * a ↔ 1 ≤ b :=
by rw [mul_comm, ha.le_mul_iff_one_le_right]

@[to_additive]
protected lemma mul_le_iff_le_one_left [comm_monoid α] [covariant_class α α (*) (≤)]
  {a b : α} (ha : mul_le_cancellable a) : b * a ≤ a ↔ b ≤ 1 :=
by rw [mul_comm, ha.mul_le_iff_le_one_right]

end mul_le_cancellable