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

import algebra.group_ring_action.basic
import algebra.hom.ring
import algebra.ring.inj_surj
import group_theory.congruence

/-!
# Congruence relations on rings

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

This file defines congruence relations on rings, which extend `con` and `add_con` on monoids and
additive monoids.

Most of the time you likely want to use the `ideal.quotient` API that is built on top of this.

## Main Definitions

* `ring_con R`: the type of congruence relations respecting `+` and `*`.
* `ring_con_gen r`: the inductively defined smallest ring congruence relation containing a given
  binary relation.

## TODO

* Use this for `ring_quot` too.
* Copy across more API from `con` and `add_con` in `group_theory/congruence.lean`, such as:
  * The `complete_lattice` structure.
  * The `con_gen_eq` lemma, stating that
    `ring_con_gen r = Inf {s : ring_con M | ∀ x y, r x y → s x y}`.
-/

/-- A congruence relation on a type with an addition and multiplication is an equivalence relation
which preserves both. -/
/- Note: we can't extend both `add_con R` and `mul_con R` in Lean 3 due to interactions between old-
and new-style structures. We can revisit this in Lean 4. (After and not during the port!) -/
structure ring_con (R : Type*) [has_add R] [has_mul R] extends setoid R :=
(add' : ∀ {w x y z}, r w x → r y z → r (w + y) (x + z))
(mul' : ∀ {w x y z}, r w x → r y z → r (w * y) (x * z))

variables {α R : Type*}

/-- The inductively defined smallest ring congruence relation containing a given binary
    relation. -/
inductive ring_con_gen.rel [has_add R] [has_mul R] (r : R → R → Prop) : R → R → Prop
| of : Π x y, r x y → ring_con_gen.rel x y
| refl : Π x, ring_con_gen.rel x x
| symm : Π {x y}, ring_con_gen.rel x y → ring_con_gen.rel y x
| trans : Π {x y z}, ring_con_gen.rel x y → ring_con_gen.rel y z → ring_con_gen.rel x z
| add : Π {w x y z}, ring_con_gen.rel w x → ring_con_gen.rel y z → ring_con_gen.rel (w + y) (x + z)
| mul : Π {w x y z}, ring_con_gen.rel w x → ring_con_gen.rel y z → ring_con_gen.rel (w * y) (x * z)

/-- The inductively defined smallest ring congruence relation containing a given binary
    relation. -/
def ring_con_gen [has_add R] [has_mul R] (r : R → R → Prop) : ring_con R :=
{ r := ring_con_gen.rel r,
  iseqv := ⟨ring_con_gen.rel.refl, @ring_con_gen.rel.symm _ _ _ _, @ring_con_gen.rel.trans _ _ _ _⟩,
  add' := λ _ _ _ _, ring_con_gen.rel.add,
  mul' := λ _ _ _ _, ring_con_gen.rel.mul }

namespace ring_con

section basic
variables [has_add R] [has_mul R] (c : ring_con R)

/-- Every `ring_con` is also an `add_con` -/
def to_add_con : add_con R := { ..c }

/-- Every `ring_con` is also a `con` -/
def to_con : con R := { ..c }

/-- A coercion from a congruence relation to its underlying binary relation. -/
instance : has_coe_to_fun (ring_con R) (λ _, R → R → Prop) := ⟨λ c, c.r⟩

@[simp]

protected lemma refl (x) : c x x := c.refl' x
protected lemma symm {x y} : c x y → c y x := c.symm'
protected lemma trans {x y z} : c x y → c y z → c x z := c.trans'
protected lemma add {w x y z} : c w x → c y z → c (w + y) (x + z) := c.add'
protected lemma mul {w x y z} : c w x → c y z → c (w * y) (x * z) := c.mul'

@[simp] lemma rel_mk {s : setoid R} {ha hm a b} : ring_con.mk s ha hm a b ↔ setoid.r a b := iff.rfl

instance : inhabited (ring_con R) := ⟨ring_con_gen empty_relation⟩

end basic

section quotient

section basic
variables [has_add R] [has_mul R] (c : ring_con R)
/-- Defining the quotient by a congruence relation of a type with addition and multiplication. -/
protected def quotient := quotient c.to_setoid

/-- Coercion from a type with addition and multiplication to its quotient by a congruence relation.

See Note [use has_coe_t]. -/
instance : has_coe_t R c.quotient := ⟨@quotient.mk _ c.to_setoid⟩

/-- The quotient by a decidable congruence relation has decidable equality. -/
-- Lower the priority since it unifies with any quotient type.
@[priority 500] instance [d : ∀ a b, decidable (c a b)] : decidable_eq c.quotient :=
@quotient.decidable_eq R c.to_setoid d

@[simp] lemma quot_mk_eq_coe (x : R) : quot.mk c x = (x : c.quotient) := rfl

/-- Two elements are related by a congruence relation `c` iff they are represented by the same
element of the quotient by `c`. -/
@[simp] protected lemma eq {a b : R} : (a : c.quotient) = b ↔ c a b := quotient.eq'

end basic

/-! ### Basic notation

The basic algebraic notation, `0`, `1`, `+`, `*`, `-`, `^`, descend naturally under the quotient
-/
section data

section add_mul
variables [has_add R] [has_mul R] (c : ring_con R)
instance : has_add c.quotient := c.to_add_con.has_add
@[simp, norm_cast] lemma coe_add (x y : R) : (↑(x + y) : c.quotient) = ↑x + ↑y := rfl
instance : has_mul c.quotient := c.to_con.has_mul
@[simp, norm_cast] lemma coe_mul (x y : R) : (↑(x * y) : c.quotient) = ↑x * ↑y := rfl
end add_mul

section zero
variables [add_zero_class R] [has_mul R] (c : ring_con R)
instance : has_zero c.quotient := c.to_add_con^.quotient.has_zero
@[simp, norm_cast] lemma coe_zero : (↑(0 : R) : c.quotient) = 0 := rfl
end zero

section one
variables [has_add R] [mul_one_class R] (c : ring_con R)
instance : has_one c.quotient := c.to_con^.quotient.has_one
@[simp, norm_cast] lemma coe_one : (↑(1 : R) : c.quotient) = 1 := rfl
end one

section smul
variables [has_add R] [mul_one_class R] [has_smul α R] [is_scalar_tower α R R] (c : ring_con R)
instance : has_smul α c.quotient := c.to_con.has_smul
@[simp, norm_cast] lemma coe_smul (a : α) (x : R) : (↑(a • x) : c.quotient) = a • x := rfl
end smul

section neg_sub_zsmul
variables [add_group R] [has_mul R] (c : ring_con R)
instance : has_neg c.quotient := c.to_add_con^.has_neg
@[simp, norm_cast] lemma coe_neg (x : R) : (↑(-x) : c.quotient) = -x := rfl
instance : has_sub c.quotient := c.to_add_con^.has_sub
@[simp, norm_cast] lemma coe_sub (x y : R) : (↑(x - y) : c.quotient) = x - y := rfl
instance has_zsmul : has_smul ℤ c.quotient := c.to_add_con^.quotient.has_zsmul
@[simp, norm_cast] lemma coe_zsmul (z : ℤ) (x : R) : (↑(z • x) : c.quotient) = z • x := rfl
end neg_sub_zsmul

section nsmul
variables [add_monoid R] [has_mul R] (c : ring_con R)
instance has_nsmul : has_smul ℕ c.quotient := c.to_add_con^.quotient.has_nsmul
@[simp, norm_cast] lemma coe_nsmul (n : ℕ) (x : R) : (↑(n • x) : c.quotient) = n • x := rfl
end nsmul

section pow
variables [has_add R] [monoid R] (c : ring_con R)
instance : has_pow c.quotient ℕ := c.to_con^.nat.has_pow
@[simp, norm_cast] lemma coe_pow (x : R) (n : ℕ) : (↑(x ^ n) : c.quotient) = x ^ n := rfl
end pow

section nat_cast
variables [add_monoid_with_one R] [has_mul R] (c : ring_con R)
instance : has_nat_cast c.quotient := ⟨λ n, ↑(n : R)⟩
@[simp, norm_cast] lemma coe_nat_cast (n : ℕ) : (↑(n : R) : c.quotient) = n := rfl
end nat_cast

section int_cast
variables [add_group_with_one R] [has_mul R] (c : ring_con R)
instance : has_int_cast c.quotient := ⟨λ z, ↑(z : R)⟩
@[simp, norm_cast] lemma coe_int_cast (n : ℕ) : (↑(n : R) : c.quotient) = n := rfl
end int_cast

instance [inhabited R] [has_add R] [has_mul R] (c : ring_con R) : inhabited c.quotient :=
⟨↑(default : R)⟩

end data

/-! ### Algebraic structure

The operations above on the quotient by `c : ring_con R` preseverse the algebraic structure of `R`.
-/

section algebraic

instance [non_unital_non_assoc_semiring R] (c : ring_con R) :
  non_unital_non_assoc_semiring c.quotient :=
function.surjective.non_unital_non_assoc_semiring _ quotient.surjective_quotient_mk'
  rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)

instance [non_assoc_semiring R] (c : ring_con R) :
  non_assoc_semiring c.quotient :=
function.surjective.non_assoc_semiring _ quotient.surjective_quotient_mk'
  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl)

instance [non_unital_semiring R] (c : ring_con R) :
  non_unital_semiring c.quotient :=
function.surjective.non_unital_semiring _ quotient.surjective_quotient_mk'
  rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)

instance [semiring R] (c : ring_con R) :
  semiring c.quotient :=
function.surjective.semiring _ quotient.surjective_quotient_mk'
  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl)

instance [comm_semiring R] (c : ring_con R) :
  comm_semiring c.quotient :=
function.surjective.comm_semiring _ quotient.surjective_quotient_mk'
  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl)

instance [non_unital_non_assoc_ring R] (c : ring_con R) :
  non_unital_non_assoc_ring c.quotient :=
function.surjective.non_unital_non_assoc_ring _ quotient.surjective_quotient_mk'
  rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)

instance [non_assoc_ring R] (c : ring_con R) :
  non_assoc_ring c.quotient :=
function.surjective.non_assoc_ring _ quotient.surjective_quotient_mk'
  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl)
  (λ _, rfl)

instance [non_unital_ring R] (c : ring_con R) :
  non_unital_ring c.quotient :=
function.surjective.non_unital_ring _ quotient.surjective_quotient_mk'
  rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)

instance [ring R] (c : ring_con R) :
  ring c.quotient :=
function.surjective.ring _ quotient.surjective_quotient_mk'
  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
  (λ _, rfl) (λ _, rfl)

instance [comm_ring R] (c : ring_con R) :
  comm_ring c.quotient :=
function.surjective.comm_ring _ quotient.surjective_quotient_mk'
  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
  (λ _, rfl) (λ _, rfl)

instance [monoid α] [non_assoc_semiring R] [distrib_mul_action α R] [is_scalar_tower α R R]
  (c : ring_con R) :
  distrib_mul_action α c.quotient :=
{ smul := (•),
  smul_zero := λ r, congr_arg quotient.mk' $ smul_zero _,
  smul_add := λ r, quotient.ind₂' $ by exact λ m₁ m₂, congr_arg quotient.mk' $ smul_add _ _ _,
  .. c.to_con.mul_action }

instance [monoid α] [semiring R] [mul_semiring_action α R] [is_scalar_tower α R R]
  (c : ring_con R) :
  mul_semiring_action α c.quotient :=
{ smul := (•),
  .. c^.quotient.distrib_mul_action,
  .. c.to_con.mul_distrib_mul_action }

end algebraic

/-- The natural homomorphism from a ring to its quotient by a congruence relation. -/
def mk' [non_assoc_semiring R] (c : ring_con R) : R →+* c.quotient :=
{ to_fun := quotient.mk', map_zero' := rfl, map_one' := rfl,
  map_add' :=  λ _ _, rfl, map_mul' := λ _ _, rfl }

end quotient

end ring_con


/-
Copyright (c) 2017 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Mario Carneiro, Johannes Hölzl, Chris Hughes, Jens Wagemaker
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.group.basic
import Mathlib.logic.nontrivial
import Mathlib.PostPort

universes u l u_1

namespace Mathlib

/-!
# Units (i.e., invertible elements) of a multiplicative monoid
-/

/-- Units of a monoid, bundled version. An element of a `monoid` is a unit if it has a two-sided
inverse. This version bundles the inverse element so that it can be computed. For a predicate
see `is_unit`. -/
structure units (α : Type u) [monoid α] where
  val : α
  inv : α
  val_inv : val * inv = 1
  inv_val : inv * val = 1

/-- Units of an add_monoid, bundled version. An element of an add_monoid is a unit if it has a
    two-sided additive inverse. This version bundles the inverse element so that it can be
    computed. For a predicate see `is_add_unit`. -/
structure add_units (α : Type u) [add_monoid α] where
  val : α
  neg : α
  val_neg : val + neg = 0
  neg_val : neg + val = 0

namespace units

protected instance Mathlib.add_units.has_coe {α : Type u} [add_monoid α] :
    has_coe (add_units α) α :=
  has_coe.mk add_units.val

@[simp] theorem Mathlib.add_units.coe_mk {α : Type u} [add_monoid α] (a : α) (b : α)
    (h₁ : a + b = 0) (h₂ : b + a = 0) : ↑(add_units.mk a b h₁ h₂) = a :=
  rfl

theorem ext {α : Type u} [monoid α] : function.injective coe := sorry

theorem Mathlib.add_units.eq_iff {α : Type u} [add_monoid α] {a : add_units α} {b : add_units α} :
    ↑a = ↑b ↔ a = b :=
  function.injective.eq_iff add_units.ext

theorem Mathlib.add_units.ext_iff {α : Type u} [add_monoid α] {a : add_units α} {b : add_units α} :
    a = b ↔ ↑a = ↑b :=
  iff.symm add_units.eq_iff

protected instance Mathlib.add_units.decidable_eq {α : Type u} [add_monoid α] [DecidableEq α] :
    DecidableEq (add_units α) :=
  fun (a b : add_units α) => decidable_of_iff' (↑a = ↑b) add_units.ext_iff

@[simp] theorem mk_coe {α : Type u} [monoid α] (u : units α) (y : α) (h₁ : ↑u * y = 1)
    (h₂ : y * ↑u = 1) : mk (↑u) y h₁ h₂ = u :=
  ext rfl

/-- Units of a monoid form a group. -/
protected instance group {α : Type u} [monoid α] : group (units α) :=
  group.mk (fun (u₁ u₂ : units α) => mk (val u₁ * val u₂) (inv u₂ * inv u₁) sorry sorry) sorry
    (mk 1 1 sorry sorry) sorry sorry
    (fun (u : units α) => mk (inv u) (val u) (inv_val u) (val_inv u))
    (div_inv_monoid.div._default
      (fun (u₁ u₂ : units α) => mk (val u₁ * val u₂) (inv u₂ * inv u₁) sorry sorry) sorry
      (mk 1 1 sorry sorry) sorry sorry
      fun (u : units α) => mk (inv u) (val u) (inv_val u) (val_inv u))
    sorry

@[simp] theorem Mathlib.add_units.coe_add {α : Type u} [add_monoid α] (a : add_units α)
    (b : add_units α) : ↑(a + b) = ↑a + ↑b :=
  rfl

@[simp] theorem coe_one {α : Type u} [monoid α] : ↑1 = 1 := rfl

@[simp] theorem Mathlib.add_units.coe_eq_zero {α : Type u} [add_monoid α] {a : add_units α} :
    ↑a = 0 ↔ a = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑a = 0 ↔ a = 0)) (Eq.symm add_units.coe_zero)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑a = ↑0 ↔ a = 0)) (propext add_units.eq_iff)))
      (iff.refl (a = 0)))

@[simp] theorem inv_mk {α : Type u} [monoid α] (x : α) (y : α) (h₁ : x * y = 1) (h₂ : y * x = 1) :
    mk x y h₁ h₂⁻¹ = mk y x h₂ h₁ :=
  rfl

theorem val_coe {α : Type u} [monoid α] (a : units α) : ↑a = val a := rfl

theorem coe_inv {α : Type u} [monoid α] (a : units α) : ↑(a⁻¹) = inv a := rfl

@[simp] theorem inv_mul {α : Type u} [monoid α] (a : units α) : ↑(a⁻¹) * ↑a = 1 := inv_val a

@[simp] theorem Mathlib.add_units.add_neg {α : Type u} [add_monoid α] (a : add_units α) :
    ↑a + ↑(-a) = 0 :=
  add_units.val_neg a

theorem inv_mul_of_eq {α : Type u} [monoid α] {u : units α} {a : α} (h : ↑u = a) : ↑(u⁻¹) * a = 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑(u⁻¹) * a = 1)) (Eq.symm h)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑(u⁻¹) * ↑u = 1)) (inv_mul u))) (Eq.refl 1))

theorem Mathlib.add_units.add_neg_of_eq {α : Type u} [add_monoid α] {u : add_units α} {a : α}
    (h : ↑u = a) : a + ↑(-u) = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a + ↑(-u) = 0)) (Eq.symm h)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑u + ↑(-u) = 0)) (add_units.add_neg u))) (Eq.refl 0))

@[simp] theorem mul_inv_cancel_left {α : Type u} [monoid α] (a : units α) (b : α) :
    ↑a * (↑(a⁻¹) * b) = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑a * (↑(a⁻¹) * b) = b)) (Eq.symm (mul_assoc (↑a) (↑(a⁻¹)) b))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑a * ↑(a⁻¹) * b = b)) (mul_inv a)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (1 * b = b)) (one_mul b))) (Eq.refl b)))

@[simp] theorem Mathlib.add_units.neg_add_cancel_left {α : Type u} [add_monoid α] (a : add_units α)
    (b : α) : ↑(-a) + (↑a + b) = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑(-a) + (↑a + b) = b)) (Eq.symm (add_assoc (↑(-a)) (↑a) b))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑(-a) + ↑a + b = b)) (add_units.neg_add a)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (0 + b = b)) (zero_add b))) (Eq.refl b)))

@[simp] theorem mul_inv_cancel_right {α : Type u} [monoid α] (a : α) (b : units α) :
    a * ↑b * ↑(b⁻¹) = a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * ↑b * ↑(b⁻¹) = a)) (mul_assoc a ↑b ↑(b⁻¹))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * (↑b * ↑(b⁻¹)) = a)) (mul_inv b)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a * 1 = a)) (mul_one a))) (Eq.refl a)))

@[simp] theorem Mathlib.add_units.neg_add_cancel_right {α : Type u} [add_monoid α] (a : α)
    (b : add_units α) : a + ↑(-b) + ↑b = a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a + ↑(-b) + ↑b = a)) (add_assoc a ↑(-b) ↑b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + (↑(-b) + ↑b) = a)) (add_units.neg_add b)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a + 0 = a)) (add_zero a))) (Eq.refl a)))

protected instance Mathlib.add_units.inhabited {α : Type u} [add_monoid α] :
    Inhabited (add_units α) :=
  { default := 0 }

protected instance comm_group {α : Type u_1} [comm_monoid α] : comm_group (units α) :=
  comm_group.mk group.mul sorry group.one sorry sorry group.inv group.div sorry sorry

protected instance Mathlib.add_units.has_repr {α : Type u} [add_monoid α] [has_repr α] :
    has_repr (add_units α) :=
  has_repr.mk (repr ∘ add_units.val)

@[simp] theorem Mathlib.add_units.add_right_inj {α : Type u} [add_monoid α] (a : add_units α)
    {b : α} {c : α} : ↑a + b = ↑a + c ↔ b = c :=
  sorry

@[simp] theorem Mathlib.add_units.add_left_inj {α : Type u} [add_monoid α] (a : add_units α) {b : α}
    {c : α} : b + ↑a = c + ↑a ↔ b = c :=
  sorry

theorem Mathlib.add_units.eq_add_neg_iff_add_eq {α : Type u} [add_monoid α] {c : add_units α}
    {a : α} {b : α} : a = b + ↑(-c) ↔ a + ↑c = b :=
  sorry

theorem eq_inv_mul_iff_mul_eq {α : Type u} [monoid α] (b : units α) {a : α} {c : α} :
    a = ↑(b⁻¹) * c ↔ ↑b * a = c :=
  sorry

theorem inv_mul_eq_iff_eq_mul {α : Type u} [monoid α] (a : units α) {b : α} {c : α} :
    ↑(a⁻¹) * b = c ↔ b = ↑a * c :=
  sorry

theorem mul_inv_eq_iff_eq_mul {α : Type u} [monoid α] (b : units α) {a : α} {c : α} :
    a * ↑(b⁻¹) = c ↔ a = c * ↑b :=
  sorry

theorem inv_eq_of_mul_eq_one {α : Type u} [monoid α] {u : units α} {a : α} (h : ↑u * a = 1) :
    ↑(u⁻¹) = a :=
  sorry

theorem inv_unique {α : Type u} [monoid α] {u₁ : units α} {u₂ : units α} (h : ↑u₁ = ↑u₂) :
    ↑(u₁⁻¹) = ↑(u₂⁻¹) :=
  (fun (this : ↑u₁ * ↑(u₂⁻¹) = 1) => inv_eq_of_mul_eq_one this)
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑u₁ * ↑(u₂⁻¹) = 1)) h))
      (eq.mpr (id (Eq._oldrec (Eq.refl (↑u₂ * ↑(u₂⁻¹) = 1)) (mul_inv u₂))) (Eq.refl 1)))

end units

/-- For `a, b` in a `comm_monoid` such that `a * b = 1`, makes a unit out of `a`. -/
def add_units.mk_of_add_eq_zero {α : Type u} [add_comm_monoid α] (a : α) (b : α) (hab : a + b = 0) :
    add_units α :=
  add_units.mk a b hab sorry

@[simp] theorem units.coe_mk_of_mul_eq_one {α : Type u} [comm_monoid α] {a : α} {b : α}
    (h : a * b = 1) : ↑(units.mk_of_mul_eq_one a b h) = a :=
  rfl

/-- Partial division. It is defined when the
  second argument is invertible, and unlike the division operator
  in `division_ring` it is not totalized at zero. -/
def divp {α : Type u} [monoid α] (a : α) (u : units α) : α := a * ↑(u⁻¹)

infixl:70 " /ₚ " => Mathlib.divp

@[simp] theorem divp_self {α : Type u} [monoid α] (u : units α) : ↑u /ₚ u = 1 := units.mul_inv u

@[simp] theorem divp_one {α : Type u} [monoid α] (a : α) : a /ₚ 1 = a := mul_one a

theorem divp_assoc {α : Type u} [monoid α] (a : α) (b : α) (u : units α) :
    a * b /ₚ u = a * (b /ₚ u) :=
  mul_assoc a b ↑(u⁻¹)

@[simp] theorem divp_inv {α : Type u} [monoid α] {a : α} (u : units α) : a /ₚ (u⁻¹) = a * ↑u := rfl

@[simp] theorem divp_mul_cancel {α : Type u} [monoid α] (a : α) (u : units α) : a /ₚ u * ↑u = a :=
  Eq.trans (mul_assoc a ↑(u⁻¹) ↑u)
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * (↑(u⁻¹) * ↑u) = a)) (units.inv_mul u)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a * 1 = a)) (mul_one a))) (Eq.refl a)))

@[simp] theorem mul_divp_cancel {α : Type u} [monoid α] (a : α) (u : units α) : a * ↑u /ₚ u = a :=
  Eq.trans (mul_assoc a ↑u ↑(u⁻¹))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * (↑u * ↑(u⁻¹)) = a)) (units.mul_inv u)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a * 1 = a)) (mul_one a))) (Eq.refl a)))

@[simp] theorem divp_left_inj {α : Type u} [monoid α] (u : units α) {a : α} {b : α} :
    a /ₚ u = b /ₚ u ↔ a = b :=
  units.mul_left_inj (u⁻¹)

theorem divp_divp_eq_divp_mul {α : Type u} [monoid α] (x : α) (u₁ : units α) (u₂ : units α) :
    x /ₚ u₁ /ₚ u₂ = x /ₚ (u₂ * u₁) :=
  sorry

theorem divp_eq_iff_mul_eq {α : Type u} [monoid α] {x : α} {u : units α} {y : α} :
    x /ₚ u = y ↔ y * ↑u = x :=
  iff.trans (iff.symm (units.mul_left_inj u))
    (eq.mpr (id (Eq._oldrec (Eq.refl (x /ₚ u * ↑u = y * ↑u ↔ y * ↑u = x)) (divp_mul_cancel x u)))
      { mp := Eq.symm, mpr := Eq.symm })

theorem divp_eq_one_iff_eq {α : Type u} [monoid α] {a : α} {u : units α} : a /ₚ u = 1 ↔ a = ↑u :=
  iff.trans (iff.symm (units.mul_left_inj u))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a /ₚ u * ↑u = 1 * ↑u ↔ a = ↑u)) (divp_mul_cancel a u)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a = 1 * ↑u ↔ a = ↑u)) (one_mul ↑u))) (iff.refl (a = ↑u))))

@[simp] theorem one_divp {α : Type u} [monoid α] (u : units α) : 1 /ₚ u = ↑(u⁻¹) := one_mul ↑(u⁻¹)

theorem divp_eq_divp_iff {α : Type u} [comm_monoid α] {x : α} {y : α} {ux : units α}
    {uy : units α} : x /ₚ ux = y /ₚ uy ↔ x * ↑uy = y * ↑ux :=
  sorry

theorem divp_mul_divp {α : Type u} [comm_monoid α] (x : α) (y : α) (ux : units α) (uy : units α) :
    x /ₚ ux * (y /ₚ uy) = x * y /ₚ (ux * uy) :=
  sorry

/-!
# `is_unit` predicate

In this file we define the `is_unit` predicate on a `monoid`, and
prove a few basic properties. For the bundled version see `units`. See
also `prime`, `associated`, and `irreducible` in `algebra/associated`.

-/

/-- An element `a : M` of a monoid is a unit if it has a two-sided inverse.
The actual definition says that `a` is equal to some `u : units M`, where
`units M` is a bundled version of `is_unit`. -/
def is_unit {M : Type u_1} [monoid M] (a : M) := ∃ (u : units M), ↑u = a

theorem is_unit_of_subsingleton {M : Type u_1} [monoid M] [subsingleton M] (a : M) : is_unit a :=
  Exists.intro (units.mk a a (subsingleton.elim (a * a) 1) (subsingleton.elim (a * a) 1)) rfl

@[simp] theorem is_unit_unit {M : Type u_1} [monoid M] (u : units M) : is_unit ↑u :=
  Exists.intro u rfl

@[simp] theorem is_add_unit_zero {M : Type u_1} [add_monoid M] : is_add_unit 0 := Exists.intro 0 rfl

theorem is_add_unit_of_add_eq_zero {M : Type u_1} [add_comm_monoid M] (a : M) (b : M)
    (h : a + b = 0) : is_add_unit a :=
  Exists.intro (add_units.mk_of_add_eq_zero a b h) rfl

theorem is_add_unit_iff_exists_neg {M : Type u_1} [add_comm_monoid M] {a : M} :
    is_add_unit a ↔ ∃ (b : M), a + b = 0 :=
  sorry

theorem is_add_unit_iff_exists_neg' {M : Type u_1} [add_comm_monoid M] {a : M} :
    is_add_unit a ↔ ∃ (b : M), b + a = 0 :=
  sorry

/-- Multiplication by a `u : units M` doesn't affect `is_unit`. -/
@[simp] theorem units.is_unit_mul_units {M : Type u_1} [monoid M] (a : M) (u : units M) :
    is_unit (a * ↑u) ↔ is_unit a :=
  sorry

theorem is_unit.mul {M : Type u_1} [monoid M] {x : M} {y : M} :
    is_unit x → is_unit y → is_unit (x * y) :=
  sorry

theorem is_add_unit_of_add_is_add_unit_left {M : Type u_1} [add_comm_monoid M] {x : M} {y : M}
    (hu : is_add_unit (x + y)) : is_add_unit x :=
  sorry

theorem is_unit_of_mul_is_unit_right {M : Type u_1} [comm_monoid M] {x : M} {y : M}
    (hu : is_unit (x * y)) : is_unit y :=
  is_unit_of_mul_is_unit_left
    (eq.mpr (id (Eq._oldrec (Eq.refl (is_unit (y * x))) (mul_comm y x))) hu)

theorem is_unit.mul_right_inj {M : Type u_1} [monoid M] {a : M} {b : M} {c : M} (ha : is_unit a) :
    a * b = a * c ↔ b = c :=
  sorry

theorem is_unit.mul_left_inj {M : Type u_1} [monoid M] {a : M} {b : M} {c : M} (ha : is_unit a) :
    b * a = c * a ↔ b = c :=
  sorry

/-- The element of the group of units, corresponding to an element of a monoid which is a unit. -/
def is_unit.unit {M : Type u_1} [monoid M] {a : M} (h : is_unit a) : units M := classical.some h

theorem is_unit.unit_spec {M : Type u_1} [monoid M] {a : M} (h : is_unit a) :
    ↑(is_unit.unit h) = a :=
  classical.some_spec h

/-- Constructs a `group` structure on a `monoid` consisting only of units. -/
def group_of_is_unit {M : Type u_1} [hM : monoid M] (h : ∀ (a : M), is_unit a) : group M :=
  group.mk monoid.mul monoid.mul_assoc monoid.one monoid.one_mul monoid.mul_one
    (fun (a : M) => ↑(is_unit.unit (h a)⁻¹))
    (div_inv_monoid.div._default monoid.mul monoid.mul_assoc monoid.one monoid.one_mul
      monoid.mul_one fun (a : M) => ↑(is_unit.unit (h a)⁻¹))
    sorry

/-- Constructs a `comm_group` structure on a `comm_monoid` consisting only of units. -/
def comm_group_of_is_unit {M : Type u_1} [hM : comm_monoid M] (h : ∀ (a : M), is_unit a) :
    comm_group M :=
  comm_group.mk comm_monoid.mul comm_monoid.mul_assoc comm_monoid.one comm_monoid.one_mul
    comm_monoid.mul_one (fun (a : M) => ↑(is_unit.unit (h a)⁻¹))
    (group.div._default comm_monoid.mul comm_monoid.mul_assoc comm_monoid.one comm_monoid.one_mul
      comm_monoid.mul_one fun (a : M) => ↑(is_unit.unit (h a)⁻¹))
    sorry comm_monoid.mul_comm

end Mathlib


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Violeta Hernández Palacios, Grayson Burton, Floris van Doorn
-/
import data.set.intervals.ord_connected
import order.antisymmetrization

/-!
# The covering relation

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

This file defines the covering relation in an order. `b` is said to cover `a` if `a < b` and there
is no element in between. We say that `b` weakly covers `a` if `a ≤ b` and there is no element
between `a` and `b`. In a partial order this is equivalent to `a ⋖ b ∨ a = b`, in a preorder this
is equivalent to `a ⋖ b ∨ (a ≤ b ∧ b ≤ a)`

## Notation

* `a ⋖ b` means that `b` covers `a`.
* `a ⩿ b` means that `b` weakly covers `a`.
-/

open set order_dual

variables {α β : Type*}

section weakly_covers

section preorder
variables [preorder α] [preorder β] {a b c : α}

/-- `wcovby a b` means that `a = b` or `b` covers `a`.
This means that `a ≤ b` and there is no element in between.
-/
def wcovby (a b : α) : Prop := a ≤ b ∧ ∀ ⦃c⦄, a < c → ¬ c < b

infix ` ⩿ `:50 := wcovby

lemma wcovby.le (h : a ⩿ b) : a ≤ b := h.1

lemma wcovby.refl (a : α) : a ⩿ a := ⟨le_rfl, λ c hc, hc.not_lt⟩
lemma wcovby.rfl : a ⩿ a := wcovby.refl a

protected lemma eq.wcovby (h : a = b) : a ⩿ b := h ▸ wcovby.rfl

lemma wcovby_of_le_of_le (h1 : a ≤ b) (h2 : b ≤ a) : a ⩿ b :=
⟨h1, λ c hac hcb, (hac.trans hcb).not_le h2⟩

alias wcovby_of_le_of_le ← has_le.le.wcovby_of_le

lemma antisymm_rel.wcovby (h : antisymm_rel (≤) a b) : a ⩿ b := wcovby_of_le_of_le h.1 h.2

lemma wcovby.wcovby_iff_le (hab : a ⩿ b) : b ⩿ a ↔ b ≤ a :=
⟨λ h, h.le, λ h, h.wcovby_of_le hab.le⟩

lemma wcovby_of_eq_or_eq (hab : a ≤ b) (h : ∀ c, a ≤ c → c ≤ b → c = a ∨ c = b) : a ⩿ b :=
⟨hab, λ c ha hb, (h c ha.le hb.le).elim ha.ne' hb.ne⟩

lemma antisymm_rel.trans_wcovby (hab : antisymm_rel (≤) a b) (hbc : b ⩿ c) : a ⩿ c :=
⟨hab.1.trans hbc.le, λ d had hdc, hbc.2 (hab.2.trans_lt had) hdc⟩

lemma wcovby_congr_left (hab : antisymm_rel (≤) a b) : a ⩿ c ↔ b ⩿ c :=
⟨hab.symm.trans_wcovby, hab.trans_wcovby⟩

lemma wcovby.trans_antisymm_rel (hab : a ⩿ b) (hbc : antisymm_rel (≤) b c) : a ⩿ c :=
⟨hab.le.trans hbc.1, λ d had hdc, hab.2 had $ hdc.trans_le hbc.2⟩

lemma wcovby_congr_right (hab : antisymm_rel (≤) a b) : c ⩿ a ↔ c ⩿ b :=
⟨λ h, h.trans_antisymm_rel hab, λ h, h.trans_antisymm_rel hab.symm⟩

/-- If `a ≤ b`, then `b` does not cover `a` iff there's an element in between. -/
lemma not_wcovby_iff (h : a ≤ b) : ¬ a ⩿ b ↔ ∃ c, a < c ∧ c < b :=
by simp_rw [wcovby, h, true_and, not_forall, exists_prop, not_not]

instance wcovby.is_refl : is_refl α (⩿) := ⟨wcovby.refl⟩

lemma wcovby.Ioo_eq (h : a ⩿ b) : Ioo a b = ∅ :=
eq_empty_iff_forall_not_mem.2 $ λ x hx, h.2 hx.1 hx.2

lemma wcovby_iff_Ioo_eq : a ⩿ b ↔ a ≤ b ∧ Ioo a b = ∅ :=
and_congr_right' $ by simp [eq_empty_iff_forall_not_mem]

lemma wcovby.of_image (f : α ↪o β) (h : f a ⩿ f b) : a ⩿ b :=
⟨f.le_iff_le.mp h.le, λ c hac hcb, h.2 (f.lt_iff_lt.mpr hac) (f.lt_iff_lt.mpr hcb)⟩

lemma wcovby.image (f : α ↪o β) (hab : a ⩿ b) (h : (range f).ord_connected) : f a ⩿ f b :=
begin
  refine ⟨f.monotone hab.le, λ c ha hb, _⟩,
  obtain ⟨c, rfl⟩ := h.out (mem_range_self _) (mem_range_self _) ⟨ha.le, hb.le⟩,
  rw f.lt_iff_lt at ha hb,
  exact hab.2 ha hb,
end

lemma set.ord_connected.apply_wcovby_apply_iff (f : α ↪o β) (h : (range f).ord_connected) :
  f a ⩿ f b ↔ a ⩿ b :=
⟨λ h2, h2.of_image f, λ hab, hab.image f h⟩

@[simp] lemma apply_wcovby_apply_iff {E : Type*} [order_iso_class E α β] (e : E) :
  e a ⩿ e b ↔ a ⩿ b :=
(ord_connected_range (e : α ≃o β)).apply_wcovby_apply_iff ((e : α ≃o β) : α ↪o β)

@[simp] lemma to_dual_wcovby_to_dual_iff : to_dual b ⩿ to_dual a ↔ a ⩿ b :=
and_congr_right' $ forall_congr $ λ c, forall_swap

@[simp] lemma of_dual_wcovby_of_dual_iff {a b : αᵒᵈ} :
  of_dual a ⩿ of_dual b ↔ b ⩿ a :=
and_congr_right' $ forall_congr $ λ c, forall_swap

alias to_dual_wcovby_to_dual_iff ↔ _ wcovby.to_dual
alias of_dual_wcovby_of_dual_iff ↔ _ wcovby.of_dual

end preorder

section partial_order
variables [partial_order α] {a b c : α}

lemma wcovby.eq_or_eq (h : a ⩿ b) (h2 : a ≤ c) (h3 : c ≤ b) : c = a ∨ c = b :=
begin
  rcases h2.eq_or_lt with h2|h2, { exact or.inl h2.symm },
  rcases h3.eq_or_lt with h3|h3, { exact or.inr h3 },
  exact (h.2 h2 h3).elim
end

/-- An `iff` version of `wcovby.eq_or_eq` and `wcovby_of_eq_or_eq`. -/
lemma wcovby_iff_le_and_eq_or_eq : a ⩿ b ↔ a ≤ b ∧ ∀ c, a ≤ c → c ≤ b → c = a ∨ c = b :=
⟨λ h, ⟨h.le, λ c, h.eq_or_eq⟩, and.rec wcovby_of_eq_or_eq⟩

lemma wcovby.le_and_le_iff (h : a ⩿ b) : a ≤ c ∧ c ≤ b ↔ c = a ∨ c = b :=
begin
  refine ⟨λ h2, h.eq_or_eq h2.1 h2.2, _⟩, rintro (rfl|rfl), exacts [⟨le_rfl, h.le⟩, ⟨h.le, le_rfl⟩]
end

lemma wcovby.Icc_eq (h : a ⩿ b) : Icc a b = {a, b} :=
by { ext c, exact h.le_and_le_iff }

lemma wcovby.Ico_subset (h : a ⩿ b) : Ico a b ⊆ {a} :=
by rw [← Icc_diff_right, h.Icc_eq, diff_singleton_subset_iff, pair_comm]

lemma wcovby.Ioc_subset (h : a ⩿ b) : Ioc a b ⊆ {b} :=
by rw [← Icc_diff_left, h.Icc_eq, diff_singleton_subset_iff]

end partial_order

section semilattice_sup
variables [semilattice_sup α] {a b c : α}

lemma wcovby.sup_eq (hac : a ⩿ c) (hbc : b ⩿ c) (hab : a ≠ b) : a ⊔ b = c :=
(sup_le hac.le hbc.le).eq_of_not_lt $ λ h,
  hab.lt_sup_or_lt_sup.elim (λ h', hac.2 h' h) (λ h', hbc.2 h' h)

end semilattice_sup

section semilattice_inf
variables [semilattice_inf α] {a b c : α}

lemma wcovby.inf_eq (hca : c ⩿ a) (hcb : c ⩿ b) (hab : a ≠ b) : a ⊓ b = c :=
(le_inf hca.le hcb.le).eq_of_not_gt $ λ h, hab.inf_lt_or_inf_lt.elim (hca.2 h) (hcb.2 h)

end semilattice_inf

end weakly_covers

section has_lt
variables [has_lt α] {a b : α}

/-- `covby a b` means that `b` covers `a`: `a < b` and there is no element in between. -/
def covby (a b : α) : Prop := a < b ∧ ∀ ⦃c⦄, a < c → ¬ c < b

infix ` ⋖ `:50 := covby

lemma covby.lt (h : a ⋖ b) : a < b := h.1

/-- If `a < b`, then `b` does not cover `a` iff there's an element in between. -/
lemma not_covby_iff (h : a < b) : ¬a ⋖ b ↔ ∃ c, a < c ∧ c < b :=
by simp_rw [covby, h, true_and, not_forall, exists_prop, not_not]

alias not_covby_iff ↔ exists_lt_lt_of_not_covby _
alias exists_lt_lt_of_not_covby ← has_lt.lt.exists_lt_lt

/-- In a dense order, nothing covers anything. -/
lemma not_covby [densely_ordered α] : ¬ a ⋖ b :=
λ h, let ⟨c, hc⟩ := exists_between h.1 in h.2 hc.1 hc.2

lemma densely_ordered_iff_forall_not_covby : densely_ordered α ↔ ∀ a b : α, ¬ a ⋖ b :=
⟨λ h a b, @not_covby _ _ _ _ h, λ h, ⟨λ a b hab, exists_lt_lt_of_not_covby hab $ h _ _⟩⟩

@[simp] lemma to_dual_covby_to_dual_iff : to_dual b ⋖ to_dual a ↔ a ⋖ b :=
and_congr_right' $ forall_congr $ λ c, forall_swap

@[simp] lemma of_dual_covby_of_dual_iff {a b : αᵒᵈ} : of_dual a ⋖ of_dual b ↔ b ⋖ a :=
and_congr_right' $ forall_congr $ λ c, forall_swap

alias to_dual_covby_to_dual_iff ↔ _ covby.to_dual
alias of_dual_covby_of_dual_iff ↔ _ covby.of_dual

end has_lt

section preorder
variables [preorder α] [preorder β] {a b c : α}

lemma covby.le (h : a ⋖ b) : a ≤ b := h.1.le
protected lemma covby.ne (h : a ⋖ b) : a ≠ b := h.lt.ne
lemma covby.ne' (h : a ⋖ b) : b ≠ a := h.lt.ne'

protected lemma covby.wcovby (h : a ⋖ b) : a ⩿ b := ⟨h.le, h.2⟩
lemma wcovby.covby_of_not_le (h : a ⩿ b) (h2 : ¬ b ≤ a) : a ⋖ b := ⟨h.le.lt_of_not_le h2, h.2⟩
lemma wcovby.covby_of_lt (h : a ⩿ b) (h2 : a < b) : a ⋖ b := ⟨h2, h.2⟩

lemma not_covby_of_lt_of_lt (h₁ : a < b) (h₂ : b < c) : ¬ a ⋖ c :=
(not_covby_iff (h₁.trans h₂)).2 ⟨b, h₁, h₂⟩

lemma covby_iff_wcovby_and_lt : a ⋖ b ↔ a ⩿ b ∧ a < b :=
⟨λ h, ⟨h.wcovby, h.lt⟩, λ h, h.1.covby_of_lt h.2⟩

lemma covby_iff_wcovby_and_not_le : a ⋖ b ↔ a ⩿ b ∧ ¬ b ≤ a :=
⟨λ h, ⟨h.wcovby, h.lt.not_le⟩, λ h, h.1.covby_of_not_le h.2⟩

lemma wcovby_iff_covby_or_le_and_le : a ⩿ b ↔ a ⋖ b ∨ (a ≤ b ∧ b ≤ a) :=
⟨λ h, or_iff_not_imp_right.mpr $ λ h', h.covby_of_not_le $ λ hba, h' ⟨h.le, hba⟩,
  λ h', h'.elim (λ h, h.wcovby) (λ h, h.1.wcovby_of_le h.2)⟩

lemma antisymm_rel.trans_covby (hab : antisymm_rel (≤) a b) (hbc : b ⋖ c) : a ⋖ c :=
⟨hab.1.trans_lt hbc.lt, λ d had hdc, hbc.2 (hab.2.trans_lt had) hdc⟩

lemma covby_congr_left (hab : antisymm_rel (≤) a b) : a ⋖ c ↔ b ⋖ c :=
⟨hab.symm.trans_covby, hab.trans_covby⟩

lemma covby.trans_antisymm_rel (hab : a ⋖ b) (hbc : antisymm_rel (≤) b c) : a ⋖ c :=
⟨hab.lt.trans_le hbc.1, λ d had hdb, hab.2 had $ hdb.trans_le hbc.2⟩

lemma covby_congr_right (hab : antisymm_rel (≤) a b) : c ⋖ a ↔ c ⋖ b :=
⟨λ h, h.trans_antisymm_rel hab, λ h, h.trans_antisymm_rel hab.symm⟩

instance : is_nonstrict_strict_order α (⩿) (⋖) :=
⟨λ a b, covby_iff_wcovby_and_not_le.trans $ and_congr_right $ λ h, h.wcovby_iff_le.not.symm⟩

instance covby.is_irrefl : is_irrefl α (⋖) := ⟨λ a ha, ha.ne rfl⟩

lemma covby.Ioo_eq (h : a ⋖ b) : Ioo a b = ∅ :=
h.wcovby.Ioo_eq

lemma covby_iff_Ioo_eq : a ⋖ b ↔ a < b ∧ Ioo a b = ∅ :=
and_congr_right' $ by simp [eq_empty_iff_forall_not_mem]

lemma covby.of_image (f : α ↪o β) (h : f a ⋖ f b) : a ⋖ b :=
⟨f.lt_iff_lt.mp h.lt, λ c hac hcb, h.2 (f.lt_iff_lt.mpr hac) (f.lt_iff_lt.mpr hcb)⟩

lemma covby.image (f : α ↪o β) (hab : a ⋖ b) (h : (range f).ord_connected) : f a ⋖ f b :=
(hab.wcovby.image f h).covby_of_lt $ f.strict_mono hab.lt

lemma set.ord_connected.apply_covby_apply_iff (f : α ↪o β) (h : (range f).ord_connected) :
  f a ⋖ f b ↔ a ⋖ b :=
⟨covby.of_image f, λ hab, hab.image f h⟩

@[simp] lemma apply_covby_apply_iff {E : Type*} [order_iso_class E α β] (e : E) :
  e a ⋖ e b ↔ a ⋖ b :=
(ord_connected_range (e : α ≃o β)).apply_covby_apply_iff ((e : α ≃o β) : α ↪o β)

lemma covby_of_eq_or_eq (hab : a < b) (h : ∀ c, a ≤ c → c ≤ b → c = a ∨ c = b) : a ⋖ b :=
⟨hab, λ c ha hb, (h c ha.le hb.le).elim ha.ne' hb.ne⟩

end preorder

section partial_order
variables [partial_order α] {a b c : α}

lemma wcovby.covby_of_ne (h : a ⩿ b) (h2 : a ≠ b) : a ⋖ b := ⟨h.le.lt_of_ne h2, h.2⟩

lemma covby_iff_wcovby_and_ne : a ⋖ b ↔ a ⩿ b ∧ a ≠ b :=
⟨λ h, ⟨h.wcovby, h.ne⟩, λ h, h.1.covby_of_ne h.2⟩

lemma wcovby_iff_covby_or_eq : a ⩿ b ↔ a ⋖ b ∨ a = b :=
by rw [le_antisymm_iff, wcovby_iff_covby_or_le_and_le]

lemma wcovby_iff_eq_or_covby : a ⩿ b ↔ a = b ∨ a ⋖ b := wcovby_iff_covby_or_eq.trans or.comm

alias wcovby_iff_covby_or_eq ↔ wcovby.covby_or_eq _
alias wcovby_iff_eq_or_covby ↔ wcovby.eq_or_covby _

lemma covby.eq_or_eq (h : a ⋖ b) (h2 : a ≤ c) (h3 : c ≤ b) : c = a ∨ c = b :=
h.wcovby.eq_or_eq h2 h3

/-- An `iff` version of `covby.eq_or_eq` and `covby_of_eq_or_eq`. -/
lemma covby_iff_lt_and_eq_or_eq : a ⋖ b ↔ a < b ∧ ∀ c, a ≤ c → c ≤ b → c = a ∨ c = b :=
⟨λ h, ⟨h.lt, λ c, h.eq_or_eq⟩, and.rec covby_of_eq_or_eq⟩

lemma covby.Ico_eq (h : a ⋖ b) : Ico a b = {a} :=
by rw [←Ioo_union_left h.lt, h.Ioo_eq, empty_union]

lemma covby.Ioc_eq (h : a ⋖ b) : Ioc a b = {b} :=
by rw [←Ioo_union_right h.lt, h.Ioo_eq, empty_union]

lemma covby.Icc_eq (h : a ⋖ b) : Icc a b = {a, b} :=
h.wcovby.Icc_eq

end partial_order

section linear_order
variables [linear_order α] {a b c : α}

lemma covby.Ioi_eq (h : a ⋖ b) : Ioi a = Ici b :=
by rw [← Ioo_union_Ici_eq_Ioi h.lt, h.Ioo_eq, empty_union]

lemma covby.Iio_eq (h : a ⋖ b) : Iio b = Iic a :=
by rw [← Iic_union_Ioo_eq_Iio h.lt, h.Ioo_eq, union_empty]

lemma wcovby.le_of_lt (hab : a ⩿ b) (hcb : c < b) : c ≤ a := not_lt.1 $ λ hac, hab.2 hac hcb
lemma wcovby.ge_of_gt (hab : a ⩿ b) (hac : a < c) : b ≤ c := not_lt.1 $ hab.2 hac
lemma covby.le_of_lt (hab : a ⋖ b) : c < b → c ≤ a := hab.wcovby.le_of_lt
lemma covby.ge_of_gt (hab : a ⋖ b) : a < c → b ≤ c := hab.wcovby.ge_of_gt

lemma covby.unique_left (ha : a ⋖ c) (hb : b ⋖ c) : a = b :=
(hb.le_of_lt ha.lt).antisymm $ ha.le_of_lt hb.lt

lemma covby.unique_right (hb : a ⋖ b) (hc : a ⋖ c) : b = c :=
(hb.ge_of_gt hc.lt).antisymm $ hc.ge_of_gt hb.lt

/-- If `a`, `b`, `c` are consecutive and `a < x < c` then `x = b`. -/
lemma covby.eq_of_between {x : α} (hab : a ⋖ b) (hbc : b ⋖ c) (hax : a < x) (hxc : x < c) :
  x = b :=
le_antisymm (le_of_not_lt $ λ h, hbc.2 h hxc) (le_of_not_lt $ hab.2 hax)

end linear_order

namespace set

lemma wcovby_insert (x : α) (s : set α) : s ⩿ insert x s :=
begin
  refine wcovby_of_eq_or_eq (subset_insert x s) (λ t hst h2t, _),
  by_cases h : x ∈ t,
  { exact or.inr (subset_antisymm h2t $ insert_subset.mpr ⟨h, hst⟩) },
  { refine or.inl (subset_antisymm _ hst),
    rwa [← diff_singleton_eq_self h, diff_singleton_subset_iff] }
end

lemma covby_insert {x : α} {s : set α} (hx : x ∉ s) : s ⋖ insert x s :=
(wcovby_insert x s).covby_of_lt $ ssubset_insert hx

end set

namespace prod
variables [partial_order α] [partial_order β] {a a₁ a₂ : α} {b b₁ b₂ : β} {x y : α × β}

@[simp] lemma swap_wcovby_swap : x.swap ⩿ y.swap ↔ x ⩿ y :=
apply_wcovby_apply_iff (order_iso.prod_comm : α × β ≃o β × α)

@[simp] lemma swap_covby_swap : x.swap ⋖ y.swap ↔ x ⋖ y :=
apply_covby_apply_iff (order_iso.prod_comm : α × β ≃o β × α)

lemma fst_eq_or_snd_eq_of_wcovby : x ⩿ y → x.1 = y.1 ∨ x.2 = y.2 :=
begin
  refine λ h, of_not_not (λ hab, _),
  push_neg at hab,
  exact h.2 (mk_lt_mk.2 $ or.inl ⟨hab.1.lt_of_le h.1.1, le_rfl⟩)
    (mk_lt_mk.2 $ or.inr ⟨le_rfl, hab.2.lt_of_le h.1.2⟩),
end

lemma _root_.wcovby.fst (h : x ⩿ y) : x.1 ⩿ y.1 :=
⟨h.1.1, λ c h₁ h₂, h.2 (mk_lt_mk_iff_left.2 h₁) ⟨⟨h₂.le, h.1.2⟩, λ hc, h₂.not_le hc.1⟩⟩

lemma _root_.wcovby.snd (h : x ⩿ y) : x.2 ⩿ y.2 :=
⟨h.1.2, λ c h₁ h₂, h.2 (mk_lt_mk_iff_right.2 h₁) ⟨⟨h.1.1, h₂.le⟩, λ hc, h₂.not_le hc.2⟩⟩

lemma mk_wcovby_mk_iff_left : (a₁, b) ⩿ (a₂, b) ↔ a₁ ⩿ a₂ :=
begin
  refine ⟨wcovby.fst, and.imp mk_le_mk_iff_left.2 $ λ h c h₁ h₂, _⟩,
  have : c.2 = b:= h₂.le.2.antisymm h₁.le.2,
  rw [←@prod.mk.eta _ _ c, this, mk_lt_mk_iff_left] at h₁ h₂,
  exact h h₁ h₂,
end

lemma mk_wcovby_mk_iff_right : (a, b₁) ⩿ (a, b₂) ↔ b₁ ⩿ b₂ :=
swap_wcovby_swap.trans mk_wcovby_mk_iff_left

lemma mk_covby_mk_iff_left : (a₁, b) ⋖ (a₂, b) ↔ a₁ ⋖ a₂ :=
by simp_rw [covby_iff_wcovby_and_lt, mk_wcovby_mk_iff_left, mk_lt_mk_iff_left]

lemma mk_covby_mk_iff_right : (a, b₁) ⋖ (a, b₂) ↔ b₁ ⋖ b₂ :=
by simp_rw [covby_iff_wcovby_and_lt, mk_wcovby_mk_iff_right, mk_lt_mk_iff_right]

lemma mk_wcovby_mk_iff : (a₁, b₁) ⩿ (a₂, b₂) ↔ a₁ ⩿ a₂ ∧ b₁ = b₂ ∨ b₁ ⩿ b₂ ∧ a₁ = a₂ :=
begin
  refine ⟨λ h, _, _⟩,
  { obtain rfl | rfl : a₁ = a₂ ∨ b₁ = b₂ := fst_eq_or_snd_eq_of_wcovby h,
    { exact or.inr ⟨mk_wcovby_mk_iff_right.1 h, rfl⟩ },
    { exact or.inl ⟨mk_wcovby_mk_iff_left.1 h, rfl⟩ } },
  { rintro (⟨h, rfl⟩ | ⟨h, rfl⟩),
    { exact mk_wcovby_mk_iff_left.2 h },
    { exact mk_wcovby_mk_iff_right.2 h } }
end

lemma mk_covby_mk_iff : (a₁, b₁) ⋖ (a₂, b₂) ↔ a₁ ⋖ a₂ ∧ b₁ = b₂ ∨ b₁ ⋖ b₂ ∧ a₁ = a₂ :=
begin
  refine ⟨λ h, _, _⟩,
  { obtain rfl | rfl : a₁ = a₂ ∨ b₁ = b₂ := fst_eq_or_snd_eq_of_wcovby h.wcovby,
    { exact or.inr ⟨mk_covby_mk_iff_right.1 h, rfl⟩ },
    { exact or.inl ⟨mk_covby_mk_iff_left.1 h, rfl⟩ } },
  { rintro (⟨h, rfl⟩ | ⟨h, rfl⟩),
    { exact mk_covby_mk_iff_left.2 h },
    { exact mk_covby_mk_iff_right.2 h } }
end

lemma wcovby_iff : x ⩿ y ↔ x.1 ⩿ y.1 ∧ x.2 = y.2 ∨ x.2 ⩿ y.2 ∧ x.1 = y.1 :=
by { cases x, cases y, exact mk_wcovby_mk_iff }

lemma covby_iff : x ⋖ y ↔ x.1 ⋖ y.1 ∧ x.2 = y.2 ∨ x.2 ⋖ y.2 ∧ x.1 = y.1 :=
by { cases x, cases y, exact mk_covby_mk_iff }

end prod


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

import data.list.basic

/-!
# Palindromes

This module defines *palindromes*, lists which are equal to their reverse.

The main result is the `palindrome` inductive type, and its associated `palindrome.rec_on` induction
principle. Also provided are conversions to and from other equivalent definitions.

## References

* [Pierre Castéran, *On palindromes*][casteran]

[casteran]: https://www.labri.fr/perso/casteran/CoqArt/inductive-prop-chap/palindrome.html

## Tags

palindrome, reverse, induction
-/

variables {α β : Type*}

namespace list

/--
`palindrome l` asserts that `l` is a palindrome. This is defined inductively:

* The empty list is a palindrome;
* A list with one element is a palindrome;
* Adding the same element to both ends of a palindrome results in a bigger palindrome.
-/
inductive palindrome : list α → Prop
| nil : palindrome []
| singleton : ∀ x, palindrome [x]
| cons_concat : ∀ x {l}, palindrome l → palindrome (x :: (l ++ [x]))

namespace palindrome
variables {l : list α}

lemma reverse_eq {l : list α} (p : palindrome l) : reverse l = l :=
palindrome.rec_on p rfl (λ _, rfl) (λ x l p h, by simp [h])

lemma of_reverse_eq {l : list α} : reverse l = l → palindrome l :=
begin
  refine bidirectional_rec_on l (λ _, palindrome.nil) (λ a _, palindrome.singleton a) _,
  intros x l y hp hr,
  rw [reverse_cons, reverse_append] at hr,
  rw head_eq_of_cons_eq hr,
  have : palindrome l, from hp (append_inj_left' (tail_eq_of_cons_eq hr) rfl),
  exact palindrome.cons_concat x this
end

lemma iff_reverse_eq {l : list α} : palindrome l ↔ reverse l = l :=
iff.intro reverse_eq of_reverse_eq

lemma append_reverse (l : list α) : palindrome (l ++ reverse l) :=
by { apply of_reverse_eq, rw [reverse_append, reverse_reverse] }

protected lemma map (f : α → β) (p : palindrome l) : palindrome (map f l) :=
of_reverse_eq $ by rw [← map_reverse, p.reverse_eq]

instance [decidable_eq α] (l : list α) : decidable (palindrome l) :=
decidable_of_iff' _ iff_reverse_eq

end palindrome
end list


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura
-/
import data.rat.basic data.countable data.encodable data.int.countable
open encodable nat int option quot

namespace rat
definition encode_prerat : prerat → nat
| (prerat.mk n d h) := mkpair (encode n) (encode d)

definition decode_prerat (a : nat) : option prerat :=
match unpair a with
| (cn, cd) :=
  match decode int cn with
  | some n :=
    match decode int cd with
    | some d := if h : d > 0 then some (prerat.mk n d h) else none
    | none   := none
    end
  | none   := none
  end
end

lemma decode_encode_prerat (p : prerat) : decode_prerat (encode_prerat p) = some p :=
begin
  cases p with n d h, unfold [encode_prerat, decode_prerat],
  rewrite unpair_mkpair, esimp, rewrite [*encodek, dif_pos h]
end

definition encodable_prerat [instance] : encodable prerat :=
encodable.mk
  encode_prerat
  decode_prerat
  decode_encode_prerat

definition decidable_equiv [instance] : ∀ a b : prerat, decidable (prerat.equiv a b)
| (prerat.mk n₁ d₁ h₁) (prerat.mk n₂ d₂ h₂) := begin unfold prerat.equiv, exact _ end

definition encodable_rat [instance] : encodable rat :=
@encodable_quot _ _ decidable_equiv encodable_prerat

lemma countable_rat : countable rat :=
countable_of_encodable encodable_rat
end rat


import data.mv_polynomial.basic
-- import data.finsupp.lattice

open mv_polynomial
namespace mv_polynomial
section

universes u

variables {F : Type u}
variables [field F]

noncomputable theory

parameter {vars : Type}
parameter [decidable_eq vars]

def degree_bound (b : vars →₀ ℕ) (p : mv_polynomial vars F) := (∀ v : vars →₀ ℕ, v ∈ p.support → v ≤ b)

-- Two mv_polynomials are equal iff their coefficients are equal for all terms with variables below the max degree
lemma eq_iff_coeff_eq_below_degree_bound (p q : mv_polynomial vars F)
  (b : vars →₀ ℕ)
  (bound_p : p.degree_bound b)
  (bound_q : q.degree_bound b)
  : p = q ↔ (∀ (c : vars →₀ ℕ), c ≤ b → p.coeff c = q.coeff c)
:=
begin
  rw mv_polynomial.ext_iff,
  split,
    { intros hm c hc,
      exact hm c, },
    { intros hc m,
      by_cases m ∈ p.support,
      { exact hc m (bound_p m h), },
      { have hp : coeff m p = 0, exact not_mem_support_iff.mp h,
        by_cases m ∈ q.support,
        { exact hc m (bound_q m h), },
          have hq : coeff m q = 0, exact not_mem_support_iff.mp h,
          rw [hp, hq], }, },
end

-- degree_bound lemmas for X, C, add, mul

lemma degree_bound_C (f : F) : degree_bound 0 (@mv_polynomial.C F _ _ f) :=
begin
  sorry,
end

lemma degree_bound_X (v : vars) : degree_bound (finsupp.single v 1) (@mv_polynomial.X F _ _ v) :=
begin
  sorry,
end

lemma degree_bound_add (p q : mv_polynomial vars F)
  (bp bq : vars →₀ ℕ)
  (degree_bound_p : degree_bound bp p)
  (degree_bound_q : degree_bound bq q)
 : degree_bound (bp ⊔ bq) (p + q) :=
begin
  sorry,
end

lemma degree_bound_mul (p q : mv_polynomial vars F)
  (bp bq : vars →₀ ℕ)
  (degree_bound_p : degree_bound bp p)
  (degree_bound_q : degree_bound bq q)
 : degree_bound (bp + bq) (p * q) :=
begin
  sorry,
end

end


import tactic
import data.nat.basic
import data.nat.prime

namespace lecture8

open nat

example : ¬ (∀ a b c : ℕ, a ∣ (b * c) -> a ∣ b ∨ a ∣ c) :=
begin
  intros hx,
  specialize hx 6 2 3,
  have not_dvd_2 : ¬ (6 ∣ 2) := of_to_bool_ff rfl,
  have not_dvd_3 : ¬ (6 ∣ 3) := of_to_bool_ff rfl,
  cases hx (dvd_refl 6),
  exact not_dvd_2 h,
  exact not_dvd_3 h,
end

-- non-trivial to prove before week 5 :(
lemma euclid_lemma {a b c : ℕ} {hprime : prime a} (h : a ∣ (b * c)) : a ∣ b ∨ a ∣ c :=
begin
  sorry
end

end lecture8


/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics
import group_theory.subgroup.basic -- import Lean's subgroups

/-

# Group homomorphisms

We show how to build the type `my_group_hom G H` of group homomorphisms
from `G` to `H`. We make notation `G →** H` for this, so `f : G →** H`
means "`f` is a group homomorphism from `G` to `H`".

-/

/-- `my_group_hom G H` is the type of group homomorphisms from `G` to `H`. -/
@[ext] structure my_group_hom (G H : Type) [group G] [group H] :=
(to_fun : G → H)
(map_mul' (a b : G) : to_fun (a * b) = to_fun a * to_fun b)

namespace my_group_hom

-- throughout this sheet, `G` and `H` will be groups.
variables {G H : Type} [group G] [group H]

-- We use notation `G →** H` for the type of group homs from `G` to `H`.
notation G ` →** ` H := my_group_hom G H

-- A group hom is a function, and so we set up a "coercion"
-- so that a group hom can be regarded as a function (even
-- though it's actually a pair consisting of a function and an axiom)
instance : has_coe_to_fun (G →** H) (λ _, G → H) :=
{ coe := my_group_hom.to_fun }

-- Notice that we can now write `f (a * b)` even though `f` isn't actually a
-- function, it's a pair consisting of a function `f.to_fun` and an axiom `f.map_mul'`.
-- The below lemma is how we want to use it as mathematicians though.
lemma map_mul (f : G →** H) (a b : G) :
  f (a * b) = f a * f b :=
begin
  -- the point is that f.map_mul and f.map_mul' are *definitionally equal*
  -- but *syntactically different*, and the primed version looks uglier.
  -- The point of this lemma is that `f.map_mul` looks nicer.
  exact f.map_mul' a b
end

-- let `f` be a group hom
variable (f : G →** H)

-- To prove `map_one` you're going to need to know what the below lemma
-- is called. Uncomment it, look at the output, and remember it. It's
-- a useful part of the group theory API.

-- example (a b : G) : a * b = b ↔ a = 1 := mul_left_eq_self

-- Now see if you can do these.
@[simp] lemma map_one : f 1 = 1 :=
begin
  have h := f.map_mul 1 1,
  simpa using h,
end

lemma map_inv (a : G) : f a⁻¹ = (f a)⁻¹ :=
begin
  rw ← mul_eq_one_iff_eq_inv,
  rw ← f.map_mul,
  simp,
end

variable (G)

/-- `id G` is the identity group homomorphism from `G` to `G`. -/
def id : G →** G :=
{ to_fun := λ a, a,
  map_mul' := begin intros, refl, end }

variables {K : Type} [group K] {G}

/-- `φ.comp ψ` is the composite of `φ` and `ψ`. -/
def comp (φ : G →** H) (ψ : H →** K) : G →** K :=
{ to_fun := λ g, ψ (φ g),
  map_mul' := begin
    intros a b,
    rw [φ.map_mul, ψ.map_mul],
  end
}

-- The next three lemmas are pretty standard, but they are also in fact
-- the axioms that show that groups form a category.
lemma id_comp : (id G).comp f = f :=
begin
  ext g,
  refl,
end

lemma comp_id : f.comp (id H) = f :=
begin
  ext g,
  refl,
end

lemma comp_assoc {L : Type} [group L] (φ : G →** H) (ψ : H →** K) (ρ : K →** L) :
  (φ.comp ψ).comp ρ = φ.comp (ψ.comp ρ) :=
begin
  refl,
end

/-- The kernel of a group homomorphism, as a subgroup of the source group. -/
def ker (f : G →** H) : subgroup G :=
{ carrier := {g : G | f g = 1 },
  one_mem' := f.map_one,
  mul_mem' := begin
    intros a b ha hb,
    simp [f.map_mul, *] at *,
  end,
  inv_mem' := begin
    intros a ha,
    simp [f.map_inv, *] at *,
  end,
}

/-- The image of a group homomorphism, as a subgroup of the target group. -/
def im (f : G →** H) : subgroup H :=
{ carrier := {h : H | ∃ g : G, f g = h },
  one_mem' := begin
    use 1,
    exact f.map_one,
  end,
  mul_mem' := begin
    rintro c d ⟨a, ha⟩ ⟨b, hb⟩,
    exact ⟨a * b, by rw [f.map_mul, ha, hb]⟩,
  end,
  inv_mem' := begin
    rintro c ⟨a, ha⟩,
    exact ⟨a⁻¹, by rw [f.map_inv, ha]⟩,
  end,
}

/-- The image of a subgroup under a group homomorphism, as a subgroup. -/
def map (f : G →** H) (K : subgroup G) : subgroup H :=
{ carrier := {h : H | ∃ g : G, g ∈ K ∧ f g = h },
  one_mem' := ⟨1, K.one_mem, f.map_one⟩,
  mul_mem' := begin
    rintro c d ⟨a, haK, rfl⟩ ⟨b, hbK, rfl⟩,
    refine ⟨a * b, K.mul_mem haK hbK, f.map_mul a b⟩,
  end,
  inv_mem' := begin
    intro x,
    intro hx,
    change ∃ a, _ at hx,
    cases hx with a ha,
    cases ha with haK hax,
    change ∃ b, _,
    use a⁻¹,
    split,
    { exact K.inv_mem haK },
    { subst hax, apply f.map_inv }
  end,
}

/-- The preimage of a subgroup under a group homomorphism, as a subgroup. -/
def comap (f : G →** H) (K : subgroup H) : subgroup G :=
{ carrier := {g : G | f g ∈ K },
  one_mem' := begin
    simp [K.one_mem],
  end,
  mul_mem' := begin
    intros a b ha hb,
    have h := K.mul_mem ha hb,
    rwa ← f.map_mul at h,
  end,
  inv_mem' := begin
    intros a ha,
    replace ha := K.inv_mem ha,
    rwa ← f.map_inv at ha,
  end,
}

lemma map_id (L : subgroup G) : (id G).map L = L :=
begin
  ext g,
  split,
  { intro h,
    rcases h with ⟨x, hx1, rfl⟩,
    exact hx1 },
  { intro h,
    use g,
    exact ⟨h, rfl⟩ },
end

/-- Pushing a subgroup along one homomorphism and then another is equal to
  pushing it forward along the composite of the homomorphisms. -/
lemma map_comp (φ : G →** H) (ψ : H →** K) (L : subgroup G) :
  (φ.comp ψ).map L = ψ.map (φ.map L) :=
begin
  ext x,
  split,
  { rintro ⟨g, hgL, rfl⟩,
    use φ g,
    split,
    { exact ⟨g, hgL, rfl⟩ },
    { refl } },
  { rintro ⟨h, ⟨g, hgL, rfl⟩, rfl⟩,
    exact ⟨g, hgL, rfl⟩ },
end

lemma comap_id (L : subgroup G) : (id G).comap L = L :=
begin
  ext g,
  refl,
end

/-- Pulling a subgroup back along one homomorphism and then another, is equal
to pulling it back along the composite of the homomorphisms. -/
lemma comap_comp (φ : G →** H) (ψ : H →** K) (L : subgroup K) :
  (φ.comp ψ).comap L = φ.comap (ψ.comap L) :=
begin
  refl,
end

end my_group_hom


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

! This file was ported from Lean 3 source module probability.density
! leanprover-community/mathlib commit 17ef379e997badd73e5eabb4d38f11919ab3c4b3
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Decomposition.RadonNikodym
import Mathbin.MeasureTheory.Measure.Lebesgue

/-!
# Probability density function

This file defines the probability density function of random variables, by which we mean
measurable functions taking values in a Borel space. In particular, a measurable function `f`
is said to the probability density function of a random variable `X` if for all measurable
sets `S`, `ℙ(X ∈ S) = ∫ x in S, f x dx`. Probability density functions are one way of describing
the distribution of a random variable, and are useful for calculating probabilities and
finding moments (although the latter is better achieved with moment generating functions).

This file also defines the continuous uniform distribution and proves some properties about
random variables with this distribution.

## Main definitions

* `measure_theory.has_pdf` : A random variable `X : Ω → E` is said to `has_pdf` with
  respect to the measure `ℙ` on `Ω` and `μ` on `E` if there exists a measurable function `f`
  such that the push-forward measure of `ℙ` along `X` equals `μ.with_density f`.
* `measure_theory.pdf` : If `X` is a random variable that `has_pdf X ℙ μ`, then `pdf X`
  is the measurable function `f` such that the push-forward measure of `ℙ` along `X` equals
  `μ.with_density f`.
* `measure_theory.pdf.uniform` : A random variable `X` is said to follow the uniform
  distribution if it has a constant probability density function with a compact, non-null support.

## Main results

* `measure_theory.pdf.integral_fun_mul_eq_integral` : Law of the unconscious statistician,
  i.e. if a random variable `X : Ω → E` has pdf `f`, then `𝔼(g(X)) = ∫ x, g x * f x dx` for
  all measurable `g : E → ℝ`.
* `measure_theory.pdf.integral_mul_eq_integral` : A real-valued random variable `X` with
  pdf `f` has expectation `∫ x, x * f x dx`.
* `measure_theory.pdf.uniform.integral_eq` : If `X` follows the uniform distribution with
  its pdf having support `s`, then `X` has expectation `(λ s)⁻¹ * ∫ x in s, x dx` where `λ`
  is the Lebesgue measure.

## TODOs

Ultimately, we would also like to define characteristic functions to describe distributions as
it exists for all random variables. However, to define this, we will need Fourier transforms
which we currently do not have.
-/

noncomputable section

open Classical MeasureTheory NNReal ENNReal

namespace MeasureTheory

open TopologicalSpace MeasureTheory.Measure

variable {Ω E : Type _} [MeasurableSpace E]

/-- A random variable `X : Ω → E` is said to `has_pdf` with respect to the measure `ℙ` on `Ω` and
`μ` on `E` if there exists a measurable function `f` such that the push-forward measure of `ℙ`
along `X` equals `μ.with_density f`. -/
class HasPdf {m : MeasurableSpace Ω} (X : Ω → E) (ℙ : Measure Ω)
  (μ : Measure E := by exact MeasureTheory.MeasureSpace.volume) : Prop where
  pdf' : Measurable X ∧ ∃ f : E → ℝ≥0∞, Measurable f ∧ map X ℙ = μ.withDensity f
#align measure_theory.has_pdf MeasureTheory.HasPdf

@[measurability]
theorem HasPdf.measurable {m : MeasurableSpace Ω} (X : Ω → E) (ℙ : Measure Ω)
    (μ : Measure E := by exact MeasureTheory.MeasureSpace.volume) [hX : HasPdf X ℙ μ] :
    Measurable X :=
  hX.pdf'.1
#align measure_theory.has_pdf.measurable MeasureTheory.HasPdf.measurable

/-- If `X` is a random variable that `has_pdf X ℙ μ`, then `pdf X` is the measurable function `f`
such that the push-forward measure of `ℙ` along `X` equals `μ.with_density f`. -/
def pdf {m : MeasurableSpace Ω} (X : Ω → E) (ℙ : Measure Ω)
    (μ : Measure E := by exact MeasureTheory.MeasureSpace.volume) :=
  if hX : HasPdf X ℙ μ then Classical.choose hX.pdf'.2 else 0
#align measure_theory.pdf MeasureTheory.pdf

theorem pdf_undef {m : MeasurableSpace Ω} {ℙ : Measure Ω} {μ : Measure E} {X : Ω → E}
    (h : ¬HasPdf X ℙ μ) : pdf X ℙ μ = 0 := by simp only [pdf, dif_neg h]
#align measure_theory.pdf_undef MeasureTheory.pdf_undef

theorem hasPdfOfPdfNeZero {m : MeasurableSpace Ω} {ℙ : Measure Ω} {μ : Measure E} {X : Ω → E}
    (h : pdf X ℙ μ ≠ 0) : HasPdf X ℙ μ := by
  by_contra hpdf
  rw [pdf, dif_neg hpdf] at h
  exact hpdf (False.ndrec (has_pdf X ℙ μ) (h rfl))
#align measure_theory.has_pdf_of_pdf_ne_zero MeasureTheory.hasPdfOfPdfNeZero

theorem pdf_eq_zero_of_not_measurable {m : MeasurableSpace Ω} {ℙ : Measure Ω} {μ : Measure E}
    {X : Ω → E} (hX : ¬Measurable X) : pdf X ℙ μ = 0 :=
  pdf_undef fun hpdf => hX hpdf.pdf'.1
#align measure_theory.pdf_eq_zero_of_not_measurable MeasureTheory.pdf_eq_zero_of_not_measurable

theorem measurable_of_pdf_ne_zero {m : MeasurableSpace Ω} {ℙ : Measure Ω} {μ : Measure E}
    (X : Ω → E) (h : pdf X ℙ μ ≠ 0) : Measurable X :=
  by
  by_contra hX
  exact h (pdf_eq_zero_of_not_measurable hX)
#align measure_theory.measurable_of_pdf_ne_zero MeasureTheory.measurable_of_pdf_ne_zero

@[measurability]
theorem measurable_pdf {m : MeasurableSpace Ω} (X : Ω → E) (ℙ : Measure Ω)
    (μ : Measure E := by exact MeasureTheory.MeasureSpace.volume) : Measurable (pdf X ℙ μ) :=
  by
  by_cases hX : has_pdf X ℙ μ
  · rw [pdf, dif_pos hX]
    exact (Classical.choose_spec hX.pdf'.2).1
  · rw [pdf, dif_neg hX]
    exact measurable_zero
#align measure_theory.measurable_pdf MeasureTheory.measurable_pdf

theorem map_eq_withDensity_pdf {m : MeasurableSpace Ω} (X : Ω → E) (ℙ : Measure Ω)
    (μ : Measure E := by exact MeasureTheory.MeasureSpace.volume) [hX : HasPdf X ℙ μ] :
    Measure.map X ℙ = μ.withDensity (pdf X ℙ μ) :=
  by
  rw [pdf, dif_pos hX]
  exact (Classical.choose_spec hX.pdf'.2).2
#align measure_theory.map_eq_with_density_pdf MeasureTheory.map_eq_withDensity_pdf

theorem map_eq_set_lintegral_pdf {m : MeasurableSpace Ω} (X : Ω → E) (ℙ : Measure Ω)
    (μ : Measure E := by exact MeasureTheory.MeasureSpace.volume) [hX : HasPdf X ℙ μ] {s : Set E}
    (hs : MeasurableSet s) : Measure.map X ℙ s = ∫⁻ x in s, pdf X ℙ μ x ∂μ := by
  rw [← with_density_apply _ hs, map_eq_with_density_pdf X ℙ μ]
#align measure_theory.map_eq_set_lintegral_pdf MeasureTheory.map_eq_set_lintegral_pdf

namespace Pdf

variable {m : MeasurableSpace Ω} {ℙ : Measure Ω} {μ : Measure E}

theorem lintegral_eq_measure_univ {X : Ω → E} [HasPdf X ℙ μ] :
    (∫⁻ x, pdf X ℙ μ x ∂μ) = ℙ Set.univ := by
  rw [← set_lintegral_univ, ← map_eq_set_lintegral_pdf X ℙ μ MeasurableSet.univ,
    measure.map_apply (has_pdf.measurable X ℙ μ) MeasurableSet.univ, Set.preimage_univ]
#align measure_theory.pdf.lintegral_eq_measure_univ MeasureTheory.pdf.lintegral_eq_measure_univ

theorem ae_lt_top [IsFiniteMeasure ℙ] {μ : Measure E} {X : Ω → E} : ∀ᵐ x ∂μ, pdf X ℙ μ x < ∞ :=
  by
  by_cases hpdf : has_pdf X ℙ μ
  · haveI := hpdf
    refine' ae_lt_top (measurable_pdf X ℙ μ) _
    rw [lintegral_eq_measure_univ]
    exact (measure_lt_top _ _).Ne
  · rw [pdf, dif_neg hpdf]
    exact Filter.eventually_of_forall fun x => WithTop.zero_lt_top
#align measure_theory.pdf.ae_lt_top MeasureTheory.pdf.ae_lt_top

theorem ofReal_toReal_ae_eq [IsFiniteMeasure ℙ] {X : Ω → E} :
    (fun x => ENNReal.ofReal (pdf X ℙ μ x).toReal) =ᵐ[μ] pdf X ℙ μ :=
  ofReal_toReal_ae_eq ae_lt_top
#align measure_theory.pdf.of_real_to_real_ae_eq MeasureTheory.pdf.ofReal_toReal_ae_eq

theorem integrable_iff_integrable_mul_pdf [IsFiniteMeasure ℙ] {X : Ω → E} [HasPdf X ℙ μ] {f : E → ℝ}
    (hf : Measurable f) :
    Integrable (fun x => f (X x)) ℙ ↔ Integrable (fun x => f x * (pdf X ℙ μ x).toReal) μ :=
  by
  rw [← integrable_map_measure hf.ae_strongly_measurable (has_pdf.measurable X ℙ μ).AeMeasurable,
    map_eq_with_density_pdf X ℙ μ, integrable_with_density_iff (measurable_pdf _ _ _) ae_lt_top]
  infer_instance
#align measure_theory.pdf.integrable_iff_integrable_mul_pdf MeasureTheory.pdf.integrable_iff_integrable_mul_pdf

/-- **The Law of the Unconscious Statistician**: Given a random variable `X` and a measurable
function `f`, `f ∘ X` is a random variable with expectation `∫ x, f x * pdf X ∂μ`
where `μ` is a measure on the codomain of `X`. -/
theorem integral_fun_mul_eq_integral [IsFiniteMeasure ℙ] {X : Ω → E} [HasPdf X ℙ μ] {f : E → ℝ}
    (hf : Measurable f) : (∫ x, f x * (pdf X ℙ μ x).toReal ∂μ) = ∫ x, f (X x) ∂ℙ :=
  by
  by_cases hpdf : integrable (fun x => f x * (pdf X ℙ μ x).toReal) μ
  · rw [← integral_map (has_pdf.measurable X ℙ μ).AeMeasurable hf.ae_strongly_measurable,
      map_eq_with_density_pdf X ℙ μ, integral_eq_lintegral_pos_part_sub_lintegral_neg_part hpdf,
      integral_eq_lintegral_pos_part_sub_lintegral_neg_part,
      lintegral_with_density_eq_lintegral_mul _ (measurable_pdf X ℙ μ) hf.neg.ennreal_of_real,
      lintegral_with_density_eq_lintegral_mul _ (measurable_pdf X ℙ μ) hf.ennreal_of_real]
    · congr 2
      · have :
          ∀ x,
            ENNReal.ofReal (f x * (pdf X ℙ μ x).toReal) =
              ENNReal.ofReal (pdf X ℙ μ x).toReal * ENNReal.ofReal (f x) :=
          by
          intro x
          rw [mul_comm, ENNReal.ofReal_mul ENNReal.toReal_nonneg]
        simp_rw [this]
        exact lintegral_congr_ae (Filter.EventuallyEq.mul of_real_to_real_ae_eq (ae_eq_refl _))
      · have :
          ∀ x,
            ENNReal.ofReal (-(f x * (pdf X ℙ μ x).toReal)) =
              ENNReal.ofReal (pdf X ℙ μ x).toReal * ENNReal.ofReal (-f x) :=
          by
          intro x
          rw [neg_mul_eq_neg_mul, mul_comm, ENNReal.ofReal_mul ENNReal.toReal_nonneg]
        simp_rw [this]
        exact lintegral_congr_ae (Filter.EventuallyEq.mul of_real_to_real_ae_eq (ae_eq_refl _))
    · refine' ⟨hf.ae_strongly_measurable, _⟩
      rw [has_finite_integral,
        lintegral_with_density_eq_lintegral_mul _ (measurable_pdf _ _ _)
          hf.nnnorm.coe_nnreal_ennreal]
      have :
        (fun x => (pdf X ℙ μ * fun x => ↑‖f x‖₊) x) =ᵐ[μ] fun x => ‖f x * (pdf X ℙ μ x).toReal‖₊ :=
        by
        simp_rw [← smul_eq_mul, nnnorm_smul, ENNReal.coe_mul]
        rw [smul_eq_mul, mul_comm]
        refine' Filter.EventuallyEq.mul (ae_eq_refl _) (ae_eq_trans of_real_to_real_ae_eq.symm _)
        convert ae_eq_refl _
        ext1 x
        exact Real.ennnorm_eq_ofReal ENNReal.toReal_nonneg
      rw [lintegral_congr_ae this]
      exact hpdf.2
  · rw [integral_undef hpdf, integral_undef]
    rwa [← integrable_iff_integrable_mul_pdf hf] at hpdf
    all_goals infer_instance
#align measure_theory.pdf.integral_fun_mul_eq_integral MeasureTheory.pdf.integral_fun_mul_eq_integral

theorem mapAbsolutelyContinuous {X : Ω → E} [HasPdf X ℙ μ] : map X ℙ ≪ μ :=
  by
  rw [map_eq_with_density_pdf X ℙ μ]
  exact with_density_absolutely_continuous _ _
#align measure_theory.pdf.map_absolutely_continuous MeasureTheory.pdf.mapAbsolutelyContinuous

/-- A random variable that `has_pdf` is quasi-measure preserving. -/
theorem toQuasiMeasurePreserving {X : Ω → E} [HasPdf X ℙ μ] : QuasiMeasurePreserving X ℙ μ :=
  { Measurable := HasPdf.measurable X ℙ μ
    AbsolutelyContinuous := mapAbsolutelyContinuous }
#align measure_theory.pdf.to_quasi_measure_preserving MeasureTheory.pdf.toQuasiMeasurePreserving

theorem haveLebesgueDecompositionOfHasPdf {X : Ω → E} [hX' : HasPdf X ℙ μ] :
    (map X ℙ).HaveLebesgueDecomposition μ :=
  ⟨⟨⟨0, pdf X ℙ μ⟩, by
      simp only [zero_add, measurable_pdf X ℙ μ, true_and_iff, mutually_singular.zero_left,
        map_eq_with_density_pdf X ℙ μ]⟩⟩
#align measure_theory.pdf.have_lebesgue_decomposition_of_has_pdf MeasureTheory.pdf.haveLebesgueDecompositionOfHasPdf

theorem hasPdf_iff {X : Ω → E} :
    HasPdf X ℙ μ ↔ Measurable X ∧ (map X ℙ).HaveLebesgueDecomposition μ ∧ map X ℙ ≪ μ :=
  by
  constructor
  · intro hX'
    exact ⟨hX'.pdf'.1, have_lebesgue_decomposition_of_has_pdf, map_absolutely_continuous⟩
  · rintro ⟨hX, h_decomp, h⟩
    haveI := h_decomp
    refine' ⟨⟨hX, (measure.map X ℙ).rnDeriv μ, measurable_rn_deriv _ _, _⟩⟩
    rwa [with_density_rn_deriv_eq]
#align measure_theory.pdf.has_pdf_iff MeasureTheory.pdf.hasPdf_iff

theorem hasPdf_iff_of_measurable {X : Ω → E} (hX : Measurable X) :
    HasPdf X ℙ μ ↔ (map X ℙ).HaveLebesgueDecomposition μ ∧ map X ℙ ≪ μ :=
  by
  rw [has_pdf_iff]
  simp only [hX, true_and_iff]
#align measure_theory.pdf.has_pdf_iff_of_measurable MeasureTheory.pdf.hasPdf_iff_of_measurable

section

variable {F : Type _} [MeasurableSpace F] {ν : Measure F}

/-- A random variable that `has_pdf` transformed under a `quasi_measure_preserving`
map also `has_pdf` if `(map g (map X ℙ)).have_lebesgue_decomposition μ`.

`quasi_measure_preserving_has_pdf'` is more useful in the case we are working with a
probability measure and a real-valued random variable. -/
theorem quasiMeasurePreservingHasPdf {X : Ω → E} [HasPdf X ℙ μ] {g : E → F}
    (hg : QuasiMeasurePreserving g μ ν) (hmap : (map g (map X ℙ)).HaveLebesgueDecomposition ν) :
    HasPdf (g ∘ X) ℙ ν :=
  by
  rw [has_pdf_iff, ← map_map hg.measurable (has_pdf.measurable X ℙ μ)]
  refine' ⟨hg.measurable.comp (has_pdf.measurable X ℙ μ), hmap, _⟩
  rw [map_eq_with_density_pdf X ℙ μ]
  refine' absolutely_continuous.mk fun s hsm hs => _
  rw [map_apply hg.measurable hsm, with_density_apply _ (hg.measurable hsm)]
  have := hg.absolutely_continuous hs
  rw [map_apply hg.measurable hsm] at this
  exact set_lintegral_measure_zero _ _ this
#align measure_theory.pdf.quasi_measure_preserving_has_pdf MeasureTheory.pdf.quasiMeasurePreservingHasPdf

theorem quasiMeasurePreservingHasPdf' [IsFiniteMeasure ℙ] [SigmaFinite ν] {X : Ω → E} [HasPdf X ℙ μ]
    {g : E → F} (hg : QuasiMeasurePreserving g μ ν) : HasPdf (g ∘ X) ℙ ν :=
  quasiMeasurePreservingHasPdf hg inferInstance
#align measure_theory.pdf.quasi_measure_preserving_has_pdf' MeasureTheory.pdf.quasiMeasurePreservingHasPdf'

end

section Real

variable [IsFiniteMeasure ℙ] {X : Ω → ℝ}

/-- A real-valued random variable `X` `has_pdf X ℙ λ` (where `λ` is the Lebesgue measure) if and
only if the push-forward measure of `ℙ` along `X` is absolutely continuous with respect to `λ`. -/
theorem Real.hasPdf_iff_of_measurable (hX : Measurable X) : HasPdf X ℙ ↔ map X ℙ ≪ volume :=
  by
  rw [has_pdf_iff_of_measurable hX, and_iff_right_iff_imp]
  exact fun h => inferInstance
#align measure_theory.pdf.real.has_pdf_iff_of_measurable MeasureTheory.pdf.Real.hasPdf_iff_of_measurable

theorem Real.hasPdf_iff : HasPdf X ℙ ↔ Measurable X ∧ map X ℙ ≪ volume :=
  by
  by_cases hX : Measurable X
  · rw [real.has_pdf_iff_of_measurable hX, iff_and_self]
    exact fun h => hX
    infer_instance
  · exact ⟨fun h => False.elim (hX h.pdf'.1), fun h => False.elim (hX h.1)⟩
#align measure_theory.pdf.real.has_pdf_iff MeasureTheory.pdf.Real.hasPdf_iff

/-- If `X` is a real-valued random variable that has pdf `f`, then the expectation of `X` equals
`∫ x, x * f x ∂λ` where `λ` is the Lebesgue measure. -/
theorem integral_mul_eq_integral [HasPdf X ℙ] :
    (∫ x, x * (pdf X ℙ volume x).toReal) = ∫ x, X x ∂ℙ :=
  integral_fun_mul_eq_integral measurable_id
#align measure_theory.pdf.integral_mul_eq_integral MeasureTheory.pdf.integral_mul_eq_integral

theorem hasFiniteIntegralMul {f : ℝ → ℝ} {g : ℝ → ℝ≥0∞} (hg : pdf X ℙ =ᵐ[volume] g)
    (hgi : (∫⁻ x, ‖f x‖₊ * g x) ≠ ∞) : HasFiniteIntegral fun x => f x * (pdf X ℙ volume x).toReal :=
  by
  rw [has_finite_integral]
  have : (fun x => ↑‖f x‖₊ * g x) =ᵐ[volume] fun x => ‖f x * (pdf X ℙ volume x).toReal‖₊ :=
    by
    refine'
      ae_eq_trans
        (Filter.EventuallyEq.mul (ae_eq_refl fun x => ‖f x‖₊)
          (ae_eq_trans hg.symm of_real_to_real_ae_eq.symm))
        _
    simp_rw [← smul_eq_mul, nnnorm_smul, ENNReal.coe_mul, smul_eq_mul]
    refine' Filter.EventuallyEq.mul (ae_eq_refl _) _
    convert ae_eq_refl _
    ext1 x
    exact Real.ennnorm_eq_ofReal ENNReal.toReal_nonneg
  rwa [lt_top_iff_ne_top, ← lintegral_congr_ae this]
#align measure_theory.pdf.has_finite_integral_mul MeasureTheory.pdf.hasFiniteIntegralMul

end Real

section

/-! **Uniform Distribution** -/

/-- A random variable `X` has uniform distribution if it has a probability density function `f`
with support `s` such that `f = (μ s)⁻¹ 1ₛ` a.e. where `1ₛ` is the indicator function for `s`. -/
def IsUniform {m : MeasurableSpace Ω} (X : Ω → E) (support : Set E) (ℙ : Measure Ω)
    (μ : Measure E := by exact MeasureTheory.MeasureSpace.volume) :=
  pdf X ℙ μ =ᵐ[μ] support.indicator ((μ support)⁻¹ • 1)
#align measure_theory.pdf.is_uniform MeasureTheory.pdf.IsUniform

namespace IsUniform

theorem hasPdf {m : MeasurableSpace Ω} {X : Ω → E} {ℙ : Measure Ω} {μ : Measure E} {s : Set E}
    (hns : μ s ≠ 0) (hnt : μ s ≠ ∞) (hu : IsUniform X s ℙ μ) : HasPdf X ℙ μ :=
  hasPdfOfPdfNeZero
    (by
      intro hpdf
      rw [is_uniform, hpdf] at hu
      suffices μ (s ∩ Function.support ((μ s)⁻¹ • 1)) = 0
        by
        have heq : Function.support ((μ s)⁻¹ • (1 : E → ℝ≥0∞)) = Set.univ :=
          by
          ext x
          rw [Function.mem_support]
          simp [hnt]
        rw [HEq, Set.inter_univ] at this
        exact hns this
      exact Set.indicator_ae_eq_zero hu.symm)
#align measure_theory.pdf.is_uniform.has_pdf MeasureTheory.pdf.IsUniform.hasPdf

theorem pdf_toReal_ae_eq {m : MeasurableSpace Ω} {X : Ω → E} {ℙ : Measure Ω} {μ : Measure E}
    {s : Set E} (hX : IsUniform X s ℙ μ) :
    (fun x => (pdf X ℙ μ x).toReal) =ᵐ[μ] fun x =>
      (s.indicator ((μ s)⁻¹ • (1 : E → ℝ≥0∞)) x).toReal :=
  Filter.EventuallyEq.fun_comp hX ENNReal.toReal
#align measure_theory.pdf.is_uniform.pdf_to_real_ae_eq MeasureTheory.pdf.IsUniform.pdf_toReal_ae_eq

theorem measure_preimage {m : MeasurableSpace Ω} {X : Ω → E} {ℙ : Measure Ω} {μ : Measure E}
    {s : Set E} (hns : μ s ≠ 0) (hnt : μ s ≠ ∞) (hms : MeasurableSet s) (hu : IsUniform X s ℙ μ)
    {A : Set E} (hA : MeasurableSet A) : ℙ (X ⁻¹' A) = μ (s ∩ A) / μ s :=
  by
  haveI := hu.has_pdf hns hnt
  rw [← measure.map_apply (has_pdf.measurable X ℙ μ) hA, map_eq_set_lintegral_pdf X ℙ μ hA,
    lintegral_congr_ae hu.restrict]
  simp only [hms, hA, lintegral_indicator, Pi.smul_apply, Pi.one_apply, Algebra.id.smul_eq_mul,
    mul_one, lintegral_const, restrict_apply', Set.univ_inter]
  rw [ENNReal.div_eq_inv_mul]
#align measure_theory.pdf.is_uniform.measure_preimage MeasureTheory.pdf.IsUniform.measure_preimage

theorem isProbabilityMeasure {m : MeasurableSpace Ω} {X : Ω → E} {ℙ : Measure Ω} {μ : Measure E}
    {s : Set E} (hns : μ s ≠ 0) (hnt : μ s ≠ ∞) (hms : MeasurableSet s) (hu : IsUniform X s ℙ μ) :
    IsProbabilityMeasure ℙ :=
  ⟨by
    have : X ⁻¹' Set.univ = Set.univ := by simp only [Set.preimage_univ]
    rw [← this, hu.measure_preimage hns hnt hms MeasurableSet.univ, Set.inter_univ,
      ENNReal.div_self hns hnt]⟩
#align measure_theory.pdf.is_uniform.is_probability_measure MeasureTheory.pdf.IsUniform.isProbabilityMeasure

variable {X : Ω → ℝ} {s : Set ℝ} (hms : MeasurableSet s) (hns : volume s ≠ 0)

include hms hns

theorem mulPdfIntegrable [IsFiniteMeasure ℙ] (hcs : IsCompact s) (huX : IsUniform X s ℙ) :
    Integrable fun x : ℝ => x * (pdf X ℙ volume x).toReal :=
  by
  by_cases hsupp : volume s = ∞
  · have : pdf X ℙ =ᵐ[volume] 0 := by
      refine' ae_eq_trans huX _
      simp [hsupp]
    refine' integrable.congr (integrable_zero _ _ _) _
    rw [(by simp : (fun x => 0 : ℝ → ℝ) = fun x => x * (0 : ℝ≥0∞).toReal)]
    refine'
      Filter.EventuallyEq.mul (ae_eq_refl _) (Filter.EventuallyEq.fun_comp this.symm ENNReal.toReal)
  refine'
    ⟨ae_strongly_measurable_id.mul
        (measurable_pdf X ℙ).AeMeasurable.eNNReal_toReal.AeStronglyMeasurable,
      _⟩
  refine' has_finite_integral_mul huX _
  set ind := (volume s)⁻¹ • (1 : ℝ → ℝ≥0∞) with hind
  have : ∀ x, ↑‖x‖₊ * s.indicator ind x = s.indicator (fun x => ‖x‖₊ * ind x) x := fun x =>
    (s.indicator_mul_right (fun x => ↑‖x‖₊) ind).symm
  simp only [this, lintegral_indicator _ hms, hind, mul_one, Algebra.id.smul_eq_mul, Pi.one_apply,
    Pi.smul_apply]
  rw [lintegral_mul_const _ measurable_nnnorm.coe_nnreal_ennreal]
  ·
    refine'
      (ENNReal.mul_lt_top (set_lintegral_lt_top_of_is_compact hsupp hcs continuous_nnnorm).Ne
          (ENNReal.inv_lt_top.2 (pos_iff_ne_zero.mpr hns)).Ne).Ne
  · infer_instance
#align measure_theory.pdf.is_uniform.mul_pdf_integrable MeasureTheory.pdf.IsUniform.mulPdfIntegrable

/-- A real uniform random variable `X` with support `s` has expectation
`(λ s)⁻¹ * ∫ x in s, x ∂λ` where `λ` is the Lebesgue measure. -/
theorem integral_eq (hnt : volume s ≠ ∞) (huX : IsUniform X s ℙ) :
    (∫ x, X x ∂ℙ) = (volume s)⁻¹.toReal * ∫ x in s, x :=
  by
  haveI := has_pdf hns hnt huX
  haveI := huX.is_probability_measure hns hnt hms
  rw [← integral_mul_eq_integral]
  rw [integral_congr_ae (Filter.EventuallyEq.mul (ae_eq_refl _) (pdf_to_real_ae_eq huX))]
  have :
    ∀ x,
      x * (s.indicator ((volume s)⁻¹ • (1 : ℝ → ℝ≥0∞)) x).toReal =
        x * s.indicator ((volume s)⁻¹.toReal • (1 : ℝ → ℝ)) x :=
    by
    refine' fun x => congr_arg ((· * ·) x) _
    by_cases hx : x ∈ s
    · simp [Set.indicator_of_mem hx]
    · simp [Set.indicator_of_not_mem hx]
  simp_rw [this, ← s.indicator_mul_right fun x => x, integral_indicator hms]
  change (∫ x in s, x * (volume s)⁻¹.toReal • 1 ∂volume) = _
  rw [integral_mul_right, mul_comm, Algebra.id.smul_eq_mul, mul_one]
#align measure_theory.pdf.is_uniform.integral_eq MeasureTheory.pdf.IsUniform.integral_eq

end IsUniform

end

end Pdf

end MeasureTheory


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import algebra.lie.abelian

/-!
# Tensor products of Lie modules

Tensor products of Lie modules carry natural Lie module structures.

## Tags

lie module, tensor product, universal property
-/

universes u v w w₁ w₂ w₃

variables {R : Type u} [comm_ring R]

open lie_module

namespace tensor_product

open_locale tensor_product

namespace lie_module

variables {L : Type v} {M : Type w} {N : Type w₁} {P : Type w₂} {Q : Type w₃}
variables [lie_ring L] [lie_algebra R L]
variables [add_comm_group M] [module R M] [lie_ring_module L M] [lie_module R L M]
variables [add_comm_group N] [module R N] [lie_ring_module L N] [lie_module R L N]
variables [add_comm_group P] [module R P] [lie_ring_module L P] [lie_module R L P]
variables [add_comm_group Q] [module R Q] [lie_ring_module L Q] [lie_module R L Q]
local attribute [ext] tensor_product.ext

/-- It is useful to define the bracket via this auxiliary function so that we have a type-theoretic
expression of the fact that `L` acts by linear endomorphisms. It simplifies the proofs in
`lie_ring_module` below. -/
def has_bracket_aux (x : L) : module.End R (M ⊗[R] N) :=
  (to_endomorphism R L M x).rtensor N + (to_endomorphism R L N x).ltensor M

/-- The tensor product of two Lie modules is a Lie ring module. -/
instance lie_ring_module : lie_ring_module L (M ⊗[R] N) :=
{ bracket     := λ x, has_bracket_aux x,
  add_lie     := λ x y t, by
    { simp only [has_bracket_aux, linear_map.ltensor_add, linear_map.rtensor_add, lie_hom.map_add,
        linear_map.add_apply], abel, },
  lie_add     := λ x, linear_map.map_add _,
  leibniz_lie := λ x y t, by
    { suffices : (has_bracket_aux x).comp (has_bracket_aux y) =
                  has_bracket_aux ⁅x,y⁆ + (has_bracket_aux y).comp (has_bracket_aux x),
      { simp only [← linear_map.add_apply], rw [← linear_map.comp_apply, this], refl },
      ext m n,
      simp only [has_bracket_aux, lie_ring.of_associative_ring_bracket, linear_map.mul_apply,
        mk_apply, linear_map.ltensor_sub, linear_map.compr₂_apply, function.comp_app,
        linear_map.coe_comp, linear_map.rtensor_tmul, lie_hom.map_lie,
        to_endomorphism_apply_apply, linear_map.add_apply, linear_map.map_add,
        linear_map.rtensor_sub, linear_map.sub_apply, linear_map.ltensor_tmul],
      abel, }, }

/-- The tensor product of two Lie modules is a Lie module. -/
instance lie_module : lie_module R L (M ⊗[R] N) :=
{ smul_lie := λ c x t, by
  { change has_bracket_aux (c • x) _ = c • has_bracket_aux _ _,
    simp only [has_bracket_aux, smul_add, linear_map.rtensor_smul, linear_map.smul_apply,
      linear_map.ltensor_smul, lie_hom.map_smul, linear_map.add_apply], },
  lie_smul := λ c x, linear_map.map_smul _ c, }

@[simp] lemma lie_tmul_right (x : L) (m : M) (n : N) :
  ⁅x, m ⊗ₜ[R] n⁆ = ⁅x, m⁆ ⊗ₜ n + m ⊗ₜ ⁅x, n⁆ :=
show has_bracket_aux x (m ⊗ₜ[R] n) = _,
by simp only [has_bracket_aux, linear_map.rtensor_tmul, to_endomorphism_apply_apply,
  linear_map.add_apply, linear_map.ltensor_tmul]

variables (R L M N P Q)

/-- The universal property for tensor product of modules of a Lie algebra: the `R`-linear
tensor-hom adjunction is equivariant with respect to the `L` action. -/
def lift : (M →ₗ[R] N →ₗ[R] P) ≃ₗ⁅R,L⁆ (M ⊗[R] N →ₗ[R] P) :=
{ map_lie'  := λ x f, by
    { ext m n, simp only [mk_apply, linear_map.compr₂_apply, lie_tmul_right, linear_map.sub_apply,
        lift.equiv_apply, linear_equiv.to_fun_eq_coe, lie_hom.lie_apply, linear_map.map_add],
      abel, },
  ..tensor_product.lift.equiv R M N P }

@[simp] lemma lift_apply (f : M →ₗ[R] N →ₗ[R] P) (m : M) (n : N) :
  lift R L M N P f (m ⊗ₜ n) = f m n :=
rfl

/-- A weaker form of the universal property for tensor product of modules of a Lie algebra.

Note that maps `f` of type `M →ₗ⁅R,L⁆ N →ₗ[R] P` are exactly those `R`-bilinear maps satisfying
`⁅x, f m n⁆ = f ⁅x, m⁆ n + f m ⁅x, n⁆` for all `x, m, n` (see e.g, `lie_module_hom.map_lie₂`). -/
def lift_lie : (M →ₗ⁅R,L⁆ N →ₗ[R] P) ≃ₗ[R] (M ⊗[R] N →ₗ⁅R,L⁆ P) :=
(max_triv_linear_map_equiv_lie_module_hom.symm ≪≫ₗ
↑(max_triv_equiv (lift R L M N P))) ≪≫ₗ
max_triv_linear_map_equiv_lie_module_hom

@[simp] lemma coe_lift_lie_eq_lift_coe (f : M →ₗ⁅R,L⁆ N →ₗ[R] P) :
  ⇑(lift_lie R L M N P f) = lift R L M N P f :=
begin
  suffices : (lift_lie R L M N P f : M ⊗[R] N →ₗ[R] P) = lift R L M N P f,
  { rw [← this, lie_module_hom.coe_to_linear_map], },
  ext m n,
  simp only [lift_lie, linear_equiv.trans_apply, lie_module_equiv.coe_to_linear_equiv,
    coe_linear_map_max_triv_linear_map_equiv_lie_module_hom, coe_max_triv_equiv_apply,
    coe_linear_map_max_triv_linear_map_equiv_lie_module_hom_symm],
end

lemma lift_lie_apply (f : M →ₗ⁅R,L⁆ N →ₗ[R] P) (m : M) (n : N) :
  lift_lie R L M N P f (m ⊗ₜ n) = f m n :=
by simp only [coe_lift_lie_eq_lift_coe, lie_module_hom.coe_to_linear_map, lift_apply]

variables {R L M N P Q}

/-- A pair of Lie module morphisms `f : M → P` and `g : N → Q`, induce a Lie module morphism:
`M ⊗ N → P ⊗ Q`. -/
def map (f : M →ₗ⁅R,L⁆ P) (g : N →ₗ⁅R,L⁆ Q) : M ⊗[R] N →ₗ⁅R,L⁆ P ⊗[R] Q :=
{ map_lie' := λ x t, by
    { simp only [linear_map.to_fun_eq_coe],
      apply t.induction_on,
      { simp only [linear_map.map_zero, lie_zero], },
      { intros m n, simp only [lie_module_hom.coe_to_linear_map, lie_tmul_right,
          lie_module_hom.map_lie, map_tmul, linear_map.map_add], },
      { intros t₁ t₂ ht₁ ht₂, simp only [ht₁, ht₂, lie_add, linear_map.map_add], }, },
  .. map (f : M →ₗ[R] P) (g : N →ₗ[R] Q), }

@[simp] lemma coe_linear_map_map (f : M →ₗ⁅R,L⁆ P) (g : N →ₗ⁅R,L⁆ Q) :
  (map f g : M ⊗[R] N →ₗ[R] P ⊗[R] Q) = tensor_product.map (f : M →ₗ[R] P) (g : N →ₗ[R] Q) :=
rfl

@[simp] lemma map_tmul (f : M →ₗ⁅R,L⁆ P) (g : N →ₗ⁅R,L⁆ Q) (m : M) (n : N) :
  map f g (m ⊗ₜ n) = (f m) ⊗ₜ (g n) :=
map_tmul f g m n

/-- Given Lie submodules `M' ⊆ M` and `N' ⊆ N`, this is the natural map: `M' ⊗ N' → M ⊗ N`. -/
def map_incl (M' : lie_submodule R L M) (N' : lie_submodule R L N) :
  M' ⊗[R] N' →ₗ⁅R,L⁆ M ⊗[R] N :=
map M'.incl N'.incl

@[simp] lemma map_incl_def (M' : lie_submodule R L M) (N' : lie_submodule R L N) :
  map_incl M' N' = map M'.incl N'.incl :=
rfl

end lie_module

end tensor_product

namespace lie_module

open_locale tensor_product

variables (R) (L : Type v) (M : Type w)
variables [lie_ring L] [lie_algebra R L]
variables [add_comm_group M] [module R M] [lie_ring_module L M] [lie_module R L M]

/-- The action of the Lie algebra on one of its modules, regarded as a morphism of Lie modules. -/
def to_module_hom : L ⊗[R] M →ₗ⁅R,L⁆ M :=
tensor_product.lie_module.lift_lie R L L M M
{ map_lie' := λ x m, by { ext n, simp [lie_ring.of_associative_ring_bracket], },
  ..(to_endomorphism R L M : L →ₗ[R] M →ₗ[R] M), }

@[simp] lemma to_module_hom_apply (x : L) (m : M) :
  to_module_hom R L M (x ⊗ₜ m) = ⁅x, m⁆ :=
by simp only [to_module_hom, tensor_product.lie_module.lift_lie_apply, to_endomorphism_apply_apply,
  lie_hom.coe_to_linear_map, lie_module_hom.coe_mk, linear_map.coe_mk, linear_map.to_fun_eq_coe]

end lie_module

namespace lie_submodule

open_locale tensor_product

open tensor_product.lie_module
open lie_module

variables {L : Type v} {M : Type w}
variables [lie_ring L] [lie_algebra R L]
variables [add_comm_group M] [module R M] [lie_ring_module L M] [lie_module R L M]
variables (I : lie_ideal R L) (N : lie_submodule R L M)

/-- A useful alternative characterisation of Lie ideal operations on Lie submodules.

Given a Lie ideal `I ⊆ L` and a Lie submodule `N ⊆ M`, by tensoring the inclusion maps and then
applying the action of `L` on `M`, we obtain morphism of Lie modules `f : I ⊗ N → L ⊗ M → M`.

This lemma states that `⁅I, N⁆ = range f`. -/
lemma lie_ideal_oper_eq_tensor_map_range :
  ⁅I, N⁆ = ((to_module_hom R L M).comp (map_incl I N : ↥I ⊗ ↥N →ₗ⁅R,L⁆ L ⊗ M)).range :=
begin
  rw [← coe_to_submodule_eq_iff, lie_ideal_oper_eq_linear_span, lie_module_hom.coe_submodule_range,
    lie_module_hom.coe_linear_map_comp, linear_map.range_comp, map_incl_def, coe_linear_map_map,
    tensor_product.map_range_eq_span_tmul, submodule.map_span],
  congr, ext m, split,
  { rintros ⟨⟨x, hx⟩, ⟨n, hn⟩, rfl⟩, use x ⊗ₜ n, split,
    { use [⟨x, hx⟩, ⟨n, hn⟩], simp, },
    { simp, }, },
  { rintros ⟨t, ⟨⟨x, hx⟩, ⟨n, hn⟩, rfl⟩, h⟩, rw ← h, use [⟨x, hx⟩, ⟨n, hn⟩], simp, },
end

end lie_submodule


import Mathlib.Algebra.Ring.Basic
import Mathlib.Tactic.Ring
import Mathlib.Tactic.LibrarySearch
import Mathlib.Tactic.Contrapose

variable {R : Type _}

theorem add_self_eq_mul_two [Semiring R] (a : R) : a + a = 2 * a := by
  rw [←one_mul a, ←add_mul, one_mul]
  congr
  norm_num

section Ring
--theorem sub_eq_add_neg (a b : R) : a - b = a + -b := Ring.sub_eq_add_neg a b
variable [Ring R]

-- theorem mul_sub (a b c : R) : a * (b - c) = a * b - a * c := by
  -- rw [sub_eq_add_neg, mul_add, ←neg_mul_eq_mul_neg, ←sub_eq_add_neg]

-- theorem sub_mul (a b c : R) : (a - b) * c = a * c - b * c := by
  -- rw [sub_eq_add_neg, add_mul, ←neg_mul_eq_neg_mul, ←sub_eq_add_neg]

-- @[simp] theorem sub_zero (a : R) : a - 0 = a := by
--   rw [sub_eq_add_neg, ←add_zero (-0), add_left_neg (0: R)]
--   simp

-- theorem neg_add (a b : R) : - (a + b) = -a + -b := by
--   have h₁ : - (a + b) = -(a + b) + (a + b) + -a + -b := by
--     rw [add_assoc, add_comm (-a), add_assoc, add_assoc, ← add_assoc b]
--     rw [add_right_neg b, zero_add, add_right_neg a, add_zero]
--   rwa [add_left_neg (a + b), zero_add] at h₁

-- theorem sub_add (a b c : R) : a - (b + c) = a - b - c := by
--   rw [sub_eq_add_neg, neg_add, ←add_assoc, ←sub_eq_add_neg, ←sub_eq_add_neg]

-- theorem sub_add_comm (n m k : R) : n + m - k = n - k + m := by
--   rw [sub_eq_add_neg, add_assoc, add_comm m, ←add_assoc, ←sub_eq_add_neg]

end Ring

section CommRing
variable [CommRing R]

theorem evenpow_neg {n m : ℕ} (a : R) (h : n = 2 * m) : (-a) ^ n = a ^ n := by
  rw [h, pow_mul, pow_mul, neg_sq]

theorem oddpow_neg {n m : ℕ} (a : R) (h : n = 2 * m + 1) : (-a) ^ n = -(a ^ n) := by
  rw [h, pow_succ, evenpow_neg a (show 2 * m = 2 * m by rfl), ←neg_mul_eq_neg_mul, ←pow_succ,
    Nat.add_one]

end CommRing

section IntegralDomain
variable [CommRing R] [IsDomain R]

-- TODO maybe delete
theorem nzero_mul_left_cancel (a b c : R) : a ≠ 0 → a * b = a * c → b = c := by
  intro a_ne_z ab_eq_ac
  rw [←add_left_inj (-(a * c)), add_neg_self (a * c), neg_mul_eq_mul_neg, ←mul_add] at ab_eq_ac
  cases (@mul_eq_zero _ _ _ a (b + -c)).1 ab_eq_ac with
  | inl h => exact False.elim (a_ne_z h)
  | inr h =>
    rw [←add_left_inj (-c), add_neg_self c]
    exact h

end IntegralDomain


import combinatorics.simple_graph.coloring

--OUTPUT 1
theorem bipartite_graph_two_colorable {G : Type*} [graph G] : G.is_bipartite ↔ G.is_two_colorable :=
begin
  -- Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color.
  have h1 : G.is_two_colorable → G.is_bipartite, from sorry,
  -- Let $G$ be a bipartite graph, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$.
  have h2 : G.is_bipartite → G.is_two_colorable, from sorry,
  show G.is_bipartite ↔ G.is_two_colorable, from sorry,
end

--OUTPUT 2
theorem bipartite_graph_two_colorable {G : Type*} [graph G] :
  (∃ A B : set G, A ∩ B = ∅ ∧ A ∪ B = G.V ∧ ∀ e : G.E, (e.src ∈ A ∧ e.dst ∈ B) ∨ (e.src ∈ B ∧ e.dst ∈ A)) ↔
  (∃ c : G.V → ℕ, ∀ e : G.E, c e.src ≠ c e.dst) :=
begin
  -- Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color.
  assume h1 : ∃ c : G.V → ℕ, ∀ e : G.E, c e.src ≠ c e.dst,
  -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
  have h2 : ∃ A B : set G.V, A ∩ B = ∅ ∧ A ∪ B = G.V ∧ ∀ e : G.E, (e.src ∈ A ∧ e.dst ∈ B) ∨ (e.src ∈ B ∧ e.dst ∈ A), from sorry,
  -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
  have h3 : ∀ e : G.E, (e.src ∈ A ∧ e.dst ∈ B) ∨ (e.src ∈ B ∧ e.dst ∈ A), from sorry,
  -- This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
  show (∃ A B : set G.V, A ∩ B = ∅ ∧ A ∪ B = G.V ∧ ∀ e : G.E, (e.src ∈ A ∧ e.dst ∈ B) ∨ (e.src ∈ B ∧ e.dst ∈ A)) ↔
    (∃ c : G.V → ℕ, ∀ e : G.E, c e.src ≠ c e.dst), from sorry,
end

--OUTPUT 3
theorem bipartite_graph_two_colorable (G : Type*) [graph G] :
  (∃ c : G → ℕ, ∀ v w : G, (v ≠ w) → (c v ≠ c w)) ↔ (∃ A B : set G, ∀ v w : G, (v ≠ w) → ((v ∈ A ∧ w ∈ B) ∨ (v ∈ B ∧ w ∈ A))) :=
begin
  -- Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color. Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue. Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$. This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
  have h1 : (∃ c : G → ℕ, ∀ v w : G, (v ≠ w) → (c v ≠ c w)) → (∃ A B : set G, ∀ v w : G, (v ≠ w) → ((v ∈ A ∧ w ∈ B) ∨ (v ∈ B ∧ w ∈ A))), from sorry,
  -- Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$. Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.
  have h2 : (∃ A B : set G, ∀ v w : G, (v ≠ w) → ((v ∈ A ∧ w ∈ B) ∨ (v ∈ B ∧ w ∈ A))) → (∃ c : G → ℕ, ∀ v w : G, (v ≠ w) → (c v ≠ c w)), from sorry,
  show (∃ c : G → ℕ, ∀ v w : G, (v ≠ w) → (c v ≠ c w)) ↔ (∃ A B : set G, ∀ v w : G, (v ≠ w) → ((v ∈ A ∧ w ∈ B) ∨ (v ∈ B ∧ w ∈ A))), from sorry,
end

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from sorry,
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from sorry,
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from sorry,
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from sorry,
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by sorry
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by sorry
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by sorry
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by sorry,
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from sorry,
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from sorry,

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from sorry,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from sorry,

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a) = (1 : G), from sorry,
  have h6 : ∀ a : G, classical.some (h4 a) = (1 : G), from sorry,

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (h7 : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a), from sorry,
      have h9 : ∀ a : G, e = classical.some (h4 a), from sorry,
      show e = (1 : G), from sorry,
    },
    sorry,
  }
end

/--`theorem`
Bipartite Graph is two colorable
Let $G$ be a graph. Then $G$ is 2-colorable if and only if $G$ is bipartite.
`proof`
Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color. Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue. Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$. This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.

Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$. Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.

QED

-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


import Lean
open Lean Macro

universes u v

class Mem (α : outParam $ Type u) (γ : Type v) where
  mem : α → γ → Prop

infix:50 " ∈ " => Mem.mem

notation:50 x " ∉ " s => ¬ x ∈ s

def Set (α : Type u) := α → Prop

def setOf {α : Type u} (p : α → Prop) : Set α :=
p

class Subset (α : Type u) where
  subset : α → α → Prop

infix:50 " ⊆ " => Subset.subset

class Union (α : Type u) where
  union : α → α → α

infixl:65 " ∪ " => Union.union

class Inter (α : Type u) where
  inter : α → α → α

infixl:70 " ∩ " => Inter.inter

class Sdiff (α : Type u) where
  sdiff : α → α → α

infix:70 " \\ " => Sdiff.sdiff

namespace Set

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

protected def mem (a : α) (s : Set α) :=
s a

instance : Mem α (Set α) :=
⟨Set.mem⟩

protected def subset (s₁ s₂ : Set α) :=
∀ {a}, a ∈ s₁ → a ∈ s₂

instance : Subset (Set α) :=
⟨Set.subset⟩

instance : EmptyCollection (Set α) :=
⟨λ a => false⟩

declare_syntax_cat binderterm -- notation for `a` or `a : A` or `a ∈ S`
syntax ident : binderterm
syntax ident " : " term : binderterm
syntax ident " ∈ " term : binderterm

-- Notation for sets
syntax "⦃ " binderterm " | " term " ⦄" : term

macro_rules
| `(⦃ $x:ident : $t | $p ⦄) => `(setOf (λ ($x:ident : $t) => $p))
| `(⦃ $x:ident | $p ⦄) => `(setOf (λ ($x:ident) => $p))
| `(⦃ $x:ident ∈ $s | $p ⦄) => `(setOf (λ $x => $x ∈ $s ∧ $p))

syntax "∀" binderterm "," term : term
syntax "∃" binderterm "," term : term

macro_rules
| `(∀ $x:ident ∈ $s, $p) => `(∀ $x:ident, $x ∈ $s → $p)
| `(∃ $x:ident ∈ $s, $p) => `(∃ $x:ident, $x ∈ $s ∧ $p)

def univ : Set α := ⦃a | True ⦄

protected def insert (a : α) (s : Set α) : Set α :=
⦃b | b = a ∨ b ∈ s⦄

protected def singleton (a : α) : Set α :=
⦃b | b = a⦄

syntax " ⦃ " term,* " ⦄ " : term

macro_rules
| `(⦃ $elems:term,* ⦄) => do
  let n := elems.elemsAndSeps.size
  if n = 0 then throwUnsupported
  let rec expandSetLit (i : Nat) (skip : Bool) (result : Syntax) : MacroM Syntax := do
    match i, skip with
    | 0, _ => result
    | i + 1, true => expandSetLit i false result
    | i + 1, false => expandSetLit i true (← ``(Set.insert $(elems.elemsAndSeps[i]) $result))
  let some hd ← pure $ elems.elemsAndSeps.back? | throwUnsupported
  expandSetLit (n - 1) true (← ``(Set.singleton $hd))

@[appUnexpander Set.singleton] def singletonUnexpander : Lean.PrettyPrinter.Unexpander
| `(Set.singleton $a) => `(⦃ $a ⦄)
| _ => throw ()

@[appUnexpander Set.insert]
def insertUnexpander : Lean.PrettyPrinter.Unexpander
| `(Set.insert $a ⦃ $t ⦄) => `(⦃$a, $t⦄)
| `(Set.insert $a ⦃ $ts,* ⦄) => `(⦃$a, $ts,*⦄)
| _ => throw ()

#check ⦃ 3, 2, 1 ⦄ --  ⦃ 3, 2, 1 ⦄  : Set Nat

example : ⦃ 1 ⦄ = ⦃ 2, 2 ⦄ := by
  skip
  -- ⊢  ⦃ 1 ⦄  =  ⦃ 2, 2 ⦄
  admit

example : ⦃1, 2, 3⦄ = ⦃1, 2⦄ := by
  skip
  -- ⊢  ⦃ 1, 2, 3 ⦄  =  ⦃ 1, 2 ⦄
  admit


import data.real.basic

axiom well_ordered_Zplus
  (A : set ℤ) (h1A : A.nonempty) (h2A : ∀ (a:ℤ), a ∈ A → 0 < a):
  ∃ m ∈ A, ∀ k ∈ A, m ≤ k
-- this does work!
lemma wellOrd_ceil_existence (x : ℝ) (hx : 0 < x) :
  ∃ m : ℤ, m > 0 ∧ (m-1 : ℝ) ≤ x ∧ x < (m : ℝ) :=
begin
  have H := exists_nat_gt x,
  cases H with n hn,
  have h1 : 0 < (n : ℝ), exact lt_trans hx hn,
  set A := { k : ℤ | x < k } with hA,
  have h2a : ∀ (a : ℤ), a ∈ A → 0 < a,
    intros a ha,
    have h2a1 : x < a, exact ha,
    have h2a2 : 0 < (a:ℝ), exact lt_trans hx h2a1,
    exact int.cast_lt.mp h2a2,
  have h2 : (n : ℤ) ∈ A, exact hn,
  have h3 : A.nonempty, existsi (n : ℤ), exact h2,
  have h4 := well_ordered_Zplus A h3 h2a,
  cases h4 with m hmn,
  cases hmn with hm hk,
  have h5 : x < m, exact hm,
  set m1 := m-1 with hm1,
  have h6 : (m1 : ℝ) ≤ x,
    by_contradiction hf,
    push_neg at hf,
    have h6a : m1 ∈ A, exact hf,
    have h6b := hk m1 h6a, rw hm1 at h6b, linarith,
  existsi m,
  split, swap, split, swap, exact h5, swap,
  have h7 : 0 < (m : ℝ), exact lt_trans hx h5,
  exact int.cast_lt.mp h7,
  rw hm1 at h6, convert h6, norm_cast, done
end
-- how to deal with the lambda (uniqueness part)?
-- needs more work
lemma wellOrd_ceil_existuniq (x : ℝ) (hx : 0 < x) :
  ∃! m : ℕ, m > 0 ∧ (m-1 : ℝ) ≤ x ∧ x < (m : ℝ) :=
begin
  split,
  split,
  sorry, sorry,
end