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

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

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

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_`)
`covariant_class`es to assume that multiplication by positive elements is (strictly) monotone on a
`mul_zero_class`, `monoid_with_zero`,...
More specifically, we use extensively the following typeclasses:

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

## Notation

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

variable (α : Type*)

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

section abbreviations
variables [has_mul α] [has_zero α] [preorder α]

/-- `pos_mul_mono α` is an abbreviation for `covariant_class α≥0 α (λ x y, x * y) (≤)`,
expressing that multiplication by nonnegative elements on the left is monotone. -/
abbreviation pos_mul_mono : Prop := covariant_class α≥0 α (λ x y, x * y) (≤)

/-- `mul_pos_mono α` is an abbreviation for `covariant_class α≥0 α (λ x y, y * x) (≤)`,
expressing that multiplication by nonnegative elements on the right is monotone. -/
abbreviation mul_pos_mono : Prop := covariant_class α≥0 α (λ x y, y * x) (≤)

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

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

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

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

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

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

end abbreviations

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

section has_mul_zero
variables [has_mul α] [has_zero α]

section preorder
variables [preorder α]

instance pos_mul_mono.to_covariant_class_pos_mul_le [pos_mul_mono α] :
  covariant_class α>0 α (λ x y, x * y) (≤) :=
⟨λ a b c bc, @covariant_class.elim α≥0 α (λ x y, x * y) (≤) _ ⟨_, a.2.le⟩ _ _ bc⟩

instance mul_pos_mono.to_covariant_class_pos_mul_le [mul_pos_mono α] :
  covariant_class α>0 α (λ x y, y * x) (≤) :=
⟨λ a b c bc, @covariant_class.elim α≥0 α (λ x y, y * x) (≤) _ ⟨_, a.2.le⟩ _ _ bc⟩

instance pos_mul_reflect_lt.to_contravariant_class_pos_mul_lt [pos_mul_reflect_lt α] :
  contravariant_class α>0 α (λ x y, x * y) (<) :=
⟨λ a b c bc, @contravariant_class.elim α≥0 α (λ x y, x * y) (<) _ ⟨_, a.2.le⟩ _ _ bc⟩

instance mul_pos_reflect_lt.to_contravariant_class_pos_mul_lt [mul_pos_reflect_lt α] :
  contravariant_class α>0 α (λ x y, y * x) (<) :=
⟨λ a b c bc, @contravariant_class.elim α≥0 α (λ x y, y * x) (<) _ ⟨_, a.2.le⟩ _ _ bc⟩

lemma mul_le_mul_of_nonneg_left [pos_mul_mono α] (h : b ≤ c) (a0 : 0 ≤ a) : a * b ≤ a * c :=
@covariant_class.elim α≥0 α (λ x y, x * y) (≤) _ ⟨a, a0⟩ _ _ h

lemma mul_le_mul_of_nonneg_right [mul_pos_mono α] (h : b ≤ c) (a0 : 0 ≤ a) : b * a ≤ c * a :=
@covariant_class.elim α≥0 α (λ x y, y * x) (≤) _ ⟨a, a0⟩ _ _ h

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

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

lemma lt_of_mul_lt_mul_left [pos_mul_reflect_lt α] (h : a * b < a * c) (a0 : 0 ≤ a) : b < c :=
@contravariant_class.elim α≥0 α (λ x y, x * y) (<) _ ⟨a, a0⟩ _ _ h

lemma lt_of_mul_lt_mul_right [mul_pos_reflect_lt α] (h : b * a < c * a) (a0 : 0 ≤ a) : b < c :=
@contravariant_class.elim α≥0 α (λ x y, y * x) (<) _ ⟨a, a0⟩ _ _ h

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

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

alias lt_of_mul_lt_mul_left  ← lt_of_mul_lt_mul_of_nonneg_left
alias lt_of_mul_lt_mul_right ← lt_of_mul_lt_mul_of_nonneg_right
alias le_of_mul_le_mul_left  ← le_of_mul_le_mul_of_pos_left
alias le_of_mul_le_mul_right ← le_of_mul_le_mul_of_pos_right

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

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

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

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

lemma mul_lt_mul_of_pos_of_nonneg [pos_mul_strict_mono α] [mul_pos_mono α]
  (h₁ : a ≤ b) (h₂ : c < d) (a0 : 0 < a) (d0 : 0 ≤ d) : a * c < b * d :=
(mul_lt_mul_of_pos_left h₂ a0).trans_le (mul_le_mul_of_nonneg_right h₁ d0)

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

lemma mul_lt_mul_of_nonneg_of_pos [pos_mul_mono α] [mul_pos_strict_mono α]
  (h₁ : a < b) (h₂ : c ≤ d) (a0 : 0 ≤ a) (d0 : 0 < d) : a * c < b * d :=
(mul_le_mul_of_nonneg_left h₂ a0).trans_lt (mul_lt_mul_of_pos_right h₁ d0)

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

lemma mul_lt_mul_of_pos_of_pos [pos_mul_strict_mono α] [mul_pos_strict_mono α]
  (h₁ : a < b) (h₂ : c < d) (a0 : 0 < a) (d0 : 0 < d) : a * c < b * d :=
(mul_lt_mul_of_pos_left h₂ a0).trans (mul_lt_mul_of_pos_right h₁ d0)

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

lemma mul_lt_of_mul_lt_of_nonneg_left [pos_mul_mono α] (h : a * b < c) (hdb : d ≤ b) (ha : 0 ≤ a) :
  a * d < c :=
(mul_le_mul_of_nonneg_left hdb ha).trans_lt h

lemma lt_mul_of_lt_mul_of_nonneg_left [pos_mul_mono α] (h : a < b * c) (hcd : c ≤ d) (hb : 0 ≤ b) :
  a < b * d :=
h.trans_le $ mul_le_mul_of_nonneg_left hcd hb

lemma mul_lt_of_mul_lt_of_nonneg_right [mul_pos_mono α] (h : a * b < c) (hda : d ≤ a) (hb : 0 ≤ b) :
  d * b < c :=
(mul_le_mul_of_nonneg_right hda hb).trans_lt h

lemma lt_mul_of_lt_mul_of_nonneg_right [mul_pos_mono α] (h : a < b * c) (hbd : b ≤ d) (hc : 0 ≤ c) :
  a < d * c :=
h.trans_le $ mul_le_mul_of_nonneg_right hbd hc

end preorder

section linear_order
variables [linear_order α]

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

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

lemma pos_mul_mono_rev.to_pos_mul_strict_mono [pos_mul_mono_rev α] : pos_mul_strict_mono α :=
⟨λ x a b h, lt_of_not_le $ λ h', h.not_le $ le_of_mul_le_mul_of_pos_left h' x.prop⟩

lemma mul_pos_mono_rev.to_mul_pos_strict_mono [mul_pos_mono_rev α] : mul_pos_strict_mono α :=
⟨λ x a b h, lt_of_not_le $ λ h', h.not_le $ le_of_mul_le_mul_of_pos_right h' x.prop⟩

lemma pos_mul_strict_mono_iff_pos_mul_mono_rev : pos_mul_strict_mono α ↔ pos_mul_mono_rev α :=
⟨@pos_mul_strict_mono.to_pos_mul_mono_rev _ _ _ _, @pos_mul_mono_rev.to_pos_mul_strict_mono _ _ _ _⟩

lemma mul_pos_strict_mono_iff_mul_pos_mono_rev : mul_pos_strict_mono α ↔ mul_pos_mono_rev α :=
⟨@mul_pos_strict_mono.to_mul_pos_mono_rev _ _ _ _, @mul_pos_mono_rev.to_mul_pos_strict_mono _ _ _ _⟩

lemma pos_mul_reflect_lt.to_pos_mul_mono [pos_mul_reflect_lt α] : pos_mul_mono α :=
⟨λ x a b h, le_of_not_lt $ λ h', h.not_lt $ lt_of_mul_lt_mul_left h' x.prop⟩

lemma mul_pos_reflect_lt.to_mul_pos_mono [mul_pos_reflect_lt α] : mul_pos_mono α :=
⟨λ x a b h, le_of_not_lt $ λ h', h.not_lt $ lt_of_mul_lt_mul_right h' x.prop⟩

lemma pos_mul_mono.to_pos_mul_reflect_lt [pos_mul_mono α] : pos_mul_reflect_lt α :=
⟨λ x a b h, lt_of_not_le $ λ h', h.not_le $ mul_le_mul_of_nonneg_left h' x.prop⟩

lemma mul_pos_mono.to_mul_pos_reflect_lt [mul_pos_mono α] : mul_pos_reflect_lt α :=
⟨λ x a b h, lt_of_not_le $ λ h', h.not_le $ mul_le_mul_of_nonneg_right h' x.prop⟩

lemma pos_mul_mono_iff_pos_mul_reflect_lt : pos_mul_mono α ↔ pos_mul_reflect_lt α :=
⟨@pos_mul_mono.to_pos_mul_reflect_lt _ _ _ _, @pos_mul_reflect_lt.to_pos_mul_mono _ _ _ _⟩

lemma mul_pos_mono_iff_mul_pos_reflect_lt : mul_pos_mono α ↔ mul_pos_reflect_lt α :=
⟨@mul_pos_mono.to_mul_pos_reflect_lt _ _ _ _, @mul_pos_reflect_lt.to_mul_pos_mono _ _ _ _⟩

end linear_order

end has_mul_zero

section mul_zero_class
variables [mul_zero_class α]

section preorder
variables [preorder α]

/-- Assumes left covariance. -/
lemma left.mul_pos [pos_mul_strict_mono α] (ha : 0 < a) (hb : 0 < b) : 0 < a * b :=
by simpa only [mul_zero] using mul_lt_mul_of_pos_left hb ha

alias left.mul_pos ← mul_pos

lemma mul_neg_of_pos_of_neg [pos_mul_strict_mono α] (ha : 0 < a) (hb : b < 0) : a * b < 0 :=
by simpa only [mul_zero] using mul_lt_mul_of_pos_left hb ha

@[simp] lemma zero_lt_mul_left [pos_mul_strict_mono α] [pos_mul_reflect_lt α] (h : 0 < c) :
  0 < c * b ↔ 0 < b :=
by { convert mul_lt_mul_left h, simp }

/-- Assumes right covariance. -/
lemma right.mul_pos [mul_pos_strict_mono α] (ha : 0 < a) (hb : 0 < b) : 0 < a * b :=
by simpa only [zero_mul] using mul_lt_mul_of_pos_right ha hb

lemma mul_neg_of_neg_of_pos [mul_pos_strict_mono α] (ha : a < 0) (hb : 0 < b) : a * b < 0 :=
by simpa only [zero_mul] using mul_lt_mul_of_pos_right ha hb

@[simp] lemma zero_lt_mul_right [mul_pos_strict_mono α] [mul_pos_reflect_lt α] (h : 0 < c) :
  0 < b * c ↔ 0 < b :=
by { convert mul_lt_mul_right h, simp }

/-- Assumes left covariance. -/
lemma left.mul_nonneg [pos_mul_mono α] (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a * b :=
by simpa only [mul_zero] using mul_le_mul_of_nonneg_left hb ha

alias left.mul_nonneg ← mul_nonneg

lemma mul_nonpos_of_nonneg_of_nonpos [pos_mul_mono α] (ha : 0 ≤ a) (hb : b ≤ 0) : a * b ≤ 0 :=
by simpa only [mul_zero] using mul_le_mul_of_nonneg_left hb ha

/-- Assumes right covariance. -/
lemma right.mul_nonneg [mul_pos_mono α] (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a * b :=
by simpa only [zero_mul] using mul_le_mul_of_nonneg_right ha hb

lemma mul_nonpos_of_nonpos_of_nonneg [mul_pos_mono α] (ha : a ≤ 0) (hb : 0 ≤ b) : a * b ≤ 0 :=
by simpa only [zero_mul] using mul_le_mul_of_nonneg_right ha hb

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

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

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

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

lemma mul_le_mul [pos_mul_mono α] [mul_pos_mono α]
  (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

lemma mul_self_le_mul_self [pos_mul_mono α] [mul_pos_mono α] (ha : 0 ≤ a) (hab : a ≤ b) :
  a * a ≤ b * b :=
mul_le_mul hab hab ha $ ha.trans hab

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

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

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

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

end preorder

section partial_order
variables [partial_order α]

lemma pos_mul_mono_iff_covariant_pos : pos_mul_mono α ↔ covariant_class α>0 α (λ x y, x * y) (≤) :=
⟨@pos_mul_mono.to_covariant_class_pos_mul_le _ _ _ _, λ h, ⟨λ a b c h, begin
    obtain ha | ha := a.prop.eq_or_gt,
    { simp only [ha, zero_mul] },
    { exactI @covariant_class.elim α>0 α (λ x y, x * y) (≤) _ ⟨_, ha⟩ _ _ h }
  end⟩⟩

lemma mul_pos_mono_iff_covariant_pos : mul_pos_mono α ↔ covariant_class α>0 α (λ x y, y * x) (≤) :=
⟨@mul_pos_mono.to_covariant_class_pos_mul_le _ _ _ _, λ h, ⟨λ a b c h, begin
    obtain ha | ha := a.prop.eq_or_gt,
    { simp only [ha, mul_zero] },
    { exactI @covariant_class.elim α>0 α (λ x y, y * x) (≤) _ ⟨_, ha⟩ _ _ h }
  end⟩⟩

lemma pos_mul_reflect_lt_iff_contravariant_pos :
  pos_mul_reflect_lt α ↔ contravariant_class α>0 α (λ x y, x * y) (<) :=
⟨@pos_mul_reflect_lt.to_contravariant_class_pos_mul_lt _ _ _ _, λ h, ⟨λ a b c h, begin
    obtain ha | ha := a.prop.eq_or_gt,
    { simpa [ha] using h },
    { exactI (@contravariant_class.elim α>0 α (λ x y, x * y) (<) _ ⟨_, ha⟩ _ _ h) }
  end⟩⟩

lemma mul_pos_reflect_lt_iff_contravariant_pos :
  mul_pos_reflect_lt α ↔ contravariant_class α>0 α (λ x y, y * x) (<) :=
⟨@mul_pos_reflect_lt.to_contravariant_class_pos_mul_lt _ _ _ _, λ h, ⟨λ a b c h, begin
    obtain ha | ha := a.prop.eq_or_gt,
    { simpa [ha] using h },
    { exactI (@contravariant_class.elim α>0 α (λ x y, y * x) (<) _ ⟨_, ha⟩ _ _ h) }
  end⟩⟩

@[priority 100] -- see Note [lower instance priority]
instance pos_mul_strict_mono.to_pos_mul_mono [pos_mul_strict_mono α] : pos_mul_mono α :=
pos_mul_mono_iff_covariant_pos.2 $ ⟨λ a, strict_mono.monotone $ @covariant_class.elim _ _ _ _ _ _⟩

@[priority 100] -- see Note [lower instance priority]
instance mul_pos_strict_mono.to_mul_pos_mono [mul_pos_strict_mono α] : mul_pos_mono α :=
mul_pos_mono_iff_covariant_pos.2 $ ⟨λ a, strict_mono.monotone $ @covariant_class.elim _ _ _ _ _ _⟩

@[priority 100] -- see Note [lower instance priority]
instance pos_mul_mono_rev.to_pos_mul_reflect_lt [pos_mul_mono_rev α] : pos_mul_reflect_lt α :=
pos_mul_reflect_lt_iff_contravariant_pos.2
  ⟨λ a b c h, (le_of_mul_le_mul_of_pos_left h.le a.2).lt_of_ne $ by { rintro rfl, simpa using h }⟩

@[priority 100] -- see Note [lower instance priority]
instance mul_pos_mono_rev.to_mul_pos_reflect_lt [mul_pos_mono_rev α] : mul_pos_reflect_lt α :=
mul_pos_reflect_lt_iff_contravariant_pos.2
  ⟨λ a b c h, (le_of_mul_le_mul_of_pos_right h.le a.2).lt_of_ne $ by { rintro rfl, simpa using h }⟩

lemma mul_left_cancel_iff_of_pos [pos_mul_mono_rev α] (a0 : 0 < a) : a * b = a * c ↔ b = c :=
⟨λ 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 _⟩

lemma mul_right_cancel_iff_of_pos [mul_pos_mono_rev α] (b0 : 0 < b) : a * b = c * b ↔ a = c :=
⟨λ 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 _⟩

lemma mul_eq_mul_iff_eq_and_eq_of_pos [pos_mul_strict_mono α] [mul_pos_strict_mono α]
  [pos_mul_mono_rev α] [mul_pos_mono_rev α]
  (hac : a ≤ b) (hbd : c ≤ d) (a0 : 0 < a) (d0 : 0 < d) :
  a * c = b * d ↔ a = b ∧ c = d :=
begin
  refine ⟨λ h, _, λ h, congr_arg2 (*) h.1 h.2⟩,
  rcases hac.eq_or_lt with rfl | hac,
  { exact ⟨rfl, (mul_left_cancel_iff_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,
end

lemma mul_eq_mul_iff_eq_and_eq_of_pos' [pos_mul_strict_mono α] [mul_pos_strict_mono α]
  [pos_mul_mono_rev α] [mul_pos_mono_rev α]
  (hac : a ≤ b) (hbd : c ≤ d) (b0 : 0 < b) (c0 : 0 < c) :
  a * c = b * d ↔ a = b ∧ c = d :=
begin
  refine ⟨λ h, _, λ h, congr_arg2 (*) h.1 h.2⟩,
  rcases hac.eq_or_lt with rfl | hac,
  { exact ⟨rfl, (mul_left_cancel_iff_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,
end

end partial_order

section linear_order
variables [linear_order α]

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

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

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

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

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

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

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

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

end linear_order

end mul_zero_class

section mul_one_class
variables [mul_one_class α] [has_zero α]

section preorder
variables [preorder α]

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

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

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

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

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

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

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

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

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

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

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

lemma mul_le_of_le_one_left [mul_pos_mono α] (hb : 0 ≤ b) (h : a ≤ 1) : a * b ≤ b :=
by simpa only [one_mul] using mul_le_mul_of_nonneg_right h hb

lemma le_mul_of_one_le_left [mul_pos_mono α] (hb : 0 ≤ b) (h : 1 ≤ a) : b ≤ a * b :=
by simpa only [one_mul] using mul_le_mul_of_nonneg_right h hb

lemma mul_le_of_le_one_right [pos_mul_mono α] (ha : 0 ≤ a) (h : b ≤ 1) : a * b ≤ a :=
by simpa only [mul_one] using mul_le_mul_of_nonneg_left h ha

lemma le_mul_of_one_le_right [pos_mul_mono α] (ha : 0 ≤ a) (h : 1 ≤ b) : a ≤ a * b :=
by simpa only [mul_one] using mul_le_mul_of_nonneg_left h ha

lemma mul_lt_of_lt_one_left [mul_pos_strict_mono α] (hb : 0 < b) (h : a < 1) : a * b < b :=
by simpa only [one_mul] using mul_lt_mul_of_pos_right h hb

lemma lt_mul_of_one_lt_left [mul_pos_strict_mono α] (hb : 0 < b) (h : 1 < a) : b < a * b :=
by simpa only [one_mul] using mul_lt_mul_of_pos_right h hb

lemma mul_lt_of_lt_one_right [pos_mul_strict_mono α] (ha : 0 < a) (h : b < 1) : a * b < a :=
by simpa only [mul_one] using mul_lt_mul_of_pos_left h ha

lemma lt_mul_of_one_lt_right [pos_mul_strict_mono α] (ha : 0 < a) (h : 1 < b) : a < a * b :=
by simpa only [mul_one] using mul_lt_mul_of_pos_left h ha

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

lemma mul_le_of_le_of_le_one_of_nonneg [pos_mul_mono α] (h : b ≤ c) (ha : a ≤ 1) (hb : 0 ≤ b) :
  b * a ≤ c :=
(mul_le_of_le_one_right hb ha).trans h

lemma mul_lt_of_le_of_lt_one_of_pos [pos_mul_strict_mono α] (bc : b ≤ c) (ha : a < 1) (b0 : 0 < b) :
  b * a < c :=
(mul_lt_of_lt_one_right b0 ha).trans_le bc

lemma mul_lt_of_lt_of_le_one_of_nonneg [pos_mul_mono α] (h : b < c) (ha : a ≤ 1) (hb : 0 ≤ b) :
  b * a < c :=
(mul_le_of_le_one_right hb ha).trans_lt h

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

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

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

lemma mul_le_of_le_of_le_one' [pos_mul_mono α] [mul_pos_mono α]
  (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

lemma mul_lt_of_lt_of_le_one' [pos_mul_mono α] [mul_pos_strict_mono α]
  (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

lemma mul_lt_of_le_of_lt_one' [pos_mul_strict_mono α] [mul_pos_mono α]
  (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

lemma mul_lt_of_lt_of_lt_one_of_pos [pos_mul_mono α] [mul_pos_strict_mono α]
  (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

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

lemma le_mul_of_le_of_one_le_of_nonneg [pos_mul_mono α] (h : b ≤ c) (ha : 1 ≤ a) (hc : 0 ≤ c) :
  b ≤ c * a :=
h.trans $ le_mul_of_one_le_right hc ha

lemma lt_mul_of_le_of_one_lt_of_pos [pos_mul_strict_mono α] (bc : b ≤ c) (ha : 1 < a) (c0 : 0 < c) :
  b < c * a :=
bc.trans_lt $ lt_mul_of_one_lt_right c0 ha

lemma lt_mul_of_lt_of_one_le_of_nonneg [pos_mul_mono α] (h : b < c) (ha : 1 ≤ a) (hc : 0 ≤ c) :
  b < c * a :=
h.trans_le $ le_mul_of_one_le_right hc ha

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

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

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

lemma le_mul_of_le_of_one_le' [pos_mul_mono α] [mul_pos_mono α]
  (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

lemma lt_mul_of_le_of_one_lt' [pos_mul_strict_mono α] [mul_pos_mono α]
  (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

lemma lt_mul_of_lt_of_one_le' [pos_mul_mono α] [mul_pos_strict_mono α]
  (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

lemma lt_mul_of_lt_of_one_lt_of_pos [pos_mul_strict_mono α] [mul_pos_strict_mono α]
  (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

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

lemma mul_le_of_le_one_of_le_of_nonneg [mul_pos_mono α] (ha : a ≤ 1) (h : b ≤ c) (hb : 0 ≤ b) :
  a * b ≤ c :=
(mul_le_of_le_one_left hb ha).trans h

lemma mul_lt_of_lt_one_of_le_of_pos [mul_pos_strict_mono α] (ha : a < 1) (h : b ≤ c) (hb : 0 < b) :
  a * b < c :=
(mul_lt_of_lt_one_left hb ha).trans_le h

lemma mul_lt_of_le_one_of_lt_of_nonneg [mul_pos_mono α] (ha : a ≤ 1) (h : b < c) (hb : 0 ≤ b) :
  a * b < c :=
(mul_le_of_le_one_left hb ha).trans_lt h

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

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

lemma mul_lt_of_lt_one_of_lt_of_pos [pos_mul_strict_mono α] [mul_pos_strict_mono α]
  (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

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

lemma mul_le_of_le_one_of_le' [pos_mul_mono α] [mul_pos_mono α]
  (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

lemma mul_lt_of_lt_one_of_le' [pos_mul_mono α] [mul_pos_strict_mono α]
  (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

lemma mul_lt_of_le_one_of_lt' [pos_mul_strict_mono α] [mul_pos_mono α]
  (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

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

lemma lt_mul_of_one_lt_of_le_of_pos [mul_pos_strict_mono α] (ha : 1 < a) (h : b ≤ c) (hc : 0 < c) :
  b < a * c :=
h.trans_lt $ lt_mul_of_one_lt_left hc ha

lemma lt_mul_of_one_le_of_lt_of_nonneg [mul_pos_mono α] (ha : 1 ≤ a) (h : b < c) (hc : 0 ≤ c) :
  b < a * c :=
h.trans_le $ le_mul_of_one_le_left hc ha

lemma lt_mul_of_one_lt_of_lt_of_pos [mul_pos_strict_mono α] (ha : 1 < a) (h : b < c) (hc : 0 < c) :
  b < a * c :=
h.trans $ lt_mul_of_one_lt_left hc ha

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

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

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

lemma lt_mul_of_one_lt_of_lt_of_nonneg [mul_pos_mono α] (ha : 1 ≤ a) (h : b < c) (hc : 0 ≤ c) :
  b < a * c :=
h.trans_le $ le_mul_of_one_le_left hc ha

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

lemma lt_of_lt_mul_of_le_one_of_nonneg_left [pos_mul_mono α] (h : a < b * c) (hc : c ≤ 1)
  (hb : 0 ≤ b) :
  a < b :=
h.trans_le $ mul_le_of_le_one_right hb hc

lemma lt_of_lt_mul_of_le_one_of_nonneg_right [mul_pos_mono α] (h : a < b * c) (hb : b ≤ 1)
  (hc : 0 ≤ c) :
  a < c :=
h.trans_le $ mul_le_of_le_one_left hc hb

lemma le_mul_of_one_le_of_le_of_nonneg [mul_pos_mono α] (ha : 1 ≤ a) (bc : b ≤ c) (c0 : 0 ≤ c) :
  b ≤ a * c :=
bc.trans $ le_mul_of_one_le_left c0 ha

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

lemma le_of_mul_le_of_one_le_of_nonneg_left [pos_mul_mono α] (h : a * b ≤ c) (hb : 1 ≤ b)
  (ha : 0 ≤ a) :
  a ≤ c :=
(le_mul_of_one_le_right ha hb).trans h

lemma le_of_le_mul_of_le_one_of_nonneg_left [pos_mul_mono α] (h : a ≤ b * c) (hc : c ≤ 1)
  (hb : 0 ≤ b) :
  a ≤ b :=
h.trans $ mul_le_of_le_one_right hb hc

lemma le_of_mul_le_of_one_le_nonneg_right [mul_pos_mono α] (h : a * b ≤ c) (ha : 1 ≤ a)
  (hb : 0 ≤ b) :
  b ≤ c :=
(le_mul_of_one_le_left hb ha).trans h

lemma le_of_le_mul_of_le_one_of_nonneg_right [mul_pos_mono α] (h : a ≤ b * c) (hb : b ≤ 1)
  (hc : 0 ≤ c) :
  a ≤ c :=
h.trans $ mul_le_of_le_one_left hc hb

end preorder

section linear_order
variables [linear_order α]

-- 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`
lemma exists_square_le' [pos_mul_strict_mono α] (a0 : 0 < a) : ∃ (b : α), b * b ≤ a :=
begin
  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⟩ }
end

end linear_order
end mul_one_class

section cancel_monoid_with_zero

variables [cancel_monoid_with_zero α]

section partial_order
variables [partial_order α]

lemma pos_mul_mono.to_pos_mul_strict_mono [pos_mul_mono α] : pos_mul_strict_mono α :=
⟨λ x a b h, (mul_le_mul_of_nonneg_left h.le x.2.le).lt_of_ne (h.ne ∘ mul_left_cancel₀ x.2.ne')⟩

lemma pos_mul_mono_iff_pos_mul_strict_mono : pos_mul_mono α ↔ pos_mul_strict_mono α :=
⟨@pos_mul_mono.to_pos_mul_strict_mono α _ _, @pos_mul_strict_mono.to_pos_mul_mono α _ _⟩

lemma mul_pos_mono.to_mul_pos_strict_mono [mul_pos_mono α] : mul_pos_strict_mono α :=
⟨λ x a b h, (mul_le_mul_of_nonneg_right h.le x.2.le).lt_of_ne (h.ne ∘ mul_right_cancel₀ x.2.ne')⟩

lemma mul_pos_mono_iff_mul_pos_strict_mono : mul_pos_mono α ↔ mul_pos_strict_mono α :=
⟨@mul_pos_mono.to_mul_pos_strict_mono α _ _, @mul_pos_strict_mono.to_mul_pos_mono α _ _⟩

lemma pos_mul_reflect_lt.to_pos_mul_mono_rev [pos_mul_reflect_lt α] : pos_mul_mono_rev α :=
⟨λ x a b h, h.eq_or_lt.elim (le_of_eq ∘ mul_left_cancel₀ x.2.ne.symm)
                            (λ h', (lt_of_mul_lt_mul_left h' x.2.le).le)⟩

lemma pos_mul_mono_rev_iff_pos_mul_reflect_lt : pos_mul_mono_rev α ↔ pos_mul_reflect_lt α :=
⟨@pos_mul_mono_rev.to_pos_mul_reflect_lt α _ _, @pos_mul_reflect_lt.to_pos_mul_mono_rev α _ _⟩

lemma mul_pos_reflect_lt.to_mul_pos_mono_rev [mul_pos_reflect_lt α] : mul_pos_mono_rev α :=
⟨λ x a b h, h.eq_or_lt.elim (le_of_eq ∘ mul_right_cancel₀ x.2.ne.symm)
                            (λ h', (lt_of_mul_lt_mul_right h' x.2.le).le)⟩

lemma mul_pos_mono_rev_iff_mul_pos_reflect_lt : mul_pos_mono_rev α ↔ mul_pos_reflect_lt α :=
⟨@mul_pos_mono_rev.to_mul_pos_reflect_lt α _ _, @mul_pos_reflect_lt.to_mul_pos_mono_rev α _ _⟩

end partial_order

end cancel_monoid_with_zero

section comm_semigroup_has_zero
variables [comm_semigroup α] [has_zero α] [preorder α]

lemma pos_mul_strict_mono_iff_mul_pos_strict_mono :
  pos_mul_strict_mono α ↔ mul_pos_strict_mono α :=
by simp ! only [mul_comm]

lemma pos_mul_reflect_lt_iff_mul_pos_reflect_lt :
  pos_mul_reflect_lt α ↔ mul_pos_reflect_lt α :=
by simp ! only [mul_comm]

lemma pos_mul_mono_iff_mul_pos_mono :
  pos_mul_mono α ↔ mul_pos_mono α :=
by simp ! only [mul_comm]

lemma pos_mul_mono_rev_iff_mul_pos_mono_rev :
  pos_mul_mono_rev α ↔ mul_pos_mono_rev α :=
by simp ! only [mul_comm]

end comm_semigroup_has_zero


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro

! This file was ported from Lean 3 source module data.nat.prime_fin
! leanprover-community/mathlib commit 327c3c0d9232d80e250dc8f65e7835b82b266ea5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Nat.Factors
import Mathbin.Data.Set.Finite

/-!
# Prime numbers

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

This file contains some results about prime numbers which depend on finiteness of sets.
-/

namespace Nat

#print Nat.infinite_setOf_prime /-
/-- A version of `nat.exists_infinite_primes` using the `set.infinite` predicate. -/
theorem infinite_setOf_prime : { p | Prime p }.Infinite :=
  Set.infinite_of_not_bddAbove not_bddAbove_setOf_prime
#align nat.infinite_set_of_prime Nat.infinite_setOf_prime
-/

/- warning: nat.factors_mul_to_finset -> Nat.factors_mul_toFinset is a dubious translation:
lean 3 declaration is
  forall {a : Nat} {b : Nat}, (Ne.{1} Nat a (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero)))) -> (Ne.{1} Nat b (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero)))) -> (Eq.{1} (Finset.{0} Nat) (List.toFinset.{0} Nat (fun (a : Nat) (b : Nat) => Nat.decidableEq a b) (Nat.factors (HMul.hMul.{0, 0, 0} Nat Nat Nat (instHMul.{0} Nat Nat.hasMul) a b))) (Union.union.{0} (Finset.{0} Nat) (Finset.hasUnion.{0} Nat (fun (a : Nat) (b : Nat) => Nat.decidableEq a b)) (List.toFinset.{0} Nat (fun (a : Nat) (b : Nat) => Nat.decidableEq a b) (Nat.factors a)) (List.toFinset.{0} Nat (fun (a : Nat) (b : Nat) => Nat.decidableEq a b) (Nat.factors b))))
but is expected to have type
  forall {a : Nat} {b : Nat}, (Ne.{1} Nat a (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))) -> (Ne.{1} Nat b (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))) -> (Eq.{1} (Finset.{0} Nat) (List.toFinset.{0} Nat (fun (a : Nat) (b : Nat) => instDecidableEqNat a b) (Nat.factors (HMul.hMul.{0, 0, 0} Nat Nat Nat (instHMul.{0} Nat instMulNat) a b))) (Union.union.{0} (Finset.{0} Nat) (Finset.instUnionFinset.{0} Nat (fun (a : Nat) (b : Nat) => instDecidableEqNat a b)) (List.toFinset.{0} Nat (fun (a : Nat) (b : Nat) => instDecidableEqNat a b) (Nat.factors a)) (List.toFinset.{0} Nat (fun (a : Nat) (b : Nat) => instDecidableEqNat a b) (Nat.factors b))))
Case conversion may be inaccurate. Consider using '#align nat.factors_mul_to_finset Nat.factors_mul_toFinsetₓ'. -/
/-- If `a`, `b` are positive, the prime divisors of `a * b` are the union of those of `a` and `b` -/
theorem factors_mul_toFinset {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) :
    (a * b).factors.toFinset = a.factors.toFinset ∪ b.factors.toFinset :=
  (List.toFinset.ext fun x => (mem_factors_mul ha hb).trans List.mem_union.symm).trans <|
    List.toFinset_union _ _
#align nat.factors_mul_to_finset Nat.factors_mul_toFinset

/- warning: nat.pow_succ_factors_to_finset -> Nat.pow_succ_factors_toFinset is a dubious translation:
lean 3 declaration is
  forall (n : Nat) (k : Nat), Eq.{1} (Finset.{0} Nat) (List.toFinset.{0} Nat (fun (a : Nat) (b : Nat) => Nat.decidableEq a b) (Nat.factors (HPow.hPow.{0, 0, 0} Nat Nat Nat (instHPow.{0, 0} Nat Nat (Monoid.Pow.{0} Nat Nat.monoid)) n (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) k (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))))) (List.toFinset.{0} Nat (fun (a : Nat) (b : Nat) => Nat.decidableEq a b) (Nat.factors n))
but is expected to have type
  forall (n : Nat) (k : Nat), Eq.{1} (Finset.{0} Nat) (List.toFinset.{0} Nat (fun (a : Nat) (b : Nat) => instDecidableEqNat a b) (Nat.factors (HPow.hPow.{0, 0, 0} Nat Nat Nat (instHPow.{0, 0} Nat Nat instPowNat) n (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) k (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))))) (List.toFinset.{0} Nat (fun (a : Nat) (b : Nat) => instDecidableEqNat a b) (Nat.factors n))
Case conversion may be inaccurate. Consider using '#align nat.pow_succ_factors_to_finset Nat.pow_succ_factors_toFinsetₓ'. -/
theorem pow_succ_factors_toFinset (n k : ℕ) : (n ^ (k + 1)).factors.toFinset = n.factors.toFinset :=
  by
  rcases eq_or_ne n 0 with (rfl | hn)
  · simp
  induction' k with k ih
  · simp
  rw [pow_succ, factors_mul_to_finset hn (pow_ne_zero _ hn), ih, Finset.union_idempotent]
#align nat.pow_succ_factors_to_finset Nat.pow_succ_factors_toFinset

/- warning: nat.pow_factors_to_finset -> Nat.pow_factors_toFinset is a dubious translation:
lean 3 declaration is
  forall (n : Nat) {k : Nat}, (Ne.{1} Nat k (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero)))) -> (Eq.{1} (Finset.{0} Nat) (List.toFinset.{0} Nat (fun (a : Nat) (b : Nat) => Nat.decidableEq a b) (Nat.factors (HPow.hPow.{0, 0, 0} Nat Nat Nat (instHPow.{0, 0} Nat Nat (Monoid.Pow.{0} Nat Nat.monoid)) n k))) (List.toFinset.{0} Nat (fun (a : Nat) (b : Nat) => Nat.decidableEq a b) (Nat.factors n)))
but is expected to have type
  forall (n : Nat) {k : Nat}, (Ne.{1} Nat k (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))) -> (Eq.{1} (Finset.{0} Nat) (List.toFinset.{0} Nat (fun (a : Nat) (b : Nat) => instDecidableEqNat a b) (Nat.factors (HPow.hPow.{0, 0, 0} Nat Nat Nat (instHPow.{0, 0} Nat Nat instPowNat) n k))) (List.toFinset.{0} Nat (fun (a : Nat) (b : Nat) => instDecidableEqNat a b) (Nat.factors n)))
Case conversion may be inaccurate. Consider using '#align nat.pow_factors_to_finset Nat.pow_factors_toFinsetₓ'. -/
theorem pow_factors_toFinset (n : ℕ) {k : ℕ} (hk : k ≠ 0) :
    (n ^ k).factors.toFinset = n.factors.toFinset :=
  by
  cases k
  · simpa using hk
  rw [pow_succ_factors_to_finset]
#align nat.pow_factors_to_finset Nat.pow_factors_toFinset

/- warning: nat.prime_pow_prime_divisor -> Nat.prime_pow_prime_divisor is a dubious translation:
lean 3 declaration is
  forall {p : Nat} {k : Nat}, (Ne.{1} Nat k (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero)))) -> (Nat.Prime p) -> (Eq.{1} (Finset.{0} Nat) (List.toFinset.{0} Nat (fun (a : Nat) (b : Nat) => Nat.decidableEq a b) (Nat.factors (HPow.hPow.{0, 0, 0} Nat Nat Nat (instHPow.{0, 0} Nat Nat (Monoid.Pow.{0} Nat Nat.monoid)) p k))) (Singleton.singleton.{0, 0} Nat (Finset.{0} Nat) (Finset.hasSingleton.{0} Nat) p))
but is expected to have type
  forall {p : Nat} {k : Nat}, (Ne.{1} Nat k (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))) -> (Nat.Prime p) -> (Eq.{1} (Finset.{0} Nat) (List.toFinset.{0} Nat (fun (a : Nat) (b : Nat) => instDecidableEqNat a b) (Nat.factors (HPow.hPow.{0, 0, 0} Nat Nat Nat (instHPow.{0, 0} Nat Nat instPowNat) p k))) (Singleton.singleton.{0, 0} Nat (Finset.{0} Nat) (Finset.instSingletonFinset.{0} Nat) p))
Case conversion may be inaccurate. Consider using '#align nat.prime_pow_prime_divisor Nat.prime_pow_prime_divisorₓ'. -/
/-- The only prime divisor of positive prime power `p^k` is `p` itself -/
theorem prime_pow_prime_divisor {p k : ℕ} (hk : k ≠ 0) (hp : Prime p) :
    (p ^ k).factors.toFinset = {p} := by simp [pow_factors_to_finset p hk, factors_prime hp]
#align nat.prime_pow_prime_divisor Nat.prime_pow_prime_divisor

/- warning: nat.factors_mul_to_finset_of_coprime -> Nat.factors_mul_toFinset_of_coprime is a dubious translation:
lean 3 declaration is
  forall {a : Nat} {b : Nat}, (Nat.coprime a b) -> (Eq.{1} (Finset.{0} Nat) (List.toFinset.{0} Nat (fun (a : Nat) (b : Nat) => Nat.decidableEq a b) (Nat.factors (HMul.hMul.{0, 0, 0} Nat Nat Nat (instHMul.{0} Nat Nat.hasMul) a b))) (Union.union.{0} (Finset.{0} Nat) (Finset.hasUnion.{0} Nat (fun (a : Nat) (b : Nat) => Nat.decidableEq a b)) (List.toFinset.{0} Nat (fun (a : Nat) (b : Nat) => Nat.decidableEq a b) (Nat.factors a)) (List.toFinset.{0} Nat (fun (a : Nat) (b : Nat) => Nat.decidableEq a b) (Nat.factors b))))
but is expected to have type
  forall {a : Nat} {b : Nat}, (Nat.coprime a b) -> (Eq.{1} (Finset.{0} Nat) (List.toFinset.{0} Nat (fun (a : Nat) (b : Nat) => instDecidableEqNat a b) (Nat.factors (HMul.hMul.{0, 0, 0} Nat Nat Nat (instHMul.{0} Nat instMulNat) a b))) (Union.union.{0} (Finset.{0} Nat) (Finset.instUnionFinset.{0} Nat (fun (a : Nat) (b : Nat) => instDecidableEqNat a b)) (List.toFinset.{0} Nat (fun (a : Nat) (b : Nat) => instDecidableEqNat a b) (Nat.factors a)) (List.toFinset.{0} Nat (fun (a : Nat) (b : Nat) => instDecidableEqNat a b) (Nat.factors b))))
Case conversion may be inaccurate. Consider using '#align nat.factors_mul_to_finset_of_coprime Nat.factors_mul_toFinset_of_coprimeₓ'. -/
theorem factors_mul_toFinset_of_coprime {a b : ℕ} (hab : coprime a b) :
    (a * b).factors.toFinset = a.factors.toFinset ∪ b.factors.toFinset :=
  (List.toFinset.ext <| mem_factors_mul_of_coprime hab).trans <| List.toFinset_union _ _
#align nat.factors_mul_to_finset_of_coprime Nat.factors_mul_toFinset_of_coprime

end Nat


/-
Copyright (c) 2021 David Wärn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Wärn, Eric Wieser, Joachim Breitner

! This file was ported from Lean 3 source module group_theory.is_free_group
! leanprover-community/mathlib commit f7fc89d5d5ff1db2d1242c7bb0e9062ce47ef47c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.GroupTheory.FreeGroup

/-!
# Free groups structures on arbitrary types

This file defines a type class for type that are free groups, together with the usual operations.
The type class can be instantiated by providing an isomorphim to the canonical free group, or by
proving that the universal property holds.

For the explicit construction of free groups, see `GroupTheory/FreeGroup`.

## Main definitions

* `IsFreeGroup G` - a typeclass to indicate that `G` is free over some generators
* `IsFreeGroup.of` - the canonical injection of `G`'s generators into `G`
* `IsFreeGroup.lift` - the universal property of the free group

## Main results

* `IsFreeGroup.toFreeGroup` - any free group with generators `A` is equivalent to `FreeGroup A`.
* `IsFreeGroup.unique_lift` - the universal property of a free group
* `IsFreeGroup.ofUniqueLift` - constructing `IsFreeGroup` from the universal property

-/

universe u

/- ./././Mathport/Syntax/Translate/Command.lean:388:30: infer kinds are unsupported in Lean 4:
#[`MulEquiv] [] -/
/- Porting Note regarding the comment above:
The mathlib3 version makes `G` explicit in `is_free_group.mul_equiv`. -/

/-- `IsFreeGroup G` means that `G` isomorphic to a free group. -/
class IsFreeGroup (G : Type u) [Group G] where
  /-- The generators of a free group. -/
  Generators : Type u
  /-- The multiplicative equivalence between "the" free group on the generators, and
  the given group `G`.
  Note: `IsFreeGroup.MulEquiv'` should not be used directly.
  `IsFreeGroup.MulEquiv` should be used instead because it makes `G` an explicit variable.-/
  MulEquiv' : FreeGroup Generators ≃* G
#align is_free_group IsFreeGroup

instance (X : Type _) : IsFreeGroup (FreeGroup X) where
  Generators := X
  MulEquiv' := MulEquiv.refl _

namespace IsFreeGroup

variable (G : Type _) [Group G] [IsFreeGroup G]

/-- Any free group is isomorphic to "the" free group. -/
def MulEquiv : FreeGroup (Generators G) ≃* G := IsFreeGroup.MulEquiv'

/-- Any free group is isomorphic to "the" free group. -/
@[simps!]
def toFreeGroup : G ≃* FreeGroup (Generators G) :=
  (MulEquiv G).symm
#align is_free_group.to_free_group IsFreeGroup.toFreeGroup
#align is_free_group.to_free_group_apply IsFreeGroup.toFreeGroup_apply
#align is_free_group.to_free_group_symm_apply IsFreeGroup.toFreeGroup_symm_apply

variable {G}

/-- The canonical injection of G's generators into G -/
def of : Generators G → G :=
  (MulEquiv G).toFun ∘ FreeGroup.of
#align is_free_group.of IsFreeGroup.of

@[simp]
theorem of_eq_freeGroup_of {A : Type u} : @of (FreeGroup A) _ _ = FreeGroup.of :=
  rfl
#align is_free_group.of_eq_free_group_of IsFreeGroup.of_eq_freeGroup_of

variable {H : Type _} [Group H]

/-- The equivalence between functions on the generators and group homomorphisms from a free group
given by those generators. -/
def lift : (Generators G → H) ≃ (G →* H) :=
  FreeGroup.lift.trans
    { toFun := fun f => f.comp (MulEquiv G).symm.toMonoidHom
      invFun := fun f => f.comp (MulEquiv G).toMonoidHom
      left_inv := fun f => by
        ext
        simp
      right_inv := fun f => by
        ext
        simp }
#align is_free_group.lift IsFreeGroup.lift

@[simp]

@[simp]
theorem lift_of (f : Generators G → H) (a : Generators G) : lift f (of a) = f a :=
  congr_fun (lift.symm_apply_apply f) a
#align is_free_group.lift_of IsFreeGroup.lift_of

@[simp]
theorem lift_symm_apply (f : G →* H) (a : Generators G) : (lift.symm f) a = f (of a) :=
  rfl
#align is_free_group.lift_symm_apply IsFreeGroup.lift_symm_apply

@[ext 1050] --Porting note: increased priority, but deliberately less than for example
--`FreeProduct.ext_hom`
theorem ext_hom ⦃f g : G →* H⦄ (h : ∀ a : Generators G, f (of a) = g (of a)) : f = g :=
  lift.symm.injective (funext h)
#align is_free_group.ext_hom IsFreeGroup.ext_hom

/-- The universal property of a free group: A functions from the generators of `G` to another
group extends in a unique way to a homomorphism from `G`.

Note that since `IsFreeGroup.lift` is expressed as a bijection, it already
expresses the universal property.  -/
theorem unique_lift (f : Generators G → H) : ∃! F : G →* H, ∀ a, F (of a) = f a := by
  simpa only [Function.funext_iff] using lift.symm.bijective.existsUnique f
#align is_free_group.unique_lift IsFreeGroup.unique_lift

/-- If a group satisfies the universal property of a free group, then it is a free group, where
the universal property is expressed as in `IsFreeGroup.lift` and its properties. -/
def ofLift {G : Type u} [Group G] (X : Type u) (of : X → G)
    (lift : ∀ {H : Type u} [Group H], (X → H) ≃ (G →* H))
    (lift_of : ∀ {H : Type u} [Group H], ∀ (f : X → H) (a), lift f (of a) = f a) : IsFreeGroup G
    where
  Generators := X
  MulEquiv' :=
    MonoidHom.toMulEquiv (FreeGroup.lift of) (lift FreeGroup.of)
      (by
        apply FreeGroup.ext_hom; intro x
        simp only [MonoidHom.coe_comp, Function.comp_apply, MonoidHom.id_apply, FreeGroup.lift.of,
          lift_of])
      (by
        let lift_symm_of : ∀ {H : Type u} [Group H], ∀ (f : G →* H) (a), lift.symm f a = f (of a) :=
          by intro H _ f a ; simp [← lift_of (lift.symm f)]
        apply lift.symm.injective; ext x
        simp only [MonoidHom.coe_comp, Function.comp_apply, MonoidHom.id_apply, FreeGroup.lift.of,
          lift_of, lift_symm_of])
#align is_free_group.of_lift IsFreeGroup.ofLift

/-- If a group satisfies the universal property of a free group, then it is a free group, where
the universal property is expressed as in `IsFreeGroup.unique_lift`.  -/
noncomputable def ofUniqueLift {G : Type u} [Group G] (X : Type u) (of : X → G)
    (h : ∀ {H : Type u} [Group H] (f : X → H), ∃! F : G →* H, ∀ a, F (of a) = f a) :
    IsFreeGroup G :=
  let lift {H : Type u} [Group H] : (X → H) ≃ (G →* H) :=
    { toFun := fun f => Classical.choose (h f)
      invFun := fun F => F ∘ of
      left_inv := fun f => funext (Classical.choose_spec (h f)).left
      right_inv := fun F => ((Classical.choose_spec (h (F ∘ of))).right F fun _ => rfl).symm }
  let lift_of {H : Type u} [Group H] (f : X → H) (a : X) : lift f (of a) = f a :=
    congr_fun (lift.symm_apply_apply f) a
  ofLift X of @lift @lift_of
#align is_free_group.of_unique_lift IsFreeGroup.ofUniqueLift

/-- Being a free group transports across group isomorphisms. -/
def ofMulEquiv {H : Type _} [Group H] (h : G ≃* H) : IsFreeGroup H
    where
  Generators := Generators G
  MulEquiv' := (MulEquiv G).trans h
#align is_free_group.of_mul_equiv IsFreeGroup.ofMulEquiv

end IsFreeGroup


/-
Copyright (c) 2020 Hanting Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Hanting Zhang, Johan Commelin
-/
import tactic
import data.mv_polynomial.rename
import data.mv_polynomial.comm_ring
import algebra.algebra.subalgebra

/-!
# Symmetric Polynomials and Elementary Symmetric Polynomials

This file defines symmetric `mv_polynomial`s and elementary symmetric `mv_polynomial`s.
We also prove some basic facts about them.

## Main declarations

* `mv_polynomial.is_symmetric`

* `mv_polynomial.symmetric_subalgebra`

* `mv_polynomial.esymm`

## Notation

+ `esymm σ R n`, is the `n`th elementary symmetric polynomial in `mv_polynomial σ R`.

As in other polynomial files, we typically use the notation:

+ `σ τ : Type*` (indexing the variables)

+ `R S : Type*` `[comm_semiring R]` `[comm_semiring S]` (the coefficients)

+ `r : R` elements of the coefficient ring

+ `i : σ`, with corresponding monomial `X i`, often denoted `X_i` by mathematicians

+ `φ ψ : mv_polynomial σ R`

-/

open equiv (perm)
open_locale big_operators
noncomputable theory

namespace mv_polynomial

variables {σ : Type*} {R : Type*}
variables {τ : Type*} {S : Type*}

/-- A `mv_polynomial φ` is symmetric if it is invariant under
permutations of its variables by the  `rename` operation -/
def is_symmetric [comm_semiring R] (φ : mv_polynomial σ R) : Prop :=
∀ e : perm σ, rename e φ = φ

variables (σ R)

/-- The subalgebra of symmetric `mv_polynomial`s. -/
def symmetric_subalgebra [comm_semiring R] : subalgebra R (mv_polynomial σ R) :=
{ carrier := set_of is_symmetric,
  algebra_map_mem' := λ r e, rename_C e r,
  mul_mem' := λ a b ha hb e, by rw [alg_hom.map_mul, ha, hb],
  add_mem' := λ a b ha hb e, by rw [alg_hom.map_add, ha, hb] }

variables {σ R}

@[simp] lemma mem_symmetric_subalgebra [comm_semiring R] (p : mv_polynomial σ R) :
  p ∈ symmetric_subalgebra σ R ↔ p.is_symmetric := iff.rfl

namespace is_symmetric

section comm_semiring
variables [comm_semiring R] [comm_semiring S] {φ ψ : mv_polynomial σ R}

@[simp]
lemma C (r : R) : is_symmetric (C r : mv_polynomial σ R) :=
(symmetric_subalgebra σ R).algebra_map_mem r

@[simp]
lemma zero : is_symmetric (0 : mv_polynomial σ R) :=
(symmetric_subalgebra σ R).zero_mem

@[simp]
lemma one : is_symmetric (1 : mv_polynomial σ R) :=
(symmetric_subalgebra σ R).one_mem

lemma add (hφ : is_symmetric φ) (hψ : is_symmetric ψ) : is_symmetric (φ + ψ) :=
(symmetric_subalgebra σ R).add_mem hφ hψ

lemma mul (hφ : is_symmetric φ) (hψ : is_symmetric ψ) : is_symmetric (φ * ψ) :=
(symmetric_subalgebra σ R).mul_mem hφ hψ

lemma smul (r : R) (hφ : is_symmetric φ) : is_symmetric (r • φ) :=
(symmetric_subalgebra σ R).smul_mem hφ r

@[simp]
lemma map (hφ : is_symmetric φ) (f : R →+* S) : is_symmetric (map f φ) :=
λ e, by rw [← map_rename, hφ]

end comm_semiring

section comm_ring
variables [comm_ring R] {φ ψ : mv_polynomial σ R}

lemma neg (hφ : is_symmetric φ) : is_symmetric (-φ) :=
(symmetric_subalgebra σ R).neg_mem hφ

lemma sub (hφ : is_symmetric φ) (hψ : is_symmetric ψ) : is_symmetric (φ - ψ) :=
(symmetric_subalgebra σ R).sub_mem hφ hψ

end comm_ring

end is_symmetric

section elementary_symmetric
open finset
variables (σ R) [comm_semiring R] [comm_semiring S] [fintype σ] [fintype τ]

/-- The `n`th elementary symmetric `mv_polynomial σ R`. -/
def esymm (n : ℕ) : mv_polynomial σ R :=
∑ t in powerset_len n univ, ∏ i in t, X i

/-- We can define `esymm σ R n` by summing over a subtype instead of over `powerset_len`. -/
lemma esymm_eq_sum_subtype (n : ℕ) : esymm σ R n =
  ∑ t : {s : finset σ // s.card = n}, ∏ i in (t : finset σ), X i :=
begin
  rw esymm,
  let i : Π (a : finset σ), a ∈ powerset_len n univ → {s : finset σ // s.card = n} :=
    λ a ha, ⟨_, (mem_powerset_len.mp ha).2⟩,
  refine sum_bij i (λ a ha, mem_univ (i a ha)) _ (λ _ _ _ _ hi, subtype.ext_iff_val.mp hi) _,
  { intros,
    apply prod_congr,
    simp only [subtype.coe_mk],
    intros, refl,},
  { refine (λ b H, ⟨b.val, mem_powerset_len.mpr ⟨subset_univ b.val, b.property⟩, _⟩),
    simp [i] },
end

/-- We can define `esymm σ R n` as a sum over explicit monomials -/
lemma esymm_eq_sum_monomial (n : ℕ) : esymm σ R n =
  ∑ t in powerset_len n univ, monomial (∑ i in t, finsupp.single i 1) 1 :=
begin
  refine sum_congr rfl (λ x hx, _),
  rw monic_monomial_eq,
  rw finsupp.prod_pow,
  rw ← prod_subset (λ y _, finset.mem_univ y : x ⊆ univ) (λ y _ hy, _),
  { refine prod_congr rfl (λ x' hx', _),
    convert (pow_one _).symm,
    convert (finsupp.apply_add_hom x' : (σ →₀ ℕ) →+ ℕ).map_sum _ x,
    classical,
    simp [finsupp.single_apply, finset.filter_eq', apply_ite, apply_ite finset.card],
    rw if_pos hx', },
  { convert pow_zero _,
    convert (finsupp.apply_add_hom y : (σ →₀ ℕ) →+ ℕ).map_sum _ x,
    classical,
    simp [finsupp.single_apply, finset.filter_eq', apply_ite, apply_ite finset.card],
    rw if_neg hy, }
end

@[simp] lemma esymm_zero : esymm σ R 0 = 1 :=
by simp only [esymm, powerset_len_zero, sum_singleton, prod_empty]

lemma map_esymm (n : ℕ) (f : R →+* S) : map f (esymm σ R n) = esymm σ S n :=
begin
  rw [esymm, (map f).map_sum],
  refine sum_congr rfl (λ x hx, _),
  rw (map f).map_prod,
  simp,
end

lemma rename_esymm (n : ℕ) (e : σ ≃ τ) : rename e (esymm σ R n) = esymm τ R n :=
begin
  rw [esymm_eq_sum_subtype, esymm_eq_sum_subtype, (rename ⇑e).map_sum],
  let e' : {s : finset σ // s.card = n} ≃ {s : finset τ // s.card = n} :=
    equiv.subtype_equiv (equiv.finset_congr e) (by simp),
  rw ← equiv.sum_comp e'.symm,
  apply fintype.sum_congr,
  intro,
  calc _ = (∏ i in (e'.symm a : finset σ), (rename e) (X i)) : (rename e).map_prod _ _
     ... = (∏ i in (a : finset τ), (rename e) (X (e.symm i))) : prod_map (a : finset τ) _ _
     ... = _ : _,
  apply finset.prod_congr rfl,
  intros,
  simp,
end

lemma esymm_is_symmetric (n : ℕ) : is_symmetric (esymm σ R n) :=
by { intro, rw rename_esymm }

lemma support_esymm'' (n : ℕ) [decidable_eq σ] [nontrivial R] :
  (esymm σ R n).support = (powerset_len n (univ : finset σ)).bUnion
    (λ t, (finsupp.single (∑ (i : σ) in t, finsupp.single i 1) (1:R)).support) :=
begin
  rw esymm_eq_sum_monomial,
  simp only [monomial],
  convert finsupp.support_sum_eq_bUnion (powerset_len n (univ : finset σ)) _,
  intros s t hst d,
  simp only [finsupp.support_single_ne_zero one_ne_zero, and_imp, inf_eq_inter, mem_inter,
             mem_singleton],
  rintro h rfl,
  have := congr_arg finsupp.support h,
  rw [finsupp.support_sum_eq_bUnion, finsupp.support_sum_eq_bUnion] at this,
  { simp only [finsupp.support_single_ne_zero one_ne_zero, bUnion_singleton_eq_self] at this,
    exact absurd this hst.symm },
  all_goals { intros x y, simp [finsupp.support_single_disjoint] }
end

lemma support_esymm' (n : ℕ) [decidable_eq σ] [nontrivial R] :
  (esymm σ R n).support =
  (powerset_len n (univ : finset σ)).bUnion (λ t, {∑ (i : σ) in t, finsupp.single i 1}) :=
begin
  rw support_esymm'',
  congr,
  funext,
  exact finsupp.support_single_ne_zero one_ne_zero
end

lemma support_esymm (n : ℕ) [decidable_eq σ] [nontrivial R] :
  (esymm σ R n).support =
  (powerset_len n (univ : finset σ)).image (λ t, ∑ (i : σ) in t, finsupp.single i 1) :=
by { rw support_esymm', exact bUnion_singleton }

lemma degrees_esymm [nontrivial R]
  (n : ℕ) (hpos : 0 < n) (hn : n ≤ fintype.card σ) :
  (esymm σ R n).degrees = (univ : finset σ).val :=
begin
  classical,
  have : (finsupp.to_multiset ∘ λ (t : finset σ), ∑ (i : σ) in t, finsupp.single i 1) = finset.val,
    { funext, simp [finsupp.to_multiset_sum_single] },
  rw [degrees, support_esymm, sup_finset_image, this, ←comp_sup_eq_sup_comp],
  { obtain ⟨k, rfl⟩ := nat.exists_eq_succ_of_ne_zero hpos.ne',
    simpa using powerset_len_sup _ _ (nat.lt_of_succ_le hn) },
  { intros,
    simp only [union_val, sup_eq_union],
    congr },
  { refl }
end

end elementary_symmetric

end mv_polynomial


/-
Copyright (c) 2020 Heather Macbeth, Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth, Patrick Massot
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.group_theory.subgroup
import Mathlib.algebra.archimedean
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Archimedean groups

This file proves a few facts about ordered groups which satisfy the `archimedean` property, that is:
`class archimedean (α) [ordered_add_comm_monoid α] : Prop :=`
`(arch : ∀ (x : α) {y}, 0 < y → ∃ n : ℕ, x ≤ n •ℕ y)`

They are placed here in a separate file (rather than incorporated as a continuation of
`algebra.archimedean`) because they rely on some imports from `group_theory` -- bundled subgroups
in particular.

The main result is `add_subgroup.cyclic_of_min`:  a subgroup of a decidable archimedean abelian
group is cyclic, if its set of positive elements has a minimal element.

This result is used in this file to deduce `int.subgroup_cyclic`, proving that every subgroup of `ℤ`
is cyclic.  (There are several other methods one could use to prove this fact, including more purely
algebraic methods, but none seem to exist in mathlib as of writing.  The closest is
`subgroup.is_cyclic`, but that has not been transferred to `add_subgroup`.)

The result is also used in `topology.instances.real` as an ingredient in the classification of
subgroups of `ℝ`.
-/

/-- Given a subgroup `H` of a decidable linearly ordered archimedean abelian group `G`, if there
exists a minimal element `a` of `H ∩ G_{>0}` then `H` is generated by `a`. -/
theorem add_subgroup.cyclic_of_min {G : Type u_1} [linear_ordered_add_comm_group G] [archimedean G]
    {H : add_subgroup G} {a : G} (ha : is_least (set_of fun (g : G) => g ∈ H ∧ 0 < g) a) :
    H = add_subgroup.closure (singleton a) :=
  sorry

/-- Every subgroup of `ℤ` is cyclic. -/
theorem int.subgroup_cyclic (H : add_subgroup ℤ) :
    ∃ (a : ℤ), H = add_subgroup.closure (singleton a) :=
  sorry

end Mathlib


/-
Lemma 10.16.10. Let R be a ring. The space Spec(R) is quasi-compact.

Proof. It suffices to prove that any covering of Spec(R) by standard opens can be refined by a finite covering.
 Thus suppose that Spec(R)=∪D(fi) for a set of elements {fi}i∈I of R. This means that ∩V(fi)=∅. According to
 Lemma 10.16.2 (00E0) this means that V({fi})=∅. According to the same lemma this means that the ideal generated
  by the fi is the unit ideal of R. This means that we can write 1 as a finite sum: 1=∑i∈Jrifi with J⊂I finite.
   And then it follows that Spec(R)=∪i∈JD(fi).
-/

import Kenny_comm_alg.Zariski algebra.module Kenny_comm_alg.maximal_ideal tag00DY tag00E0
import tag009L -- standard basis for Spec(R)
universe u

local attribute [instance] classical.prop_decidable

-- this next lemma will go to mathlib one day
lemma mem_subset_basis_of_mem_open {X : Type u} [T : topological_space X] {b : set (set X)}
  (hb : topological_space.is_topological_basis b) {a:X} (u : set X) (au : a ∈ u)
  (ou : _root_.is_open u) : ∃v ∈ b, a ∈ v ∧ v ⊆ u :=
(topological_space.mem_nhds_of_is_topological_basis hb).1 $ mem_nhds_sets ou au

-- this was warm-up : I never use it
/-
lemma cover_open_by_basis {X : Type u} [T : topological_space X] {U : set X} (HU : T.is_open U)
(B : set (set X)) (HB : topological_space.is_topological_basis B)
  : ∃ (g : {x : X // U x} → set X), (∀ j, B (g j)) ∧ set.Union g = U :=
begin
  existsi λ (xUx : {x : X // U x}), classical.some (mem_subset_basis_of_mem_open HB U xUx.property HU),
  split,
  { intro xUx,
    exact classical.some (classical.some_spec (mem_subset_basis_of_mem_open HB U xUx.property HU)),
  },
  apply set.subset.antisymm,
  { intros x Hx,
    cases Hx with V HV,
    cases HV with HV Hx,
    cases HV with xUx HV,
    have H := classical.some_spec (classical.some_spec (mem_subset_basis_of_mem_open HB U xUx.property HU)),
    have H2 := H.2,
    rw (eq.symm HV : classical.some (mem_subset_basis_of_mem_open HB U (xUx.property) HU) = V) at H2,
    exact H2 Hx,
  },
  intros x Hx,
  let xUx : { x // U x} := ⟨x,Hx⟩,
  existsi classical.some (mem_subset_basis_of_mem_open HB U (xUx.property) HU),
  existsi _,
  { exact (classical.some_spec (classical.some_spec (mem_subset_basis_of_mem_open HB U (xUx.property) HU))).1,
  },
  existsi xUx,
  refl
end
-/

-- a cover can be refined to a cover by a basis
lemma refine_cover_with_basis {X : Type u} [T : topological_space X]
  (B : set (set X)) (HB : topological_space.is_topological_basis B)
  (c : set (set X)) (Oc : ∀ U ∈ c, T.is_open U) (Hcov : set.sUnion c = set.univ) :
∃ (d : set (set X)), d ⊆ B ∧ (∀ V ∈ d, ∃ U ∈ c, V ⊆ U) ∧ set.sUnion d = set.univ :=
begin
  existsi λ V, V ∈ B ∧ ∃ U ∈ c, V ⊆ U,
  split,intros V HV,exact HV.1,
  split,intros V HV,exact HV.2,
  apply set.subset.antisymm,simp,
  intros x Hx,
  rw ←Hcov at Hx,
  cases Hx with U HU,
  cases HU with HU Hx,
  cases (mem_subset_basis_of_mem_open HB U Hx (Oc U HU)) with V HV,
  cases HV with HV1 HV2,
  existsi V,
  existsi _,exact HV2.1,
  split,exact HV1,
  existsi U,
  existsi HU,
  exact HV2.2
end

-- a cover by basis elements has a finite subcover
lemma basis_quasi_compact {R : Type u} [comm_ring R] :
∀ F : set R, @set.univ (X R) = set.Union (λ fF : {f // f ∈ F}, Spec.D' fF.val) →
∃ G : set R, G ⊆ F ∧ set.finite G ∧
  @set.univ (X R) = set.Union (λ gG : {g // g ∈ G}, Spec.D' gG.val) :=
begin
  intros F Hcover,
  -- first let's show that the union of D(f), f in F, is all Spec(R)
  have H : @set.univ (X R) = ⋃₀(Spec.D' '' F),
    rw Hcover,
    apply set.ext,
    intro x,simp,
  -- now let's deduce that V(F) is empty.
  rw tag00E0.lemma16 at H,
  have H2 : Spec.V F = ∅,
    rw [←set.compl_compl (Spec.V F),←H,set.compl_univ],
  -- now let's deduce that the ideal gen by F is all of R.
  rw ←tag00E0.lemma05 at H2,
  letI : is_ideal (span F) := is_ideal_span,
  have H3 : span F = set.univ := (tag00E0.lemma08 _ _).1 H2,
  -- now let's write 1 as a finite linear combination of elements of F
  have H4 : (1 : R) ∈ span F := by simp [H3],
  cases H4 with f Hf, -- f is a function R -> R supported on a finite subset of F
  -- now let's build G, finite, with 1 in span G, and then let's run the entire argument backwards.
  let G : set R := {r | r ∈ f.support},
  existsi G, -- need to prove G in F, G finite, and D(g) covers for g in G
  split,
  { show G ⊆ F,
    intros g Hg,
    cases classical.em (g ∈ F) with H5 H5,assumption,
    exfalso,
    have H6 : f g = 0 := Hf.1 g H5,
    exact (f.mem_support_to_fun g).1 Hg H6
  },
  split,
  { show set.finite G, -- G = f.support which is a finset
    exact set.finite_mem_finset _,
  },
  -- goal now to show that union of D(g) is Spec(R)
  -- first reformulate so we can apply lemma16
  suffices H' : @set.univ (X R) = ⋃₀(Spec.D' '' G),
    apply set.ext,simp [H'],
  -- now reduce goal to complement of V(G) is everything
  rw tag00E0.lemma16,
  -- now reduce to V(G) empty
  rw ←set.compl_empty,
  congr,
  -- now reduce to span(G) = R
  rw ←tag00E0.lemma05,
  apply eq.symm,
  letI : is_ideal (span G) := is_ideal_span,
  rw tag00E0.lemma08,
  -- now reduce to 1 in span(G)
  apply is_submodule.univ_of_one_mem (span G),
  -- now prove this
  rw Hf.2,
  existsi f,
  split,swap,refl,
  intros x Hx,
  cases classical.em (f x = 0) with H4 H4,assumption,
  exfalso,
  exact Hx ((f.mem_support_to_fun x).2 H4),
end

-- now deduce main result from compact basis result
lemma lemma_quasi_compact {R : Type u} [comm_ring R] : compact (@set.univ (X R)) :=
begin
  rw compact_iff_finite_subcover,
  intros c HOc Hccov,
  let B := {U : set (X R) | ∃ (f : R), U = Spec.D' f},
  have HB : topological_space.is_topological_basis B := D_f_form_basis R,
  cases (refine_cover_with_basis B HB c HOc (set.subset.antisymm (by simp) Hccov)) with d Hd,
  have HdB : ∀ V ∈ d, ∃ f : R, V = Spec.D' f := λ _ HV,Hd.1 HV,
  have H := basis_quasi_compact (λ f, (Spec.D' f) ∈ d),
  have Hdcov : (⋃ (fHf : {f // Spec.D' f ∈ d}), Spec.D' (fHf.val)) = set.univ,
  { apply set.subset.antisymm,simp,
    rw ←Hd.2.2,
    intros x Hx,cases Hx with V HV,cases HV with HVd HxV,
    existsi V,
    existsi _,
    exact HxV,
    cases Hd.1 HVd with f Hf,
    rw Hf at HVd,
    existsi (⟨f,HVd⟩ : {f // Spec.D' f ∈ d}),
    exact Hf
  },
  cases H (eq.symm Hdcov) with G HG,
  let m : {g // g ∈ G} → set (X R) := λ gG,classical.some (Hd.2.1 (Spec.D' gG.val) (HG.1 gG.property)),
  have mH : ∀ (gG : {g // g ∈ G}), ∃ (H : (m gG) ∈ c), Spec.D' (gG.val) ⊆ (m gG)
      := λ (gG : {g // g ∈ G}), classical.some_spec (Hd.2.1 (Spec.D' gG.val) (HG.1 gG.property)),
  existsi set.range m,
  existsi _,split,
  { have HGfin : set.finite G := HG.2.1,
    exact let ⟨HF⟩ := HGfin in ⟨@set.fintype_range _ _ _ m HF⟩,
  },
  { rw HG.2.2,
    intros x Hx,
    cases Hx with U HU,cases HU with HU HxU,cases HU with gG HU,
    change U = Spec.D' (gG.val)  at HU,
    cases mH gG with H1 H2,
    existsi m gG,
    existsi _,
    { apply H2,
      rw ←HU,
      exact HxU },
    existsi gG,refl
  },
  intros U HU,cases HU with gG HU,
  cases (mH gG) with Hc,
  rw HU at Hc,exact Hc,
end


/-
Copyright (c) 2020 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Devon Tuma
-/
import measure_theory.probability_mass_function.basic

/-!
# Monad Operations for Probability Mass Functions

This file constructs two operations on `pmf` that give it a monad structure.
`pure a` is the distribution where a single value `a` has probability `1`.
`bind pa pb : pmf β` is the distribution given by sampling `a : α` from `pa : pmf α`,
and then sampling from `pb a : pmf β` to get a final result `b : β`.

`bind_on_support` generalizes `bind` to allow binding to a partial function,
so that the second argument only needs to be defined on the support of the first argument.

-/

noncomputable theory
variables {α β γ : Type*}
open_locale classical big_operators nnreal ennreal

namespace pmf

section pure

/-- The pure `pmf` is the `pmf` where all the mass lies in one point.
  The value of `pure a` is `1` at `a` and `0` elsewhere. -/
def pure (a : α) : pmf α := ⟨λ a', if a' = a then 1 else 0, has_sum_ite_eq _ _⟩

variables (a a' : α)

@[simp] lemma pure_apply : pure a a' = (if a' = a then 1 else 0) := rfl

@[simp] lemma support_pure : (pure a).support = {a} := set.ext (λ a', by simp [mem_support_iff])

lemma mem_support_pure_iff: a' ∈ (pure a).support ↔ a' = a := by simp

instance [inhabited α] : inhabited (pmf α) := ⟨pure default⟩

section measure

variable (s : set α)

@[simp] lemma to_outer_measure_pure_apply : (pure a).to_outer_measure s = if a ∈ s then 1 else 0 :=
begin
  refine (to_outer_measure_apply' (pure a) s).trans _,
  split_ifs with ha ha,
  { refine ennreal.coe_eq_one.2 ((tsum_congr (λ b, _)).trans (tsum_ite_eq a 1)),
    exact ite_eq_left_iff.2 (λ hb, symm (ite_eq_right_iff.2 (λ h, (hb $ h.symm ▸ ha).elim))) },
  { refine ennreal.coe_eq_zero.2 ((tsum_congr (λ b, _)).trans (tsum_zero)),
    exact ite_eq_right_iff.2 (λ hb, ite_eq_right_iff.2 (λ h, (ha $ h ▸ hb).elim)) }
end

/-- The measure of a set under `pure a` is `1` for sets containing `a` and `0` otherwise -/
@[simp] lemma to_measure_pure_apply [measurable_space α] (hs : measurable_set s) :
  (pure a).to_measure s = if a ∈ s then 1 else 0 :=
(to_measure_apply_eq_to_outer_measure_apply (pure a) s hs).trans (to_outer_measure_pure_apply a s)

end measure

end pure

section bind

protected lemma bind.summable (p : pmf α) (f : α → pmf β) (b : β) :
  summable (λ a : α, p a * f a b) :=
begin
  refine nnreal.summable_of_le (assume a, _) p.summable_coe,
  suffices : p a * f a b ≤ p a * 1, { simpa },
  exact mul_le_mul_of_nonneg_left ((f a).coe_le_one _) (p a).2
end

/-- The monadic bind operation for `pmf`. -/
def bind (p : pmf α) (f : α → pmf β) : pmf β :=
⟨λ b, ∑'a, p a * f a b,
  begin
    apply ennreal.has_sum_coe.1,
    simp only [ennreal.coe_tsum (bind.summable p f _)],
    rw [ennreal.summable.has_sum_iff, ennreal.tsum_comm],
    simp [ennreal.tsum_mul_left, (ennreal.coe_tsum (f _).summable_coe).symm,
      (ennreal.coe_tsum p.summable_coe).symm]
  end⟩

variables (p : pmf α) (f : α → pmf β) (g : β → pmf γ)

@[simp] lemma bind_apply (b : β) : p.bind f b = ∑'a, p a * f a b := rfl

@[simp] lemma support_bind : (p.bind f).support = {b | ∃ a ∈ p.support, b ∈ (f a).support} :=
set.ext (λ b, by simp [mem_support_iff, tsum_eq_zero_iff (bind.summable p f b), not_or_distrib])

lemma mem_support_bind_iff (b : β) : b ∈ (p.bind f).support ↔ ∃ a ∈ p.support, b ∈ (f a).support :=
by simp

lemma coe_bind_apply (b : β) : (p.bind f b : ℝ≥0∞) = ∑'a, p a * f a b :=
eq.trans (ennreal.coe_tsum $ bind.summable p f b) $ by simp

@[simp] lemma pure_bind (a : α) : (pure a).bind f = f a :=
have ∀ b a', ite (a' = a) 1 0 * f a' b = ite (a' = a) (f a b) 0, from
  assume b a', by split_ifs; simp; subst h; simp,
by ext b; simp [this]

@[simp] lemma bind_pure : p.bind pure = p :=
have ∀ a a', (p a * ite (a' = a) 1 0) = ite (a = a') (p a') 0, from
  assume a a', begin split_ifs; try { subst a }; try { subst a' }; simp * at * end,
by ext b; simp [this]

@[simp] lemma bind_bind : (p.bind f).bind g = p.bind (λ a, (f a).bind g) :=
begin
  ext1 b,
  simp only [ennreal.coe_eq_coe.symm, coe_bind_apply, ennreal.tsum_mul_left.symm,
             ennreal.tsum_mul_right.symm],
  rw [ennreal.tsum_comm],
  simp [mul_assoc, mul_left_comm, mul_comm]
end

lemma bind_comm (p : pmf α) (q : pmf β) (f : α → β → pmf γ) :
  p.bind (λ a, q.bind (f a)) = q.bind (λ b, p.bind (λ a, f a b)) :=
begin
  ext1 b,
  simp only [ennreal.coe_eq_coe.symm, coe_bind_apply, ennreal.tsum_mul_left.symm,
             ennreal.tsum_mul_right.symm],
  rw [ennreal.tsum_comm],
  simp [mul_assoc, mul_left_comm, mul_comm]
end

section measure

variable (s : set β)

@[simp] lemma to_outer_measure_bind_apply :
  (p.bind f).to_outer_measure s = ∑' (a : α), (p a : ℝ≥0∞) * (f a).to_outer_measure s :=
calc (p.bind f).to_outer_measure s
  = ∑' (b : β), if b ∈ s then (↑(∑' (a : α), p a * f a b) : ℝ≥0∞) else 0 :
    by simp [to_outer_measure_apply, set.indicator_apply]
  ... = ∑' (b : β), ↑(∑' (a : α), p a * (if b ∈ s then f a b else 0)) :
    tsum_congr (λ b, by split_ifs; simp)
  ... = ∑' (b : β) (a : α), ↑(p a * (if b ∈ s then f a b else 0)) :
    tsum_congr (λ b, ennreal.coe_tsum $
      nnreal.summable_of_le (by split_ifs; simp) (bind.summable p f b))
  ... = ∑' (a : α) (b : β), ↑(p a) * ↑(if b ∈ s then f a b else 0) :
    ennreal.tsum_comm.trans (tsum_congr $ λ a, tsum_congr $ λ b, ennreal.coe_mul)
  ... = ∑' (a : α), ↑(p a) * ∑' (b : β), ↑(if b ∈ s then f a b else 0) :
    tsum_congr (λ a, ennreal.tsum_mul_left)
  ... = ∑' (a : α), ↑(p a) * ∑' (b : β), if b ∈ s then ↑(f a b) else (0 : ℝ≥0∞) :
    tsum_congr (λ a, congr_arg (λ x, ↑(p a) * x) $ tsum_congr (λ b, by split_ifs; refl))
  ... = ∑' (a : α), ↑(p a) * (f a).to_outer_measure s :
    tsum_congr (λ a, by rw [to_outer_measure_apply, set.indicator])

/-- The measure of a set under `p.bind f` is the sum over `a : α`
  of the probability of `a` under `p` times the measure of the set under `f a` -/
@[simp] lemma to_measure_bind_apply [measurable_space β] (hs : measurable_set s) :
  (p.bind f).to_measure s = ∑' (a : α), (p a : ℝ≥0∞) * (f a).to_measure s :=
(to_measure_apply_eq_to_outer_measure_apply (p.bind f) s hs).trans
  ((to_outer_measure_bind_apply p f s).trans (tsum_congr (λ a, congr_arg (λ x, p a * x)
  (to_measure_apply_eq_to_outer_measure_apply (f a) s hs).symm)))

end measure

end bind

instance : monad pmf :=
{ pure := λ A a, pure a,
  bind := λ A B pa pb, pa.bind pb }

section bind_on_support

protected lemma bind_on_support.summable (p : pmf α) (f : Π a ∈ p.support, pmf β) (b : β) :
  summable (λ a : α, p a * if h : p a = 0 then 0 else f a h b) :=
begin
  refine nnreal.summable_of_le (assume a, _) p.summable_coe,
  split_ifs,
  { refine (mul_zero (p a)).symm ▸ le_of_eq h.symm },
  { suffices : p a * f a h b ≤ p a * 1, { simpa },
    exact mul_le_mul_of_nonneg_left ((f a h).coe_le_one _) (p a).2 }
end

/-- Generalized version of `bind` allowing `f` to only be defined on the support of `p`.
  `p.bind f` is equivalent to `p.bind_on_support (λ a _, f a)`, see `bind_on_support_eq_bind` -/
def bind_on_support (p : pmf α) (f : Π a ∈ p.support, pmf β) : pmf β :=
⟨λ b, ∑' a, p a * if h : p a = 0 then 0 else f a h b,
ennreal.has_sum_coe.1 begin
  simp only [ennreal.coe_tsum (bind_on_support.summable p f _)],
  rw [ennreal.summable.has_sum_iff, ennreal.tsum_comm],
  simp only [ennreal.coe_mul, ennreal.coe_one, ennreal.tsum_mul_left],
  have : ∑' (a : α), (p a : ennreal) = 1 :=
    by simp only [←ennreal.coe_tsum p.summable_coe, ennreal.coe_one, tsum_coe],
  refine trans (tsum_congr (λ a, _)) this,
  split_ifs with h,
  { simp [h] },
  { simp [← ennreal.coe_tsum (f a h).summable_coe, (f a h).tsum_coe] }
end⟩

variables {p : pmf α} (f : Π a ∈ p.support, pmf β)

@[simp] lemma bind_on_support_apply (b : β) :
  p.bind_on_support f b = ∑' a, p a * if h : p a = 0 then 0 else f a h b :=
rfl

@[simp] lemma support_bind_on_support :
  (p.bind_on_support f).support = {b | ∃ (a : α) (h : a ∈ p.support), b ∈ (f a h).support} :=
begin
  refine set.ext (λ b, _),
  simp only [tsum_eq_zero_iff (bind_on_support.summable p f b), not_or_distrib, mem_support_iff,
    bind_on_support_apply, ne.def, not_forall, mul_eq_zero],
  exact ⟨λ hb, let ⟨a, ⟨ha, ha'⟩⟩ := hb in ⟨a, ha, by simpa [ha] using ha'⟩,
    λ hb, let ⟨a, ha, ha'⟩ := hb in ⟨a, ⟨ha, by simpa [(mem_support_iff _ a).1 ha] using ha'⟩⟩⟩
end

lemma mem_support_bind_on_support_iff (b : β) :
  b ∈ (p.bind_on_support f).support ↔ ∃ (a : α) (h : a ∈ p.support), b ∈ (f a h).support :=
by simp

/-- `bind_on_support` reduces to `bind` if `f` doesn't depend on the additional hypothesis -/
@[simp] lemma bind_on_support_eq_bind (p : pmf α) (f : α → pmf β) :
  p.bind_on_support (λ a _, f a) = p.bind f :=
begin
  ext b,
  simp only [bind_on_support_apply (λ a _, f a), p.bind_apply f,
    dite_eq_ite, nnreal.coe_eq, mul_ite, mul_zero],
  refine congr_arg _ (funext (λ a, _)),
  split_ifs with h; simp [h],
end

lemma coe_bind_on_support_apply (b : β) :
  (p.bind_on_support f b : ℝ≥0∞) = ∑' a, p a * if h : p a = 0 then 0 else f a h b :=
by simp only [bind_on_support_apply, ennreal.coe_tsum (bind_on_support.summable p f b),
    dite_cast, ennreal.coe_mul, ennreal.coe_zero]

lemma bind_on_support_eq_zero_iff (b : β) :
  p.bind_on_support f b = 0 ↔ ∀ a (ha : p a ≠ 0), f a ha b = 0 :=
begin
  simp only [bind_on_support_apply, tsum_eq_zero_iff (bind_on_support.summable p f b),
    mul_eq_zero, or_iff_not_imp_left],
  exact ⟨λ h a ha, trans (dif_neg ha).symm (h a ha), λ h a ha, trans (dif_neg ha) (h a ha)⟩,
end

@[simp] lemma pure_bind_on_support (a : α) (f : Π (a' : α) (ha : a' ∈ (pure a).support), pmf β) :
  (pure a).bind_on_support f = f a ((mem_support_pure_iff a a).mpr rfl) :=
begin
  refine pmf.ext (λ b, _),
  simp only [nnreal.coe_eq, bind_on_support_apply, pure_apply],
  refine trans (tsum_congr (λ a', _)) (tsum_ite_eq a _),
  by_cases h : (a' = a); simp [h],
end

lemma bind_on_support_pure (p : pmf α) :
  p.bind_on_support (λ a _, pure a) = p :=
by simp only [pmf.bind_pure, pmf.bind_on_support_eq_bind]

@[simp] lemma bind_on_support_bind_on_support (p : pmf α)
  (f : ∀ a ∈ p.support, pmf β)
  (g : ∀ (b ∈ (p.bind_on_support f).support), pmf γ) :
  (p.bind_on_support f).bind_on_support g =
    p.bind_on_support (λ a ha, (f a ha).bind_on_support
      (λ b hb, g b ((mem_support_bind_on_support_iff f b).mpr ⟨a, ha, hb⟩))) :=
begin
  refine pmf.ext (λ a, _),
  simp only [ennreal.coe_eq_coe.symm, coe_bind_on_support_apply, ← tsum_dite_right,
    ennreal.tsum_mul_left.symm, ennreal.tsum_mul_right.symm],
  simp only [ennreal.tsum_eq_zero, ennreal.coe_eq_coe, ennreal.coe_eq_zero, ennreal.coe_zero,
    dite_eq_left_iff, mul_eq_zero],
  refine ennreal.tsum_comm.trans (tsum_congr (λ a', tsum_congr (λ b, _))),
  split_ifs,
  any_goals { ring1 },
  { have := h_1 a', simp [h] at this, contradiction },
  { simp [h_2], },
end

lemma bind_on_support_comm (p : pmf α) (q : pmf β)
  (f : ∀ (a ∈ p.support) (b ∈ q.support), pmf γ) :
  p.bind_on_support (λ a ha, q.bind_on_support (f a ha)) =
    q.bind_on_support (λ b hb, p.bind_on_support (λ a ha, f a ha b hb)) :=
begin
  apply pmf.ext, rintro c,
  simp only [ennreal.coe_eq_coe.symm, coe_bind_on_support_apply, ← tsum_dite_right,
    ennreal.tsum_mul_left.symm, ennreal.tsum_mul_right.symm],
  refine trans (ennreal.tsum_comm) (tsum_congr (λ b, tsum_congr (λ a, _))),
  split_ifs with h1 h2 h2; ring,
end

section measure

variable (s : set β)

@[simp] lemma to_outer_measure_bind_on_support_apply :
  (p.bind_on_support f).to_outer_measure s =
    ∑' (a : α), (p a : ℝ≥0) * if h : p a = 0 then 0 else (f a h).to_outer_measure s :=
let g : α → β → ℝ≥0 := λ a b, if h : p a = 0 then 0 else f a h b in
calc (p.bind_on_support f).to_outer_measure s
  = ∑' (b : β), if b ∈ s then ↑(∑' (a : α), p a * g a b) else 0 :
    by simp [to_outer_measure_apply, set.indicator_apply]
  ... = ∑' (b : β), ↑(∑' (a : α), p a * (if b ∈ s then g a b else 0)) :
    tsum_congr (λ b, by split_ifs; simp)
  ... = ∑' (b : β) (a : α), ↑(p a * (if b ∈ s then g a b else 0)) :
    tsum_congr (λ b, ennreal.coe_tsum $
      nnreal.summable_of_le (by split_ifs; simp) (bind_on_support.summable p f b))
  ... = ∑' (a : α) (b : β), ↑(p a) * ↑(if b ∈ s then g a b else 0) :
    ennreal.tsum_comm.trans (tsum_congr $ λ a, tsum_congr $ λ b, ennreal.coe_mul)
  ... = ∑' (a : α), ↑(p a) * ∑' (b : β), ↑(if b ∈ s then g a b else 0) :
    tsum_congr (λ a, ennreal.tsum_mul_left)
  ... = ∑' (a : α), ↑(p a) * ∑' (b : β), if b ∈ s then ↑(g a b) else (0 : ℝ≥0∞) :
    tsum_congr (λ a, congr_arg (λ x, ↑(p a) * x) $ tsum_congr (λ b, by split_ifs; refl))
  ... = ∑' (a : α), ↑(p a) * if h : p a = 0 then 0 else (f a h).to_outer_measure s :
    tsum_congr (λ a, congr_arg (has_mul.mul ↑(p a)) begin
      split_ifs with h h,
      { exact ennreal.tsum_eq_zero.mpr (λ x,
          (by simp [g, h] : (0 : ℝ≥0∞) = ↑(g a x)) ▸ (if_t_t (x ∈ s) 0)) },
      { simp [to_outer_measure_apply, g, h, set.indicator_apply] }
    end)

/-- The measure of a set under `p.bind_on_support f` is the sum over `a : α`
  of the probability of `a` under `p` times the measure of the set under `f a _`.
  The additional if statement is needed since `f` is only a partial function -/
@[simp] lemma to_measure_bind_on_support_apply [measurable_space β] (hs : measurable_set s) :
  (p.bind_on_support f).to_measure s =
    ∑' (a : α), (p a : ℝ≥0∞) * if h : p a = 0 then 0 else (f a h).to_measure s :=
(to_measure_apply_eq_to_outer_measure_apply (p.bind_on_support f) s hs).trans
  ((to_outer_measure_bind_on_support_apply f s).trans
  (tsum_congr $ λ a, congr_arg (has_mul.mul ↑(p a)) (congr_arg (dite (p a = 0) (λ _, 0))
    $ funext (λ h, symm $ to_measure_apply_eq_to_outer_measure_apply (f a h) s hs))))

end measure

end bind_on_support

end pmf


/- Exercício 5

Formalize os argumentos abaixo e determine quais são válidos. Justifique via tabela verdade.

-/

-- (a) Se Jones é um comunista, então Jones é ateu. Jones é ateu. Logo, Jones é comunista.
-- resposta

/- NÃO ESTÁ BOM
 PRIMEIRO, IDENTIFIQUE AS PROPOSIÇÕES:
p : jONES É COMUNISTA
q : jONES É ATEU
SEGUNDO, UMA FÓRMULA PARA CADA AFIRMAÇÃO.
O ARGUMENTO FICA
  p → q, q ⊧ p  (esse símbolo é feito escrevendo \Vdash)
POR FIM, PODE MONTAR A FÓRMULA COMPLETA
#CHECK ((p → q) ∧ q) → p
ACHO QUE AQUI SERIA MAIS INTERESSANTE USAR O MODELO EXAMPLE,
PARA IDENTIFICAR PREMISSAS E CONCLUSÃO (veja abaixo).
-/

/-

Example x Theorem :

The example command states a theorem without
naming it or storing it in the permanent context.
Essentially, it just checks that the given term has the indicated type.

The Theorem: it is never necessary to unfold the “definition” of a theorem;
 by proof irrelevance, any two proofs of that theorem are definitionally equal.
 Once the proof of a theorem is complete, typically we only need to know that the proof exists;
 it doesn’t matter what the proof is.
 In light of that fact, Lean tags proofs as irreducible, which serves as a hint to the parser (more precisely, the elaborator)
 that there is generally no need to unfold it when processing a file.
  In fact, Lean is generally able to process and check proofs in parallel, since assessing the correctness of one proof does not require knowing the details of another.

-/

 /- variables p q : Prop
example (h₁ : p → q) (h₂ : q) : p := sorry
--ou
example : ((p → q) ∧ q) → p := sorry

-- NOTE QUE NÃO É ESSA FÓRMULA QUE QUEREMOS VERIFICAR SE É TAUTOLOGIA.
#check ( p → q ) ∧ (q → p)

-/
/- b) Se a temperatura e a pressão do ar estavam constantes, então não houve chuva. A temperatura permaneceu
-- constante. Portanto, se choveu, então a pressão do ar não se manteve constante.
--resposta

t : Temperatura constante
p: Pressao constante
c: houve chuva

-/
variables t p c : Prop
example (h1 : t ∧ p) (h2 : ¬ c) : c → ¬ p := sorry
#check (((t ∧ p ) → ¬ c ) ∧ t) → (c → ¬ p)

/- (c) Se Gorton ganhar a eleição, os impostos subirão se o déficit permanecer alto. Se Gorton ganhar a eleição,
o déficit permanecerá alto. Ou seja, se Gorton ganhar, haverá aumento de impostos.
resposta

g: Gorton ganhará a eleição
i: impostos subirão
d: déficit alto

-/

variables g i d : Prop
example (h1: g → d → i) (h2: g → d) : g → i := sorry
#check (g → d → i) ∧ (g → d ) → (g → i )

/- d) Se o número x termina em 0, então é divisível por 5. O número x não termina em 0. Logo, x não é
divisível por 5.

n : x termina em zero
s : x divisivel por 5

--/

variables n s : Prop
example (h1: n → s) (h2: ¬ n) : ¬ s := sorry
#check ((n → s) ∧ ¬ n) → ¬s

/-
(e) Se a = 0 e b = 0, então ab = 0. Mas ab , 0. Portanto, a , 0 e b , 0.

Professora não entendi essa questão
-/

 /- (f) Uma condição suficiente para f ser integrável é que g seja limitada. Uma condição necessária para que h
seja contínua é que f seja integrável. Logo, se g é limitada ou h é contínua, então f é integrável.

f : f é integravel
l : g é limitada
h : h é continua
--/

variables f l h : Prop
example (h1: l → f) (h2: h → f) :  (l ∨ h) → f := sorry
#check (l → f) ∧ ( h → f) → (l ∨ h ) → f

/-
g) Smith não pode, ao mesmo tempo, ser maratonista e fumante. Smith não é maratonista. Logo, Smith é
fumante.

m : smith é maratonista
a: smith é fumante
--/

variables  m a: Prop
example (h1: ¬ (m ∧ a ) ) (h2: ¬ m) : a := sorry
#check (¬ (m ∧ a) ∧ ¬ m) → a

/-
(h) Se Jones dirigiu o carro, Smith é inocente. Se Brown disparou a arma, Smith não é inocente. Portanto,
se Brown disparou a arma, então Jones não dirigiu o carro.

j: jones dirigiu o carro
o: smith é inocente
b: brown disparou a arma

-/

variables j o b : Prop
example(h1: j → o ) (h2: b → ¬ o) : b → ¬ j := sorry
#check  (j → o ) ∧ (b → ¬ o) →  (b → ¬ j )