/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.pfun
import Mathlib.tactic.norm_num
import Mathlib.data.equiv.mul_add
import Mathlib.PostPort

namespace Mathlib

/-!
# Natural numbers with infinity

The natural numbers and an extra `top` element `⊤`.

## Main definitions

The following instances are defined:

* `ordered_add_comm_monoid enat`
* `canonically_ordered_add_monoid enat`

There is no additive analogue of `monoid_with_zero`; if there were then `enat` could
be an `add_monoid_with_top`.

* `to_with_top` : the map from `enat` to `with_top ℕ`, with theorems that it plays well
with `+` and `≤`.

* `with_top_add_equiv : enat ≃+ with_top ℕ`
* `with_top_order_iso : enat ≃o with_top ℕ`

## Implementation details

`enat` is defined to be `roption ℕ`.

`+` and `≤` are defined on `enat`, but there is an issue with `*` because it's not
clear what `0 * ⊤` should be. `mul` is hence left undefined. Similarly `⊤ - ⊤` is ambiguous
so there is no `-` defined on `enat`.

Before the `open_locale classical` line, various proofs are made with decidability assumptions.
This can cause issues -- see for example the non-simp lemma `to_with_top_zero` proved by `rfl`,
followed by `@[simp] lemma to_with_top_zero'` whose proof uses `convert`.

## Tags

enat, with_top ℕ
-/

/-- Type of natural numbers with infinity (`⊤`) -/
def enat := roption ℕ

namespace enat

protected instance has_zero : HasZero enat := { zero := roption.some 0 }

protected instance inhabited : Inhabited enat := { default := 0 }

protected instance has_one : HasOne enat := { one := roption.some 1 }

protected instance has_add : Add enat :=
  { add :=
      fun (x y : enat) =>
        roption.mk (roption.dom x ∧ roption.dom y)
          fun (h : roption.dom x ∧ roption.dom y) => roption.get x sorry + roption.get y sorry }

protected instance has_coe : has_coe ℕ enat := has_coe.mk roption.some

protected instance dom.decidable (n : ℕ) : Decidable (roption.dom ↑n) := is_true trivial

@[simp] theorem coe_inj {x : ℕ} {y : ℕ} : ↑x = ↑y ↔ x = y := roption.some_inj

@[simp] theorem dom_coe (x : ℕ) : roption.dom ↑x := trivial

protected instance add_comm_monoid : add_comm_monoid enat :=
  add_comm_monoid.mk Add.add sorry 0 sorry sorry sorry

protected instance has_le : HasLessEq enat :=
  { LessEq :=
      fun (x y : enat) =>
        ∃ (h : roption.dom y → roption.dom x),
          ∀ (hy : roption.dom y), roption.get x (h hy) ≤ roption.get y hy }

protected instance has_top : has_top enat := has_top.mk roption.none

protected instance has_bot : has_bot enat := has_bot.mk 0

protected instance has_sup : has_sup enat :=
  has_sup.mk
    fun (x y : enat) =>
      roption.mk (roption.dom x ∧ roption.dom y)
        fun (h : roption.dom x ∧ roption.dom y) => roption.get x sorry ⊔ roption.get y sorry

theorem le_def (x : enat) (y : enat) :
    x ≤ y ↔
        ∃ (h : roption.dom y → roption.dom x),
          ∀ (hy : roption.dom y), roption.get x (h hy) ≤ roption.get y hy :=
  iff.rfl

protected theorem cases_on {P : enat → Prop} (a : enat) : P ⊤ → (∀ (n : ℕ), P ↑n) → P a :=
  roption.induction_on

@[simp] theorem top_add (x : enat) : ⊤ + x = ⊤ :=
  roption.ext' (false_and (roption.dom x)) fun (h : roption.dom (⊤ + x)) => false.elim (and.left h)

@[simp] theorem add_top (x : enat) : x + ⊤ = ⊤ :=
  eq.mpr (id (Eq._oldrec (Eq.refl (x + ⊤ = ⊤)) (add_comm x ⊤)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (⊤ + x = ⊤)) (top_add x))) (Eq.refl ⊤))

@[simp] theorem coe_zero : ↑0 = 0 := rfl

@[simp] theorem coe_one : ↑1 = 1 := rfl

@[simp] theorem coe_add (x : ℕ) (y : ℕ) : ↑(x + y) = ↑x + ↑y :=
  roption.ext' (iff.symm (and_true (roption.dom ↑(x + y))))
    fun (_x : roption.dom ↑(x + y)) (_x_1 : roption.dom (↑x + ↑y)) => rfl

theorem get_coe {x : ℕ} : roption.get (↑x) True.intro = x := rfl

@[simp] theorem get_coe' (x : ℕ) (h : roption.dom ↑x) : roption.get (↑x) h = x := rfl

theorem coe_add_get {x : ℕ} {y : enat} (h : roption.dom (↑x + y)) :
    roption.get (↑x + y) h = x + roption.get y (and.right h) :=
  rfl

@[simp] theorem get_add {x : enat} {y : enat} (h : roption.dom (x + y)) :
    roption.get (x + y) h = roption.get x (and.left h) + roption.get y (and.right h) :=
  rfl

@[simp] theorem coe_get {x : enat} (h : roption.dom x) : ↑(roption.get x h) = x :=
  roption.ext' (iff_of_true trivial h)
    fun (_x : roption.dom ↑(roption.get x h)) (_x_1 : roption.dom x) => rfl

@[simp] theorem get_zero (h : roption.dom 0) : roption.get 0 h = 0 := rfl

@[simp] theorem get_one (h : roption.dom 1) : roption.get 1 h = 1 := rfl

theorem dom_of_le_of_dom {x : enat} {y : enat} : x ≤ y → roption.dom y → roption.dom x := sorry

theorem dom_of_le_some {x : enat} {y : ℕ} (h : x ≤ ↑y) : roption.dom x := dom_of_le_of_dom h trivial

protected instance decidable_le (x : enat) (y : enat) [Decidable (roption.dom x)]
    [Decidable (roption.dom y)] : Decidable (x ≤ y) :=
  dite (roption.dom x)
    (fun (hx : roption.dom x) =>
      decidable_of_decidable_of_iff
        ((fun (this : Decidable (∀ (hy : roption.dom y), roption.get x hx ≤ roption.get y hy)) =>
            this)
          (Mathlib.forall_prop_decidable
            fun (hy : roption.dom y) => roption.get x hx ≤ roption.get y hy))
        sorry)
    fun (hx : ¬roption.dom x) =>
      dite (roption.dom y) (fun (hy : roption.dom y) => isFalse sorry)
        fun (hy : ¬roption.dom y) => is_true sorry

/-- The coercion `ℕ → enat` preserves `0` and addition. -/
def coe_hom : ℕ →+ enat := add_monoid_hom.mk coe coe_zero coe_add

protected instance partial_order : partial_order enat :=
  partial_order.mk LessEq (preorder.lt._default LessEq) sorry sorry sorry

theorem lt_def (x : enat) (y : enat) :
    x < y ↔ ∃ (hx : roption.dom x), ∀ (hy : roption.dom y), roption.get x hx < roption.get y hy :=
  sorry

@[simp] theorem coe_le_coe {x : ℕ} {y : ℕ} : ↑x ≤ ↑y ↔ x ≤ y := sorry

@[simp] theorem coe_lt_coe {x : ℕ} {y : ℕ} : ↑x < ↑y ↔ x < y := sorry

@[simp] theorem get_le_get {x : enat} {y : enat} {hx : roption.dom x} {hy : roption.dom y} :
    roption.get x hx ≤ roption.get y hy ↔ x ≤ y :=
  sorry

theorem le_coe_iff (x : enat) (n : ℕ) : x ≤ ↑n ↔ ∃ (h : roption.dom x), roption.get x h ≤ n := sorry

theorem lt_coe_iff (x : enat) (n : ℕ) : x < ↑n ↔ ∃ (h : roption.dom x), roption.get x h < n := sorry

theorem coe_le_iff (n : ℕ) (x : enat) : ↑n ≤ x ↔ ∀ (h : roption.dom x), n ≤ roption.get x h := sorry

theorem coe_lt_iff (n : ℕ) (x : enat) : ↑n < x ↔ ∀ (h : roption.dom x), n < roption.get x h := sorry

protected theorem zero_lt_one : 0 < 1 := sorry

protected instance semilattice_sup_bot : semilattice_sup_bot enat :=
  semilattice_sup_bot.mk ⊥ partial_order.le partial_order.lt partial_order.le_refl
    partial_order.le_trans partial_order.le_antisymm sorry has_sup.sup sorry sorry sorry

protected instance order_top : order_top enat :=
  order_top.mk ⊤ semilattice_sup_bot.le semilattice_sup_bot.lt semilattice_sup_bot.le_refl
    semilattice_sup_bot.le_trans semilattice_sup_bot.le_antisymm sorry

theorem dom_of_lt {x : enat} {y : enat} : x < y → roption.dom x :=
  enat.cases_on x not_top_lt fun (_x : ℕ) (_x : ↑_x < y) => trivial

theorem top_eq_none : ⊤ = roption.none := rfl

@[simp] theorem coe_lt_top (x : ℕ) : ↑x < ⊤ :=
  lt_of_le_of_ne le_top fun (h : ↑x = ⊤) => absurd (congr_arg roption.dom h) true_ne_false

@[simp] theorem coe_ne_top (x : ℕ) : ↑x ≠ ⊤ := ne_of_lt (coe_lt_top x)

theorem ne_top_iff {x : enat} : x ≠ ⊤ ↔ ∃ (n : ℕ), x = ↑n := roption.ne_none_iff

theorem ne_top_iff_dom {x : enat} : x ≠ ⊤ ↔ roption.dom x :=
  iff.mp not_iff_comm (iff.symm roption.eq_none_iff')

theorem ne_top_of_lt {x : enat} {y : enat} (h : x < y) : x ≠ ⊤ := ne_of_lt (lt_of_lt_of_le h le_top)

theorem eq_top_iff_forall_lt (x : enat) : x = ⊤ ↔ ∀ (n : ℕ), ↑n < x := sorry

theorem eq_top_iff_forall_le (x : enat) : x = ⊤ ↔ ∀ (n : ℕ), ↑n ≤ x :=
  iff.trans (eq_top_iff_forall_lt x)
    { mp := fun (h : ∀ (n : ℕ), ↑n < x) (n : ℕ) => has_lt.lt.le (h n),
      mpr :=
        fun (h : ∀ (n : ℕ), ↑n ≤ x) (n : ℕ) =>
          lt_of_lt_of_le (iff.mpr coe_lt_coe (nat.lt_succ_self n)) (h (n + 1)) }

theorem pos_iff_one_le {x : enat} : 0 < x ↔ 1 ≤ x := sorry

protected instance linear_order : linear_order enat :=
  linear_order.mk partial_order.le partial_order.lt partial_order.le_refl partial_order.le_trans
    partial_order.le_antisymm sorry (classical.dec_rel LessEq) Mathlib.decidable_eq_of_decidable_le
    Mathlib.decidable_lt_of_decidable_le

protected instance bounded_lattice : bounded_lattice enat :=
  bounded_lattice.mk semilattice_sup_bot.sup order_top.le order_top.lt order_top.le_refl
    order_top.le_trans order_top.le_antisymm semilattice_sup_bot.le_sup_left
    semilattice_sup_bot.le_sup_right semilattice_sup_bot.sup_le min min_le_left min_le_right sorry
    order_top.top order_top.le_top semilattice_sup_bot.bot semilattice_sup_bot.bot_le

theorem sup_eq_max {a : enat} {b : enat} : a ⊔ b = max a b :=
  le_antisymm (sup_le (le_max_left a b) (le_max_right a b)) (max_le le_sup_left le_sup_right)

theorem inf_eq_min {a : enat} {b : enat} : a ⊓ b = min a b := rfl

protected instance ordered_add_comm_monoid : ordered_add_comm_monoid enat :=
  ordered_add_comm_monoid.mk add_comm_monoid.add add_comm_monoid.add_assoc add_comm_monoid.zero
    add_comm_monoid.zero_add add_comm_monoid.add_zero add_comm_monoid.add_comm linear_order.le
    linear_order.lt linear_order.le_refl linear_order.le_trans linear_order.le_antisymm sorry sorry

protected instance canonically_ordered_add_monoid : canonically_ordered_add_monoid enat :=
  canonically_ordered_add_monoid.mk ordered_add_comm_monoid.add ordered_add_comm_monoid.add_assoc
    ordered_add_comm_monoid.zero ordered_add_comm_monoid.zero_add ordered_add_comm_monoid.add_zero
    ordered_add_comm_monoid.add_comm semilattice_sup_bot.le semilattice_sup_bot.lt
    semilattice_sup_bot.le_refl semilattice_sup_bot.le_trans semilattice_sup_bot.le_antisymm
    ordered_add_comm_monoid.add_le_add_left ordered_add_comm_monoid.lt_of_add_lt_add_left
    semilattice_sup_bot.bot semilattice_sup_bot.bot_le sorry

protected theorem add_lt_add_right {x : enat} {y : enat} {z : enat} (h : x < y) (hz : z ≠ ⊤) :
    x + z < y + z :=
  sorry

protected theorem add_lt_add_iff_right {x : enat} {y : enat} {z : enat} (hz : z ≠ ⊤) :
    x + z < y + z ↔ x < y :=
  { mp := lt_of_add_lt_add_right, mpr := fun (h : x < y) => enat.add_lt_add_right h hz }

protected theorem add_lt_add_iff_left {x : enat} {y : enat} {z : enat} (hz : z ≠ ⊤) :
    z + x < z + y ↔ x < y :=
  sorry

protected theorem lt_add_iff_pos_right {x : enat} {y : enat} (hx : x ≠ ⊤) : x < x + y ↔ 0 < y :=
  sorry

theorem lt_add_one {x : enat} (hx : x ≠ ⊤) : x < x + 1 := sorry

theorem le_of_lt_add_one {x : enat} {y : enat} (h : x < y + 1) : x ≤ y := sorry

theorem add_one_le_of_lt {x : enat} {y : enat} (h : x < y) : x + 1 ≤ y := sorry

theorem add_one_le_iff_lt {x : enat} {y : enat} (hx : x ≠ ⊤) : x + 1 ≤ y ↔ x < y := sorry

theorem lt_add_one_iff_lt {x : enat} {y : enat} (hx : x ≠ ⊤) : x < y + 1 ↔ x ≤ y := sorry

theorem add_eq_top_iff {a : enat} {b : enat} : a + b = ⊤ ↔ a = ⊤ ∨ b = ⊤ := sorry

protected theorem add_right_cancel_iff {a : enat} {b : enat} {c : enat} (hc : c ≠ ⊤) :
    a + c = b + c ↔ a = b :=
  sorry

protected theorem add_left_cancel_iff {a : enat} {b : enat} {c : enat} (ha : a ≠ ⊤) :
    a + b = a + c ↔ b = c :=
  sorry

/-- Computably converts an `enat` to a `with_top ℕ`. -/
def to_with_top (x : enat) [Decidable (roption.dom x)] : with_top ℕ := roption.to_option x

theorem to_with_top_top : to_with_top ⊤ = ⊤ := rfl

@[simp] theorem to_with_top_top' {h : Decidable (roption.dom ⊤)} : to_with_top ⊤ = ⊤ := sorry

theorem to_with_top_zero : to_with_top 0 = 0 := rfl

@[simp] theorem to_with_top_zero' {h : Decidable (roption.dom 0)} : to_with_top 0 = 0 := sorry

theorem to_with_top_coe (n : ℕ) : to_with_top ↑n = ↑n := rfl

@[simp] theorem to_with_top_coe' (n : ℕ) {h : Decidable (roption.dom ↑n)} : to_with_top ↑n = ↑n :=
  sorry

@[simp] theorem to_with_top_le {x : enat} {y : enat} [Decidable (roption.dom x)]
    [Decidable (roption.dom y)] : to_with_top x ≤ to_with_top y ↔ x ≤ y :=
  sorry

@[simp] theorem to_with_top_lt {x : enat} {y : enat} [Decidable (roption.dom x)]
    [Decidable (roption.dom y)] : to_with_top x < to_with_top y ↔ x < y :=
  lt_iff_lt_of_le_iff_le to_with_top_le

@[simp] theorem to_with_top_add {x : enat} {y : enat} :
    to_with_top (x + y) = to_with_top x + to_with_top y :=
  sorry

/-- `equiv` between `enat` and `with_top ℕ` (for the order isomorphism see `with_top_order_iso`). -/
def with_top_equiv : enat ≃ with_top ℕ :=
  equiv.mk (fun (x : enat) => to_with_top x) (fun (x : with_top ℕ) => sorry) sorry sorry

@[simp] theorem with_top_equiv_top : coe_fn with_top_equiv ⊤ = ⊤ := to_with_top_top'

@[simp] theorem with_top_equiv_coe (n : ℕ) : coe_fn with_top_equiv ↑n = ↑n := to_with_top_coe' n

@[simp] theorem with_top_equiv_zero : coe_fn with_top_equiv 0 = 0 := with_top_equiv_coe 0

@[simp] theorem with_top_equiv_le {x : enat} {y : enat} :
    coe_fn with_top_equiv x ≤ coe_fn with_top_equiv y ↔ x ≤ y :=
  to_with_top_le

@[simp] theorem with_top_equiv_lt {x : enat} {y : enat} :
    coe_fn with_top_equiv x < coe_fn with_top_equiv y ↔ x < y :=
  to_with_top_lt

/-- `to_with_top` induces an order isomorphism between `enat` and `with_top ℕ`. -/
def with_top_order_iso : enat ≃o with_top ℕ :=
  rel_iso.mk (equiv.mk (equiv.to_fun with_top_equiv) (equiv.inv_fun with_top_equiv) sorry sorry)
    sorry

@[simp] theorem with_top_equiv_symm_top : coe_fn (equiv.symm with_top_equiv) ⊤ = ⊤ := rfl

@[simp] theorem with_top_equiv_symm_coe (n : ℕ) : coe_fn (equiv.symm with_top_equiv) ↑n = ↑n := rfl

@[simp] theorem with_top_equiv_symm_zero : coe_fn (equiv.symm with_top_equiv) 0 = 0 := rfl

@[simp] theorem with_top_equiv_symm_le {x : with_top ℕ} {y : with_top ℕ} :
    coe_fn (equiv.symm with_top_equiv) x ≤ coe_fn (equiv.symm with_top_equiv) y ↔ x ≤ y :=
  sorry

@[simp] theorem with_top_equiv_symm_lt {x : with_top ℕ} {y : with_top ℕ} :
    coe_fn (equiv.symm with_top_equiv) x < coe_fn (equiv.symm with_top_equiv) y ↔ x < y :=
  sorry

/-- `to_with_top` induces an additive monoid isomorphism between `enat` and `with_top ℕ`. -/
def with_top_add_equiv : enat ≃+ with_top ℕ :=
  add_equiv.mk (equiv.to_fun with_top_equiv) (equiv.inv_fun with_top_equiv) sorry sorry sorry

theorem lt_wf : well_founded Less := sorry

protected instance has_well_founded : has_well_founded enat := has_well_founded.mk Less lt_wf

/-- The smallest `enat` satisfying a (decidable) predicate `P : ℕ → Prop` -/
def find (P : ℕ → Prop) [decidable_pred P] : enat := roption.mk (∃ (n : ℕ), P n) nat.find

@[simp] theorem find_get (P : ℕ → Prop) [decidable_pred P] (h : roption.dom (find P)) :
    roption.get (find P) h = nat.find h :=
  rfl

theorem find_dom (P : ℕ → Prop) [decidable_pred P] (h : ∃ (n : ℕ), P n) : roption.dom (find P) := h

theorem lt_find (P : ℕ → Prop) [decidable_pred P] (n : ℕ) (h : ∀ (m : ℕ), m ≤ n → ¬P m) :
    ↑n < find P :=
  sorry

theorem lt_find_iff (P : ℕ → Prop) [decidable_pred P] (n : ℕ) :
    ↑n < find P ↔ ∀ (m : ℕ), m ≤ n → ¬P m :=
  sorry

theorem find_le (P : ℕ → Prop) [decidable_pred P] (n : ℕ) (h : P n) : find P ≤ ↑n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (find P ≤ ↑n)) (propext (le_coe_iff (find P) n))))
    (Exists.intro (Exists.intro n h) (nat.find_min' (Exists.intro n h) h))

theorem find_eq_top_iff (P : ℕ → Prop) [decidable_pred P] : find P = ⊤ ↔ ∀ (n : ℕ), ¬P n :=
  iff.trans (eq_top_iff_forall_lt (find P))
    { mp := fun (h : ∀ (n : ℕ), ↑n < find P) (n : ℕ) => iff.mp (lt_find_iff P n) (h n) n le_rfl,
      mpr := fun (h : ∀ (n : ℕ), ¬P n) (n : ℕ) => lt_find P n fun (_x : ℕ) (_x_1 : _x ≤ n) => h _x }

end Mathlib


#check option.cases_on

def comp {α β γ : Type*} (f: α -> option β) (g: β -> option γ) (x: α): option γ :=
  option.cases_on (f x) option.none (λ y, g y)

#print comp
#reduce comp (λ x, some (x*x)) (λ x, some (x+1)) 10
example: comp (λ x, some (x*x)) (λ x, some (x+1)) 10 = some 101 := by rsimp

#reduce comp (λ x, none) (λ x, some (x+1)) 10
example: comp (λ x, none) (λ x, some (x+1)) 10 = none := by rsimp

def pipe {α β : Type*} (x: option α) (f: α -> option β): option β :=
  option.cases_on x option.none (λ y, f y)

#print pipe
infixl `>>`:50 := pipe

#reduce (some 10) >> (λ x, some $ x*x) >> (λ x, some $ x+1).
#reduce (some 10) >> (λ x, none) >> (λ x, some $ x+1).
#reduce none >> (λ x, some $ x*x) >> (λ x, some $x+1).

def ibool: inhabited bool := inhabited.mk tt
def inat: inhabited ℕ := inhabited.mk 0

theorem ipair: ∀α β : Type*, inhabited α × inhabited β -> inhabited (α × β) := begin
intros α β h,
cases h with a b,
from inhabited.mk (a.default, b.default)
end

theorem ifun: ∀ α β : Type*, (α -> inhabited β) -> inhabited (α -> β) := begin
intros α β f,
from inhabited.mk (λ x: α, (f x).default)
end


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import logic.nontrivial
import algebra.group.units_hom
import algebra.group.inj_surj
import algebra.group_with_zero.defs

/-!
# Groups with an adjoined zero element

This file describes structures that are not usually studied on their own right in mathematics,
namely a special sort of monoid: apart from a distinguished “zero element” they form a group,
or in other words, they are groups with an adjoined zero element.

Examples are:

* division rings;
* the value monoid of a multiplicative valuation;
* in particular, the non-negative real numbers.

## Main definitions

Various lemmas about `group_with_zero` and `comm_group_with_zero`.
To reduce import dependencies, the type-classes themselves are in
`algebra.group_with_zero.defs`.

## Implementation details

As is usual in mathlib, we extend the inverse function to the zero element,
and require `0⁻¹ = 0`.

-/

set_option old_structure_cmd true
open_locale classical
open function

variables {M₀ G₀ M₀' G₀' : Type*}

mk_simp_attribute field_simps "The simpset `field_simps` is used by the tactic `field_simp` to
reduce an expression in a field to an expression of the form `n / d` where `n` and `d` are
division-free."

attribute [field_simps] mul_div_assoc'

section

section mul_zero_class

variables [mul_zero_class M₀] {a b : M₀}

/-- Pullback a `mul_zero_class` instance along an injective function.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.mul_zero_class [has_mul M₀'] [has_zero M₀'] (f : M₀' → M₀)
  (hf : injective f) (zero : f 0 = 0) (mul : ∀ a b, f (a * b) = f a * f b) :
  mul_zero_class M₀' :=
{ mul := (*),
  zero := 0,
  zero_mul := λ a, hf $ by simp only [mul, zero, zero_mul],
  mul_zero := λ a, hf $ by simp only [mul, zero, mul_zero] }

/-- Pushforward a `mul_zero_class` instance along an surjective function.
See note [reducible non-instances]. -/
@[reducible]
protected def function.surjective.mul_zero_class [has_mul M₀'] [has_zero M₀'] (f : M₀ → M₀')
  (hf : surjective f) (zero : f 0 = 0) (mul : ∀ a b, f (a * b) = f a * f b) :
  mul_zero_class M₀' :=
{ mul := (*),
  zero := 0,
  mul_zero := hf.forall.2 $ λ x, by simp only [← zero, ← mul, mul_zero],
  zero_mul := hf.forall.2 $ λ x, by simp only [← zero, ← mul, zero_mul] }

lemma mul_eq_zero_of_left (h : a = 0) (b : M₀) : a * b = 0 := h.symm ▸ zero_mul b

lemma mul_eq_zero_of_right (a : M₀) (h : b = 0) : a * b = 0 := h.symm ▸ mul_zero a

lemma left_ne_zero_of_mul : a * b ≠ 0 → a ≠ 0 := mt (λ h, mul_eq_zero_of_left h b)

lemma right_ne_zero_of_mul : a * b ≠ 0 → b ≠ 0 := mt (mul_eq_zero_of_right a)

lemma ne_zero_and_ne_zero_of_mul (h : a * b ≠ 0) : a ≠ 0 ∧ b ≠ 0 :=
⟨left_ne_zero_of_mul h, right_ne_zero_of_mul h⟩

lemma mul_eq_zero_of_ne_zero_imp_eq_zero {a b : M₀} (h : a ≠ 0 → b = 0) :
  a * b = 0 :=
if ha : a = 0 then by rw [ha, zero_mul] else by rw [h ha, mul_zero]

end mul_zero_class

/-- Pushforward a `no_zero_divisors` instance along an injective function. -/
protected lemma function.injective.no_zero_divisors [has_mul M₀] [has_zero M₀]
  [has_mul M₀'] [has_zero M₀'] [no_zero_divisors M₀']
  (f : M₀ → M₀') (hf : injective f) (zero : f 0 = 0) (mul : ∀ x y, f (x * y) = f x * f y) :
  no_zero_divisors M₀ :=
{ eq_zero_or_eq_zero_of_mul_eq_zero := λ x y H,
  have f x * f y = 0, by rw [← mul, H, zero],
  (eq_zero_or_eq_zero_of_mul_eq_zero this).imp (λ H, hf $ by rwa zero)  (λ H, hf $ by rwa zero) }

lemma eq_zero_of_mul_self_eq_zero [has_mul M₀] [has_zero M₀] [no_zero_divisors M₀]
  {a : M₀} (h : a * a = 0) :
  a = 0 :=
(eq_zero_or_eq_zero_of_mul_eq_zero h).elim id id

section

variables [mul_zero_class M₀] [no_zero_divisors M₀] {a b : M₀}

/-- If `α` has no zero divisors, then the product of two elements equals zero iff one of them
equals zero. -/
@[simp] theorem mul_eq_zero : a * b = 0 ↔ a = 0 ∨ b = 0 :=
⟨eq_zero_or_eq_zero_of_mul_eq_zero,
  λo, o.elim (λ h, mul_eq_zero_of_left h b) (mul_eq_zero_of_right a)⟩

/-- If `α` has no zero divisors, then the product of two elements equals zero iff one of them
equals zero. -/
@[simp] theorem zero_eq_mul : 0 = a * b ↔ a = 0 ∨ b = 0 :=
by rw [eq_comm, mul_eq_zero]

/-- If `α` has no zero divisors, then the product of two elements is nonzero iff both of them
are nonzero. -/
theorem mul_ne_zero_iff : a * b ≠ 0 ↔ a ≠ 0 ∧ b ≠ 0 :=
(not_congr mul_eq_zero).trans not_or_distrib

@[field_simps] theorem mul_ne_zero (ha : a ≠ 0) (hb : b ≠ 0) : a * b ≠ 0 :=
mul_ne_zero_iff.2 ⟨ha, hb⟩

/-- If `α` has no zero divisors, then for elements `a, b : α`, `a * b` equals zero iff so is
`b * a`. -/
theorem mul_eq_zero_comm : a * b = 0 ↔ b * a = 0 :=
mul_eq_zero.trans $ (or_comm _ _).trans mul_eq_zero.symm

/-- If `α` has no zero divisors, then for elements `a, b : α`, `a * b` is nonzero iff so is
`b * a`. -/
theorem mul_ne_zero_comm : a * b ≠ 0 ↔ b * a ≠ 0 :=
not_congr mul_eq_zero_comm

lemma mul_self_eq_zero : a * a = 0 ↔ a = 0 := by simp
lemma zero_eq_mul_self : 0 = a * a ↔ a = 0 := by simp

end

end

section

variables [mul_zero_one_class M₀]

/-- Pullback a `mul_zero_one_class` instance along an injective function.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.mul_zero_one_class [has_mul M₀'] [has_zero M₀'] [has_one M₀']
  (f : M₀' → M₀)
  (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) (mul : ∀ a b, f (a * b) = f a * f b) :
  mul_zero_one_class M₀' :=
{ ..hf.mul_zero_class f zero mul, ..hf.mul_one_class f one mul }

/-- Pushforward a `mul_zero_one_class` instance along an surjective function.
See note [reducible non-instances]. -/
@[reducible]
protected def function.surjective.mul_zero_one_class [has_mul M₀'] [has_zero M₀'] [has_one M₀']
  (f : M₀ → M₀')
  (hf : surjective f) (zero : f 0 = 0) (one : f 1 = 1) (mul : ∀ a b, f (a * b) = f a * f b) :
  mul_zero_one_class M₀' :=
{ ..hf.mul_zero_class f zero mul, ..hf.mul_one_class f one mul }

/-- In a monoid with zero, if zero equals one, then zero is the only element. -/
lemma eq_zero_of_zero_eq_one (h : (0 : M₀) = 1) (a : M₀) : a = 0 :=
by rw [← mul_one a, ← h, mul_zero]

/-- In a monoid with zero, if zero equals one, then zero is the unique element.

Somewhat arbitrarily, we define the default element to be `0`.
All other elements will be provably equal to it, but not necessarily definitionally equal. -/
def unique_of_zero_eq_one (h : (0 : M₀) = 1) : unique M₀ :=
{ default := 0, uniq := eq_zero_of_zero_eq_one h }

/-- In a monoid with zero, zero equals one if and only if all elements of that semiring
are equal. -/
theorem subsingleton_iff_zero_eq_one : (0 : M₀) = 1 ↔ subsingleton M₀ :=
⟨λ h, @unique.subsingleton _ (unique_of_zero_eq_one h), λ h, @subsingleton.elim _ h _ _⟩

alias subsingleton_iff_zero_eq_one ↔ subsingleton_of_zero_eq_one _

lemma eq_of_zero_eq_one (h : (0 : M₀) = 1) (a b : M₀) : a = b :=
@subsingleton.elim _ (subsingleton_of_zero_eq_one h) a b

/-- In a monoid with zero, either zero and one are nonequal, or zero is the only element. -/
lemma zero_ne_one_or_forall_eq_0 : (0 : M₀) ≠ 1 ∨ (∀a:M₀, a = 0) :=
not_or_of_imp eq_zero_of_zero_eq_one
end

section

variables [mul_zero_one_class M₀] [nontrivial M₀] {a b : M₀}

/-- In a nontrivial monoid with zero, zero and one are different. -/
@[simp] lemma zero_ne_one : 0 ≠ (1:M₀) :=
begin
  assume h,
  rcases exists_pair_ne M₀ with ⟨x, y, hx⟩,
  apply hx,
  calc x = 1 * x : by rw [one_mul]
  ... = 0 : by rw [← h, zero_mul]
  ... = 1 * y : by rw [← h, zero_mul]
  ... = y : by rw [one_mul]
end

@[simp] lemma one_ne_zero : (1:M₀) ≠ 0 :=
zero_ne_one.symm

lemma ne_zero_of_eq_one {a : M₀} (h : a = 1) : a ≠ 0 :=
calc a = 1 : h
   ... ≠ 0 : one_ne_zero

lemma left_ne_zero_of_mul_eq_one (h : a * b = 1) : a ≠ 0 :=
left_ne_zero_of_mul $ ne_zero_of_eq_one h

lemma right_ne_zero_of_mul_eq_one (h : a * b = 1) : b ≠ 0 :=
right_ne_zero_of_mul $ ne_zero_of_eq_one h

/-- Pullback a `nontrivial` instance along a function sending `0` to `0` and `1` to `1`. -/
protected lemma pullback_nonzero [has_zero M₀'] [has_one M₀']
  (f : M₀' → M₀) (zero : f 0 = 0) (one : f 1 = 1) : nontrivial M₀' :=
⟨⟨0, 1, mt (congr_arg f) $ by { rw [zero, one], exact zero_ne_one }⟩⟩

end

section semigroup_with_zero

/-- Pullback a `semigroup_with_zero` class along an injective function.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.semigroup_with_zero
  [has_zero M₀'] [has_mul M₀'] [semigroup_with_zero M₀] (f : M₀' → M₀) (hf : injective f)
  (zero : f 0 = 0) (mul : ∀ x y, f (x * y) = f x * f y) :
  semigroup_with_zero M₀' :=
{ .. hf.mul_zero_class f zero mul,
  .. ‹has_zero M₀'›,
  .. hf.semigroup f mul }

/-- Pushforward a `semigroup_with_zero` class along an surjective function.
See note [reducible non-instances]. -/
@[reducible]
protected def function.surjective.semigroup_with_zero
  [semigroup_with_zero M₀] [has_zero M₀'] [has_mul M₀'] (f : M₀ → M₀') (hf : surjective f)
  (zero : f 0 = 0) (mul : ∀ x y, f (x * y) = f x * f y) :
  semigroup_with_zero M₀' :=
{ .. hf.mul_zero_class f zero mul,
  .. ‹has_zero M₀'›,
  .. hf.semigroup f mul }

end semigroup_with_zero

section monoid_with_zero

/-- Pullback a `monoid_with_zero` class along an injective function.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.monoid_with_zero [has_zero M₀'] [has_mul M₀'] [has_one M₀']
  [monoid_with_zero M₀]
  (f : M₀' → M₀) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1)
  (mul : ∀ x y, f (x * y) = f x * f y) :
  monoid_with_zero M₀' :=
{ .. hf.monoid f one mul, .. hf.mul_zero_class f zero mul }

/-- Pushforward a `monoid_with_zero` class along a surjective function.
See note [reducible non-instances]. -/
@[reducible]
protected def function.surjective.monoid_with_zero [has_zero M₀'] [has_mul M₀'] [has_one M₀']
  [monoid_with_zero M₀]
  (f : M₀ → M₀') (hf : surjective f) (zero : f 0 = 0) (one : f 1 = 1)
  (mul : ∀ x y, f (x * y) = f x * f y) :
  monoid_with_zero M₀' :=
{ .. hf.monoid f one mul, .. hf.mul_zero_class f zero mul }

/-- Pullback a `monoid_with_zero` class along an injective function.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.comm_monoid_with_zero [has_zero M₀'] [has_mul M₀'] [has_one M₀']
  [comm_monoid_with_zero M₀]
  (f : M₀' → M₀) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1)
  (mul : ∀ x y, f (x * y) = f x * f y) :
  comm_monoid_with_zero M₀' :=
{ .. hf.comm_monoid f one mul, .. hf.mul_zero_class f zero mul }

/-- Pushforward a `monoid_with_zero` class along a surjective function.
See note [reducible non-instances]. -/
@[reducible]
protected def function.surjective.comm_monoid_with_zero [has_zero M₀'] [has_mul M₀'] [has_one M₀']
  [comm_monoid_with_zero M₀]
  (f : M₀ → M₀') (hf : surjective f) (zero : f 0 = 0) (one : f 1 = 1)
  (mul : ∀ x y, f (x * y) = f x * f y) :
  comm_monoid_with_zero M₀' :=
{ .. hf.comm_monoid f one mul, .. hf.mul_zero_class f zero mul }

variables [monoid_with_zero M₀]

namespace units

/-- An element of the unit group of a nonzero monoid with zero represented as an element
    of the monoid is nonzero. -/
@[simp] lemma ne_zero [nontrivial M₀] (u : units M₀) :
  (u : M₀) ≠ 0 :=
left_ne_zero_of_mul_eq_one u.mul_inv

-- We can't use `mul_eq_zero` + `units.ne_zero` in the next two lemmas because we don't assume
-- `nonzero M₀`.

@[simp] lemma mul_left_eq_zero (u : units M₀) {a : M₀} : a * u = 0 ↔ a = 0 :=
⟨λ h, by simpa using mul_eq_zero_of_left h ↑u⁻¹, λ h, mul_eq_zero_of_left h u⟩

@[simp] lemma mul_right_eq_zero (u : units M₀) {a : M₀} : ↑u * a = 0 ↔ a = 0 :=
⟨λ h, by simpa using mul_eq_zero_of_right ↑u⁻¹ h, mul_eq_zero_of_right u⟩

end units

namespace is_unit

lemma ne_zero [nontrivial M₀] {a : M₀} (ha : is_unit a) : a ≠ 0 := let ⟨u, hu⟩ :=
ha in hu ▸ u.ne_zero

lemma mul_right_eq_zero {a b : M₀} (ha : is_unit a) : a * b = 0 ↔ b = 0 :=
let ⟨u, hu⟩ := ha in hu ▸ u.mul_right_eq_zero

lemma mul_left_eq_zero {a b : M₀} (hb : is_unit b) : a * b = 0 ↔ a = 0 :=
let ⟨u, hu⟩ := hb in hu ▸ u.mul_left_eq_zero

end is_unit

@[simp] theorem is_unit_zero_iff : is_unit (0 : M₀) ↔ (0:M₀) = 1 :=
⟨λ ⟨⟨_, a, (a0 : 0 * a = 1), _⟩, rfl⟩, by rwa zero_mul at a0,
 λ h, @is_unit_of_subsingleton _ _ (subsingleton_of_zero_eq_one h) 0⟩

@[simp] theorem not_is_unit_zero [nontrivial M₀] : ¬ is_unit (0 : M₀) :=
mt is_unit_zero_iff.1 zero_ne_one

namespace ring
open_locale classical

/-- Introduce a function `inverse` on a monoid with zero `M₀`, which sends `x` to `x⁻¹` if `x` is
invertible and to `0` otherwise.  This definition is somewhat ad hoc, but one needs a fully (rather
than partially) defined inverse function for some purposes, including for calculus.

Note that while this is in the `ring` namespace for brevity, it requires the weaker assumption
`monoid_with_zero M₀` instead of `ring M₀`. -/
noncomputable def inverse : M₀ → M₀ :=
λ x, if h : is_unit x then ((h.unit⁻¹ : units M₀) : M₀) else 0

/-- By definition, if `x` is invertible then `inverse x = x⁻¹`. -/
@[simp] lemma inverse_unit (u : units M₀) : inverse (u : M₀) = (u⁻¹ : units M₀) :=
begin
  simp only [units.is_unit, inverse, dif_pos],
  exact units.inv_unique rfl
end

/-- By definition, if `x` is not invertible then `inverse x = 0`. -/
@[simp] lemma inverse_non_unit (x : M₀) (h : ¬(is_unit x)) : inverse x = 0 := dif_neg h

lemma mul_inverse_cancel (x : M₀) (h : is_unit x) : x * inverse x = 1 :=
by { rcases h with ⟨u, rfl⟩, rw [inverse_unit, units.mul_inv], }

lemma inverse_mul_cancel (x : M₀) (h : is_unit x) : inverse x * x = 1 :=
by { rcases h with ⟨u, rfl⟩, rw [inverse_unit, units.inv_mul], }

lemma mul_inverse_cancel_right (x y : M₀) (h : is_unit x) : y * x * inverse x = y :=
by rw [mul_assoc, mul_inverse_cancel x h, mul_one]

lemma inverse_mul_cancel_right (x y : M₀) (h : is_unit x) : y * inverse x * x = y :=
by rw [mul_assoc, inverse_mul_cancel x h, mul_one]

lemma mul_inverse_cancel_left (x y : M₀) (h : is_unit x) : x * (inverse x * y) = y :=
by rw [← mul_assoc, mul_inverse_cancel x h, one_mul]

lemma inverse_mul_cancel_left (x y : M₀) (h : is_unit x) : inverse x * (x * y) = y :=
by rw [← mul_assoc, inverse_mul_cancel x h, one_mul]

variables (M₀)

@[simp] lemma inverse_one : inverse (1 : M₀) = 1 :=
inverse_unit 1

@[simp] lemma inverse_zero : inverse (0 : M₀) = 0 :=
by { nontriviality, exact inverse_non_unit _ not_is_unit_zero }

variables {M₀}

lemma mul_inverse_rev' {a b : M₀} (h : commute a b) : inverse (a * b) = inverse b * inverse a :=
begin
  by_cases hab : is_unit (a * b),
  { obtain ⟨⟨a, rfl⟩, b, rfl⟩ := h.is_unit_mul_iff.mp hab,
    rw [←units.coe_mul, inverse_unit, inverse_unit, inverse_unit, ←units.coe_mul,
      mul_inv_rev], },
  obtain ha | hb := not_and_distrib.mp (mt h.is_unit_mul_iff.mpr hab),
  { rw [inverse_non_unit _ hab, inverse_non_unit _ ha, mul_zero]},
  { rw [inverse_non_unit _ hab, inverse_non_unit _ hb, zero_mul]},
end

lemma mul_inverse_rev {M₀} [comm_monoid_with_zero M₀] (a b : M₀) :
  ring.inverse (a * b) = inverse b * inverse a :=
mul_inverse_rev' (commute.all _ _)

end ring

lemma is_unit.ring_inverse {a : M₀} : is_unit a → is_unit (ring.inverse a)
| ⟨u, hu⟩ := hu ▸ ⟨u⁻¹, (ring.inverse_unit u).symm⟩

@[simp] lemma is_unit_ring_inverse {a : M₀} : is_unit (ring.inverse a) ↔ is_unit a :=
⟨λ h, begin
  casesI subsingleton_or_nontrivial M₀,
  { convert h },
  { contrapose h,
    rw ring.inverse_non_unit _ h,
    exact not_is_unit_zero, },
end, is_unit.ring_inverse⟩

lemma commute.ring_inverse_ring_inverse {a b : M₀} (h : commute a b) :
  commute (ring.inverse a) (ring.inverse b) :=
(ring.mul_inverse_rev' h.symm).symm.trans $ (congr_arg _ h.symm.eq).trans $ ring.mul_inverse_rev' h

variable (M₀)

end monoid_with_zero

section cancel_monoid_with_zero

variables [cancel_monoid_with_zero M₀] {a b c : M₀}

@[priority 10] -- see Note [lower instance priority]
instance cancel_monoid_with_zero.to_no_zero_divisors : no_zero_divisors M₀ :=
⟨λ a b ab0, by { by_cases a = 0, { left, exact h }, right,
  apply cancel_monoid_with_zero.mul_left_cancel_of_ne_zero h, rw [ab0, mul_zero], }⟩

lemma mul_left_inj' (hc : c ≠ 0) : a * c = b * c ↔ a = b := ⟨mul_right_cancel₀ hc, λ h, h ▸ rfl⟩

lemma mul_right_inj' (ha : a ≠ 0) : a * b = a * c ↔ b = c := ⟨mul_left_cancel₀ ha, λ h, h ▸ rfl⟩

@[simp] lemma mul_eq_mul_right_iff : a * c = b * c ↔ a = b ∨ c = 0 :=
by by_cases hc : c = 0; [simp [hc], simp [mul_left_inj', hc]]

@[simp] lemma mul_eq_mul_left_iff : a * b = a * c ↔ b = c ∨ a = 0 :=
by by_cases ha : a = 0; [simp [ha], simp [mul_right_inj', ha]]

/-- Pullback a `monoid_with_zero` class along an injective function.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.cancel_monoid_with_zero [has_zero M₀'] [has_mul M₀'] [has_one M₀']
  (f : M₀' → M₀) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1)
  (mul : ∀ x y, f (x * y) = f x * f y) :
  cancel_monoid_with_zero M₀' :=
{ mul_left_cancel_of_ne_zero := λ x y z hx H, hf $ mul_left_cancel₀ ((hf.ne_iff' zero).2 hx) $
    by erw [← mul, ← mul, H]; refl,
  mul_right_cancel_of_ne_zero := λ x y z hx H, hf $ mul_right_cancel₀ ((hf.ne_iff' zero).2 hx) $
    by erw [← mul, ← mul, H]; refl,
  .. hf.monoid f one mul, .. hf.mul_zero_class f zero mul }

/-- An element of a `cancel_monoid_with_zero` fixed by right multiplication by an element other
than one must be zero. -/
theorem eq_zero_of_mul_eq_self_right (h₁ : b ≠ 1) (h₂ : a * b = a) : a = 0 :=
classical.by_contradiction $ λ ha, h₁ $ mul_left_cancel₀ ha $ h₂.symm ▸ (mul_one a).symm

/-- An element of a `cancel_monoid_with_zero` fixed by left multiplication by an element other
than one must be zero. -/
theorem eq_zero_of_mul_eq_self_left (h₁ : b ≠ 1) (h₂ : b * a = a) : a = 0 :=
classical.by_contradiction $ λ ha, h₁ $ mul_right_cancel₀ ha $ h₂.symm ▸ (one_mul a).symm

end cancel_monoid_with_zero

section comm_cancel_monoid_with_zero

variables [comm_cancel_monoid_with_zero M₀] {a b c : M₀}

/-- Pullback a `comm_cancel_monoid_with_zero` class along an injective function.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.comm_cancel_monoid_with_zero
  [has_zero M₀'] [has_mul M₀'] [has_one M₀']
  (f : M₀' → M₀) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1)
  (mul : ∀ x y, f (x * y) = f x * f y) :
  comm_cancel_monoid_with_zero M₀' :=
{ .. hf.comm_monoid_with_zero f zero one mul,
  .. hf.cancel_monoid_with_zero f zero one mul }

end comm_cancel_monoid_with_zero

section group_with_zero
variables [group_with_zero G₀] {a b c g h x : G₀}

alias div_eq_mul_inv ← division_def

/-- Pullback a `group_with_zero` class along an injective function.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.group_with_zero [has_zero G₀'] [has_mul G₀'] [has_one G₀']
  [has_inv G₀'] [has_div G₀'] (f : G₀' → G₀) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1)
  (mul : ∀ x y, f (x * y) = f x * f y) (inv : ∀ x, f x⁻¹ = (f x)⁻¹)
  (div : ∀ x y, f (x / y) = f x / f y) :
  group_with_zero G₀' :=
{ inv_zero := hf $ by erw [inv, zero, inv_zero],
  mul_inv_cancel := λ x hx, hf $ by erw [one, mul, inv, mul_inv_cancel ((hf.ne_iff' zero).2 hx)],
  .. hf.monoid_with_zero f zero one mul,
  .. hf.div_inv_monoid f one mul inv div,
  .. pullback_nonzero f zero one, }

/-- Pushforward a `group_with_zero` class along an surjective function.
See note [reducible non-instances]. -/
@[reducible]
protected def function.surjective.group_with_zero [has_zero G₀'] [has_mul G₀'] [has_one G₀']
  [has_inv G₀'] [has_div G₀'] (h01 : (0:G₀') ≠ 1) (f : G₀ → G₀') (hf : surjective f)
  (zero : f 0 = 0) (one : f 1 = 1) (mul : ∀ x y, f (x * y) = f x * f y)
  (inv : ∀ x, f x⁻¹ = (f x)⁻¹) (div : ∀ x y, f (x / y) = f x / f y) :
  group_with_zero G₀' :=
{ inv_zero := by erw [← zero, ← inv, inv_zero],
  mul_inv_cancel := hf.forall.2 $ λ x hx,
    by erw [← inv, ← mul, mul_inv_cancel (mt (congr_arg f) $ trans_rel_left ne hx zero.symm)];
      exact one,
  exists_pair_ne := ⟨0, 1, h01⟩,
  .. hf.monoid_with_zero f zero one mul,
  .. hf.div_inv_monoid f one mul inv div }

@[simp] lemma mul_inv_cancel_right₀ (h : b ≠ 0) (a : G₀) :
  (a * b) * b⁻¹ = a :=
calc (a * b) * b⁻¹ = a * (b * b⁻¹) : mul_assoc _ _ _
               ... = a             : by simp [h]

@[simp] lemma mul_inv_cancel_left₀ (h : a ≠ 0) (b : G₀) :
  a * (a⁻¹ * b) = b :=
calc a * (a⁻¹ * b) = (a * a⁻¹) * b : (mul_assoc _ _ _).symm
               ... = b             : by simp [h]

lemma inv_ne_zero (h : a ≠ 0) : a⁻¹ ≠ 0 :=
assume a_eq_0, by simpa [a_eq_0] using mul_inv_cancel h

@[simp] lemma inv_mul_cancel (h : a ≠ 0) : a⁻¹ * a = 1 :=
calc a⁻¹ * a = (a⁻¹ * a) * a⁻¹ * a⁻¹⁻¹ : by simp [inv_ne_zero h]
         ... = a⁻¹ * a⁻¹⁻¹             : by simp [h]
         ... = 1                       : by simp [inv_ne_zero h]

lemma group_with_zero.mul_left_injective (h : x ≠ 0) :
  function.injective (λ y, x * y) :=
λ y y' w, by simpa only [←mul_assoc, inv_mul_cancel h, one_mul] using congr_arg (λ y, x⁻¹ * y) w

lemma group_with_zero.mul_right_injective (h : x ≠ 0) :
  function.injective (λ y, y * x) :=
λ y y' w, by simpa only [mul_assoc, mul_inv_cancel h, mul_one] using congr_arg (λ y, y * x⁻¹) w

@[simp] lemma inv_mul_cancel_right₀ (h : b ≠ 0) (a : G₀) :
  (a * b⁻¹) * b = a :=
calc (a * b⁻¹) * b = a * (b⁻¹ * b) : mul_assoc _ _ _
               ... = a             : by simp [h]

@[simp] lemma inv_mul_cancel_left₀ (h : a ≠ 0) (b : G₀) :
  a⁻¹ * (a * b) = b :=
calc a⁻¹ * (a * b) = (a⁻¹ * a) * b : (mul_assoc _ _ _).symm
               ... = b             : by simp [h]

@[simp] lemma inv_one : 1⁻¹ = (1:G₀) :=
calc 1⁻¹ = 1 * 1⁻¹ : by rw [one_mul]
     ... = (1:G₀)  : by simp

@[simp] lemma inv_inv₀ (a : G₀) : a⁻¹⁻¹ = a :=
begin
  by_cases h : a = 0, { simp [h] },
  calc a⁻¹⁻¹ = a * (a⁻¹ * a⁻¹⁻¹) : by simp [h]
         ... = a                 : by simp [inv_ne_zero h]
end

/-- Multiplying `a` by itself and then by its inverse results in `a`
(whether or not `a` is zero). -/
@[simp] lemma mul_self_mul_inv (a : G₀) : a * a * a⁻¹ = a :=
begin
  by_cases h : a = 0,
  { rw [h, inv_zero, mul_zero] },
  { rw [mul_assoc, mul_inv_cancel h, mul_one] }
end

/-- Multiplying `a` by its inverse and then by itself results in `a`
(whether or not `a` is zero). -/
@[simp] lemma mul_inv_mul_self (a : G₀) : a * a⁻¹ * a = a :=
begin
  by_cases h : a = 0,
  { rw [h, inv_zero, mul_zero] },
  { rw [mul_inv_cancel h, one_mul] }
end

/-- Multiplying `a⁻¹` by `a` twice results in `a` (whether or not `a`
is zero). -/
@[simp] lemma inv_mul_mul_self (a : G₀) : a⁻¹ * a * a = a :=
begin
  by_cases h : a = 0,
  { rw [h, inv_zero, mul_zero] },
  { rw [inv_mul_cancel h, one_mul] }
end

/-- Multiplying `a` by itself and then dividing by itself results in
`a` (whether or not `a` is zero). -/
@[simp] lemma mul_self_div_self (a : G₀) : a * a / a = a :=
by rw [div_eq_mul_inv, mul_self_mul_inv a]

/-- Dividing `a` by itself and then multiplying by itself results in
`a` (whether or not `a` is zero). -/
@[simp] lemma div_self_mul_self (a : G₀) : a / a * a = a :=
by rw [div_eq_mul_inv, mul_inv_mul_self a]

lemma inv_involutive₀ : function.involutive (has_inv.inv : G₀ → G₀) :=
inv_inv₀

lemma eq_inv_of_mul_right_eq_one (h : a * b = 1) :
  b = a⁻¹ :=
by rw [← inv_mul_cancel_left₀ (left_ne_zero_of_mul_eq_one h) b, h, mul_one]

lemma eq_inv_of_mul_left_eq_one (h : a * b = 1) :
  a = b⁻¹ :=
by rw [← mul_inv_cancel_right₀ (right_ne_zero_of_mul_eq_one h) a, h, one_mul]

lemma inv_injective₀ : function.injective (@has_inv.inv G₀ _) :=
inv_involutive₀.injective

@[simp] lemma inv_inj₀ : g⁻¹ = h⁻¹ ↔ g = h := inv_injective₀.eq_iff

/-- This is the analogue of `inv_eq_iff_inv_eq` for `group_with_zero`.
  It could also be named `inv_eq_iff_inv_eq'`. -/
lemma inv_eq_iff : g⁻¹ = h ↔ h⁻¹ = g :=
by rw [← inv_inj₀, eq_comm, inv_inv₀]

/-- This is the analogue of `eq_inv_iff_eq_inv` for `group_with_zero`.
  It could also be named `eq_inv_iff_eq_inv'`. -/
lemma eq_inv_iff : a = b⁻¹ ↔ b = a⁻¹ :=
by rw [eq_comm, inv_eq_iff, eq_comm]

@[simp] lemma inv_eq_one₀ : g⁻¹ = 1 ↔ g = 1 :=
by rw [inv_eq_iff, inv_one, eq_comm]

lemma eq_mul_inv_iff_mul_eq₀ (hc : c ≠ 0) : a = b * c⁻¹ ↔ a * c = b :=
by split; rintro rfl; [rw inv_mul_cancel_right₀ hc, rw mul_inv_cancel_right₀ hc]

lemma eq_inv_mul_iff_mul_eq₀ (hb : b ≠ 0) : a = b⁻¹ * c ↔ b * a = c :=
by split; rintro rfl; [rw mul_inv_cancel_left₀ hb, rw inv_mul_cancel_left₀ hb]

lemma inv_mul_eq_iff_eq_mul₀ (ha : a ≠ 0) : a⁻¹ * b = c ↔ b = a * c :=
by rw [eq_comm, eq_inv_mul_iff_mul_eq₀ ha, eq_comm]

lemma mul_inv_eq_iff_eq_mul₀ (hb : b ≠ 0) : a * b⁻¹ = c ↔ a = c * b :=
by rw [eq_comm, eq_mul_inv_iff_mul_eq₀ hb, eq_comm]

lemma mul_inv_eq_one₀ (hb : b ≠ 0) : a * b⁻¹ = 1 ↔ a = b :=
by rw [mul_inv_eq_iff_eq_mul₀ hb, one_mul]

lemma inv_mul_eq_one₀ (ha : a ≠ 0) : a⁻¹ * b = 1 ↔ a = b :=
by rw [inv_mul_eq_iff_eq_mul₀ ha, mul_one, eq_comm]

lemma mul_eq_one_iff_eq_inv₀ (hb : b ≠ 0) : a * b = 1 ↔ a = b⁻¹ :=
by { convert mul_inv_eq_one₀ (inv_ne_zero hb), rw [inv_inv₀] }

lemma mul_eq_one_iff_inv_eq₀ (ha : a ≠ 0) : a * b = 1 ↔ a⁻¹ = b :=
by { convert inv_mul_eq_one₀ (inv_ne_zero ha), rw [inv_inv₀] }

end group_with_zero

namespace units
variables [group_with_zero G₀]
variables {a b : G₀}

/-- Embed a non-zero element of a `group_with_zero` into the unit group.
  By combining this function with the operations on units,
  or the `/ₚ` operation, it is possible to write a division
  as a partial function with three arguments. -/
def mk0 (a : G₀) (ha : a ≠ 0) : units G₀ :=
⟨a, a⁻¹, mul_inv_cancel ha, inv_mul_cancel ha⟩

@[simp] lemma mk0_one (h := one_ne_zero) :
  mk0 (1 : G₀) h = 1 :=
by { ext, refl }

@[simp] lemma coe_mk0 {a : G₀} (h : a ≠ 0) : (mk0 a h : G₀) = a := rfl

@[simp] lemma mk0_coe (u : units G₀) (h : (u : G₀) ≠ 0) : mk0 (u : G₀) h = u :=
units.ext rfl

@[simp, norm_cast] lemma coe_inv' (u : units G₀) : ((u⁻¹ : units G₀) : G₀) = u⁻¹ :=
eq_inv_of_mul_left_eq_one u.inv_mul

@[simp] lemma mul_inv' (u : units G₀) : (u : G₀) * u⁻¹ = 1 := mul_inv_cancel u.ne_zero

@[simp] lemma inv_mul' (u : units G₀) : (u⁻¹ : G₀) * u = 1 := inv_mul_cancel u.ne_zero

@[simp] lemma mk0_inj {a b : G₀} (ha : a ≠ 0) (hb : b ≠ 0) :
  units.mk0 a ha = units.mk0 b hb ↔ a = b :=
⟨λ h, by injection h, λ h, units.ext h⟩

@[simp] lemma exists_iff_ne_zero {x : G₀} : (∃ u : units G₀, ↑u = x) ↔ x ≠ 0 :=
⟨λ ⟨u, hu⟩, hu ▸ u.ne_zero, assume hx, ⟨mk0 x hx, rfl⟩⟩

lemma _root_.group_with_zero.eq_zero_or_unit (a : G₀) :
  a = 0 ∨ ∃ u : units G₀, a = u :=
begin
  by_cases h : a = 0,
  { left,
    exact h },
  { right,
    simpa only [eq_comm] using units.exists_iff_ne_zero.mpr h }
end

instance : can_lift G₀ (units G₀) :=
{ coe := coe,
  cond := (≠ 0),
  prf := λ x, exists_iff_ne_zero.mpr }

end units

section group_with_zero
variables [group_with_zero G₀]

lemma is_unit.mk0 (x : G₀) (hx : x ≠ 0) : is_unit x := (units.mk0 x hx).is_unit

lemma is_unit_iff_ne_zero {x : G₀} : is_unit x ↔ x ≠ 0 :=
units.exists_iff_ne_zero

@[priority 10] -- see Note [lower instance priority]
instance group_with_zero.no_zero_divisors : no_zero_divisors G₀ :=
{ eq_zero_or_eq_zero_of_mul_eq_zero := λ a b h,
    begin
      contrapose! h,
      exact ((units.mk0 a h.1) * (units.mk0 b h.2)).ne_zero
    end,
  .. (‹_› : group_with_zero G₀) }

@[priority 10] -- see Note [lower instance priority]
instance group_with_zero.cancel_monoid_with_zero : cancel_monoid_with_zero G₀ :=
{ mul_left_cancel_of_ne_zero := λ x y z hx h,
    by rw [← inv_mul_cancel_left₀ hx y, h, inv_mul_cancel_left₀ hx z],
  mul_right_cancel_of_ne_zero := λ x y z hy h,
    by rw [← mul_inv_cancel_right₀ hy x, h, mul_inv_cancel_right₀ hy z],
  .. (‹_› : group_with_zero G₀) }

-- Can't be put next to the other `mk0` lemmas becuase it depends on the
-- `no_zero_divisors` instance, which depends on `mk0`.
@[simp] lemma units.mk0_mul (x y : G₀) (hxy) :
  units.mk0 (x * y) hxy =
    units.mk0 x (mul_ne_zero_iff.mp hxy).1 * units.mk0 y (mul_ne_zero_iff.mp hxy).2 :=
by { ext, refl }

lemma mul_inv_rev₀ (x y : G₀) : (x * y)⁻¹ = y⁻¹ * x⁻¹ :=
begin
  by_cases hx : x = 0, { simp [hx] },
  by_cases hy : y = 0, { simp [hy] },
  symmetry,
  apply eq_inv_of_mul_left_eq_one,
  simp [mul_assoc, hx, hy]
end

@[simp] lemma div_self {a : G₀} (h : a ≠ 0) : a / a = 1 :=
by rw [div_eq_mul_inv, mul_inv_cancel h]

@[simp] lemma div_one (a : G₀) : a / 1 = a :=
by simp [div_eq_mul_inv a 1]

@[simp] lemma zero_div (a : G₀) : 0 / a = 0 :=
by rw [div_eq_mul_inv, zero_mul]

@[simp] lemma div_zero (a : G₀) : a / 0 = 0 :=
by rw [div_eq_mul_inv, inv_zero, mul_zero]

@[simp] lemma div_mul_cancel (a : G₀) {b : G₀} (h : b ≠ 0) : a / b * b = a :=
by rw [div_eq_mul_inv, inv_mul_cancel_right₀ h a]

lemma div_mul_cancel_of_imp {a b : G₀} (h : b = 0 → a = 0) : a / b * b = a :=
classical.by_cases (λ hb : b = 0, by simp [*]) (div_mul_cancel a)

@[simp] lemma mul_div_cancel (a : G₀) {b : G₀} (h : b ≠ 0) : a * b / b = a :=
by rw [div_eq_mul_inv, mul_inv_cancel_right₀ h a]

lemma mul_div_cancel_of_imp {a b : G₀} (h : b = 0 → a = 0) : a * b / b = a :=
classical.by_cases (λ hb : b = 0, by simp [*]) (mul_div_cancel a)

local attribute [simp] div_eq_mul_inv mul_comm mul_assoc mul_left_comm

@[simp] lemma div_self_mul_self' (a : G₀) : a / (a * a) = a⁻¹ :=
calc a / (a * a) = a⁻¹⁻¹ * a⁻¹ * a⁻¹ : by simp [mul_inv_rev₀]
... = a⁻¹ : inv_mul_mul_self _

lemma div_eq_mul_one_div (a b : G₀) : a / b = a * (1 / b) :=
by simp

lemma mul_one_div_cancel {a : G₀} (h : a ≠ 0) : a * (1 / a) = 1 :=
by simp [h]

lemma one_div_mul_cancel {a : G₀} (h : a ≠ 0) : (1 / a) * a = 1 :=
by simp [h]

lemma one_div_one : 1 / 1 = (1:G₀) :=
div_self (ne.symm zero_ne_one)

lemma one_div_ne_zero {a : G₀} (h : a ≠ 0) : 1 / a ≠ 0 :=
by simpa only [one_div] using inv_ne_zero h

lemma eq_one_div_of_mul_eq_one {a b : G₀} (h : a * b = 1) : b = 1 / a :=
by simpa only [one_div] using eq_inv_of_mul_right_eq_one h

lemma eq_one_div_of_mul_eq_one_left {a b : G₀} (h : b * a = 1) : b = 1 / a :=
by simpa only [one_div] using eq_inv_of_mul_left_eq_one h

@[simp] lemma one_div_div (a b : G₀) : 1 / (a / b) = b / a :=
by rw [one_div, div_eq_mul_inv, mul_inv_rev₀, inv_inv₀, div_eq_mul_inv]

lemma one_div_one_div (a : G₀) : 1 / (1 / a) = a :=
by simp

lemma eq_of_one_div_eq_one_div {a b : G₀} (h : 1 / a = 1 / b) : a = b :=
by rw [← one_div_one_div a, h, one_div_one_div]

variables {a b c : G₀}

@[simp] lemma inv_eq_zero {a : G₀} : a⁻¹ = 0 ↔ a = 0 :=
by rw [inv_eq_iff, inv_zero, eq_comm]

@[simp] lemma zero_eq_inv {a : G₀} : 0 = a⁻¹ ↔ 0 = a :=
eq_comm.trans $ inv_eq_zero.trans eq_comm

lemma one_div_mul_one_div_rev (a b : G₀) : (1 / a) * (1 / b) =  1 / (b * a) :=
by simp only [div_eq_mul_inv, one_mul, mul_inv_rev₀]

theorem divp_eq_div (a : G₀) (u : units G₀) : a /ₚ u = a / u :=
by simpa only [div_eq_mul_inv] using congr_arg ((*) a) u.coe_inv'

@[simp] theorem divp_mk0 (a : G₀) {b : G₀} (hb : b ≠ 0) :
  a /ₚ units.mk0 b hb = a / b :=
divp_eq_div _ _

lemma inv_div : (a / b)⁻¹ = b / a :=
by rw [div_eq_mul_inv, mul_inv_rev₀, div_eq_mul_inv, inv_inv₀]

lemma inv_div_left : a⁻¹ / b = (b * a)⁻¹ :=
by rw [mul_inv_rev₀, div_eq_mul_inv]

lemma div_ne_zero (ha : a ≠ 0) (hb : b ≠ 0) : a / b ≠ 0 :=
by { rw div_eq_mul_inv, exact mul_ne_zero ha (inv_ne_zero hb) }

@[simp] lemma div_eq_zero_iff : a / b = 0 ↔ a = 0 ∨ b = 0:=
by simp [div_eq_mul_inv]

lemma div_ne_zero_iff : a / b ≠ 0 ↔ a ≠ 0 ∧ b ≠ 0 :=
(not_congr div_eq_zero_iff).trans not_or_distrib

lemma div_left_inj' (hc : c ≠ 0) : a / c = b / c ↔ a = b :=
by rw [← divp_mk0 _ hc, ← divp_mk0 _ hc, divp_left_inj]

lemma div_eq_iff_mul_eq (hb : b ≠ 0) : a / b = c ↔ c * b = a :=
⟨λ h, by rw [← h, div_mul_cancel _ hb],
 λ h, by rw [← h, mul_div_cancel _ hb]⟩

lemma eq_div_iff_mul_eq (hc : c ≠ 0) : a = b / c ↔ a * c = b :=
by rw [eq_comm, div_eq_iff_mul_eq hc]

lemma div_eq_of_eq_mul {x : G₀} (hx : x ≠ 0) {y z : G₀} (h : y = z * x) : y / x = z :=
(div_eq_iff_mul_eq hx).2 h.symm

lemma eq_div_of_mul_eq {x : G₀} (hx : x ≠ 0) {y z : G₀} (h : z * x = y) : z = y / x :=
eq.symm $ div_eq_of_eq_mul hx h.symm

lemma eq_of_div_eq_one (h : a / b = 1) : a = b :=
begin
  by_cases hb : b = 0,
  { rw [hb, div_zero] at h,
    exact eq_of_zero_eq_one h a b },
  { rwa [div_eq_iff_mul_eq hb, one_mul, eq_comm] at h }
end

lemma div_eq_one_iff_eq (hb : b ≠ 0) : a / b = 1 ↔ a = b :=
⟨eq_of_div_eq_one, λ h, h.symm ▸ div_self hb⟩

lemma div_mul_left {a b : G₀} (hb : b ≠ 0) : b / (a * b) = 1 / a :=
by simp only [div_eq_mul_inv, mul_inv_rev₀, mul_inv_cancel_left₀ hb, one_mul]

lemma mul_div_mul_right (a b : G₀) {c : G₀} (hc : c ≠ 0) :
  (a * c) / (b * c) = a / b :=
by simp only [div_eq_mul_inv, mul_inv_rev₀, mul_assoc, mul_inv_cancel_left₀ hc]

lemma mul_mul_div (a : G₀) {b : G₀} (hb : b ≠ 0) : a = a * b * (1 / b) :=
by simp [hb]

lemma ring.inverse_eq_inv (a : G₀) : ring.inverse a = a⁻¹ :=
begin
  obtain rfl | ha := eq_or_ne a 0,
  { simp },
  { exact ring.inverse_unit (units.mk0 a ha) }
end

@[simp] lemma ring.inverse_eq_inv' : (ring.inverse : G₀ → G₀) = has_inv.inv :=
funext ring.inverse_eq_inv

@[field_simps] lemma div_div_eq_mul_div (a b c : G₀) :
  a / (b / c) = (a * c) / b :=
by rw [div_eq_mul_one_div, one_div_div, ← mul_div_assoc]

/-- Dividing `a` by the result of dividing `a` by itself results in
`a` (whether or not `a` is zero). -/
@[simp] lemma div_div_self (a : G₀) : a / (a / a) = a :=
begin
  rw div_div_eq_mul_div,
  exact mul_self_div_self a
end

lemma ne_zero_of_one_div_ne_zero {a : G₀} (h : 1 / a ≠ 0) : a ≠ 0 :=
assume ha : a = 0, begin rw [ha, div_zero] at h, contradiction end

lemma eq_zero_of_one_div_eq_zero {a : G₀} (h : 1 / a = 0) : a = 0 :=
classical.by_cases
  (assume ha, ha)
  (assume ha, ((one_div_ne_zero ha) h).elim)

lemma div_div_div_cancel_right (a : G₀) (hc : c ≠ 0) : (a / c) / (b / c) = a / b :=
by rw [div_div_eq_mul_div, div_mul_cancel _ hc]

lemma div_mul_div_cancel (a : G₀) (hc : c ≠ 0) : (a / c) * (c / b) = a / b :=
by rw [← mul_div_assoc, div_mul_cancel _ hc]

@[field_simps] lemma eq_div_iff (hb : b ≠ 0) : c = a / b ↔ c * b = a :=
eq_div_iff_mul_eq hb

@[field_simps] lemma div_eq_iff (hb : b ≠ 0) : a / b = c ↔ a = c * b :=
(div_eq_iff_mul_eq hb).trans eq_comm

end group_with_zero

section comm_group_with_zero -- comm
variables [comm_group_with_zero G₀] {a b c : G₀}

@[priority 10] -- see Note [lower instance priority]
instance comm_group_with_zero.comm_cancel_monoid_with_zero : comm_cancel_monoid_with_zero G₀ :=
{ ..group_with_zero.cancel_monoid_with_zero, ..comm_group_with_zero.to_comm_monoid_with_zero G₀ }

/-- Pullback a `comm_group_with_zero` class along an injective function.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.comm_group_with_zero [has_zero G₀'] [has_mul G₀'] [has_one G₀']
  [has_inv G₀'] [has_div G₀'] (f : G₀' → G₀) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1)
  (mul : ∀ x y, f (x * y) = f x * f y) (inv : ∀ x, f x⁻¹ = (f x)⁻¹)
  (div : ∀ x y, f (x / y) = f x / f y) :
  comm_group_with_zero G₀' :=
{ .. hf.group_with_zero f zero one mul inv div, .. hf.comm_semigroup f mul }

/-- Pushforward a `comm_group_with_zero` class along a surjective function. -/
protected def function.surjective.comm_group_with_zero [has_zero G₀'] [has_mul G₀']
  [has_one G₀'] [has_inv G₀'] [has_div G₀'] (h01 : (0:G₀') ≠ 1) (f : G₀ → G₀') (hf : surjective f)
  (zero : f 0 = 0) (one : f 1 = 1) (mul : ∀ x y, f (x * y) = f x * f y) (inv : ∀ x, f x⁻¹ = (f x)⁻¹)
  (div : ∀ x y, f (x / y) = f x / f y) :
  comm_group_with_zero G₀' :=
{ .. hf.group_with_zero h01 f zero one mul inv div, .. hf.comm_semigroup f mul }

lemma mul_inv₀ : (a * b)⁻¹ = a⁻¹ * b⁻¹ :=
by rw [mul_inv_rev₀, mul_comm]

lemma one_div_mul_one_div (a b : G₀) : (1 / a) * (1 / b) = 1 / (a * b) :=
by rw [one_div_mul_one_div_rev, mul_comm b]

lemma div_mul_right {a : G₀} (b : G₀) (ha : a ≠ 0) : a / (a * b) = 1 / b :=
by rw [mul_comm, div_mul_left ha]

lemma mul_div_cancel_left_of_imp {a b : G₀} (h : a = 0 → b = 0) : a * b / a = b :=
by rw [mul_comm, mul_div_cancel_of_imp h]

lemma mul_div_cancel_left {a : G₀} (b : G₀) (ha : a ≠ 0) : a * b / a = b :=
mul_div_cancel_left_of_imp $ λ h, (ha h).elim

lemma mul_div_cancel_of_imp' {a b : G₀} (h : b = 0 → a = 0) : b * (a / b) = a :=
by rw [mul_comm, div_mul_cancel_of_imp h]

lemma mul_div_cancel' (a : G₀) {b : G₀} (hb : b ≠ 0) : b * (a / b) = a :=
by rw [mul_comm, (div_mul_cancel _ hb)]

local attribute [simp] mul_assoc mul_comm mul_left_comm

lemma div_mul_div (a b c d : G₀) :
      (a / b) * (c / d) = (a * c) / (b * d) :=
by simp [div_eq_mul_inv, mul_inv₀]

lemma mul_div_mul_left (a b : G₀) {c : G₀} (hc : c ≠ 0) :
      (c * a) / (c * b) = a / b :=
by rw [mul_comm c, mul_comm c, mul_div_mul_right _ _ hc]

@[field_simps] lemma div_mul_eq_mul_div (a b c : G₀) : (b / c) * a = (b * a) / c :=
by simp [div_eq_mul_inv]

lemma div_mul_eq_mul_div_comm (a b c : G₀) :
      (b / c) * a = b * (a / c) :=
by rw [div_mul_eq_mul_div, ← one_mul c, ← div_mul_div, div_one, one_mul]

lemma mul_eq_mul_of_div_eq_div (a : G₀) {b : G₀} (c : G₀) {d : G₀} (hb : b ≠ 0)
      (hd : d ≠ 0) (h : a / b = c / d) : a * d = c * b :=
by rw [← mul_one (a*d), mul_assoc, mul_comm d, ← mul_assoc, ← div_self hb,
       ← div_mul_eq_mul_div_comm, h, div_mul_eq_mul_div, div_mul_cancel _ hd]

@[field_simps] lemma div_div_eq_div_mul (a b c : G₀) :
      (a / b) / c = a / (b * c) :=
by rw [div_eq_mul_one_div, div_mul_div, mul_one]

lemma div_div_div_div_eq (a : G₀) {b c d : G₀} :
      (a / b) / (c / d) = (a * d) / (b * c) :=
by rw [div_div_eq_mul_div, div_mul_eq_mul_div, div_div_eq_div_mul]

lemma div_mul_eq_div_mul_one_div (a b c : G₀) :
      a / (b * c) = (a / b) * (1 / c) :=
by rw [← div_div_eq_div_mul, ← div_eq_mul_one_div]

lemma div_helper {a : G₀} (b : G₀) (h : a ≠ 0) : (1 / (a * b)) * a = 1 / b :=
by rw [div_mul_eq_mul_div, one_mul, div_mul_right _ h]

end comm_group_with_zero

section comm_group_with_zero
variables [comm_group_with_zero G₀] {a b c d : G₀}

lemma div_eq_inv_mul : a / b = b⁻¹ * a :=
by rw [div_eq_mul_inv, mul_comm]

lemma mul_div_right_comm (a b c : G₀) : (a * b) / c = (a / c) * b :=
by rw [div_eq_mul_inv, mul_assoc, mul_comm b, ← mul_assoc, div_eq_mul_inv]

lemma mul_comm_div' (a b c : G₀) : (a / b) * c = a * (c / b) :=
by rw [← mul_div_assoc, mul_div_right_comm]

lemma div_mul_comm' (a b c : G₀) : (a / b) * c = (c / b) * a :=
by rw [div_mul_eq_mul_div, mul_comm, mul_div_right_comm]

lemma mul_div_comm (a b c : G₀) : a * (b / c) = b * (a / c) :=
by rw [← mul_div_assoc, mul_comm, mul_div_assoc]

lemma div_right_comm (a : G₀) : (a / b) / c = (a / c) / b :=
by rw [div_div_eq_div_mul, div_div_eq_div_mul, mul_comm]

@[field_simps] lemma div_eq_div_iff (hb : b ≠ 0) (hd : d ≠ 0) : a / b = c / d ↔ a * d = c * b :=
calc a / b = c / d ↔ a / b * (b * d) = c / d * (b * d) :
by rw [mul_left_inj' (mul_ne_zero hb hd)]
               ... ↔ a * d = c * b :
by rw [← mul_assoc, div_mul_cancel _ hb,
      ← mul_assoc, mul_right_comm, div_mul_cancel _ hd]

lemma div_div_cancel' (ha : a ≠ 0) : a / (a / b) = b :=
by rw [div_eq_mul_inv, inv_div, mul_div_cancel' _ ha]

end comm_group_with_zero

namespace semiconj_by

@[simp] lemma zero_right [mul_zero_class G₀] (a : G₀) : semiconj_by a 0 0 :=
by simp only [semiconj_by, mul_zero, zero_mul]

@[simp] lemma zero_left [mul_zero_class G₀] (x y : G₀) : semiconj_by 0 x y :=
by simp only [semiconj_by, mul_zero, zero_mul]

variables [group_with_zero G₀] {a x y x' y' : G₀}

@[simp] lemma inv_symm_left_iff₀ : semiconj_by a⁻¹ x y ↔ semiconj_by a y x :=
classical.by_cases
  (λ ha : a = 0, by simp only [ha, inv_zero, semiconj_by.zero_left])
  (λ ha, @units_inv_symm_left_iff _ _ (units.mk0 a ha) _ _)

lemma inv_symm_left₀ (h : semiconj_by a x y) : semiconj_by a⁻¹ y x :=
semiconj_by.inv_symm_left_iff₀.2 h

lemma inv_right₀ (h : semiconj_by a x y) : semiconj_by a x⁻¹ y⁻¹ :=
begin
  by_cases ha : a = 0,
  { simp only [ha, zero_left] },
  by_cases hx : x = 0,
  { subst x,
    simp only [semiconj_by, mul_zero, @eq_comm _ _ (y * a), mul_eq_zero] at h,
    simp [h.resolve_right ha] },
  { have := mul_ne_zero ha hx,
    rw [h.eq, mul_ne_zero_iff] at this,
    exact @units_inv_right _ _ _ (units.mk0 x hx) (units.mk0 y this.1) h },
end

@[simp] lemma inv_right_iff₀ : semiconj_by a x⁻¹ y⁻¹ ↔ semiconj_by a x y :=
⟨λ h, inv_inv₀ x ▸ inv_inv₀ y ▸ h.inv_right₀, inv_right₀⟩

lemma div_right (h : semiconj_by a x y) (h' : semiconj_by a x' y') :
  semiconj_by a (x / x') (y / y') :=
by { rw [div_eq_mul_inv, div_eq_mul_inv], exact h.mul_right h'.inv_right₀ }

end semiconj_by

namespace commute

@[simp] theorem zero_right [mul_zero_class G₀] (a : G₀) :commute a 0 := semiconj_by.zero_right a
@[simp] theorem zero_left [mul_zero_class G₀] (a : G₀) : commute 0 a := semiconj_by.zero_left a a

variables [group_with_zero G₀] {a b c : G₀}

@[simp] theorem inv_left_iff₀ : commute a⁻¹ b ↔ commute a b :=
semiconj_by.inv_symm_left_iff₀

theorem inv_left₀ (h : commute a b) : commute a⁻¹ b := inv_left_iff₀.2 h

@[simp] theorem inv_right_iff₀ : commute a b⁻¹ ↔ commute a b :=
semiconj_by.inv_right_iff₀

theorem inv_right₀ (h : commute a b) : commute a b⁻¹ := inv_right_iff₀.2 h

theorem inv_inv₀ (h : commute a b) : commute a⁻¹ b⁻¹ := h.inv_left₀.inv_right₀

@[simp] theorem div_right (hab : commute a b) (hac : commute a c) :
  commute a (b / c) :=
hab.div_right hac

@[simp] theorem div_left (hac : commute a c) (hbc : commute b c) :
  commute (a / b) c :=
by { rw div_eq_mul_inv, exact hac.mul_left hbc.inv_left₀ }

end commute

namespace monoid_with_zero_hom

variables [group_with_zero G₀] [group_with_zero G₀'] [monoid_with_zero M₀] [nontrivial M₀]

section monoid_with_zero

variables (f : monoid_with_zero_hom G₀ M₀) {a : G₀}

lemma map_ne_zero : f a ≠ 0 ↔ a ≠ 0 :=
⟨λ hfa ha, hfa $ ha.symm ▸ f.map_zero, λ ha, ((is_unit.mk0 a ha).map f.to_monoid_hom).ne_zero⟩

@[simp] lemma map_eq_zero : f a = 0 ↔ a = 0 :=
not_iff_not.1 f.map_ne_zero

end monoid_with_zero

section group_with_zero

variables (f : monoid_with_zero_hom G₀ G₀') (a b : G₀)

/-- A monoid homomorphism between groups with zeros sending `0` to `0` sends `a⁻¹` to `(f a)⁻¹`. -/
@[simp] lemma map_inv : f a⁻¹ = (f a)⁻¹ :=
begin
  by_cases h : a = 0, by simp [h],
  apply eq_inv_of_mul_left_eq_one,
  rw [← f.map_mul, inv_mul_cancel h, f.map_one]
end

@[simp] lemma map_div : f (a / b) = f a / f b :=
by simpa only [div_eq_mul_inv] using ((f.map_mul _ _).trans $ _root_.congr_arg _ $ f.map_inv b)

end group_with_zero

end monoid_with_zero_hom

@[simp] lemma monoid_hom.map_units_inv {M G₀ : Type*} [monoid M] [group_with_zero G₀]
  (f : M →* G₀) (u : units M) : f ↑u⁻¹ = (f u)⁻¹ :=
by rw [← units.coe_map, ← units.coe_map, ← units.coe_inv', monoid_hom.map_inv]

@[simp] lemma monoid_with_zero_hom.map_units_inv {M G₀ : Type*} [monoid_with_zero M]
  [group_with_zero G₀] (f : monoid_with_zero_hom M G₀) (u : units M) : f ↑u⁻¹ = (f u)⁻¹ :=
f.to_monoid_hom.map_units_inv u

section noncomputable_defs

variables {M : Type*} [nontrivial M]

/-- Constructs a `group_with_zero` structure on a `monoid_with_zero`
  consisting only of units and 0. -/
noncomputable def group_with_zero_of_is_unit_or_eq_zero [hM : monoid_with_zero M]
  (h : ∀ (a : M), is_unit a ∨ a = 0) : group_with_zero M :=
{ inv := λ a, if h0 : a = 0 then 0 else ↑((h a).resolve_right h0).unit⁻¹,
  inv_zero := dif_pos rfl,
  mul_inv_cancel := λ a h0, by
  { change a * (if h0 : a = 0 then 0 else ↑((h a).resolve_right h0).unit⁻¹) = 1,
    rw [dif_neg h0, units.mul_inv_eq_iff_eq_mul, one_mul, is_unit.unit_spec] },
  exists_pair_ne := nontrivial.exists_pair_ne,
.. hM }

/-- Constructs a `comm_group_with_zero` structure on a `comm_monoid_with_zero`
  consisting only of units and 0. -/
noncomputable def comm_group_with_zero_of_is_unit_or_eq_zero [hM : comm_monoid_with_zero M]
  (h : ∀ (a : M), is_unit a ∨ a = 0) : comm_group_with_zero M :=
{ .. (group_with_zero_of_is_unit_or_eq_zero h), .. hM }

end noncomputable_defs


/-
Copyright (c) 2019 mathlib community. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Wojciech Nawrocki

! This file was ported from Lean 3 source module data.tree
! leanprover-community/mathlib commit 69c6a5a12d8a2b159f20933e60115a4f2de62b58
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Rbtree.Init
import Mathbin.Data.Num.Basic
import Mathbin.Order.Basic

/-!
# Binary tree

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

Provides binary tree storage for values of any type, with O(lg n) retrieval.
See also `data.rbtree` for red-black trees - this version allows more operations
to be defined and is better suited for in-kernel computation.

We also specialize for `tree unit`, which is a binary tree without any
additional data. We provide the notation `a △ b` for making a `tree unit` with children
`a` and `b`.

## References

<https://leanprover-community.github.io/archive/stream/113488-general/topic/tactic.20question.html>
-/

#print Tree /-
/-- A binary tree with values stored in non-leaf nodes. -/
inductive Tree.{u} (α : Type u) : Type u
  | nil : Tree
  | node : α → Tree → Tree → Tree
  deriving has_reflect, DecidableEq
#align tree Tree
-/

namespace Tree

universe u

variable {α : Type u}

/- warning: tree.repr clashes with [anonymous] -> [anonymous]
warning: tree.repr -> [anonymous] is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u}} [_inst_1 : Repr.{u} α], (Tree.{u} α) -> String
but is expected to have type
  forall {α : Type.{u}} {_inst_1 : Type.{v}}, (Nat -> α -> _inst_1) -> Nat -> (List.{u} α) -> (List.{v} _inst_1)
Case conversion may be inaccurate. Consider using '#align tree.repr [anonymous]ₓ'. -/
/-- Construct a string representation of a tree. Provides a `has_repr` instance. -/
def [anonymous] [Repr α] : Tree α → String
  | nil => "nil"
  | node a t1 t2 => "tree.node " ++ Repr.repr a ++ " (" ++ repr t1 ++ ") (" ++ repr t2 ++ ")"
#align tree.repr [anonymous]

instance [Repr α] : Repr (Tree α) :=
  ⟨[anonymous]⟩

instance : Inhabited (Tree α) :=
  ⟨nil⟩

/- warning: tree.of_rbnode -> Tree.ofRBNode is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}}, (Rbnode.{u1} α) -> (Tree.{u1} α)
but is expected to have type
  forall {α : Type.{u1}}, (Std.RBNode.{u1} α) -> (Tree.{u1} α)
Case conversion may be inaccurate. Consider using '#align tree.of_rbnode Tree.ofRBNodeₓ'. -/
/-- Makes a `tree α` out of a red-black tree. -/
def ofRBNode : Rbnode α → Tree α
  | Rbnode.leaf => nil
  | Rbnode.red_node l a r => node a (of_rbnode l) (of_rbnode r)
  | Rbnode.black_node l a r => node a (of_rbnode l) (of_rbnode r)
#align tree.of_rbnode Tree.ofRBNode

#print Tree.indexOf /-
/-- Finds the index of an element in the tree assuming the tree has been
constructed according to the provided decidable order on its elements.
If it hasn't, the result will be incorrect. If it has, but the element
is not in the tree, returns none. -/
def indexOf (lt : α → α → Prop) [DecidableRel lt] (x : α) : Tree α → Option PosNum
  | nil => none
  | node a t₁ t₂ =>
    match cmpUsing lt x a with
    | Ordering.lt => PosNum.bit0 <$> index_of t₁
    | Ordering.eq => some PosNum.one
    | Ordering.gt => PosNum.bit1 <$> index_of t₂
#align tree.index_of Tree.indexOf
-/

#print Tree.get /-
/-- Retrieves an element uniquely determined by a `pos_num` from the tree,
taking the following path to get to the element:
- `bit0` - go to left child
- `bit1` - go to right child
- `pos_num.one` - retrieve from here -/
def get : PosNum → Tree α → Option α
  | _, nil => none
  | PosNum.one, node a t₁ t₂ => some a
  | PosNum.bit0 n, node a t₁ t₂ => t₁.get n
  | PosNum.bit1 n, node a t₁ t₂ => t₂.get n
#align tree.get Tree.get
-/

#print Tree.getOrElse /-
/-- Retrieves an element from the tree, or the provided default value
if the index is invalid. See `tree.get`. -/
def getOrElse (n : PosNum) (t : Tree α) (v : α) : α :=
  (t.get n).getD v
#align tree.get_or_else Tree.getOrElse
-/

#print Tree.map /-
/-- Apply a function to each value in the tree.  This is the `map` function for the `tree` functor.
TODO: implement `traversable tree`. -/
def map {β} (f : α → β) : Tree α → Tree β
  | nil => nil
  | node a l r => node (f a) (map l) (map r)
#align tree.map Tree.map
-/

#print Tree.numNodes /-
/-- The number of internal nodes (i.e. not including leaves) of a binary tree -/
@[simp]
def numNodes : Tree α → ℕ
  | nil => 0
  | node _ a b => a.numNodes + b.numNodes + 1
#align tree.num_nodes Tree.numNodes
-/

#print Tree.numLeaves /-
/-- The number of leaves of a binary tree -/
@[simp]
def numLeaves : Tree α → ℕ
  | nil => 1
  | node _ a b => a.numLeaves + b.numLeaves
#align tree.num_leaves Tree.numLeaves
-/

#print Tree.height /-
/-- The height - length of the longest path from the root - of a binary tree -/
@[simp]
def height : Tree α → ℕ
  | nil => 0
  | node _ a b => max a.height b.height + 1
#align tree.height Tree.height
-/

#print Tree.numLeaves_eq_numNodes_succ /-
theorem numLeaves_eq_numNodes_succ (x : Tree α) : x.numLeaves = x.numNodes + 1 := by
  induction x <;> simp [*, Nat.add_comm, Nat.add_assoc, Nat.add_left_comm]
#align tree.num_leaves_eq_num_nodes_succ Tree.numLeaves_eq_numNodes_succ
-/

#print Tree.numLeaves_pos /-
theorem numLeaves_pos (x : Tree α) : 0 < x.numLeaves :=
  by
  rw [num_leaves_eq_num_nodes_succ]
  exact x.num_nodes.zero_lt_succ
#align tree.num_leaves_pos Tree.numLeaves_pos
-/

#print Tree.height_le_numNodes /-
theorem height_le_numNodes : ∀ x : Tree α, x.height ≤ x.numNodes
  | nil => le_rfl
  | node _ a b =>
    Nat.succ_le_succ
      (max_le (trans a.height_le_numNodes <| a.numNodes.le_add_right _)
        (trans b.height_le_numNodes <| b.numNodes.le_add_left _))
#align tree.height_le_num_nodes Tree.height_le_numNodes
-/

#print Tree.left /-
/-- The left child of the tree, or `nil` if the tree is `nil` -/
@[simp]
def left : Tree α → Tree α
  | nil => nil
  | node _ l r => l
#align tree.left Tree.left
-/

#print Tree.right /-
/-- The right child of the tree, or `nil` if the tree is `nil` -/
@[simp]
def right : Tree α → Tree α
  | nil => nil
  | node _ l r => r
#align tree.right Tree.right
-/

-- mathport name: «expr △ »
-- Notation for making a node with `unit` data
scoped infixr:65 " △ " => Tree.node ()

#print Tree.unitRecOn /-
/-- Recursion on `tree unit`; allows for a better `induction` which does not have to worry
  about the element of type `α = unit` -/
@[elab_as_elim]
def unitRecOn {motive : Tree Unit → Sort _} (t : Tree Unit) (base : motive nil)
    (ind : ∀ x y, motive x → motive y → motive (x △ y)) : motive t :=
  t.recOn base fun u => u.recOn ind
#align tree.unit_rec_on Tree.unitRecOn
-/

#print Tree.left_node_right_eq_self /-
theorem left_node_right_eq_self : ∀ {x : Tree Unit} (hx : x ≠ nil), x.left △ x.right = x
  | nil, h => by trivial
  | a △ b, _ => rfl
#align tree.left_node_right_eq_self Tree.left_node_right_eq_self
-/

end Tree


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Markus Himmel
-/
import algebra.homology.chain_complex
import algebra.homology.image_to_kernel_map

/-!
# (Co)homology groups for complexes

We setup that part of the theory of homology groups which works in
any category with kernels and images.

We define the homology groups themselves, and show that they induce maps on kernels.

Under the additional assumption that our category has equalizers and functorial images, we construct
induced morphisms on images and functorial induced morphisms in homology.

## Chains and cochains

Throughout we work with complexes graded by an arbitrary `[add_comm_group β]`,
with a differential with grading `b : β`.
Thus we're simultaneously doing homology and cohomology groups
(and in future, e.g., enabling computing homologies for successive pages of spectral sequences).

At the end of the file we set up abbreviations `cohomology` and `graded_cohomology`,
so that when you're working with a `C : cochain_complex V`, you can write `C.cohomology i`
rather than the confusing `C.homology i`.
-/

universes v u

noncomputable theory

open category_theory
open category_theory.limits

variables {V : Type u} [category.{v} V] [has_zero_morphisms V]

variables {β : Type} [add_comm_group β] {b : β}

namespace homological_complex

section has_kernels

variable [has_kernels V]

/-- The map induced by a chain map between the kernels of the differentials. -/
def kernel_map {C C' : homological_complex V b} (f : C ⟶ C') (i : β) :
  kernel (C.d i) ⟶ kernel (C'.d i) :=
kernel.lift _ (kernel.ι _ ≫ f.f i)
begin
  rw [category.assoc, ←comm_at f, ←category.assoc, kernel.condition, zero_comp],
end

@[simp, reassoc]
lemma kernel_map_condition {C C' : homological_complex V b} (f : C ⟶ C') (i : β) :
  kernel_map f i ≫ kernel.ι (C'.d i) = kernel.ι (C.d i) ≫ f.f i :=
by simp [kernel_map]

@[simp]
lemma kernel_map_id (C : homological_complex V b) (i : β) :
  kernel_map (𝟙 C) i = 𝟙 _ :=
(cancel_mono (kernel.ι (C.d i))).1 $ by simp

@[simp]
lemma kernel_map_comp {C C' C'' : homological_complex V b} (f : C ⟶ C')
  (g : C' ⟶ C'') (i : β) :
  kernel_map (f ≫ g) i = kernel_map f i ≫ kernel_map g i :=
(cancel_mono (kernel.ι (C''.d i))).1 $ by simp

/-- The kernels of the differentials of a complex form a `β`-graded object. -/
def kernel_functor : homological_complex V b ⥤ graded_object β V :=
{ obj := λ C i, kernel (C.d i),
  map := λ X Y f i, kernel_map f i }

end has_kernels

section has_image_maps
variables [has_images V] [has_image_maps V]

/-- A morphism of complexes induces a morphism on the images of the differentials in every
    degree. -/
abbreviation image_map {C C' : homological_complex V b} (f : C ⟶ C') (i : β) :
  image (C.d i) ⟶ image (C'.d i) :=
image.map (arrow.hom_mk' (comm_at f i).symm)

@[simp]
lemma image_map_ι {C C' : homological_complex V b} (f : C ⟶ C') (i : β) :
  image_map f i ≫ image.ι (C'.d i) = image.ι (C.d i) ≫ f.f (i + b) :=
image.map_hom_mk'_ι (comm_at f i).symm

end has_image_maps

variables [has_images V] [has_equalizers V]

/--
The connecting morphism from the image of `d i` to the kernel of `d (i ± 1)`.
-/
def image_to_kernel_map (C : homological_complex V b) (i : β) :
  image (C.d i) ⟶ kernel (C.d (i+b)) :=
category_theory.image_to_kernel_map (C.d i) (C.d (i+b)) (by simp)

@[simp, reassoc]
lemma image_to_kernel_map_condition (C : homological_complex V b) (i : β) :
  image_to_kernel_map C i ≫ kernel.ι (C.d (i + b)) = image.ι (C.d i) :=
by simp [image_to_kernel_map]

@[reassoc]
lemma image_to_kernel_map_comp_kernel_map [has_image_maps V]
  {C C' : homological_complex V b} (f : C ⟶ C') (i : β) :
  image_to_kernel_map C i ≫ kernel_map f (i + b) = image_map f i ≫ image_to_kernel_map C' i :=
by { ext, simp }

variables [has_cokernels V]

/-- The `i`-th homology group of the complex `C`. -/
def homology_group (i : β) (C : homological_complex V b) : V :=
cokernel (image_to_kernel_map C (i-b))

variables [has_image_maps V]

/-- A chain map induces a morphism in homology at every degree. -/
def homology_map {C C' : homological_complex V b} (f : C ⟶ C') (i : β) :
  C.homology_group i ⟶ C'.homology_group i :=
cokernel.desc _ (kernel_map f (i - b + b) ≫ cokernel.π _) $
  by simp [image_to_kernel_map_comp_kernel_map_assoc]

@[simp, reassoc]
lemma homology_map_condition {C C' : homological_complex V b} (f : C ⟶ C') (i : β) :
  cokernel.π (image_to_kernel_map C (i - b)) ≫ homology_map f i =
    kernel_map f (i - b + b) ≫ cokernel.π _ :=
by simp [homology_map]

@[simp]
lemma homology_map_id (C : homological_complex V b) (i : β) :
  homology_map (𝟙 C) i = 𝟙 (C.homology_group i) :=
begin
  ext,
  simp only [homology_map_condition, kernel_map_id, category.id_comp],
  erw [category.comp_id]
end

@[simp]
lemma homology_map_comp {C C' C'' : homological_complex V b} (f : C ⟶ C') (g : C' ⟶ C'') (i : β) :
  homology_map (f ≫ g) i = homology_map f i ≫ homology_map g i :=
by { ext, simp }

variables (V)

/-- The `i`-th homology functor from `β` graded complexes to `V`. -/
@[simps]
def homology (i : β) : homological_complex V b ⥤ V :=
{ obj := λ C, C.homology_group i,
  map := λ C C' f, homology_map f i, }

/-- The homology functor from `β` graded complexes to `β` graded objects in `V`. -/
@[simps]
def graded_homology : homological_complex V b ⥤ graded_object β V :=
{ obj := λ C i, C.homology_group i,
  map := λ C C' f i, homology_map f i }

end homological_complex

/-!
We now set up abbreviations so that you can write `C.cohomology i` or `(graded_cohomology V).map f`,
etc., when `C` is a cochain complex.
-/

namespace cochain_complex

variables [has_images V] [has_equalizers V] [has_cokernels V]

/-- The `i`-th cohomology group of the cochain complex `C`. -/
abbreviation cohomology_group (C : cochain_complex V) (i : ℤ) : V :=
C.homology_group i

variables [has_image_maps V]

/-- A chain map induces a morphism in cohomology at every degree. -/
abbreviation cohomology_map {C C' : cochain_complex V} (f : C ⟶ C') (i : ℤ) :
  C.cohomology_group i ⟶ C'.cohomology_group i :=
homological_complex.homology_map f i

variables (V)

/-- The `i`-th homology functor from cohain complexes to `V`. -/
abbreviation cohomology (i : ℤ) : cochain_complex V ⥤ V :=
homological_complex.homology V i

/-- The cohomology functor from cochain complexes to `ℤ`-graded objects in `V`. -/
abbreviation graded_cohomology : cochain_complex V ⥤ graded_object ℤ V :=
homological_complex.graded_homology V

end cochain_complex


/-
Copyright (c) 2019 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon
-/
import control.monad.basic
import data.fintype.basic

/-!
Type class for finitely enumerable types. The property is stronger
than `fintype` in that it assigns each element a rank in a finite
enumeration.
-/

open finset

/-- `fin_enum α` means that `α` is finite and can be enumerated in some order,
  i.e. `α` has an explicit bijection with `fin n` for some n. -/
class fin_enum (α : Sort*) :=
(card : ℕ)
(equiv [] : α ≃ fin card)
[dec_eq : decidable_eq α]

attribute [instance, priority 100] fin_enum.dec_eq

namespace fin_enum

variables {α : Type*}

/-- transport a `fin_enum` instance across an equivalence -/
def of_equiv (α) {β} [fin_enum α] (h : β ≃ α) : fin_enum β :=
{ card := card α,
  equiv := h.trans (equiv α),
  dec_eq := (h.trans (equiv _)).decidable_eq }

/-- create a `fin_enum` instance from an exhaustive list without duplicates -/
def of_nodup_list [decidable_eq α] (xs : list α) (h : ∀ x : α, x ∈ xs) (h' : list.nodup xs) :
  fin_enum α :=
{ card := xs.length,
  equiv := ⟨λ x, ⟨xs.index_of x,by rw [list.index_of_lt_length]; apply h⟩,
           λ ⟨i,h⟩, xs.nth_le _ h,
           λ x, by simp [of_nodup_list._match_1],
           λ ⟨i,h⟩, by simp [of_nodup_list._match_1,*]; rw list.nth_le_index_of;
             apply list.nodup_erase_dup ⟩ }

/-- create a `fin_enum` instance from an exhaustive list; duplicates are removed -/
def of_list [decidable_eq α] (xs : list α) (h : ∀ x : α, x ∈ xs) : fin_enum α :=
of_nodup_list xs.erase_dup (by simp *) (list.nodup_erase_dup _)

/-- create an exhaustive list of the values of a given type -/
def to_list (α) [fin_enum α] : list α :=
(list.fin_range (card α)).map (equiv α).symm

open function

@[simp] lemma mem_to_list [fin_enum α] (x : α) : x ∈ to_list α :=
by simp [to_list]; existsi equiv α x; simp

@[simp] lemma nodup_to_list [fin_enum α] : list.nodup (to_list α) :=
by simp [to_list]; apply list.nodup_map; [apply equiv.injective, apply list.nodup_fin_range]

/-- create a `fin_enum` instance using a surjection -/
def of_surjective {β} (f : β → α) [decidable_eq α] [fin_enum β] (h : surjective f) : fin_enum α :=
of_list ((to_list β).map f) (by intro; simp; exact h _)

/-- create a `fin_enum` instance using an injection -/
noncomputable def of_injective {α β} (f : α → β) [decidable_eq α] [fin_enum β] (h : injective f) :
  fin_enum α :=
of_list ((to_list β).filter_map (partial_inv f))
begin
  intro x,
  simp only [mem_to_list, true_and, list.mem_filter_map],
  use f x,
  simp only [h, function.partial_inv_left],
end

instance pempty : fin_enum pempty :=
of_list [] (λ x, pempty.elim x)

instance empty : fin_enum empty :=
of_list [] (λ x, empty.elim x)

instance punit : fin_enum punit :=
of_list [punit.star] (λ x, by cases x; simp)

instance prod {β} [fin_enum α] [fin_enum β] : fin_enum (α × β) :=
of_list ( (to_list α).product (to_list β) ) (λ x, by cases x; simp)

instance sum {β} [fin_enum α] [fin_enum β] : fin_enum (α ⊕ β) :=
of_list ( (to_list α).map sum.inl ++ (to_list β).map sum.inr ) (λ x, by cases x; simp)

instance fin {n} : fin_enum (fin n) :=
of_list (list.fin_range _) (by simp)

instance quotient.enum [fin_enum α] (s : setoid α)
  [decidable_rel ((≈) : α → α → Prop)] : fin_enum (quotient s) :=
fin_enum.of_surjective quotient.mk (λ x, quotient.induction_on x (λ x, ⟨x, rfl⟩))

/-- enumerate all finite sets of a given type -/
def finset.enum [decidable_eq α] : list α → list (finset α)
| [] := [∅]
| (x :: xs) :=
  do r ← finset.enum xs,
     [r,{x} ∪ r]

@[simp]lemma finset.mem_enum [decidable_eq α] (s : finset α) (xs : list α) :
  s ∈ finset.enum xs ↔ ∀ x ∈ s, x ∈ xs :=
begin
  induction xs generalizing s; simp [*,finset.enum],
  { simp [finset.eq_empty_iff_forall_not_mem,(∉)], refl },
  { split, rintro ⟨a,h,h'⟩ x hx,
    cases h',
    { right, apply h, subst a, exact hx, },
    { simp only [h', mem_union, mem_singleton] at hx ⊢, cases hx,
      { exact or.inl hx },
      { exact or.inr (h _ hx) }  },
    intro h, existsi s \ ({xs_hd} : finset α),
    simp only [and_imp, union_comm, mem_sdiff, mem_singleton],
    simp only [or_iff_not_imp_left] at h,
    existsi h,
    by_cases xs_hd ∈ s,
    { have : {xs_hd} ⊆ s, simp only [has_subset.subset, *, forall_eq, mem_singleton],
      simp only [union_sdiff_of_subset this, or_true, finset.union_sdiff_of_subset,
        eq_self_iff_true], },
    { left, symmetry, simp only [sdiff_eq_self],
      intro a, simp only [and_imp, mem_inter, mem_singleton, not_mem_empty],
      intros h₀ h₁, subst a, apply h h₀, } }
end

instance finset.fin_enum [fin_enum α] : fin_enum (finset α) :=
of_list (finset.enum (to_list α)) (by intro; simp)

instance subtype.fin_enum [fin_enum α] (p : α → Prop) [decidable_pred p] : fin_enum {x // p x} :=
of_list ((to_list α).filter_map $ λ x, if h : p x then some ⟨_,h⟩ else none)
  (by rintro ⟨x,h⟩; simp; existsi x; simp *)

instance (β : α → Type*)
  [fin_enum α] [∀ a, fin_enum (β a)] : fin_enum (sigma β) :=
of_list
  ((to_list α).bind $ λ a, (to_list (β a)).map $ sigma.mk a)
  (by intro x; cases x; simp)

instance psigma.fin_enum {β : α → Type*} [fin_enum α] [∀ a, fin_enum (β a)] :
  fin_enum (Σ' a, β a) :=
fin_enum.of_equiv _ (equiv.psigma_equiv_sigma _)

instance psigma.fin_enum_prop_left {α : Prop} {β : α → Type*} [∀ a, fin_enum (β a)] [decidable α] :
  fin_enum (Σ' a, β a) :=
if h : α then of_list ((to_list (β h)).map $ psigma.mk h) (λ ⟨a,Ba⟩, by simp)
else of_list [] (λ ⟨a,Ba⟩, (h a).elim)

instance psigma.fin_enum_prop_right {β : α → Prop} [fin_enum α] [∀ a, decidable (β a)] :
  fin_enum (Σ' a, β a) :=
fin_enum.of_equiv {a // β a} ⟨λ ⟨x, y⟩, ⟨x, y⟩, λ ⟨x, y⟩, ⟨x, y⟩, λ ⟨x, y⟩, rfl, λ ⟨x, y⟩, rfl⟩

instance psigma.fin_enum_prop_prop {α : Prop} {β : α → Prop} [decidable α] [∀ a, decidable (β a)] :
  fin_enum (Σ' a, β a) :=
if h : ∃ a, β a
  then of_list [⟨h.fst,h.snd⟩] (by rintro ⟨⟩; simp)
  else of_list [] (λ a, (h ⟨a.fst,a.snd⟩).elim)

@[priority 100]
instance [fin_enum α] : fintype α :=
{ elems := univ.map (equiv α).symm.to_embedding,
  complete := by intros; simp; existsi (equiv α x); simp }

/-- For `pi.cons x xs y f` create a function where every `i ∈ xs` is mapped to `f i` and
`x` is mapped to `y`  -/
def pi.cons {β : α → Type*} [decidable_eq α] (x : α) (xs : list α) (y : β x)
  (f : Π a, a ∈ xs → β a) :
  Π a, a ∈ (x :: xs : list α) → β a
| b h :=
  if h' : b = x then cast (by rw h') y
    else f b (list.mem_of_ne_of_mem h' h)

/-- Given `f` a function whose domain is `x :: xs`, produce a function whose domain
is restricted to `xs`.  -/
def pi.tail {α : Type*} {β : α → Type*} {x : α} {xs : list α}
  (f : Π a, a ∈ (x :: xs : list α) → β a) :
  Π a, a ∈ xs → β a
| a h := f a (list.mem_cons_of_mem _ h)

/-- `pi xs f` creates the list of functions `g` such that, for `x ∈ xs`, `g x ∈ f x` -/
def pi {α : Type*} {β : α → Type*} [decidable_eq α] : Π xs : list α, (Π a, list (β a)) →
  list (Π a, a ∈ xs → β a)
| [] fs := [λ x h, h.elim]
| (x :: xs) fs :=
  fin_enum.pi.cons x xs <$> fs x <*> pi xs fs

lemma mem_pi  {α : Type*} {β : α → Type*} [fin_enum α] [∀a, fin_enum (β a)] (xs : list α)
  (f : Π a, a ∈ xs → β a) :
  f ∈ pi xs (λ x, to_list (β x)) :=
begin
  induction xs; simp [pi,-list.map_eq_map] with monad_norm functor_norm,
  { ext a ⟨ ⟩ },
  { existsi pi.cons xs_hd xs_tl (f _ (list.mem_cons_self _ _)),
    split, exact ⟨_,rfl⟩,
    existsi pi.tail f, split,
    { apply xs_ih, },
    { ext x h, simp [pi.cons], split_ifs, subst x, refl, refl }, }
end

/-- enumerate all functions whose domain and range are finitely enumerable -/
def pi.enum  {α : Type*} (β : α → Type*) [fin_enum α] [∀a, fin_enum (β a)] : list (Π a, β a) :=
(pi (to_list α) (λ x, to_list (β x))).map (λ f x, f x (mem_to_list _))

lemma pi.mem_enum  {α : Type*} {β : α → Type*} [fin_enum α] [∀a, fin_enum (β a)] (f : Π a, β a) :
  f ∈ pi.enum β :=
by simp [pi.enum]; refine ⟨λ a h, f a, mem_pi _ _, rfl⟩

instance pi.fin_enum {α : Type*} {β : α → Type*}
  [fin_enum α] [∀a, fin_enum (β a)] : fin_enum (Πa, β a) :=
of_list (pi.enum _) (λ x, pi.mem_enum _)

instance pfun_fin_enum (p : Prop) [decidable p] (α : p → Type*)
  [Π hp, fin_enum (α hp)] : fin_enum (Π hp : p, α hp) :=
if hp : p then of_list ( (to_list (α hp)).map $ λ x hp', x ) (by intro; simp; exact ⟨x hp,rfl⟩)
          else of_list [λ hp', (hp hp').elim] (by intro; simp; ext hp'; cases hp hp')

end fin_enum


/-
Copyright (c) 2019 Jean Lo. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jean Lo
-/
import topology.metric_space.hausdorff_distance

/-!
# Riesz's lemma

Riesz's lemma, stated for a normed space over a normed field: for any
closed proper subspace `F` of `E`, there is a nonzero `x` such that `∥x - F∥`
is at least `r * ∥x∥` for any `r < 1`. This is `riesz_lemma`.

In a nondiscrete normed field (with an element `c` of norm `> 1`) and any `R > ∥c∥`, one can
guarantee `∥x∥ ≤ R` and `∥x - y∥ ≥ 1` for any `y` in `F`. This is `riesz_lemma_of_norm_lt`.
-/

variables {𝕜 : Type*} [normed_field 𝕜]
variables {E : Type*} [normed_group E] [normed_space 𝕜 E]

/-- Riesz's lemma, which usually states that it is possible to find a
vector with norm 1 whose distance to a closed proper subspace is
arbitrarily close to 1. The statement here is in terms of multiples of
norms, since in general the existence of an element of norm exactly 1
is not guaranteed. For a variant giving an element with norm in `[1, R]`, see
`riesz_lemma_of_norm_lt`. -/
lemma riesz_lemma {F : subspace 𝕜 E} (hFc : is_closed (F : set E))
  (hF : ∃ x : E, x ∉ F) {r : ℝ} (hr : r < 1) :
  ∃ x₀ : E, x₀ ∉ F ∧ ∀ y ∈ F, r * ∥x₀∥ ≤ ∥x₀ - y∥ :=
begin
  classical,
  obtain ⟨x, hx⟩ : ∃ x : E, x ∉ F := hF,
  let d := metric.inf_dist x F,
  have hFn : (F : set E).nonempty, from ⟨_, F.zero_mem⟩,
  have hdp : 0 < d,
    from lt_of_le_of_ne metric.inf_dist_nonneg (λ heq, hx
    ((hFc.mem_iff_inf_dist_zero hFn).2 heq.symm)),
  let r' := max r 2⁻¹,
  have hr' : r' < 1, by { simp [r', hr], norm_num },
  have hlt : 0 < r' := lt_of_lt_of_le (by norm_num) (le_max_right r 2⁻¹),
  have hdlt : d < d / r', from (lt_div_iff hlt).mpr ((mul_lt_iff_lt_one_right hdp).2 hr'),
  obtain ⟨y₀, hy₀F, hxy₀⟩ : ∃ y ∈ F, dist x y < d / r' := (metric.inf_dist_lt_iff hFn).mp hdlt,
  have x_ne_y₀ : x - y₀ ∉ F,
  { by_contradiction h,
    have : (x - y₀) + y₀ ∈ F, from F.add_mem h hy₀F,
    simp only [neg_add_cancel_right, sub_eq_add_neg] at this,
    exact hx this },
  refine ⟨x - y₀, x_ne_y₀, λy hy, le_of_lt _⟩,
  have hy₀y : y₀ + y ∈ F, from F.add_mem hy₀F hy,
  calc
    r * ∥x - y₀∥ ≤ r' * ∥x - y₀∥ : mul_le_mul_of_nonneg_right (le_max_left _ _) (norm_nonneg _)
    ... < d : by { rw ←dist_eq_norm, exact (lt_div_iff' hlt).1 hxy₀ }
    ... ≤ dist x (y₀ + y) : metric.inf_dist_le_dist_of_mem hy₀y
    ... = ∥x - y₀ - y∥ : by { rw [sub_sub, dist_eq_norm] }
end

/--
A version of Riesz lemma: given a strict closed subspace `F`, one may find an element of norm `≤ R`
which is at distance  at least `1` of every element of `F`. Here, `R` is any given constant
strictly larger than the norm of an element of norm `> 1`. For a version without an `R`, see
`riesz_lemma`.

Since we are considering a general nondiscrete normed field, there may be a gap in possible norms
(for instance no element of norm in `(1,2)`). Hence, we can not allow `R` arbitrarily close to `1`,
and require `R > ∥c∥` for some `c : 𝕜` with norm `> 1`.
-/
lemma riesz_lemma_of_norm_lt
  {c : 𝕜} (hc : 1 < ∥c∥) {R : ℝ} (hR : ∥c∥ < R)
  {F : subspace 𝕜 E} (hFc : is_closed (F : set E)) (hF : ∃ x : E, x ∉ F) :
  ∃ x₀ : E, ∥x₀∥ ≤ R ∧ ∀ y ∈ F, 1 ≤ ∥x₀ - y∥ :=
begin
  have Rpos : 0 < R := (norm_nonneg _).trans_lt hR,
  have : ∥c∥ / R < 1, by { rw div_lt_iff Rpos, simpa using hR },
  rcases riesz_lemma hFc hF this with ⟨x, xF, hx⟩,
  have x0 : x ≠ 0 := λ H, by simpa [H] using xF,
  obtain ⟨d, d0, dxlt, ledx, -⟩ :
    ∃ (d : 𝕜), d ≠ 0 ∧ ∥d • x∥ < R ∧ R / ∥c∥ ≤ ∥d • x∥ ∧ ∥d∥⁻¹ ≤ R⁻¹ * ∥c∥ * ∥x∥ :=
      rescale_to_shell hc Rpos x0,
  refine ⟨d • x, dxlt.le, λ y hy, _⟩,
  set y' := d⁻¹ • y with hy',
  have y'F : y' ∈ F, by simp [hy', submodule.smul_mem _ _ hy],
  have yy' : y = d • y', by simp [hy', smul_smul, mul_inv_cancel d0],
  calc 1 = (∥c∥/R) * (R/∥c∥) : by field_simp [Rpos.ne', (zero_lt_one.trans hc).ne']
  ... ≤ (∥c∥/R) * (∥d • x∥) :
    mul_le_mul_of_nonneg_left ledx (div_nonneg (norm_nonneg _) Rpos.le)
  ... = ∥d∥ * (∥c∥/R * ∥x∥) : by { simp [norm_smul], ring }
  ... ≤ ∥d∥ * ∥x - y'∥ :
    mul_le_mul_of_nonneg_left (hx y' (by simp [hy', submodule.smul_mem _ _ hy])) (norm_nonneg _)
  ... = ∥d • x - y∥ : by simp [yy', ← smul_sub, norm_smul],
end


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

/-!
# booleans

This file proves various trivial lemmas about booleans and their
relation to decidable propositions.

## Notations

This file introduces the notation `!b` for `bnot b`, the boolean "not".

## Tags
bool, boolean, De Morgan
-/

prefix `!`:90 := bnot

namespace bool

-- TODO: duplicate of a lemma in core
theorem coe_sort_tt : coe_sort.{1 1} tt = true := coe_sort_tt

-- TODO: duplicate of a lemma in core
theorem coe_sort_ff : coe_sort.{1 1} ff = false := coe_sort_ff

-- TODO: duplicate of a lemma in core
theorem to_bool_true {h} : @to_bool true h = tt :=
to_bool_true_eq_tt h

-- TODO: duplicate of a lemma in core
theorem to_bool_false {h} : @to_bool false h = ff :=
to_bool_false_eq_ff h

@[simp] theorem to_bool_coe (b:bool) {h} : @to_bool b h = b :=
(show _ = to_bool b, by congr).trans (by cases b; refl)

@[simp] lemma of_to_bool_iff {p : Prop} [decidable p] : to_bool p ↔ p :=
⟨of_to_bool_true, _root_.to_bool_true⟩

@[simp] lemma tt_eq_to_bool_iff {p : Prop} [decidable p] : tt = to_bool p ↔ p :=
eq_comm.trans of_to_bool_iff

@[simp] lemma ff_eq_to_bool_iff {p : Prop} [decidable p] : ff = to_bool p ↔ ¬ p :=
eq_comm.trans (to_bool_ff_iff _)

@[simp] theorem to_bool_not (p : Prop) [decidable p] : to_bool (¬ p) = bnot (to_bool p) :=
by by_cases p; simp *

@[simp] theorem to_bool_and (p q : Prop) [decidable p] [decidable q] :
  to_bool (p ∧ q) = p && q :=
by by_cases p; by_cases q; simp *

@[simp] theorem to_bool_or (p q : Prop) [decidable p] [decidable q] :
  to_bool (p ∨ q) = p || q :=
by by_cases p; by_cases q; simp *

@[simp] theorem to_bool_eq {p q : Prop} [decidable p] [decidable q] :
  to_bool p = to_bool q ↔ (p ↔ q) :=
⟨λ h, (coe_to_bool p).symm.trans $ by simp [h], to_bool_congr⟩

lemma not_ff : ¬ ff := ff_ne_tt

@[simp] theorem default_bool : default = ff := rfl

theorem dichotomy (b : bool) : b = ff ∨ b = tt :=
by cases b; simp

@[simp] theorem forall_bool {p : bool → Prop} : (∀ b, p b) ↔ p ff ∧ p tt :=
⟨λ h, by simp [h], λ ⟨h₁, h₂⟩ b, by cases b; assumption⟩

@[simp] theorem exists_bool {p : bool → Prop} : (∃ b, p b) ↔ p ff ∨ p tt :=
⟨λ ⟨b, h⟩, by cases b; [exact or.inl h, exact or.inr h],
 λ h, by cases h; exact ⟨_, h⟩⟩

/-- If `p b` is decidable for all `b : bool`, then `∀ b, p b` is decidable -/
instance decidable_forall_bool {p : bool → Prop} [∀ b, decidable (p b)] : decidable (∀ b, p b) :=
decidable_of_decidable_of_iff and.decidable forall_bool.symm

/-- If `p b` is decidable for all `b : bool`, then `∃ b, p b` is decidable -/
instance decidable_exists_bool {p : bool → Prop} [∀ b, decidable (p b)] : decidable (∃ b, p b) :=
decidable_of_decidable_of_iff or.decidable exists_bool.symm

@[simp] theorem cond_ff {α} (t e : α) : cond ff t e = e := rfl

@[simp] theorem cond_tt {α} (t e : α) : cond tt t e = t := rfl

@[simp] theorem cond_to_bool {α} (p : Prop) [decidable p] (t e : α) :
  cond (to_bool p) t e = if p then t else e :=
by by_cases p; simp *

@[simp] theorem cond_bnot {α} (b : bool) (t e : α) : cond (!b) t e = cond b e t :=
by cases b; refl

theorem coe_bool_iff : ∀ {a b : bool}, (a ↔ b) ↔ a = b := dec_trivial

theorem eq_tt_of_ne_ff : ∀ {a : bool}, a ≠ ff → a = tt := dec_trivial

theorem eq_ff_of_ne_tt : ∀ {a : bool}, a ≠ tt → a = ff := dec_trivial

theorem bor_comm : ∀ a b, a || b = b || a := dec_trivial

@[simp] theorem bor_assoc : ∀ a b c, (a || b) || c = a || (b || c) := dec_trivial

theorem bor_left_comm : ∀ a b c, a || (b || c) = b || (a || c) := dec_trivial

theorem bor_inl {a b : bool} (H : a) : a || b :=
by simp [H]

theorem bor_inr {a b : bool} (H : b) : a || b :=
by simp [H]

theorem band_comm : ∀ a b, a && b = b && a := dec_trivial

@[simp] theorem band_assoc : ∀ a b c, (a && b) && c = a && (b && c) := dec_trivial

theorem band_left_comm : ∀ a b c, a && (b && c) = b && (a && c) := dec_trivial

theorem band_elim_left : ∀ {a b : bool}, a && b → a := dec_trivial

theorem band_intro : ∀ {a b : bool}, a → b → a && b := dec_trivial

theorem band_elim_right : ∀ {a b : bool}, a && b → b := dec_trivial

@[simp] theorem bnot_false : bnot ff = tt := rfl

@[simp] theorem bnot_true : bnot tt = ff := rfl

@[simp] theorem bnot_iff_not : ∀ {b : bool}, !b ↔ ¬b := dec_trivial

theorem eq_tt_of_bnot_eq_ff : ∀ {a : bool}, bnot a = ff → a = tt := dec_trivial

theorem eq_ff_of_bnot_eq_tt : ∀ {a : bool}, bnot a = tt → a = ff := dec_trivial

@[simp] lemma band_bnot_self : ∀ x, x && !x = ff := dec_trivial
@[simp] lemma bnot_band_self : ∀ x, !x && x = ff := dec_trivial
@[simp] lemma bor_bnot_self : ∀ x, x || !x = tt := dec_trivial
@[simp] lemma bnot_bor_self : ∀ x, !x || x = tt := dec_trivial

theorem bxor_comm : ∀ a b, bxor a b = bxor b a := dec_trivial
@[simp] theorem bxor_assoc : ∀ a b c, bxor (bxor a b) c = bxor a (bxor b c) := dec_trivial
theorem bxor_left_comm : ∀ a b c, bxor a (bxor b c) = bxor b (bxor a c) := dec_trivial
@[simp] theorem bxor_bnot_left : ∀ a, bxor (!a) a = tt := dec_trivial
@[simp] theorem bxor_bnot_right : ∀ a, bxor a (!a) = tt := dec_trivial
@[simp] theorem bxor_bnot_bnot : ∀ a b, bxor (!a) (!b) = bxor a b := dec_trivial
@[simp] theorem bxor_ff_left : ∀ a, bxor ff a = a := dec_trivial
@[simp] theorem bxor_ff_right : ∀ a, bxor a ff = a := dec_trivial

lemma bxor_iff_ne : ∀ {x y : bool}, bxor x y = tt ↔ x ≠ y := dec_trivial

/-! ### De Morgan's laws for booleans-/
@[simp] lemma bnot_band : ∀ (a b : bool), !(a && b) = !a || !b := dec_trivial
@[simp] lemma bnot_bor : ∀ (a b : bool), !(a || b) = !a && !b := dec_trivial

lemma bnot_inj : ∀ {a b : bool}, !a = !b → a = b := dec_trivial

instance : linear_order bool :=
{ le := λ a b, a = ff ∨ b = tt,
  le_refl := dec_trivial,
  le_trans := dec_trivial,
  le_antisymm := dec_trivial,
  le_total := dec_trivial,
  decidable_le := infer_instance,
  decidable_eq := infer_instance,
  decidable_lt := infer_instance,
  max := bor,
  max_def := by { funext x y, revert x y, exact dec_trivial },
  min := band,
  min_def := by { funext x y, revert x y, exact dec_trivial } }

@[simp] lemma ff_le {x : bool} : ff ≤ x := or.intro_left _ rfl

@[simp] lemma le_tt {x : bool} : x ≤ tt := or.intro_right _ rfl

lemma lt_iff : ∀ {x y : bool}, x < y ↔ x = ff ∧ y = tt := dec_trivial

@[simp] lemma ff_lt_tt : ff < tt := lt_iff.2 ⟨rfl, rfl⟩

lemma le_iff_imp : ∀ {x y : bool}, x ≤ y ↔ (x → y) := dec_trivial

lemma band_le_left : ∀ x y : bool, x && y ≤ x := dec_trivial

lemma band_le_right : ∀ x y : bool, x && y ≤ y := dec_trivial

lemma le_band : ∀ {x y z : bool}, x ≤ y → x ≤ z → x ≤ y && z := dec_trivial

lemma left_le_bor : ∀ x y : bool, x ≤ x || y := dec_trivial

lemma right_le_bor : ∀ x y : bool, y ≤ x || y := dec_trivial

lemma bor_le : ∀ {x y z}, x ≤ z → y ≤ z → x || y ≤ z := dec_trivial

/-- convert a `bool` to a `ℕ`, `false -> 0`, `true -> 1` -/
def to_nat (b : bool) : ℕ :=
cond b 1 0

/-- convert a `ℕ` to a `bool`, `0 -> false`, everything else -> `true` -/
def of_nat (n : ℕ) : bool :=
to_bool (n ≠ 0)

lemma of_nat_le_of_nat {n m : ℕ} (h : n ≤ m) : of_nat n ≤ of_nat m :=
begin
  simp [of_nat];
    cases nat.decidable_eq n 0;
    cases nat.decidable_eq m 0;
    simp only [to_bool],
  { subst m, have h := le_antisymm h (nat.zero_le _),
    contradiction },
  { left, refl }
end

lemma to_nat_le_to_nat {b₀ b₁ : bool} (h : b₀ ≤ b₁) : to_nat b₀ ≤ to_nat b₁ :=
by cases h; subst h; [cases b₁, cases b₀]; simp [to_nat,nat.zero_le]

lemma of_nat_to_nat (b : bool) : of_nat (to_nat b) = b :=
by cases b; simp only [of_nat,to_nat]; exact dec_trivial

@[simp] lemma injective_iff {α : Sort*} {f : bool → α} : function.injective f ↔ f ff ≠ f tt :=
⟨λ Hinj Heq, ff_ne_tt (Hinj Heq),
  λ H x y hxy, by { cases x; cases y, exacts [rfl, (H hxy).elim, (H hxy.symm).elim, rfl] }⟩

end bool


theorem ex [Add α]
            (assoc : {a b c : α} → a + b + c = a + (b + c))
            (comm  : {a b : α} → a + b = b + a)
            (f : α → α) (x y z : α) : f (x + (y + z)) = f (y + (x + z)) := by
  let leftAssoc {a b c : α} : a + (b + c) = b + (a + c) := by
    rw [← assoc, comm (a := a), assoc]
  simp [leftAssoc]


def Commute (a b : Nat) := a * b = b * a

example : Commute m n :=
  calc m * n = n * m := Nat.mul_comm ..