/-
Copyright (c) 2020 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Simon Hudon
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.pfun
import Mathlib.order.preorder_hom
import Mathlib.tactic.wlog
import Mathlib.tactic.monotonicity.default
import Mathlib.PostPort

universes u_1 u_2 u_5 u_6 u_3 u v l u_4

namespace Mathlib

/-!
# Omega Complete Partial Orders

An omega-complete partial order is a partial order with a supremum
operation on increasing sequences indexed by natural numbers (which we
call `ωSup`). In this sense, it is strictly weaker than join complete
semi-lattices as only ω-sized totally ordered sets have a supremum.

The concept of an omega-complete partial order (ωCPO) is useful for the
formalization of the semantics of programming languages. Its notion of
supremum helps define the meaning of recursive procedures.

## Main definitions

 * class `omega_complete_partial_order`
 * `ite`, `map`, `bind`, `seq` as continuous morphisms

## Instances of `omega_complete_partial_order`

 * `roption`
 * every `complete_lattice`
 * pi-types
 * product types
 * `monotone_hom`
 * `continuous_hom` (with notation →𝒄)
   * an instance of `omega_complete_partial_order (α →𝒄 β)`
 * `continuous_hom.of_fun`
 * `continuous_hom.of_mono`
 * continuous functions:
   * `id`
   * `ite`
   * `const`
   * `roption.bind`
   * `roption.map`
   * `roption.seq`

## References

 * [G. Markowsky, *Chain-complete posets and directed sets with applications*, https://doi.org/10.1007/BF02485815][markowsky]
 * [J. M. Cadiou and Zohar Manna, *Recursive definitions of partial functions and their computations.*, https://doi.org/10.1145/942580.807072][cadiou]
 * [Carl A. Gunter, *Semantics of Programming Languages: Structures and Techniques*, ISBN: 0262570955][gunter]
-/

namespace preorder_hom

/-- The constant function, as a monotone function. -/
@[simp] theorem const_to_fun (α : Type u_1) {β : Type u_2} [preorder α] [preorder β] (f : β) : ∀ (ᾰ : α), coe_fn (const α f) ᾰ = function.const α f ᾰ :=
  fun (ᾰ : α) => Eq.refl (coe_fn (const α f) ᾰ)

/-- The diagonal function, as a monotone function. -/
def prod.diag {α : Type u_1} [preorder α] : α →ₘ α × α :=
  mk (fun (x : α) => (x, x)) sorry

/-- The `prod.map` function, as a monotone function. -/
@[simp] theorem prod.map_to_fun {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] {α' : Type u_5} {β' : Type u_6} [preorder α'] [preorder β'] (f : α →ₘ β) (f' : α' →ₘ β') (x : α × α') : coe_fn (prod.map f f') x = prod.map (⇑f) (⇑f') x :=
  Eq.refl (coe_fn (prod.map f f') x)

/-- The `prod.fst` projection, as a monotone function. -/
def prod.fst {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] : α × β →ₘ α :=
  mk prod.fst sorry

/-- The `prod.snd` projection, as a monotone function. -/
def prod.snd {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] : α × β →ₘ β :=
  mk prod.snd sorry

/-- The `prod` constructor, as a monotone function. -/
@[simp] theorem prod.zip_to_fun {α : Type u_1} {β : Type u_2} {γ : Type u_3} [preorder α] [preorder β] [preorder γ] (f : α →ₘ β) (g : α →ₘ γ) : ∀ (ᾰ : α), coe_fn (prod.zip f g) ᾰ = (coe_fn f ᾰ, coe_fn g ᾰ) :=
  fun (ᾰ : α) => Eq.refl (coe_fn f ᾰ, coe_fn g ᾰ)

/-- `roption.bind` as a monotone function -/
@[simp] theorem bind_to_fun {α : Type u_1} [preorder α] {β : Type u_2} {γ : Type u_2} (f : α →ₘ roption β) (g : α →ₘ β → roption γ) (x : α) : coe_fn (bind f g) x = coe_fn f x >>= coe_fn g x :=
  Eq.refl (coe_fn (bind f g) x)

end preorder_hom

namespace omega_complete_partial_order

/-- A chain is a monotonically increasing sequence.

See the definition on page 114 of [gunter]. -/
def chain (α : Type u) [preorder α] :=
  ℕ →ₘ α

namespace chain

protected instance has_coe_to_fun {α : Type u} [preorder α] : has_coe_to_fun (chain α) :=
  infer_instance

protected instance inhabited {α : Type u} [preorder α] [Inhabited α] : Inhabited (chain α) :=
  { default := preorder_hom.mk (fun (_x : ℕ) => Inhabited.default) sorry }

protected instance has_mem {α : Type u} [preorder α] : has_mem α (chain α) :=
  has_mem.mk fun (a : α) (c : ℕ →ₘ α) => ∃ (i : ℕ), a = coe_fn c i

protected instance has_le {α : Type u} [preorder α] : HasLessEq (chain α) :=
  { LessEq := fun (x y : chain α) => ∀ (i : ℕ), ∃ (j : ℕ), coe_fn x i ≤ coe_fn y j }

/-- `map` function for `chain` -/
@[simp] theorem map_to_fun {α : Type u} {β : Type v} [preorder α] [preorder β] (c : chain α) (f : α →ₘ β) : ∀ (ᾰ : ℕ), coe_fn (map c f) ᾰ = coe_fn f (coe_fn c ᾰ) :=
  fun (ᾰ : ℕ) => Eq.refl (coe_fn f (coe_fn c ᾰ))

theorem mem_map {α : Type u} {β : Type v} [preorder α] [preorder β] (c : chain α) {f : α →ₘ β} (x : α) : x ∈ c → coe_fn f x ∈ map c f := sorry

theorem exists_of_mem_map {α : Type u} {β : Type v} [preorder α] [preorder β] (c : chain α) {f : α →ₘ β} {b : β} : b ∈ map c f → ∃ (a : α), a ∈ c ∧ coe_fn f a = b := sorry

theorem mem_map_iff {α : Type u} {β : Type v} [preorder α] [preorder β] (c : chain α) {f : α →ₘ β} {b : β} : b ∈ map c f ↔ ∃ (a : α), a ∈ c ∧ coe_fn f a = b := sorry

@[simp] theorem map_id {α : Type u} [preorder α] (c : chain α) : map c preorder_hom.id = c :=
  preorder_hom.comp_id c

theorem map_comp {α : Type u} {β : Type v} {γ : Type u_1} [preorder α] [preorder β] [preorder γ] (c : chain α) {f : α →ₘ β} (g : β →ₘ γ) : map (map c f) g = map c (preorder_hom.comp g f) :=
  rfl

theorem map_le_map {α : Type u} {β : Type v} [preorder α] [preorder β] (c : chain α) {f : α →ₘ β} {g : α →ₘ β} (h : f ≤ g) : map c f ≤ map c g := sorry

/-- `chain.zip` pairs up the elements of two chains that have the same index -/
@[simp] theorem zip_to_fun {α : Type u} {β : Type v} [preorder α] [preorder β] (c₀ : chain α) (c₁ : chain β) : ∀ (ᾰ : ℕ), coe_fn (zip c₀ c₁) ᾰ = (coe_fn c₀ ᾰ, coe_fn c₁ ᾰ) :=
  fun (ᾰ : ℕ) => Eq.refl (coe_fn c₀ ᾰ, coe_fn c₁ ᾰ)

end chain

end omega_complete_partial_order

/-- An omega-complete partial order is a partial order with a supremum
operation on increasing sequences indexed by natural numbers (which we
call `ωSup`). In this sense, it is strictly weaker than join complete
semi-lattices as only ω-sized totally ordered sets have a supremum.

See the definition on page 114 of [gunter]. -/
class omega_complete_partial_order (α : Type u_1)
extends partial_order α
where
  ωSup : omega_complete_partial_order.chain α → α
  le_ωSup : ∀ (c : omega_complete_partial_order.chain α) (i : ℕ), coe_fn c i ≤ ωSup c
  ωSup_le : ∀ (c : omega_complete_partial_order.chain α) (x : α), (∀ (i : ℕ), coe_fn c i ≤ x) → ωSup c ≤ x

namespace omega_complete_partial_order

/-- Transfer a `omega_complete_partial_order` on `β` to a `omega_complete_partial_order` on `α` using
a strictly monotone function `f : β →ₘ α`, a definition of ωSup and a proof that `f` is continuous
with regard to the provided `ωSup` and the ωCPO on `α`. -/
protected def lift {α : Type u} {β : Type v} [omega_complete_partial_order α] [partial_order β] (f : β →ₘ α) (ωSup₀ : chain β → β) (h : ∀ (x y : β), coe_fn f x ≤ coe_fn f y → x ≤ y) (h' : ∀ (c : chain β), coe_fn f (ωSup₀ c) = ωSup (chain.map c f)) : omega_complete_partial_order β :=
  mk ωSup₀ sorry sorry

theorem le_ωSup_of_le {α : Type u} [omega_complete_partial_order α] {c : chain α} {x : α} (i : ℕ) (h : x ≤ coe_fn c i) : x ≤ ωSup c :=
  le_trans h (le_ωSup c i)

theorem ωSup_total {α : Type u} [omega_complete_partial_order α] {c : chain α} {x : α} (h : ∀ (i : ℕ), coe_fn c i ≤ x ∨ x ≤ coe_fn c i) : ωSup c ≤ x ∨ x ≤ ωSup c := sorry

theorem ωSup_le_ωSup_of_le {α : Type u} [omega_complete_partial_order α] {c₀ : chain α} {c₁ : chain α} (h : c₀ ≤ c₁) : ωSup c₀ ≤ ωSup c₁ :=
  ωSup_le c₀ (ωSup c₁)
    fun (i : ℕ) => Exists.rec_on (h i) fun (j : ℕ) (h : coe_fn c₀ i ≤ coe_fn c₁ j) => le_trans h (le_ωSup c₁ j)

theorem ωSup_le_iff {α : Type u} [omega_complete_partial_order α] (c : chain α) (x : α) : ωSup c ≤ x ↔ ∀ (i : ℕ), coe_fn c i ≤ x :=
  { mp := fun (ᾰ : ωSup c ≤ x) (i : ℕ) => le_trans (le_ωSup c i) ᾰ,
    mpr := fun (ᾰ : ∀ (i : ℕ), coe_fn c i ≤ x) => ωSup_le c x ᾰ }

/-- A subset `p : α → Prop` of the type closed under `ωSup` induces an
`omega_complete_partial_order` on the subtype `{a : α // p a}`. -/
def subtype {α : Type u_1} [omega_complete_partial_order α] (p : α → Prop) (hp : ∀ (c : chain α), (∀ (i : α), i ∈ c → p i) → p (ωSup c)) : omega_complete_partial_order (Subtype p) :=
  omega_complete_partial_order.lift (preorder_hom.subtype.val p)
    (fun (c : chain (Subtype p)) => { val := ωSup (chain.map c (preorder_hom.subtype.val p)), property := sorry }) sorry
    sorry

/-- A monotone function `f : α →ₘ β` is continuous if it distributes over ωSup.

In order to distinguish it from the (more commonly used) continuity from topology
(see topology/basic.lean), the present definition is often referred to as
"Scott-continuity" (referring to Dana Scott). It corresponds to continuity
in Scott topological spaces (not defined here). -/
def continuous {α : Type u} {β : Type v} [omega_complete_partial_order α] [omega_complete_partial_order β] (f : α →ₘ β) :=
  ∀ (c : chain α), coe_fn f (ωSup c) = ωSup (chain.map c f)

/-- `continuous' f` asserts that `f` is both monotone and continuous. -/
def continuous' {α : Type u} {β : Type v} [omega_complete_partial_order α] [omega_complete_partial_order β] (f : α → β) :=
  ∃ (hf : monotone f), continuous (preorder_hom.mk f hf)

theorem continuous.to_monotone {α : Type u} {β : Type v} [omega_complete_partial_order α] [omega_complete_partial_order β] {f : α → β} (hf : continuous' f) : monotone f :=
  Exists.fst hf

theorem continuous.of_bundled {α : Type u} {β : Type v} [omega_complete_partial_order α] [omega_complete_partial_order β] (f : α → β) (hf : monotone f) (hf' : continuous (preorder_hom.mk f hf)) : continuous' f :=
  Exists.intro hf hf'

theorem continuous.of_bundled' {α : Type u} {β : Type v} [omega_complete_partial_order α] [omega_complete_partial_order β] (f : α →ₘ β) (hf' : continuous f) : continuous' ⇑f :=
  Exists.intro (preorder_hom.monotone f) hf'

theorem continuous.to_bundled {α : Type u} {β : Type v} [omega_complete_partial_order α] [omega_complete_partial_order β] (f : α → β) (hf : continuous' f) : continuous (preorder_hom.mk f (continuous.to_monotone hf)) :=
  Exists.snd hf

theorem continuous_id {α : Type u} [omega_complete_partial_order α] : continuous preorder_hom.id := sorry

theorem continuous_comp {α : Type u} {β : Type v} {γ : Type u_1} [omega_complete_partial_order α] [omega_complete_partial_order β] [omega_complete_partial_order γ] (f : α →ₘ β) (g : β →ₘ γ) (hfc : continuous f) (hgc : continuous g) : continuous (preorder_hom.comp g f) := sorry

theorem id_continuous' {α : Type u} [omega_complete_partial_order α] : continuous' id := sorry

theorem const_continuous' {α : Type u} {β : Type v} [omega_complete_partial_order α] [omega_complete_partial_order β] (x : β) : continuous' (function.const α x) := sorry

end omega_complete_partial_order

namespace roption

theorem eq_of_chain {α : Type u} {c : omega_complete_partial_order.chain (roption α)} {a : α} {b : α} (ha : some a ∈ c) (hb : some b ∈ c) : a = b := sorry

/-- The (noncomputable) `ωSup` definition for the `ω`-CPO structure on `roption α`. -/
protected def ωSup {α : Type u} (c : omega_complete_partial_order.chain (roption α)) : roption α :=
  dite (∃ (a : α), some a ∈ c) (fun (h : ∃ (a : α), some a ∈ c) => some (classical.some h))
    fun (h : ¬∃ (a : α), some a ∈ c) => none

theorem ωSup_eq_some {α : Type u} {c : omega_complete_partial_order.chain (roption α)} {a : α} (h : some a ∈ c) : roption.ωSup c = some a := sorry

theorem ωSup_eq_none {α : Type u} {c : omega_complete_partial_order.chain (roption α)} (h : ¬∃ (a : α), some a ∈ c) : roption.ωSup c = none :=
  dif_neg h

theorem mem_chain_of_mem_ωSup {α : Type u} {c : omega_complete_partial_order.chain (roption α)} {a : α} (h : a ∈ roption.ωSup c) : some a ∈ c := sorry

protected instance omega_complete_partial_order {α : Type u} : omega_complete_partial_order (roption α) :=
  omega_complete_partial_order.mk roption.ωSup sorry sorry

theorem mem_ωSup {α : Type u} (x : α) (c : omega_complete_partial_order.chain (roption α)) : x ∈ omega_complete_partial_order.ωSup c ↔ some x ∈ c := sorry

end roption

namespace pi

/-- Function application `λ f, f a` is monotone with respect to `f` for fixed `a`. -/
def monotone_apply {α : Type u_1} {β : α → Type u_2} [(a : α) → partial_order (β a)] (a : α) : ((a : α) → β a) →ₘ β a :=
  preorder_hom.mk (fun (f : (a : α) → β a) => f a) sorry

protected instance omega_complete_partial_order {α : Type u_1} {β : α → Type u_2} [(a : α) → omega_complete_partial_order (β a)] : omega_complete_partial_order ((a : α) → β a) :=
  omega_complete_partial_order.mk
    (fun (c : omega_complete_partial_order.chain ((a : α) → β a)) (a : α) =>
      omega_complete_partial_order.ωSup (omega_complete_partial_order.chain.map c (monotone_apply a)))
    sorry sorry

namespace omega_complete_partial_order

theorem flip₁_continuous' {α : Type u_1} {β : α → Type u_2} {γ : Type u_3} [(x : α) → omega_complete_partial_order (β x)] [omega_complete_partial_order γ] (f : (x : α) → γ → β x) (a : α) (hf : omega_complete_partial_order.continuous' fun (x : γ) (y : α) => f y x) : omega_complete_partial_order.continuous' (f a) := sorry

theorem flip₂_continuous' {α : Type u_1} {β : α → Type u_2} {γ : Type u_3} [(x : α) → omega_complete_partial_order (β x)] [omega_complete_partial_order γ] (f : γ → (x : α) → β x) (hf : ∀ (x : α), omega_complete_partial_order.continuous' fun (g : γ) => f g x) : omega_complete_partial_order.continuous' f := sorry

end omega_complete_partial_order

end pi

namespace prod

/-- The supremum of a chain in the product `ω`-CPO. -/
protected def ωSup {α : Type u_1} {β : Type u_2} [omega_complete_partial_order α] [omega_complete_partial_order β] (c : omega_complete_partial_order.chain (α × β)) : α × β :=
  (omega_complete_partial_order.ωSup (omega_complete_partial_order.chain.map c preorder_hom.prod.fst),
  omega_complete_partial_order.ωSup (omega_complete_partial_order.chain.map c preorder_hom.prod.snd))

protected instance omega_complete_partial_order {α : Type u_1} {β : Type u_2} [omega_complete_partial_order α] [omega_complete_partial_order β] : omega_complete_partial_order (α × β) :=
  omega_complete_partial_order.mk prod.ωSup sorry sorry

end prod

namespace complete_lattice

/-- Any complete lattice has an `ω`-CPO structure where the countable supremum is a special case
of arbitrary suprema. -/
protected instance omega_complete_partial_order (α : Type u) [complete_lattice α] : omega_complete_partial_order α :=
  omega_complete_partial_order.mk (fun (c : omega_complete_partial_order.chain α) => supr fun (i : ℕ) => coe_fn c i) sorry
    sorry

theorem inf_continuous {α : Type u} {β : Type v} [omega_complete_partial_order α] [complete_lattice β] [is_total β LessEq] (f : α →ₘ β) (g : α →ₘ β) (hf : omega_complete_partial_order.continuous f) (hg : omega_complete_partial_order.continuous g) : omega_complete_partial_order.continuous (f ⊓ g) := sorry

theorem Sup_continuous {α : Type u} {β : Type v} [omega_complete_partial_order α] [complete_lattice β] (s : set (α →ₘ β)) (hs : ∀ (f : α →ₘ β), f ∈ s → omega_complete_partial_order.continuous f) : omega_complete_partial_order.continuous (Sup s) := sorry

theorem Sup_continuous' {α : Type u} {β : Type v} [omega_complete_partial_order α] [complete_lattice β] (s : set (α → β)) : (∀ (t : α → β), t ∈ s → omega_complete_partial_order.continuous' t) → omega_complete_partial_order.continuous' (Sup s) := sorry

theorem sup_continuous {α : Type u} {β : Type v} [omega_complete_partial_order α] [complete_lattice β] {f : α →ₘ β} {g : α →ₘ β} (hf : omega_complete_partial_order.continuous f) (hg : omega_complete_partial_order.continuous g) : omega_complete_partial_order.continuous (f ⊔ g) := sorry

theorem top_continuous {α : Type u} {β : Type v} [omega_complete_partial_order α] [complete_lattice β] : omega_complete_partial_order.continuous ⊤ := sorry

theorem bot_continuous {α : Type u} {β : Type v} [omega_complete_partial_order α] [complete_lattice β] : omega_complete_partial_order.continuous ⊥ := sorry

end complete_lattice

namespace omega_complete_partial_order

namespace preorder_hom

/-- Function application `λ f, f a` (for fixed `a`) is a monotone function from the
monotone function space `α →ₘ β` to `β`. -/
def monotone_apply {α : Type u} {β : Type v} [omega_complete_partial_order α] [omega_complete_partial_order β] (a : α) : (α →ₘ β) →ₘ β :=
  preorder_hom.mk (fun (f : α →ₘ β) => coe_fn f a) sorry

/-- The "forgetful functor" from `α →ₘ β` to `α → β` that takes the underlying function,
is monotone. -/
def to_fun_hom {α : Type u} {β : Type v} [omega_complete_partial_order α] [omega_complete_partial_order β] : (α →ₘ β) →ₘ α → β :=
  preorder_hom.mk (fun (f : α →ₘ β) => preorder_hom.to_fun f) sorry

/-- The `ωSup` operator for monotone functions. -/
@[simp] theorem ωSup_to_fun {α : Type u} {β : Type v} [omega_complete_partial_order α] [omega_complete_partial_order β] (c : chain (α →ₘ β)) (a : α) : coe_fn (preorder_hom.ωSup c) a = ωSup (chain.map c (monotone_apply a)) :=
  Eq.refl (coe_fn (preorder_hom.ωSup c) a)

protected instance omega_complete_partial_order {α : Type u} {β : Type v} [omega_complete_partial_order α] [omega_complete_partial_order β] : omega_complete_partial_order (α →ₘ β) :=
  omega_complete_partial_order.lift to_fun_hom preorder_hom.ωSup sorry sorry

end preorder_hom

/-- A monotone function on `ω`-continuous partial orders is said to be continuous
if for every chain `c : chain α`, `f (⊔ i, c i) = ⊔ i, f (c i)`.
This is just the bundled version of `preorder_hom.continuous`. -/
structure continuous_hom (α : Type u) (β : Type v) [omega_complete_partial_order α] [omega_complete_partial_order β]
extends α →ₘ β
where
  cont : continuous (preorder_hom.mk to_fun monotone')

infixr:25 " →𝒄 " => Mathlib.omega_complete_partial_order.continuous_hom

protected instance continuous_hom.has_coe_to_fun (α : Type u) (β : Type v) [omega_complete_partial_order α] [omega_complete_partial_order β] : has_coe_to_fun (α →𝒄 β) :=
  has_coe_to_fun.mk (fun (_x : α →𝒄 β) => α → β) continuous_hom.to_fun

protected instance preorder_hom.has_coe (α : Type u) (β : Type v) [omega_complete_partial_order α] [omega_complete_partial_order β] : has_coe (α →𝒄 β) (α →ₘ β) :=
  has_coe.mk continuous_hom.to_preorder_hom

protected instance continuous_hom.partial_order (α : Type u) (β : Type v) [omega_complete_partial_order α] [omega_complete_partial_order β] : partial_order (α →𝒄 β) :=
  partial_order.lift continuous_hom.to_fun sorry

namespace continuous_hom

theorem congr_fun {α : Type u} {β : Type v} [omega_complete_partial_order α] [omega_complete_partial_order β] {f : α →𝒄 β} {g : α →𝒄 β} (h : f = g) (x : α) : coe_fn f x = coe_fn g x :=
  congr_arg (fun (h : α →𝒄 β) => coe_fn h x) h

theorem congr_arg {α : Type u} {β : Type v} [omega_complete_partial_order α] [omega_complete_partial_order β] (f : α →𝒄 β) {x : α} {y : α} (h : x = y) : coe_fn f x = coe_fn f y :=
  congr_arg (fun (x : α) => coe_fn f x) h

theorem monotone {α : Type u} {β : Type v} [omega_complete_partial_order α] [omega_complete_partial_order β] (f : α →𝒄 β) : monotone ⇑f :=
  monotone' f

theorem ite_continuous' {α : Type u} {β : Type v} [omega_complete_partial_order α] [omega_complete_partial_order β] {p : Prop} [hp : Decidable p] (f : α → β) (g : α → β) (hf : continuous' f) (hg : continuous' g) : continuous' fun (x : α) => ite p (f x) (g x) := sorry

theorem ωSup_bind {α : Type u} [omega_complete_partial_order α] {β : Type v} {γ : Type v} (c : chain α) (f : α →ₘ roption β) (g : α →ₘ β → roption γ) : ωSup (chain.map c (preorder_hom.bind f g)) = ωSup (chain.map c f) >>= ωSup (chain.map c g) := sorry

theorem bind_continuous' {α : Type u} [omega_complete_partial_order α] {β : Type v} {γ : Type v} (f : α → roption β) (g : α → β → roption γ) : continuous' f → continuous' g → continuous' fun (x : α) => f x >>= g x := sorry

theorem map_continuous' {α : Type u} [omega_complete_partial_order α] {β : Type v} {γ : Type v} (f : β → γ) (g : α → roption β) (hg : continuous' g) : continuous' fun (x : α) => f <$> g x := sorry

theorem seq_continuous' {α : Type u} [omega_complete_partial_order α] {β : Type v} {γ : Type v} (f : α → roption (β → γ)) (g : α → roption β) (hf : continuous' f) (hg : continuous' g) : continuous' fun (x : α) => f x <*> g x := sorry

theorem continuous {α : Type u} {β : Type v} [omega_complete_partial_order α] [omega_complete_partial_order β] (F : α →𝒄 β) (C : chain α) : coe_fn F (ωSup C) = ωSup (chain.map C ↑F) :=
  cont F C

/-- Construct a continuous function from a bare function, a continuous function, and a proof that
they are equal. -/
def of_fun {α : Type u} {β : Type v} [omega_complete_partial_order α] [omega_complete_partial_order β] (f : α → β) (g : α →𝒄 β) (h : f = ⇑g) : α →𝒄 β :=
  mk f sorry sorry

/-- Construct a continuous function from a monotone function with a proof of continuity. -/
def of_mono {α : Type u} {β : Type v} [omega_complete_partial_order α] [omega_complete_partial_order β] (f : α →ₘ β) (h : ∀ (c : chain α), coe_fn f (ωSup c) = ωSup (chain.map c f)) : α →𝒄 β :=
  mk ⇑f sorry h

/-- The identity as a continuous function. -/
@[simp] theorem id_to_fun {α : Type u} [omega_complete_partial_order α] : ∀ (ᾰ : α), coe_fn id ᾰ = ᾰ :=
  fun (ᾰ : α) => Eq.refl ᾰ

/-- The composition of continuous functions. -/
def comp {α : Type u} {β : Type v} {γ : Type u_3} [omega_complete_partial_order α] [omega_complete_partial_order β] [omega_complete_partial_order γ] (f : β →𝒄 γ) (g : α →𝒄 β) : α →𝒄 γ :=
  of_mono (preorder_hom.comp ↑f ↑g) sorry

protected theorem ext {α : Type u} {β : Type v} [omega_complete_partial_order α] [omega_complete_partial_order β] (f : α →𝒄 β) (g : α →𝒄 β) (h : ∀ (x : α), coe_fn f x = coe_fn g x) : f = g := sorry

protected theorem coe_inj {α : Type u} {β : Type v} [omega_complete_partial_order α] [omega_complete_partial_order β] (f : α →𝒄 β) (g : α →𝒄 β) (h : ⇑f = ⇑g) : f = g :=
  continuous_hom.ext f g (congr_fun h)

@[simp] theorem comp_id {β : Type v} {γ : Type u_3} [omega_complete_partial_order β] [omega_complete_partial_order γ] (f : β →𝒄 γ) : comp f id = f :=
  continuous_hom.ext (comp f id) f fun (x : β) => Eq.refl (coe_fn (comp f id) x)

@[simp] theorem id_comp {β : Type v} {γ : Type u_3} [omega_complete_partial_order β] [omega_complete_partial_order γ] (f : β →𝒄 γ) : comp id f = f :=
  continuous_hom.ext (comp id f) f fun (x : β) => Eq.refl (coe_fn (comp id f) x)

@[simp] theorem comp_assoc {α : Type u} {β : Type v} {γ : Type u_3} {φ : Type u_4} [omega_complete_partial_order α] [omega_complete_partial_order β] [omega_complete_partial_order γ] [omega_complete_partial_order φ] (f : γ →𝒄 φ) (g : β →𝒄 γ) (h : α →𝒄 β) : comp f (comp g h) = comp (comp f g) h :=
  continuous_hom.ext (comp f (comp g h)) (comp (comp f g) h) fun (x : α) => Eq.refl (coe_fn (comp f (comp g h)) x)

@[simp] theorem coe_apply {α : Type u} {β : Type v} [omega_complete_partial_order α] [omega_complete_partial_order β] (a : α) (f : α →𝒄 β) : coe_fn (↑f) a = coe_fn f a :=
  rfl

/-- `function.const` is a continuous function. -/
def const {α : Type u} {β : Type v} [omega_complete_partial_order α] [omega_complete_partial_order β] (f : β) : α →𝒄 β :=
  of_mono (preorder_hom.const α f) sorry

@[simp] theorem const_apply {α : Type u} {β : Type v} [omega_complete_partial_order α] [omega_complete_partial_order β] (f : β) (a : α) : coe_fn (const f) a = f :=
  rfl

protected instance inhabited {α : Type u} {β : Type v} [omega_complete_partial_order α] [omega_complete_partial_order β] [Inhabited β] : Inhabited (α →𝒄 β) :=
  { default := const Inhabited.default }

namespace prod

/-- The application of continuous functions as a monotone function.

(It would make sense to make it a continuous function, but we are currently constructing a
`omega_complete_partial_order` instance for `α →𝒄 β`, and we cannot use it as the domain or image
of a continuous function before we do.) -/
def apply {α : Type u} {β : Type v} [omega_complete_partial_order α] [omega_complete_partial_order β] : (α →𝒄 β) × α →ₘ β :=
  preorder_hom.mk (fun (f : (α →𝒄 β) × α) => coe_fn (prod.fst f) (prod.snd f)) sorry

end prod

/-- The map from continuous functions to monotone functions is itself a monotone function. -/
@[simp] theorem to_mono_to_fun {α : Type u} {β : Type v} [omega_complete_partial_order α] [omega_complete_partial_order β] (f : α →𝒄 β) : coe_fn to_mono f = ↑f :=
  Eq.refl (coe_fn to_mono f)

/-- When proving that a chain of applications is below a bound `z`, it suffices to consider the
functions and values being selected from the same index in the chains.

This lemma is more specific than necessary, i.e. `c₀` only needs to be a
chain of monotone functions, but it is only used with continuous functions. -/
@[simp] theorem forall_forall_merge {α : Type u} {β : Type v} [omega_complete_partial_order α] [omega_complete_partial_order β] (c₀ : chain (α →𝒄 β)) (c₁ : chain α) (z : β) : (∀ (i j : ℕ), coe_fn (coe_fn c₀ i) (coe_fn c₁ j) ≤ z) ↔ ∀ (i : ℕ), coe_fn (coe_fn c₀ i) (coe_fn c₁ i) ≤ z := sorry

@[simp] theorem forall_forall_merge' {α : Type u} {β : Type v} [omega_complete_partial_order α] [omega_complete_partial_order β] (c₀ : chain (α →𝒄 β)) (c₁ : chain α) (z : β) : (∀ (j i : ℕ), coe_fn (coe_fn c₀ i) (coe_fn c₁ j) ≤ z) ↔ ∀ (i : ℕ), coe_fn (coe_fn c₀ i) (coe_fn c₁ i) ≤ z := sorry

/-- The `ωSup` operator for continuous functions, which takes the pointwise countable supremum
of the functions in the `ω`-chain. -/
protected def ωSup {α : Type u} {β : Type v} [omega_complete_partial_order α] [omega_complete_partial_order β] (c : chain (α →𝒄 β)) : α →𝒄 β :=
  of_mono (ωSup (chain.map c to_mono)) sorry

protected instance omega_complete_partial_order {α : Type u} {β : Type v} [omega_complete_partial_order α] [omega_complete_partial_order β] : omega_complete_partial_order (α →𝒄 β) :=
  omega_complete_partial_order.lift to_mono continuous_hom.ωSup sorry sorry

theorem ωSup_def {α : Type u} {β : Type v} [omega_complete_partial_order α] [omega_complete_partial_order β] (c : chain (α →𝒄 β)) (x : α) : coe_fn (ωSup c) x = coe_fn (continuous_hom.ωSup c) x :=
  rfl

theorem ωSup_ωSup {α : Type u} {β : Type v} [omega_complete_partial_order α] [omega_complete_partial_order β] (c₀ : chain (α →𝒄 β)) (c₁ : chain α) : coe_fn (ωSup c₀) (ωSup c₁) = ωSup (preorder_hom.comp prod.apply (chain.zip c₀ c₁)) := sorry

/-- A family of continuous functions yields a continuous family of functions. -/
def flip {β : Type v} {γ : Type u_3} [omega_complete_partial_order β] [omega_complete_partial_order γ] {α : Type u_1} (f : α → β →𝒄 γ) : β →𝒄 α → γ :=
  mk (fun (x : β) (y : α) => coe_fn (f y) x) sorry sorry

/-- `roption.bind` as a continuous function. -/
def bind {α : Type u} [omega_complete_partial_order α] {β : Type v} {γ : Type v} (f : α →𝒄 roption β) (g : α →𝒄 β → roption γ) : α →𝒄 roption γ :=
  of_mono (preorder_hom.bind ↑f ↑g) sorry

/-- `roption.map` as a continuous function. -/
@[simp] theorem map_to_fun {α : Type u} [omega_complete_partial_order α] {β : Type v} {γ : Type v} (f : β → γ) (g : α →𝒄 roption β) (x : α) : coe_fn (map f g) x = f <$> coe_fn g x :=
  Eq.refl (coe_fn (map f g) x)

/-- `roption.seq` as a continuous function. -/
def seq {α : Type u} [omega_complete_partial_order α] {β : Type v} {γ : Type v} (f : α →𝒄 roption (β → γ)) (g : α →𝒄 roption β) : α →𝒄 roption γ :=
  of_fun (fun (x : α) => coe_fn f x <*> coe_fn g x) (bind f (flip (flip map g))) sorry


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

universes u_1 u_3 u u_2 u_4 u_5

namespace Mathlib

/-!
# 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`.

-/

/-- Pullback a `mul_zero_class` instance along an injective function. -/
protected def function.injective.mul_zero_class {M₀ : Type u_1} {M₀' : Type u_3} [mul_zero_class M₀] [Mul M₀'] [HasZero M₀'] (f : M₀' → M₀) (hf : function.injective f) (zero : f 0 = 0) (mul : ∀ (a b : M₀'), f (a * b) = f a * f b) : mul_zero_class M₀' :=
  mul_zero_class.mk Mul.mul 0 sorry sorry

/-- Pushforward a `mul_zero_class` instance along an surjective function. -/
protected def function.surjective.mul_zero_class {M₀ : Type u_1} {M₀' : Type u_3} [mul_zero_class M₀] [Mul M₀'] [HasZero M₀'] (f : M₀ → M₀') (hf : function.surjective f) (zero : f 0 = 0) (mul : ∀ (a b : M₀), f (a * b) = f a * f b) : mul_zero_class M₀' :=
  mul_zero_class.mk Mul.mul 0 sorry sorry

theorem mul_eq_zero_of_left {M₀ : Type u_1} [mul_zero_class M₀] {a : M₀} (h : a = 0) (b : M₀) : a * b = 0 :=
  Eq.symm h ▸ zero_mul b

theorem mul_eq_zero_of_right {M₀ : Type u_1} [mul_zero_class M₀] {b : M₀} (a : M₀) (h : b = 0) : a * b = 0 :=
  Eq.symm h ▸ mul_zero a

theorem left_ne_zero_of_mul {M₀ : Type u_1} [mul_zero_class M₀] {a : M₀} {b : M₀} : a * b ≠ 0 → a ≠ 0 :=
  mt fun (h : a = 0) => mul_eq_zero_of_left h b

theorem right_ne_zero_of_mul {M₀ : Type u_1} [mul_zero_class M₀] {a : M₀} {b : M₀} : a * b ≠ 0 → b ≠ 0 :=
  mt (mul_eq_zero_of_right a)

theorem ne_zero_and_ne_zero_of_mul {M₀ : Type u_1} [mul_zero_class M₀] {a : M₀} {b : M₀} (h : a * b ≠ 0) : a ≠ 0 ∧ b ≠ 0 :=
  { left := left_ne_zero_of_mul h, right := right_ne_zero_of_mul h }

theorem mul_eq_zero_of_ne_zero_imp_eq_zero {M₀ : Type u_1} [mul_zero_class M₀] {a : M₀} {b : M₀} (h : a ≠ 0 → b = 0) : a * b = 0 := sorry

/-- Pushforward a `no_zero_divisors` instance along an injective function. -/
protected theorem function.injective.no_zero_divisors {M₀ : Type u_1} {M₀' : Type u_3} [Mul M₀] [HasZero M₀] [Mul M₀'] [HasZero M₀'] [no_zero_divisors M₀'] (f : M₀ → M₀') (hf : function.injective f) (zero : f 0 = 0) (mul : ∀ (x y : M₀), f (x * y) = f x * f y) : no_zero_divisors M₀ := sorry

theorem eq_zero_of_mul_self_eq_zero {M₀ : Type u_1} [Mul M₀] [HasZero M₀] [no_zero_divisors M₀] {a : M₀} (h : a * a = 0) : a = 0 :=
  or.elim (eq_zero_or_eq_zero_of_mul_eq_zero h) id id

/-- If `α` has no zero divisors, then the product of two elements equals zero iff one of them
equals zero. -/
@[simp] theorem mul_eq_zero {M₀ : Type u_1} [mul_zero_class M₀] [no_zero_divisors M₀] {a : M₀} {b : M₀} : a * b = 0 ↔ a = 0 ∨ b = 0 :=
  { mp := eq_zero_or_eq_zero_of_mul_eq_zero,
    mpr := fun (o : a = 0 ∨ b = 0) => or.elim o (fun (h : a = 0) => 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 {M₀ : Type u_1} [mul_zero_class M₀] [no_zero_divisors M₀] {a : M₀} {b : M₀} : 0 = a * b ↔ a = 0 ∨ b = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (0 = a * b ↔ a = 0 ∨ b = 0)) (propext eq_comm)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * b = 0 ↔ a = 0 ∨ b = 0)) (propext mul_eq_zero))) (iff.refl (a = 0 ∨ b = 0)))

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

theorem mul_ne_zero {M₀ : Type u_1} [mul_zero_class M₀] [no_zero_divisors M₀] {a : M₀} {b : M₀} (ha : a ≠ 0) (hb : b ≠ 0) : a * b ≠ 0 :=
  iff.mpr mul_ne_zero_iff { left := ha, right := 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 {M₀ : Type u_1} [mul_zero_class M₀] [no_zero_divisors M₀] {a : M₀} {b : M₀} : a * b = 0 ↔ b * a = 0 :=
  iff.trans mul_eq_zero (iff.trans (or_comm (a = 0) (b = 0)) (iff.symm mul_eq_zero))

/-- If `α` has no zero divisors, then for elements `a, b : α`, `a * b` is nonzero iff so is
`b * a`. -/
theorem mul_ne_zero_comm {M₀ : Type u_1} [mul_zero_class M₀] [no_zero_divisors M₀] {a : M₀} {b : M₀} : a * b ≠ 0 ↔ b * a ≠ 0 :=
  not_congr mul_eq_zero_comm

theorem mul_self_eq_zero {M₀ : Type u_1} [mul_zero_class M₀] [no_zero_divisors M₀] {a : M₀} : a * a = 0 ↔ a = 0 := sorry

theorem zero_eq_mul_self {M₀ : Type u_1} [mul_zero_class M₀] [no_zero_divisors M₀] {a : M₀} : 0 = a * a ↔ a = 0 := sorry

/-- In a nontrivial monoid with zero, zero and one are different. -/
@[simp] theorem zero_ne_one {M₀ : Type u_1} [monoid_with_zero M₀] [nontrivial M₀] : 0 ≠ 1 := sorry

@[simp] theorem one_ne_zero {M₀ : Type u_1} [monoid_with_zero M₀] [nontrivial M₀] : 1 ≠ 0 :=
  ne.symm zero_ne_one

theorem ne_zero_of_eq_one {M₀ : Type u_1} [monoid_with_zero M₀] [nontrivial M₀] {a : M₀} (h : a = 1) : a ≠ 0 :=
  trans_rel_right ne h one_ne_zero

theorem left_ne_zero_of_mul_eq_one {M₀ : Type u_1} [monoid_with_zero M₀] [nontrivial M₀] {a : M₀} {b : M₀} (h : a * b = 1) : a ≠ 0 :=
  left_ne_zero_of_mul (ne_zero_of_eq_one h)

theorem right_ne_zero_of_mul_eq_one {M₀ : Type u_1} [monoid_with_zero M₀] [nontrivial M₀] {a : M₀} {b : M₀} (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 theorem pullback_nonzero {M₀ : Type u_1} {M₀' : Type u_3} [monoid_with_zero M₀] [nontrivial M₀] [HasZero M₀'] [HasOne M₀'] (f : M₀' → M₀) (zero : f 0 = 0) (one : f 1 = 1) : nontrivial M₀' := sorry

/-- Pullback a `monoid_with_zero` class along an injective function. -/
protected def function.injective.monoid_with_zero {M₀ : Type u_1} {M₀' : Type u_3} [HasZero M₀'] [Mul M₀'] [HasOne M₀'] [monoid_with_zero M₀] (f : M₀' → M₀) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1) (mul : ∀ (x y : M₀'), f (x * y) = f x * f y) : monoid_with_zero M₀' :=
  monoid_with_zero.mk monoid.mul sorry monoid.one sorry sorry mul_zero_class.zero sorry sorry

/-- Pushforward a `monoid_with_zero` class along a surjective function. -/
protected def function.surjective.monoid_with_zero {M₀ : Type u_1} {M₀' : Type u_3} [HasZero M₀'] [Mul M₀'] [HasOne M₀'] [monoid_with_zero M₀] (f : M₀ → M₀') (hf : function.surjective f) (zero : f 0 = 0) (one : f 1 = 1) (mul : ∀ (x y : M₀), f (x * y) = f x * f y) : monoid_with_zero M₀' :=
  monoid_with_zero.mk monoid.mul sorry monoid.one sorry sorry mul_zero_class.zero sorry sorry

/-- Pullback a `monoid_with_zero` class along an injective function. -/
protected def function.injective.comm_monoid_with_zero {M₀ : Type u_1} {M₀' : Type u_3} [HasZero M₀'] [Mul M₀'] [HasOne M₀'] [comm_monoid_with_zero M₀] (f : M₀' → M₀) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1) (mul : ∀ (x y : M₀'), f (x * y) = f x * f y) : comm_monoid_with_zero M₀' :=
  comm_monoid_with_zero.mk comm_monoid.mul sorry comm_monoid.one sorry sorry sorry mul_zero_class.zero sorry sorry

/-- Pushforward a `monoid_with_zero` class along a surjective function. -/
protected def function.surjective.comm_monoid_with_zero {M₀ : Type u_1} {M₀' : Type u_3} [HasZero M₀'] [Mul M₀'] [HasOne M₀'] [comm_monoid_with_zero M₀] (f : M₀ → M₀') (hf : function.surjective f) (zero : f 0 = 0) (one : f 1 = 1) (mul : ∀ (x y : M₀), f (x * y) = f x * f y) : comm_monoid_with_zero M₀' :=
  comm_monoid_with_zero.mk comm_monoid.mul sorry comm_monoid.one sorry sorry sorry mul_zero_class.zero sorry sorry

namespace units

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

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

-- `nonzero M₀`.

@[simp] theorem mul_left_eq_zero {M₀ : Type u_1} [monoid_with_zero M₀] (u : units M₀) {a : M₀} : a * ↑u = 0 ↔ a = 0 := sorry

@[simp] theorem mul_right_eq_zero {M₀ : Type u_1} [monoid_with_zero M₀] (u : units M₀) {a : M₀} : ↑u * a = 0 ↔ a = 0 := sorry

end units

namespace is_unit

theorem ne_zero {M₀ : Type u_1} [monoid_with_zero M₀] [nontrivial M₀] {a : M₀} (ha : is_unit a) : a ≠ 0 :=
  (fun (_a : is_unit a) =>
      Exists.dcases_on _a fun (w : units M₀) (h : ↑w = a) => idRhs ((fun (_x : M₀) => _x ≠ 0) a) (h ▸ units.ne_zero w))
    ha

theorem mul_right_eq_zero {M₀ : Type u_1} [monoid_with_zero M₀] {a : M₀} {b : M₀} (ha : is_unit a) : a * b = 0 ↔ b = 0 := sorry

theorem mul_left_eq_zero {M₀ : Type u_1} [monoid_with_zero M₀] {a : M₀} {b : M₀} (hb : is_unit b) : a * b = 0 ↔ a = 0 := sorry

end is_unit

/-- In a monoid with zero, if zero equals one, then zero is the only element. -/
theorem eq_zero_of_zero_eq_one {M₀ : Type u_1} [monoid_with_zero M₀] (h : 0 = 1) (a : M₀) : a = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a = 0)) (Eq.symm (mul_one a))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * 1 = 0)) (Eq.symm h)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a * 0 = 0)) (mul_zero a))) (Eq.refl 0)))

/-- 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 {M₀ : Type u_1} [monoid_with_zero M₀] (h : 0 = 1) : unique M₀ :=
  unique.mk { default := 0 } (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 {M₀ : Type u_1} [monoid_with_zero M₀] : 0 = 1 ↔ subsingleton M₀ :=
  { mp := fun (h : 0 = 1) => unique.subsingleton, mpr := fun (h : subsingleton M₀) => subsingleton.elim 0 1 }

theorem subsingleton_of_zero_eq_one {M₀ : Type u_1} [monoid_with_zero M₀] : 0 = 1 → subsingleton M₀ :=
  iff.mp subsingleton_iff_zero_eq_one

theorem eq_of_zero_eq_one {M₀ : Type u_1} [monoid_with_zero M₀] (h : 0 = 1) (a : M₀) (b : M₀) : a = b :=
  subsingleton.elim a b

@[simp] theorem is_unit_zero_iff {M₀ : Type u_1} [monoid_with_zero M₀] : is_unit 0 ↔ 0 = 1 := sorry

@[simp] theorem not_is_unit_zero {M₀ : Type u_1} [monoid_with_zero M₀] [nontrivial M₀] : ¬is_unit 0 :=
  mt (iff.mp is_unit_zero_iff) zero_ne_one

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

protected instance cancel_monoid_with_zero.to_no_zero_divisors {M₀ : Type u_1} [cancel_monoid_with_zero M₀] : no_zero_divisors M₀ :=
  no_zero_divisors.mk
    fun (a b : M₀) (ab0 : a * b = 0) =>
      dite (a = 0) (fun (h : a = 0) => Or.inl h)
        fun (h : ¬a = 0) =>
          Or.inr
            (cancel_monoid_with_zero.mul_left_cancel_of_ne_zero h
              (eq.mpr (id (Eq._oldrec (Eq.refl (a * b = a * 0)) ab0))
                (eq.mpr (id (Eq._oldrec (Eq.refl (0 = a * 0)) (mul_zero a))) (Eq.refl 0))))

theorem mul_left_inj' {M₀ : Type u_1} [cancel_monoid_with_zero M₀] {a : M₀} {b : M₀} {c : M₀} (hc : c ≠ 0) : a * c = b * c ↔ a = b :=
  { mp := mul_right_cancel' hc, mpr := fun (h : a = b) => h ▸ rfl }

theorem mul_right_inj' {M₀ : Type u_1} [cancel_monoid_with_zero M₀] {a : M₀} {b : M₀} {c : M₀} (ha : a ≠ 0) : a * b = a * c ↔ b = c :=
  { mp := mul_left_cancel' ha, mpr := fun (h : b = c) => h ▸ rfl }

@[simp] theorem mul_eq_mul_right_iff {M₀ : Type u_1} [cancel_monoid_with_zero M₀] {a : M₀} {b : M₀} {c : M₀} : a * c = b * c ↔ a = b ∨ c = 0 := sorry

@[simp] theorem mul_eq_mul_left_iff {M₀ : Type u_1} [cancel_monoid_with_zero M₀] {a : M₀} {b : M₀} {c : M₀} : a * b = a * c ↔ b = c ∨ a = 0 := sorry

/-- Pullback a `monoid_with_zero` class along an injective function. -/
protected def function.injective.cancel_monoid_with_zero {M₀ : Type u_1} {M₀' : Type u_3} [cancel_monoid_with_zero M₀] [HasZero M₀'] [Mul M₀'] [HasOne M₀'] (f : M₀' → M₀) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1) (mul : ∀ (x y : M₀'), f (x * y) = f x * f y) : cancel_monoid_with_zero M₀' :=
  cancel_monoid_with_zero.mk monoid.mul sorry monoid.one sorry sorry mul_zero_class.zero sorry sorry sorry sorry

/-- 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 {M₀ : Type u_1} [cancel_monoid_with_zero M₀] {a : M₀} {b : M₀} (h₁ : b ≠ 1) (h₂ : a * b = a) : a = 0 :=
  classical.by_contradiction fun (ha : ¬a = 0) => h₁ (mul_left_cancel' ha (Eq.symm h₂ ▸ Eq.symm (mul_one a)))

/-- 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 {M₀ : Type u_1} [cancel_monoid_with_zero M₀] {a : M₀} {b : M₀} (h₁ : b ≠ 1) (h₂ : b * a = a) : a = 0 :=
  classical.by_contradiction fun (ha : ¬a = 0) => h₁ (mul_right_cancel' ha (Eq.symm h₂ ▸ Eq.symm (one_mul a)))

theorem division_def {G : Type u} [div_inv_monoid G] (a : G) (b : G) : a / b = a * (b⁻¹) :=
  div_eq_mul_inv

/-- Pullback a `group_with_zero` class along an injective function. -/
protected def function.injective.group_with_zero {G₀ : Type u_2} {G₀' : Type u_4} [group_with_zero G₀] [HasZero G₀'] [Mul G₀'] [HasOne G₀'] [has_inv G₀'] (f : G₀' → G₀) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1) (mul : ∀ (x y : G₀'), f (x * y) = f x * f y) (inv : ∀ (x : G₀'), f (x⁻¹) = (f x⁻¹)) : group_with_zero G₀' :=
  group_with_zero.mk monoid_with_zero.mul sorry monoid_with_zero.one sorry sorry monoid_with_zero.zero sorry sorry
    has_inv.inv (div_inv_monoid.div._default monoid_with_zero.mul sorry monoid_with_zero.one sorry sorry has_inv.inv)
    sorry sorry sorry

/-- Pullback a `group_with_zero` class along an injective function. This is a version of
`function.injective.group_with_zero` that uses a specified `/` instead of the default
`a / b = a * b⁻¹`. -/
protected def function.injective.group_with_zero_div {G₀ : Type u_2} {G₀' : Type u_4} [group_with_zero G₀] [HasZero G₀'] [Mul G₀'] [HasOne G₀'] [has_inv G₀'] [Div G₀'] (f : G₀' → G₀) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1) (mul : ∀ (x y : G₀'), f (x * y) = f x * f y) (inv : ∀ (x : G₀'), f (x⁻¹) = (f x⁻¹)) (div : ∀ (x y : G₀'), f (x / y) = f x / f y) : group_with_zero G₀' :=
  group_with_zero.mk monoid_with_zero.mul sorry monoid_with_zero.one sorry sorry monoid_with_zero.zero sorry sorry
    div_inv_monoid.inv div_inv_monoid.div sorry sorry sorry

/-- Pushforward a `group_with_zero` class along an surjective function. -/
protected def function.surjective.group_with_zero {G₀ : Type u_2} {G₀' : Type u_4} [group_with_zero G₀] [HasZero G₀'] [Mul G₀'] [HasOne G₀'] [has_inv G₀'] (h01 : 0 ≠ 1) (f : G₀ → G₀') (hf : function.surjective f) (zero : f 0 = 0) (one : f 1 = 1) (mul : ∀ (x y : G₀), f (x * y) = f x * f y) (inv : ∀ (x : G₀), f (x⁻¹) = (f x⁻¹)) : group_with_zero G₀' :=
  group_with_zero.mk monoid_with_zero.mul sorry monoid_with_zero.one sorry sorry monoid_with_zero.zero sorry sorry
    has_inv.inv (div_inv_monoid.div._default monoid_with_zero.mul sorry monoid_with_zero.one sorry sorry has_inv.inv)
    sorry sorry sorry

/-- Pushforward a `group_with_zero` class along a surjective function. This is a version of
`function.surjective.group_with_zero` that uses a specified `/` instead of the default
`a / b = a * b⁻¹`. -/
protected def function.surjective.group_with_zero_div {G₀ : Type u_2} {G₀' : Type u_4} [group_with_zero G₀] [HasZero G₀'] [Mul G₀'] [HasOne G₀'] [has_inv G₀'] [Div G₀'] (h01 : 0 ≠ 1) (f : G₀ → G₀') (hf : function.surjective f) (zero : f 0 = 0) (one : f 1 = 1) (mul : ∀ (x y : G₀), f (x * y) = f x * f y) (inv : ∀ (x : G₀), f (x⁻¹) = (f x⁻¹)) (div : ∀ (x y : G₀), f (x / y) = f x / f y) : group_with_zero G₀' :=
  group_with_zero.mk div_inv_monoid.mul sorry div_inv_monoid.one sorry sorry group_with_zero.zero sorry sorry
    div_inv_monoid.inv div_inv_monoid.div sorry sorry sorry

@[simp] theorem mul_inv_cancel_right' {G₀ : Type u_2} [group_with_zero G₀] {b : G₀} (h : b ≠ 0) (a : G₀) : a * b * (b⁻¹) = a := sorry

@[simp] theorem mul_inv_cancel_left' {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} (h : a ≠ 0) (b : G₀) : a * (a⁻¹ * b) = b := sorry

theorem inv_ne_zero {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} (h : a ≠ 0) : a⁻¹ ≠ 0 := sorry

@[simp] theorem inv_mul_cancel {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} (h : a ≠ 0) : a⁻¹ * a = 1 := sorry

@[simp] theorem inv_mul_cancel_right' {G₀ : Type u_2} [group_with_zero G₀] {b : G₀} (h : b ≠ 0) (a : G₀) : a * (b⁻¹) * b = a := sorry

@[simp] theorem inv_mul_cancel_left' {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} (h : a ≠ 0) (b : G₀) : a⁻¹ * (a * b) = b := sorry

@[simp] theorem inv_one {G₀ : Type u_2} [group_with_zero G₀] : 1⁻¹ = 1 := sorry

@[simp] theorem inv_inv' {G₀ : Type u_2} [group_with_zero G₀] (a : G₀) : a⁻¹⁻¹ = a := sorry

/-- Multiplying `a` by itself and then by its inverse results in `a`
(whether or not `a` is zero). -/
@[simp] theorem mul_self_mul_inv {G₀ : Type u_2} [group_with_zero G₀] (a : G₀) : a * a * (a⁻¹) = a := sorry

/-- Multiplying `a` by its inverse and then by itself results in `a`
(whether or not `a` is zero). -/
@[simp] theorem mul_inv_mul_self {G₀ : Type u_2} [group_with_zero G₀] (a : G₀) : a * (a⁻¹) * a = a := sorry

/-- Multiplying `a⁻¹` by `a` twice results in `a` (whether or not `a`
is zero). -/
@[simp] theorem inv_mul_mul_self {G₀ : Type u_2} [group_with_zero G₀] (a : G₀) : a⁻¹ * a * a = a := sorry

/-- Multiplying `a` by itself and then dividing by itself results in
`a` (whether or not `a` is zero). -/
@[simp] theorem mul_self_div_self {G₀ : Type u_2} [group_with_zero G₀] (a : G₀) : a * a / a = a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * a / a = a)) (div_eq_mul_inv (a * a) a)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * a * (a⁻¹) = a)) (mul_self_mul_inv a))) (Eq.refl a))

/-- Dividing `a` by itself and then multiplying by itself results in
`a` (whether or not `a` is zero). -/
@[simp] theorem div_self_mul_self {G₀ : Type u_2} [group_with_zero G₀] (a : G₀) : a / a * a = a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a / a * a = a)) (div_eq_mul_inv a a)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * (a⁻¹) * a = a)) (mul_inv_mul_self a))) (Eq.refl a))

theorem inv_involutive' {G₀ : Type u_2} [group_with_zero G₀] : function.involutive has_inv.inv :=
  inv_inv'

theorem eq_inv_of_mul_right_eq_one {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} {b : G₀} (h : a * b = 1) : b = (a⁻¹) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (b = (a⁻¹))) (Eq.symm (inv_mul_cancel_left' (left_ne_zero_of_mul_eq_one h) b))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a⁻¹ * (a * b) = (a⁻¹))) h))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a⁻¹ * 1 = (a⁻¹))) (mul_one (a⁻¹)))) (Eq.refl (a⁻¹))))

theorem eq_inv_of_mul_left_eq_one {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} {b : G₀} (h : a * b = 1) : a = (b⁻¹) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a = (b⁻¹))) (Eq.symm (mul_inv_cancel_right' (right_ne_zero_of_mul_eq_one h) a))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * b * (b⁻¹) = (b⁻¹))) h))
      (eq.mpr (id (Eq._oldrec (Eq.refl (1 * (b⁻¹) = (b⁻¹))) (one_mul (b⁻¹)))) (Eq.refl (b⁻¹))))

theorem inv_injective' {G₀ : Type u_2} [group_with_zero G₀] : function.injective has_inv.inv :=
  function.involutive.injective inv_involutive'

@[simp] theorem inv_inj' {G₀ : Type u_2} [group_with_zero G₀] {g : G₀} {h : G₀} : g⁻¹ = (h⁻¹) ↔ g = h :=
  function.injective.eq_iff inv_injective'

theorem inv_eq_iff {G₀ : Type u_2} [group_with_zero G₀] {g : G₀} {h : G₀} : g⁻¹ = h ↔ h⁻¹ = g :=
  eq.mpr (id (Eq._oldrec (Eq.refl (g⁻¹ = h ↔ h⁻¹ = g)) (Eq.symm (propext inv_inj'))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (g⁻¹⁻¹ = (h⁻¹) ↔ h⁻¹ = g)) (propext eq_comm)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (h⁻¹ = (g⁻¹⁻¹) ↔ h⁻¹ = g)) (inv_inv' g))) (iff.refl (h⁻¹ = g))))

@[simp] theorem inv_eq_one' {G₀ : Type u_2} [group_with_zero G₀] {g : G₀} : g⁻¹ = 1 ↔ g = 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (g⁻¹ = 1 ↔ g = 1)) (propext inv_eq_iff)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (1⁻¹ = g ↔ g = 1)) inv_one))
      (eq.mpr (id (Eq._oldrec (Eq.refl (1 = g ↔ g = 1)) (propext eq_comm))) (iff.refl (g = 1))))

namespace units

/-- 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 {G₀ : Type u_2} [group_with_zero G₀] (a : G₀) (ha : a ≠ 0) : units G₀ :=
  mk a (a⁻¹) (mul_inv_cancel ha) (inv_mul_cancel ha)

@[simp] theorem coe_mk0 {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} (h : a ≠ 0) : ↑(mk0 a h) = a :=
  rfl

@[simp] theorem mk0_coe {G₀ : Type u_2} [group_with_zero G₀] (u : units G₀) (h : ↑u ≠ 0) : mk0 (↑u) h = u :=
  ext rfl

@[simp] theorem coe_inv' {G₀ : Type u_2} [group_with_zero G₀] (u : units G₀) : ↑(u⁻¹) = (↑u⁻¹) :=
  eq_inv_of_mul_left_eq_one (inv_mul u)

@[simp] theorem mul_inv' {G₀ : Type u_2} [group_with_zero G₀] (u : units G₀) : ↑u * (↑u⁻¹) = 1 :=
  mul_inv_cancel (ne_zero u)

@[simp] theorem inv_mul' {G₀ : Type u_2} [group_with_zero G₀] (u : units G₀) : ↑u⁻¹ * ↑u = 1 :=
  inv_mul_cancel (ne_zero u)

@[simp] theorem mk0_inj {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} {b : G₀} (ha : a ≠ 0) (hb : b ≠ 0) : mk0 a ha = mk0 b hb ↔ a = b :=
  { mp := fun (h : mk0 a ha = mk0 b hb) => mk.inj_arrow h fun (h_1 : a = b) (h_2 : a⁻¹ = (b⁻¹)) => h_1,
    mpr := fun (h : a = b) => ext h }

@[simp] theorem exists_iff_ne_zero {G₀ : Type u_2} [group_with_zero G₀] {x : G₀} : (∃ (u : units G₀), ↑u = x) ↔ x ≠ 0 := sorry

end units

theorem is_unit.mk0 {G₀ : Type u_2} [group_with_zero G₀] (x : G₀) (hx : x ≠ 0) : is_unit x :=
  is_unit_unit (units.mk0 x hx)

theorem is_unit_iff_ne_zero {G₀ : Type u_2} [group_with_zero G₀] {x : G₀} : is_unit x ↔ x ≠ 0 :=
  units.exists_iff_ne_zero

protected instance group_with_zero.no_zero_divisors {G₀ : Type u_2} [group_with_zero G₀] : no_zero_divisors G₀ :=
  no_zero_divisors.mk
    fun (a b : G₀) (h : a * b = 0) =>
      imp_of_not_imp_not (a * b = 0) (a = 0 ∨ b = 0)
        (eq.mpr (id (imp_congr_eq (push_neg.not_or_eq (a = 0) (b = 0)) (Eq.refl (¬a * b = 0))))
          (eq.mpr
            (id
              (imp_congr_eq
                ((fun (a a_1 : Prop) (e_1 : a = a_1) (b b_1 : Prop) (e_2 : b = b_1) => congr (congr_arg And e_1) e_2)
                  (¬a = 0) (a ≠ 0) (propext (push_neg.not_eq a 0)) (¬b = 0) (b ≠ 0) (propext (push_neg.not_eq b 0)))
                (propext (push_neg.not_eq (a * b) 0))))
            fun (h : a ≠ 0 ∧ b ≠ 0) => units.ne_zero (units.mk0 a (and.left h) * units.mk0 b (and.right h))))
        h

protected instance group_with_zero.cancel_monoid_with_zero {G₀ : Type u_2} [group_with_zero G₀] : cancel_monoid_with_zero G₀ :=
  cancel_monoid_with_zero.mk group_with_zero.mul group_with_zero.mul_assoc group_with_zero.one group_with_zero.one_mul
    group_with_zero.mul_one group_with_zero.zero group_with_zero.zero_mul group_with_zero.mul_zero sorry sorry

theorem mul_inv_rev' {G₀ : Type u_2} [group_with_zero G₀] (x : G₀) (y : G₀) : x * y⁻¹ = y⁻¹ * (x⁻¹) := sorry

@[simp] theorem div_self {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} (h : a ≠ 0) : a / a = 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a / a = 1)) (div_eq_mul_inv a a)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * (a⁻¹) = 1)) (mul_inv_cancel h))) (Eq.refl 1))

@[simp] theorem div_one {G₀ : Type u_2} [group_with_zero G₀] (a : G₀) : a / 1 = a := sorry

@[simp] theorem zero_div {G₀ : Type u_2} [group_with_zero G₀] (a : G₀) : 0 / a = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (0 / a = 0)) (div_eq_mul_inv 0 a)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (0 * (a⁻¹) = 0)) (zero_mul (a⁻¹)))) (Eq.refl 0))

@[simp] theorem div_zero {G₀ : Type u_2} [group_with_zero G₀] (a : G₀) : a / 0 = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a / 0 = 0)) (div_eq_mul_inv a 0)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * (0⁻¹) = 0)) inv_zero))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a * 0 = 0)) (mul_zero a))) (Eq.refl 0)))

@[simp] theorem div_mul_cancel {G₀ : Type u_2} [group_with_zero G₀] (a : G₀) {b : G₀} (h : b ≠ 0) : a / b * b = a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a / b * b = a)) (div_eq_mul_inv a b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * (b⁻¹) * b = a)) (inv_mul_cancel_right' h a))) (Eq.refl a))

theorem div_mul_cancel_of_imp {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} {b : G₀} (h : b = 0 → a = 0) : a / b * b = a := sorry

@[simp] theorem mul_div_cancel {G₀ : Type u_2} [group_with_zero G₀] (a : G₀) {b : G₀} (h : b ≠ 0) : a * b / b = a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * b / b = a)) (div_eq_mul_inv (a * b) b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * b * (b⁻¹) = a)) (mul_inv_cancel_right' h a))) (Eq.refl a))

theorem mul_div_cancel_of_imp {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} {b : G₀} (h : b = 0 → a = 0) : a * b / b = a := sorry

@[simp] theorem div_self_mul_self' {G₀ : Type u_2} [group_with_zero G₀] (a : G₀) : a / (a * a) = (a⁻¹) := sorry

theorem div_eq_mul_one_div {G₀ : Type u_2} [group_with_zero G₀] (a : G₀) (b : G₀) : a / b = a * (1 / b) := sorry

theorem mul_one_div_cancel {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} (h : a ≠ 0) : a * (1 / a) = 1 := sorry

theorem one_div_mul_cancel {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} (h : a ≠ 0) : 1 / a * a = 1 := sorry

theorem one_div_one {G₀ : Type u_2} [group_with_zero G₀] : 1 / 1 = 1 :=
  div_self (ne.symm zero_ne_one)

theorem one_div_ne_zero {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} (h : a ≠ 0) : 1 / a ≠ 0 := sorry

theorem eq_one_div_of_mul_eq_one {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} {b : G₀} (h : a * b = 1) : b = 1 / a := sorry

theorem eq_one_div_of_mul_eq_one_left {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} {b : G₀} (h : b * a = 1) : b = 1 / a := sorry

@[simp] theorem one_div_div {G₀ : Type u_2} [group_with_zero G₀] (a : G₀) (b : G₀) : 1 / (a / b) = b / a := sorry

theorem one_div_one_div {G₀ : Type u_2} [group_with_zero G₀] (a : G₀) : 1 / (1 / a) = a := sorry

theorem eq_of_one_div_eq_one_div {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} {b : G₀} (h : 1 / a = 1 / b) : a = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a = b)) (Eq.symm (one_div_one_div a))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (1 / (1 / a) = b)) h))
      (eq.mpr (id (Eq._oldrec (Eq.refl (1 / (1 / b) = b)) (one_div_one_div b))) (Eq.refl b)))

@[simp] theorem inv_eq_zero {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} : a⁻¹ = 0 ↔ a = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a⁻¹ = 0 ↔ a = 0)) (propext inv_eq_iff)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (0⁻¹ = a ↔ a = 0)) inv_zero))
      (eq.mpr (id (Eq._oldrec (Eq.refl (0 = a ↔ a = 0)) (propext eq_comm))) (iff.refl (a = 0))))

@[simp] theorem zero_eq_inv {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} : 0 = (a⁻¹) ↔ 0 = a :=
  iff.trans eq_comm (iff.trans inv_eq_zero eq_comm)

theorem one_div_mul_one_div_rev {G₀ : Type u_2} [group_with_zero G₀] (a : G₀) (b : G₀) : 1 / a * (1 / b) = 1 / (b * a) := sorry

theorem divp_eq_div {G₀ : Type u_2} [group_with_zero G₀] (a : G₀) (u : units G₀) : a /ₚ u = a / ↑u := sorry

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

theorem inv_div {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} {b : G₀} : a / b⁻¹ = b / a := sorry

theorem inv_div_left {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} {b : G₀} : a⁻¹ / b = (b * a⁻¹) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a⁻¹ / b = (b * a⁻¹))) (mul_inv_rev' b a)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a⁻¹ / b = a⁻¹ * (b⁻¹))) (div_eq_mul_inv (a⁻¹) b))) (Eq.refl (a⁻¹ * (b⁻¹))))

theorem div_ne_zero {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} {b : G₀} (ha : a ≠ 0) (hb : b ≠ 0) : a / b ≠ 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a / b ≠ 0)) (div_eq_mul_inv a b))) (mul_ne_zero ha (inv_ne_zero hb))

@[simp] theorem div_eq_zero_iff {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} {b : G₀} : a / b = 0 ↔ a = 0 ∨ b = 0 := sorry

theorem div_ne_zero_iff {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} {b : G₀} : a / b ≠ 0 ↔ a ≠ 0 ∧ b ≠ 0 :=
  iff.trans (not_congr div_eq_zero_iff) not_or_distrib

theorem div_left_inj' {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} {b : G₀} {c : G₀} (hc : c ≠ 0) : a / c = b / c ↔ a = b := sorry

theorem div_eq_iff_mul_eq {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} {b : G₀} {c : G₀} (hb : b ≠ 0) : a / b = c ↔ c * b = a := sorry

theorem eq_div_iff_mul_eq {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} {b : G₀} {c : G₀} (hc : c ≠ 0) : a = b / c ↔ a * c = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a = b / c ↔ a * c = b)) (propext eq_comm)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (b / c = a ↔ a * c = b)) (propext (div_eq_iff_mul_eq hc)))) (iff.refl (a * c = b)))

theorem div_eq_of_eq_mul {G₀ : Type u_2} [group_with_zero G₀] {x : G₀} (hx : x ≠ 0) {y : G₀} {z : G₀} (h : y = z * x) : y / x = z :=
  iff.mpr (div_eq_iff_mul_eq hx) (Eq.symm h)

theorem eq_div_of_mul_eq {G₀ : Type u_2} [group_with_zero G₀] {x : G₀} (hx : x ≠ 0) {y : G₀} {z : G₀} (h : z * x = y) : z = y / x :=
  Eq.symm (div_eq_of_eq_mul hx (Eq.symm h))

theorem eq_of_div_eq_one {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} {b : G₀} (h : a / b = 1) : a = b := sorry

theorem div_eq_one_iff_eq {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} {b : G₀} (hb : b ≠ 0) : a / b = 1 ↔ a = b :=
  { mp := eq_of_div_eq_one, mpr := fun (h : a = b) => Eq.symm h ▸ div_self hb }

theorem div_mul_left {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} {b : G₀} (hb : b ≠ 0) : b / (a * b) = 1 / a := sorry

theorem mul_div_mul_right {G₀ : Type u_2} [group_with_zero G₀] (a : G₀) (b : G₀) {c : G₀} (hc : c ≠ 0) : a * c / (b * c) = a / b := sorry

theorem mul_mul_div {G₀ : Type u_2} [group_with_zero G₀] (a : G₀) {b : G₀} (hb : b ≠ 0) : a = a * b * (1 / b) := sorry

protected instance comm_group_with_zero.comm_cancel_monoid_with_zero {G₀ : Type u_2} [comm_group_with_zero G₀] : comm_cancel_monoid_with_zero G₀ :=
  comm_cancel_monoid_with_zero.mk cancel_monoid_with_zero.mul sorry cancel_monoid_with_zero.one sorry sorry sorry
    cancel_monoid_with_zero.zero sorry sorry sorry sorry

/-- Pullback a `comm_group_with_zero` class along an injective function. -/
protected def function.injective.comm_group_with_zero {G₀ : Type u_2} {G₀' : Type u_4} [comm_group_with_zero G₀] [HasZero G₀'] [Mul G₀'] [HasOne G₀'] [has_inv G₀'] (f : G₀' → G₀) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1) (mul : ∀ (x y : G₀'), f (x * y) = f x * f y) (inv : ∀ (x : G₀'), f (x⁻¹) = (f x⁻¹)) : comm_group_with_zero G₀' :=
  comm_group_with_zero.mk group_with_zero.mul sorry group_with_zero.one sorry sorry sorry group_with_zero.zero sorry sorry
    group_with_zero.inv group_with_zero.div sorry sorry sorry

/-- Pullback a `comm_group_with_zero` class along an injective function. -/
protected def function.injective.comm_group_with_zero_div {G₀ : Type u_2} {G₀' : Type u_4} [comm_group_with_zero G₀] [HasZero G₀'] [Mul G₀'] [HasOne G₀'] [has_inv G₀'] [Div G₀'] (f : G₀' → G₀) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1) (mul : ∀ (x y : G₀'), f (x * y) = f x * f y) (inv : ∀ (x : G₀'), f (x⁻¹) = (f x⁻¹)) (div : ∀ (x y : G₀'), f (x / y) = f x / f y) : comm_group_with_zero G₀' :=
  comm_group_with_zero.mk group_with_zero.mul sorry group_with_zero.one sorry sorry sorry group_with_zero.zero sorry sorry
    group_with_zero.inv group_with_zero.div sorry sorry sorry

/-- Pushforward a `comm_group_with_zero` class along an surjective function. -/
protected def function.surjective.comm_group_with_zero {G₀ : Type u_2} {G₀' : Type u_4} [comm_group_with_zero G₀] [HasZero G₀'] [Mul G₀'] [HasOne G₀'] [has_inv G₀'] (h01 : 0 ≠ 1) (f : G₀ → G₀') (hf : function.surjective f) (zero : f 0 = 0) (one : f 1 = 1) (mul : ∀ (x y : G₀), f (x * y) = f x * f y) (inv : ∀ (x : G₀), f (x⁻¹) = (f x⁻¹)) : comm_group_with_zero G₀' :=
  comm_group_with_zero.mk group_with_zero.mul sorry group_with_zero.one sorry sorry sorry group_with_zero.zero sorry sorry
    group_with_zero.inv group_with_zero.div sorry sorry sorry

/-- Pushforward a `comm_group_with_zero` class along a surjective function. -/
protected def function.surjective.comm_group_with_zero_div {G₀ : Type u_2} {G₀' : Type u_4} [comm_group_with_zero G₀] [HasZero G₀'] [Mul G₀'] [HasOne G₀'] [has_inv G₀'] [Div G₀'] (h01 : 0 ≠ 1) (f : G₀ → G₀') (hf : function.surjective f) (zero : f 0 = 0) (one : f 1 = 1) (mul : ∀ (x y : G₀), f (x * y) = f x * f y) (inv : ∀ (x : G₀), f (x⁻¹) = (f x⁻¹)) (div : ∀ (x y : G₀), f (x / y) = f x / f y) : comm_group_with_zero G₀' :=
  comm_group_with_zero.mk group_with_zero.mul sorry group_with_zero.one sorry sorry sorry group_with_zero.zero sorry sorry
    group_with_zero.inv group_with_zero.div sorry sorry sorry

theorem mul_inv' {G₀ : Type u_2} [comm_group_with_zero G₀] {a : G₀} {b : G₀} : a * b⁻¹ = a⁻¹ * (b⁻¹) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * b⁻¹ = a⁻¹ * (b⁻¹))) (mul_inv_rev' a b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (b⁻¹ * (a⁻¹) = a⁻¹ * (b⁻¹))) (mul_comm (b⁻¹) (a⁻¹)))) (Eq.refl (a⁻¹ * (b⁻¹))))

theorem one_div_mul_one_div {G₀ : Type u_2} [comm_group_with_zero G₀] (a : G₀) (b : G₀) : 1 / a * (1 / b) = 1 / (a * b) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (1 / a * (1 / b) = 1 / (a * b))) (one_div_mul_one_div_rev a b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (1 / (b * a) = 1 / (a * b))) (mul_comm b a))) (Eq.refl (1 / (a * b))))

theorem div_mul_right {G₀ : Type u_2} [comm_group_with_zero G₀] {a : G₀} (b : G₀) (ha : a ≠ 0) : a / (a * b) = 1 / b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a / (a * b) = 1 / b)) (mul_comm a b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a / (b * a) = 1 / b)) (div_mul_left ha))) (Eq.refl (1 / b)))

theorem mul_div_cancel_left_of_imp {G₀ : Type u_2} [comm_group_with_zero G₀] {a : G₀} {b : G₀} (h : a = 0 → b = 0) : a * b / a = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * b / a = b)) (mul_comm a b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (b * a / a = b)) (mul_div_cancel_of_imp h))) (Eq.refl b))

theorem mul_div_cancel_left {G₀ : Type u_2} [comm_group_with_zero G₀] {a : G₀} (b : G₀) (ha : a ≠ 0) : a * b / a = b :=
  mul_div_cancel_left_of_imp fun (h : a = 0) => false.elim (ha h)

theorem mul_div_cancel_of_imp' {G₀ : Type u_2} [comm_group_with_zero G₀] {a : G₀} {b : G₀} (h : b = 0 → a = 0) : b * (a / b) = a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (b * (a / b) = a)) (mul_comm b (a / b))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a / b * b = a)) (div_mul_cancel_of_imp h))) (Eq.refl a))

theorem mul_div_cancel' {G₀ : Type u_2} [comm_group_with_zero G₀] (a : G₀) {b : G₀} (hb : b ≠ 0) : b * (a / b) = a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (b * (a / b) = a)) (mul_comm b (a / b))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a / b * b = a)) (div_mul_cancel a hb))) (Eq.refl a))

theorem div_mul_div {G₀ : Type u_2} [comm_group_with_zero G₀] (a : G₀) (b : G₀) (c : G₀) (d : G₀) : a / b * (c / d) = a * c / (b * d) := sorry

theorem mul_div_mul_left {G₀ : Type u_2} [comm_group_with_zero G₀] (a : G₀) (b : G₀) {c : G₀} (hc : c ≠ 0) : c * a / (c * b) = a / b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (c * a / (c * b) = a / b)) (mul_comm c a)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * c / (c * b) = a / b)) (mul_comm c b)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a * c / (b * c) = a / b)) (mul_div_mul_right a b hc))) (Eq.refl (a / b))))

theorem div_mul_eq_mul_div {G₀ : Type u_2} [comm_group_with_zero G₀] (a : G₀) (b : G₀) (c : G₀) : b / c * a = b * a / c := sorry

theorem div_mul_eq_mul_div_comm {G₀ : Type u_2} [comm_group_with_zero G₀] (a : G₀) (b : G₀) (c : G₀) : b / c * a = b * (a / c) := sorry

theorem mul_eq_mul_of_div_eq_div {G₀ : Type u_2} [comm_group_with_zero G₀] (a : G₀) {b : G₀} (c : G₀) {d : G₀} (hb : b ≠ 0) (hd : d ≠ 0) (h : a / b = c / d) : a * d = c * b := sorry

theorem div_div_eq_mul_div {G₀ : Type u_2} [comm_group_with_zero G₀] (a : G₀) (b : G₀) (c : G₀) : a / (b / c) = a * c / b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a / (b / c) = a * c / b)) (div_eq_mul_one_div a (b / c))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * (1 / (b / c)) = a * c / b)) (one_div_div b c)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a * (c / b) = a * c / b)) (Eq.symm mul_div_assoc))) (Eq.refl (a * c / b))))

theorem div_div_eq_div_mul {G₀ : Type u_2} [comm_group_with_zero G₀] (a : G₀) (b : G₀) (c : G₀) : a / b / c = a / (b * c) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a / b / c = a / (b * c))) (div_eq_mul_one_div (a / b) c)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a / b * (1 / c) = a / (b * c))) (div_mul_div a b 1 c)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a * 1 / (b * c) = a / (b * c))) (mul_one a))) (Eq.refl (a / (b * c)))))

theorem div_div_div_div_eq {G₀ : Type u_2} [comm_group_with_zero G₀] (a : G₀) {b : G₀} {c : G₀} {d : G₀} : a / b / (c / d) = a * d / (b * c) := sorry

theorem div_mul_eq_div_mul_one_div {G₀ : Type u_2} [comm_group_with_zero G₀] (a : G₀) (b : G₀) (c : G₀) : a / (b * c) = a / b * (1 / c) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a / (b * c) = a / b * (1 / c))) (Eq.symm (div_div_eq_div_mul a b c))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a / b / c = a / b * (1 / c))) (Eq.symm (div_eq_mul_one_div (a / b) c))))
      (Eq.refl (a / b / c)))

/-- Dividing `a` by the result of dividing `a` by itself results in
`a` (whether or not `a` is zero). -/
@[simp] theorem div_div_self {G₀ : Type u_2} [comm_group_with_zero G₀] (a : G₀) : a / (a / a) = a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a / (a / a) = a)) (div_div_eq_mul_div a a a))) (mul_self_div_self a)

theorem ne_zero_of_one_div_ne_zero {G₀ : Type u_2} [comm_group_with_zero G₀] {a : G₀} (h : 1 / a ≠ 0) : a ≠ 0 :=
  fun (ha : a = 0) =>
    absurd (Eq.refl 0)
      (eq.mp (Eq._oldrec (Eq.refl (1 / 0 ≠ 0)) (div_zero 1)) (eq.mp (Eq._oldrec (Eq.refl (1 / a ≠ 0)) ha) h))

theorem eq_zero_of_one_div_eq_zero {G₀ : Type u_2} [comm_group_with_zero G₀] {a : G₀} (h : 1 / a = 0) : a = 0 :=
  classical.by_cases (fun (ha : a = 0) => ha) fun (ha : ¬a = 0) => false.elim (one_div_ne_zero ha h)

theorem div_helper {G₀ : Type u_2} [comm_group_with_zero G₀] {a : G₀} (b : G₀) (h : a ≠ 0) : 1 / (a * b) * a = 1 / b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (1 / (a * b) * a = 1 / b)) (div_mul_eq_mul_div a 1 (a * b))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (1 * a / (a * b) = 1 / b)) (one_mul a)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a / (a * b) = 1 / b)) (div_mul_right b h))) (Eq.refl (1 / b))))

theorem div_eq_inv_mul {G₀ : Type u_2} [comm_group_with_zero G₀] {a : G₀} {b : G₀} : a / b = b⁻¹ * a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a / b = b⁻¹ * a)) (div_eq_mul_inv a b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * (b⁻¹) = b⁻¹ * a)) (mul_comm a (b⁻¹)))) (Eq.refl (b⁻¹ * a)))

theorem mul_div_right_comm {G₀ : Type u_2} [comm_group_with_zero G₀] (a : G₀) (b : G₀) (c : G₀) : a * b / c = a / c * b := sorry

theorem mul_comm_div' {G₀ : Type u_2} [comm_group_with_zero G₀] (a : G₀) (b : G₀) (c : G₀) : a / b * c = a * (c / b) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a / b * c = a * (c / b))) (Eq.symm mul_div_assoc)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a / b * c = a * c / b)) (mul_div_right_comm a c b))) (Eq.refl (a / b * c)))

theorem div_mul_comm' {G₀ : Type u_2} [comm_group_with_zero G₀] (a : G₀) (b : G₀) (c : G₀) : a / b * c = c / b * a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a / b * c = c / b * a)) (div_mul_eq_mul_div c a b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * c / b = c / b * a)) (mul_comm a c)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (c * a / b = c / b * a)) (mul_div_right_comm c a b))) (Eq.refl (c / b * a))))

theorem mul_div_comm {G₀ : Type u_2} [comm_group_with_zero G₀] (a : G₀) (b : G₀) (c : G₀) : a * (b / c) = b * (a / c) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * (b / c) = b * (a / c))) (Eq.symm mul_div_assoc)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * b / c = b * (a / c))) (mul_comm a b)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (b * a / c = b * (a / c))) mul_div_assoc)) (Eq.refl (b * (a / c)))))

theorem div_right_comm {G₀ : Type u_2} [comm_group_with_zero G₀] {b : G₀} {c : G₀} (a : G₀) : a / b / c = a / c / b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a / b / c = a / c / b)) (div_div_eq_div_mul a b c)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a / (b * c) = a / c / b)) (div_div_eq_div_mul a c b)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a / (b * c) = a / (c * b))) (mul_comm b c))) (Eq.refl (a / (c * b)))))

theorem div_div_div_cancel_right {G₀ : Type u_2} [comm_group_with_zero G₀] {b : G₀} {c : G₀} (a : G₀) (hc : c ≠ 0) : a / c / (b / c) = a / b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a / c / (b / c) = a / b)) (div_div_eq_mul_div (a / c) b c)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a / c * c / b = a / b)) (div_mul_cancel a hc))) (Eq.refl (a / b)))

theorem div_mul_div_cancel {G₀ : Type u_2} [comm_group_with_zero G₀] {b : G₀} {c : G₀} (a : G₀) (hc : c ≠ 0) : a / c * (c / b) = a / b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a / c * (c / b) = a / b)) (Eq.symm mul_div_assoc)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a / c * c / b = a / b)) (div_mul_cancel a hc))) (Eq.refl (a / b)))

theorem div_eq_div_iff {G₀ : Type u_2} [comm_group_with_zero G₀] {a : G₀} {b : G₀} {c : G₀} {d : G₀} (hb : b ≠ 0) (hd : d ≠ 0) : a / b = c / d ↔ a * d = c * b := sorry

theorem div_eq_iff {G₀ : Type u_2} [comm_group_with_zero G₀] {a : G₀} {b : G₀} {c : G₀} (hb : b ≠ 0) : a / b = c ↔ a = c * b :=
  iff.trans (div_eq_iff_mul_eq hb) eq_comm

theorem eq_div_iff {G₀ : Type u_2} [comm_group_with_zero G₀] {a : G₀} {b : G₀} {c : G₀} (hb : b ≠ 0) : c = a / b ↔ c * b = a :=
  eq_div_iff_mul_eq hb

theorem div_div_cancel' {G₀ : Type u_2} [comm_group_with_zero G₀] {a : G₀} {b : G₀} (ha : a ≠ 0) : a / (a / b) = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a / (a / b) = b)) (div_eq_mul_inv a (a / b))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * (a / b⁻¹) = b)) inv_div))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a * (b / a) = b)) (mul_div_cancel' b ha))) (Eq.refl b)))

namespace semiconj_by

@[simp] theorem zero_right {G₀ : Type u_2} [mul_zero_class G₀] (a : G₀) : semiconj_by a 0 0 := sorry

@[simp] theorem zero_left {G₀ : Type u_2} [mul_zero_class G₀] (x : G₀) (y : G₀) : semiconj_by 0 x y := sorry

@[simp] theorem inv_symm_left_iff' {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} {x : G₀} {y : G₀} : semiconj_by (a⁻¹) x y ↔ semiconj_by a y x := sorry

theorem inv_symm_left' {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} {x : G₀} {y : G₀} (h : semiconj_by a x y) : semiconj_by (a⁻¹) y x :=
  iff.mpr inv_symm_left_iff' h

theorem inv_right' {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} {x : G₀} {y : G₀} (h : semiconj_by a x y) : semiconj_by a (x⁻¹) (y⁻¹) := sorry

@[simp] theorem inv_right_iff' {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} {x : G₀} {y : G₀} : semiconj_by a (x⁻¹) (y⁻¹) ↔ semiconj_by a x y :=
  { mp := fun (h : semiconj_by a (x⁻¹) (y⁻¹)) => inv_inv' x ▸ inv_inv' y ▸ inv_right' h, mpr := inv_right' }

theorem div_right {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} {x : G₀} {y : G₀} {x' : G₀} {y' : G₀} (h : semiconj_by a x y) (h' : semiconj_by a x' y') : semiconj_by a (x / x') (y / y') :=
  eq.mpr (id (Eq._oldrec (Eq.refl (semiconj_by a (x / x') (y / y'))) (div_eq_mul_inv x x')))
    (eq.mpr (id (Eq._oldrec (Eq.refl (semiconj_by a (x * (x'⁻¹)) (y / y'))) (div_eq_mul_inv y y')))
      (mul_right h (inv_right' h')))

end semiconj_by

namespace commute

@[simp] theorem zero_right {G₀ : Type u_2} [mul_zero_class G₀] (a : G₀) : commute a 0 :=
  semiconj_by.zero_right a

@[simp] theorem zero_left {G₀ : Type u_2} [mul_zero_class G₀] (a : G₀) : commute 0 a :=
  semiconj_by.zero_left a a

@[simp] theorem inv_left_iff' {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} {b : G₀} : commute (a⁻¹) b ↔ commute a b :=
  semiconj_by.inv_symm_left_iff'

theorem inv_left' {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} {b : G₀} (h : commute a b) : commute (a⁻¹) b :=
  iff.mpr inv_left_iff' h

@[simp] theorem inv_right_iff' {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} {b : G₀} : commute a (b⁻¹) ↔ commute a b :=
  semiconj_by.inv_right_iff'

theorem inv_right' {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} {b : G₀} (h : commute a b) : commute a (b⁻¹) :=
  iff.mpr inv_right_iff' h

theorem inv_inv' {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} {b : G₀} (h : commute a b) : commute (a⁻¹) (b⁻¹) :=
  inv_right' (inv_left' h)

@[simp] theorem div_right {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} {b : G₀} {c : G₀} (hab : commute a b) (hac : commute a c) : commute a (b / c) :=
  semiconj_by.div_right hab hac

@[simp] theorem div_left {G₀ : Type u_2} [group_with_zero G₀] {a : G₀} {b : G₀} {c : G₀} (hac : commute a c) (hbc : commute b c) : commute (a / b) c :=
  eq.mpr (id (Eq._oldrec (Eq.refl (commute (a / b) c)) (div_eq_mul_inv a b))) (mul_left hac (inv_left' hbc))

end commute

namespace monoid_with_zero_hom

theorem map_ne_zero {M₀ : Type u_1} {G₀ : Type u_2} [group_with_zero G₀] [monoid_with_zero M₀] [nontrivial M₀] (f : monoid_with_zero_hom G₀ M₀) {a : G₀} : coe_fn f a ≠ 0 ↔ a ≠ 0 :=
  { mp := fun (hfa : coe_fn f a ≠ 0) (ha : a = 0) => hfa (Eq.symm ha ▸ map_zero f),
    mpr := fun (ha : a ≠ 0) => is_unit.ne_zero (is_unit.map (to_monoid_hom f) (is_unit.mk0 a ha)) }

@[simp] theorem map_eq_zero {M₀ : Type u_1} {G₀ : Type u_2} [group_with_zero G₀] [monoid_with_zero M₀] [nontrivial M₀] (f : monoid_with_zero_hom G₀ M₀) {a : G₀} : coe_fn f a = 0 ↔ a = 0 :=
  iff.mp not_iff_not (map_ne_zero f)

/-- A monoid homomorphism between groups with zeros sending `0` to `0` sends `a⁻¹` to `(f a)⁻¹`. -/
@[simp] theorem map_inv' {G₀ : Type u_2} {G₀' : Type u_4} [group_with_zero G₀] [group_with_zero G₀'] (f : monoid_with_zero_hom G₀ G₀') (a : G₀) : coe_fn f (a⁻¹) = (coe_fn f a⁻¹) := sorry

@[simp] theorem map_div {G₀ : Type u_2} {G₀' : Type u_4} [group_with_zero G₀] [group_with_zero G₀'] (f : monoid_with_zero_hom G₀ G₀') (a : G₀) (b : G₀) : coe_fn f (a / b) = coe_fn f a / coe_fn f b := sorry

end monoid_with_zero_hom

@[simp] theorem monoid_hom.map_units_inv {M : Type u_1} {G₀ : Type u_2} [monoid M] [group_with_zero G₀] (f : M →* G₀) (u : units M) : coe_fn f ↑(u⁻¹) = (coe_fn f ↑u⁻¹) := sorry

/-- Constructs a `group_with_zero` structure on a `monoid_with_zero`
  consisting only of units and 0. -/
def group_with_zero_of_is_unit_or_eq_zero {M : Type u_5} [nontrivial M] [hM : monoid_with_zero M] (h : ∀ (a : M), is_unit a ∨ a = 0) : group_with_zero M :=
  group_with_zero.mk monoid_with_zero.mul monoid_with_zero.mul_assoc monoid_with_zero.one monoid_with_zero.one_mul
    monoid_with_zero.mul_one monoid_with_zero.zero monoid_with_zero.zero_mul monoid_with_zero.mul_zero
    (fun (a : M) => dite (a = 0) (fun (h0 : a = 0) => 0) fun (h0 : ¬a = 0) => ↑(is_unit.unit sorry⁻¹))
    (div_inv_monoid.div._default monoid_with_zero.mul monoid_with_zero.mul_assoc monoid_with_zero.one
      monoid_with_zero.one_mul monoid_with_zero.mul_one
      fun (a : M) => dite (a = 0) (fun (h0 : a = 0) => 0) fun (h0 : ¬a = 0) => ↑(is_unit.unit sorry⁻¹))
    nontrivial.exists_pair_ne sorry sorry

/-- Constructs a `comm_group_with_zero` structure on a `comm_monoid_with_zero`
  consisting only of units and 0. -/
def comm_group_with_zero_of_is_unit_or_eq_zero {M : Type u_5} [nontrivial M] [hM : comm_monoid_with_zero M] (h : ∀ (a : M), is_unit a ∨ a = 0) : comm_group_with_zero M :=
  comm_group_with_zero.mk group_with_zero.mul sorry group_with_zero.one sorry sorry comm_monoid_with_zero.mul_comm
    group_with_zero.zero sorry sorry group_with_zero.inv group_with_zero.div sorry sorry sorry


/-
Copyright (c) 2022 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma
-/
import computational_monads.simulation_semantics.constructions.logging.logging_oracle
import computational_monads.simulation_semantics.constructions.logging.query_log.lookup
import computational_monads.simulation_semantics.constructions.logging.query_log.fork
import computational_monads.simulation_semantics.oracle_compose

/-!
# Caching Simulation Oracle

This file defines a `sim_oracle` that implements caching functionality.
`caching_oracle` represents a simulator that logs all new queries, returning the old
log values for queries that have been previously asked, so the `query_log` functions as a cache.
This is often useful when composed with other oracles, such as in `random_oracle`.
-/

open oracle_comp oracle_spec

variables {α β γ : Type} {spec spec' : oracle_spec}

/-- Computation that returns a currently cached value, or queries a new value if needed,
returning both the result and the (potentially updated) cache.
The function for a fresh query is given by `ou`, which may have other oracles than the cache. -/
def query_log.lookup_cached_or_run
  (cache : query_log spec) (i : spec.ι) (t : spec.domain i)
  (ou : oracle_comp spec' (spec.range i)) :
  oracle_comp spec' (spec.range i × query_log spec) :=
match cache.lookup i t with
| (some u) := return (u, cache)
| none := do {u ← ou, return (u, cache.log_query i t u)}
end

/-- Oracle for logging previous queries, and returning the same value for matching inputs -/
def caching_oracle (spec : oracle_spec) : sim_oracle spec spec (query_log spec) :=
{ default_state := query_log.init spec,
  o := λ i ⟨t, log⟩, match log.lookup i t with
  | (some u) := return (u, log) -- Return the cached value if it already exists
  | none := do {u ← query i t, return (u, log.log_query i t u)}
  end }

namespace caching_oracle

variables (oa oa' : oracle_comp spec α) (i : spec.ι) (t : spec.domain i) (u : spec.range i)
  (log : query_log spec) (x : spec.range i × query_log spec) --TODO: naming → cache

@[simp] lemma apply_eq : (caching_oracle spec) i (t, log) = option.rec_on (log.lookup i t)
  (query i t >>= λ u, return (u, log.log_query i t u)) (λ u, return (u, log)) :=
by {simp only [caching_oracle, sim_oracle.has_coe_to_fun.def], induction log.lookup i t; refl }

lemma apply_eq_of_lookup_eq_none (hlog : log.lookup i t = none) :
  (caching_oracle spec) i (t, log) = (query i t >>= λ u, return (u, log.log_query i t u)) :=
by rw [apply_eq, hlog]

lemma apply_eq_of_lookup_eq_some (u : spec.range i) (hlog : log.lookup i t = some u) :
  (caching_oracle spec) i (t, log) = return (u, log) :=
by rw [apply_eq, hlog]

lemma apply_eq_of_not_queried (hlog : log.not_queried i t) :
  (caching_oracle spec) i (t, log) = (query i t >>= λ u, return (u, log.log_query i t u)) :=
by rw [apply_eq, (query_log.lookup_eq_none_iff_not_queried _ _ _).2 hlog]

section support

@[simp] lemma support_apply : ((caching_oracle spec) i (t, log)).support = if log.not_queried i t
  then {x | x.2 = log.log_query i t x.1} else {x | some x.1 = log.lookup i t ∧ x.2 = log} :=
begin
  split_ifs with hlog; ext x,
  { rw [apply_eq_of_not_queried i t log hlog, support_bind_return, support_query,
      set.top_eq_univ, set.image_univ, set.mem_range, set.mem_set_of_eq],
    refine ⟨λ h, _, λ h, _⟩,
    { obtain ⟨u, rfl⟩ := h,
      refl },
    { exact ⟨x.1, h ▸ (prod.eq_iff_fst_eq_snd_eq.2 ⟨rfl, rfl⟩)⟩ } },
  { obtain ⟨u, hu⟩ := log.exists_eq_lookup_of_not_not_queried i t hlog,
    simp only [apply_eq_of_lookup_eq_some _ _ _ u hu.symm, ← hu, support_return,
      prod.eq_iff_fst_eq_snd_eq, set.mem_singleton_iff, set.mem_set_of_eq] }
end

lemma support_apply_of_not_queried (hlog : log.not_queried i t) :
  ((caching_oracle spec) i (t, log)).support = {x | x.2 = log.log_query i t x.1} :=
by rw [support_apply, if_pos hlog]

lemma mem_support_apply_iff_of_not_queried (hlog : log.not_queried i t) :
  x ∈ ((caching_oracle spec) i (t, log)).support ↔ x.2 = log.log_query i t x.1 :=
by rw [support_apply_of_not_queried i t log hlog, set.mem_set_of_eq]

lemma support_apply_of_queried (hlog : ¬ log.not_queried i t) :
  ((caching_oracle spec) i (t, log)).support = {x | some x.1 = log.lookup i t ∧ x.2 = log} :=
by rw [support_apply, if_neg hlog]

lemma mem_support_apply_iff_of_queried (hlog : ¬ log.not_queried i t) :
  x ∈ ((caching_oracle spec) i (t, log)).support ↔ some x.1 = log.lookup i t ∧ x.2 = log :=
by rw [support_apply_of_queried i t log hlog, set.mem_set_of_eq]

/-- If the initial cache has `nodup` for some oracle, then so does the final cache. -/
lemma nodup_simulate (hlog : (log i).nodup) (x : α × query_log spec)
  (hx : x ∈ (simulate (caching_oracle spec) oa log).support) : (x.2 i).nodup :=
begin
  refine support_state_simulate_induction (caching_oracle spec) (λ log, (log i).nodup)
    log hlog oa x hx (λ i t log x hx hlog, _),
  by_cases h : log.not_queried i t,
  { rw [mem_support_apply_iff_of_not_queried _ _ _ _ h] at hx,
    rw [hx, query_log.nodup_log_query_apply_iff _ _ _ _ _ hlog],
    exact or.inr ((log.not_queried_iff_not_mem _ _).1 h _) },
  { rw [mem_support_apply_iff_of_queried _ _ _ _ h] at hx,
    exact hx.2.symm ▸ hlog }
end

section lookup

/-- If a value is already cached in the initial state, it has the same cache value after. -/
lemma lookup_simulate_eq_some_of_lookup_eq_some (x : α × query_log spec)
  (hx : x ∈ (simulate (caching_oracle spec) oa log).support)
  (hlog : log.lookup i t = some u) : x.2.lookup i t = some u :=
begin
  refine support_state_simulate_induction (caching_oracle spec) (λ log, log.lookup i t = some u)
    log hlog oa x hx (λ i t log x hx hlog, _),
  by_cases h : log.not_queried i t,
  { rw [support_apply_of_not_queried _ _ _ h, set.mem_set_of_eq] at hx,
    rw [hx, query_log.lookup_log_query],
    split_ifs with hi ht,
    { obtain rfl := ht,
      obtain rfl := hi,
      exact false.elim (option.some_ne_none u (trans hlog.symm $
        (log.lookup_eq_none_iff_not_queried _ _).2 h)) },
    { exact hlog },
    { exact hlog } },
  { rw [mem_support_apply_iff_of_queried _ _ _ _ h] at hx,
    exact hx.2.symm ▸ hlog }
end

/-- If a value isn't cached after simulation, it wasn't cached in the initial state. -/
lemma lookup_eq_none_of_lookup_simulate_eq_none (x : α × query_log spec)
  (hx : x ∈ (simulate (caching_oracle spec) oa log).support)
  (hx' : x.2.lookup i t = none) : log.lookup i t = none :=
begin
  by_contradiction h,
  rw [← ne.def, option.ne_none_iff_exists'] at h,
  refine let ⟨u, hu⟩ := h in option.some_ne_none u ((lookup_simulate_eq_some_of_lookup_eq_some
    oa i t u log x hx hu).symm.trans hx'),
end

/-- For any query fresh to the initial cache, if there is some output such that query has a cached
value, then there are also outputs with any other possible cached value. -/
lemma exists_cache_lookup_eq_some (hlog : log.not_queried i t)
  (x : α × query_log spec) (hx : x ∈ (simulate (caching_oracle spec) oa log).support)
  (h : x.2.lookup i t = some u) (u' : spec.range i) :
  ∃ (y : α × query_log spec) (hy : y ∈ (simulate (caching_oracle spec) oa log).support),
    y.2.lookup i t = some u' :=
begin
  induction oa using oracle_comp.induction_on with α a α β oa ob hoa hob i t,
  { rw [support_simulate_return, set.mem_singleton_iff] at hx,
    have : ¬ log.not_queried i t := begin
      rw [← query_log.lookup_eq_none_iff_not_queried,
        option.eq_none_iff_forall_not_mem, not_forall],
      refine ⟨u, _⟩,
      simpa only [hx] using h,
    end,
    refine (this hlog).elim },
  sorry, sorry,
end

end lookup

section length

lemma length_cache_apply_of_not_queried (hlog : log.not_queried i t)
  (x : spec.range i × query_log spec) (hx : x ∈ ((caching_oracle spec) i (t, log)).support) :
  (x.2 i).length = (log i).length + 1 :=
begin
  rw [support_apply_of_not_queried i t log hlog, set.mem_set_of_eq] at hx,
  rw [hx, query_log.log_query_apply_same_index, list.length_cons],
end

lemma length_cache_apply_of_not_not_queried (hlog : ¬ log.not_queried i t)
  (x : spec.range i × query_log spec) (hx : x ∈ ((caching_oracle spec) i (t, log)).support) :
  (x.2 i).length = (log i).length :=
begin
  rw [mem_support_apply_iff_of_queried _ _ _ _ hlog] at hx,
  refine congr_arg list.length (congr_fun hx.2 i)
end

/-- The length of the final cache is at least as long as the initial cache. -/
lemma length_cache_le_length_cache_simulate (x : α × query_log spec)
  (hx : x ∈ (simulate (caching_oracle spec) oa log).support) :
  (log i).length ≤ (x.2 i).length :=
begin
  refine support_state_simulate_induction (caching_oracle spec)
    (λ log', (log i).length ≤ (log' i).length) log le_rfl oa
      x hx (λ i' t log' x' hx' hlog', le_trans hlog' _),
  by_cases hlog'' : log'.not_queried i' t,
  { rw [support_apply_of_not_queried _ _ _ hlog''] at hx',
    exact hx'.symm ▸ log'.length_apply_le_lenght_log_query_apply i' t x'.1 i },
  { rw [mem_support_apply_iff_of_queried _ _ _ _ hlog''] at hx',
    rw [hx'.2] }
end

end length

section fork

/-- Given a `query_log`, and a output of simulating with that as the cache,
simulation with the `fork_cache` applied to the new cache has the same support as simulating
with the original cache. Intuitively, since all the new entries to the cache just come
from a call to `query`, it's irrelevent that they have been added, since any new call
can't tell whether this call to `query` is new or made earlier. -/
theorem support_simulate_fork_cache_some
  (cache : query_log spec) (i : spec.ι) (n : ℕ) (hn : (cache i).length ≤ n)
  (x : α × query_log spec) (hx : x ∈ (simulate (caching_oracle spec) oa' cache).support) :
  (simulate (caching_oracle spec) oa (x.2.fork_cache i (some n))).support =
    (simulate (caching_oracle spec) oa cache).support :=
begin
  induction oa using oracle_comp.induction_on with α a α β oa ob hoa hob i t,
  sorry, sorry, sorry,
end

/-- Specialized version of `support_simulate_fork_cache_some` when the initial state is empty.
In this case we don't need to place any restrictions on the value of `n`-/
lemma support_simulate_init_fork_cache_some (i : spec.ι) (n : ℕ) (x : α × query_log spec)
  (hx : x ∈ (simulate (caching_oracle spec) oa' (query_log.init spec)).support) :
  (simulate (caching_oracle spec) oa (x.2.fork_cache i (some n))).support =
    (simulate (caching_oracle spec) oa (query_log.init spec)).support :=
begin
  sorry,
end

/-- Version of `support_simulate_fork_cache` for forking on `none` -/
lemma support_simulate_fork_cache_none (i : spec.ι) (cache : query_log spec) :
  (simulate (caching_oracle spec) oa (cache.fork_cache i none)).support =
    (simulate (caching_oracle spec) oa (query_log.init spec)).support :=
by rw query_log.fork_cache_none

end fork

-- TODO: generalize. Should also work for log→seed probably ?
/-- Re-running a computation with an old cache doesn't change the possible outputs,
assuming the old cache was generated by an honest simulation. -/
theorem support_simulate_bind_simulate_eq_support_simulate (oa : oracle_comp spec α) :
  (simulate (caching_oracle spec) oa log >>= λ x, simulate (caching_oracle spec) oa x.2).support =
    (simulate (caching_oracle spec) oa log).support :=
begin
  refine support_simulate_simulate_eq_support_simulate (caching_oracle spec) (caching_oracle spec)
    _ log oa,
  clear log,
  intros i t log,
  ext x,
  refine ⟨λ h, _, λ h, _⟩,
  { simp_rw [set.mem_Union] at h,
    obtain ⟨y, hy, hy'⟩ := h,
    by_cases hlog : log.not_queried i t,
    { rw [mem_support_apply_iff_of_not_queried _ _ _ _ hlog] at ⊢ hy,
      have : ¬ y.2.not_queried i t := sorry,
      rw [mem_support_apply_iff_of_queried _ _ _ _ this] at hy',
      refine hy'.2.trans _,
      have : x.1 = y.1 := sorry,
      rw [hy, this] },
    { rw [mem_support_apply_iff_of_queried _ _ _ _ hlog] at ⊢ hy,
      have : ¬ y.2.not_queried i t := sorry,
      rw [mem_support_apply_iff_of_queried _ _ _ _ this] at hy',
      refine ⟨trans (hy'.1.trans _) hy.1, hy'.2.trans hy.2⟩,
      rw [hy.2],
      exact symm hy.1 } },
  sorry,
end

end support

section eval_dist

end eval_dist

end caching_oracle


import category_theory.preadditive.yoneda
import for_mathlib.AddCommGroup.kernels

noncomputable theory

universes v

namespace category_theory

namespace limits

section kernel_comparison
variables {C D : Type*} [category.{v} C] [category.{v} D] [has_zero_morphisms C]
  [has_zero_morphisms D] (F : C ⥤ D) [functor.preserves_zero_morphisms F]

lemma kernel_comparison_is_iso_of_is_limit {A₁ A₂ : C} (f : A₁ ⟶ A₂) [has_kernel f]
  [has_kernel (F.map f)] (s : kernel_fork f) (hs₁ : is_limit s)
    (hs₂ : is_limit (kernel_fork.of_ι (F.map s.ι) (show _ ≫ F.map f = 0,
      by { rw [← F.map_comp, kernel_fork.condition, F.map_zero],}))) :
  is_iso (limits.kernel_comparison f F) :=
begin
  let α : kernel f ≅ s.X := is_limit.cone_point_unique_up_to_iso (limit.is_limit _) hs₁,
  let β : F.obj s.X ≅ kernel (F.map f) := is_limit.cone_point_unique_up_to_iso hs₂
    (limit.is_limit _),
  suffices : limits.kernel_comparison f F = (F.map_iso α ≪≫ β).hom,
  { rw this, apply_instance, },
  rw ← cancel_mono (kernel.ι (F.map f)),
  dsimp only [α, β],
  simp only [kernel_comparison_comp_ι, iso.trans_hom, fork.of_ι_π_app,
    functor.map_iso_hom, category.assoc, limit.cone_point_unique_up_to_iso_hom_comp,
    ← F.map_comp],
  congr',
  rw ← cancel_epi ((limit.is_limit (parallel_pair f 0)).cone_point_unique_up_to_iso hs₁).inv,
  simp only [iso.inv_hom_id_assoc, limit.cone_point_unique_up_to_iso_inv_comp, fork.app_zero_eq_ι],
end

end kernel_comparison

variables {C : Type*} [category C] [preadditive C]

lemma _root_.AddCommGroup.kernel_fork_is_limit {X Y : AddCommGroup} (φ : X ⟶ Y)
  (s : kernel_fork φ) (hs₁ : function.injective s.ι)
    (hs₂ : ∀ (x : X), φ x = 0 → ∃ (z : s.X), s.ι z = x) :
  is_limit s :=
begin
  refine is_limit.of_iso_limit (AddCommGroup.kernel_is_limit φ) _,
  let e : s.X ≃+ φ.ker :=
  { to_fun := λ w, ⟨s.ι w, by { rw add_monoid_hom.mem_ker,
      exact congr_arg (λ (f : s.X ⟶ Y), (f w : Y)) s.condition, }⟩,
    inv_fun := λ x, (hs₂ x.1 x.2).some,
    left_inv := λ w, by { apply hs₁, exact (hs₂ _ _).some_spec, },
    right_inv := λ x, by { ext, exact (hs₂ x.1 x.2).some_spec, },
    map_add' := λ w₁ w₂, by { ext, simp only [map_add, add_submonoid.mk_add_mk,
      set_like.coe_mk], } },
  symmetry,
  refine cones.ext (add_equiv.to_AddCommGroup_iso e) _,
  rintro (_|_),
  { ext, refl, },
  { ext, dsimp [e], simp only [kernel_fork.app_one, comp_zero], },
end

instance preadditive_yoneda_kernel_comparison_is_iso (B : C) {A₁ A₂ : Cᵒᵖ} (f : A₁ ⟶ A₂)
  [has_kernel f] : is_iso (limits.kernel_comparison f (preadditive_yoneda.obj B)) :=
begin
  let hs₁ : is_limit ( _ : kernel_fork f) := limit.is_limit _,
  apply kernel_comparison_is_iso_of_is_limit (preadditive_yoneda.obj B) f _ hs₁,
  apply AddCommGroup.kernel_fork_is_limit,
  { intros g₁ g₂ h,
    dsimp at g₁ g₂ h ⊢,
    rw cancel_epi (kernel.ι f).unop at h,
    exact h, },
  { intros x hx,
    dsimp at x hx ⊢,
    use (kernel.lift f x.op (quiver.hom.unop_inj hx)).unop,
    rw ← unop_comp,
    simp only [kernel.lift_ι, quiver.hom.unop_op], },
end

end limits

end category_theory


import for_mathlib.finite
import o_minimal.o_minimal

namespace o_minimal

open set

instance {R : Type*} [preorder R] (S : struc R) [is_definable_le S R] [definable_constants S]
  (a b : R) : is_definable S (Ioo a b) :=
is_definable.subtype (def_set.Ioo a b)

variables {R : Type*} [DUNLO R]
variables (S : struc R) [o_minimal S]

/-- [vdD:3.1.3 Lemma 1]:
A definable function on an interval is injective or constant on some subinterval. -/
lemma mono1 {a b : R} (hab : a < b) {f : Ioo a b → R} (hf : def_fun S f) :
  ∃ (c d : R) (hcd : c < d) (hcd' : Ioo c d ⊆ Ioo a b),
  function.injective (f ∘ subtype.map id hcd') ∨
  ∃ (z : R), ∀ (x : R) (hx : x ∈ Ioo c d), f ⟨x, hcd' hx⟩ = z := -- TODO: Ugh
begin
  classical,
  by_cases H :
    ∃ (c d : R) (hcd : c < d) (hcd' : Ioo c d ⊆ Ioo a b),
    ∃ z, ∀ (x : R) (hx : x ∈ Ioo c d), f ⟨x, by exact hcd' hx⟩ = z,
  { obtain ⟨c, d, hcd, hcd', z, hf⟩ := H,
    refine ⟨c, d, hcd, hcd', or.inr ⟨z, hf⟩⟩ },
  -- Otherwise, the preimage of any {z} under f is finite
  have finite_fibers : ∀ z, finite (f ⁻¹' {z}),
  { intro z,
    have : def_set S (subtype.val '' (f ⁻¹' {z})),
    { apply def_fun.image,
      exact def_fun_subtype_val,
      exact def_fun.preimage hf def_val_const },
    replace := o_minimal.tame_of_def this,
    replace := this.finite_or_contains_interval,
    cases this with h h,
    { exact finite_of_finite_image (subtype.val_injective.inj_on _) h },
    { exfalso,
      apply H,
      obtain ⟨c, d, hcd, h'⟩ := h,
      have : Ioo c d ⊆ Ioo a b := subset.trans h' (subtype.coe_image_subset _ _),
      refine ⟨c, d, hcd, this, z, λ x hx, _⟩,
      obtain ⟨⟨_, _⟩, hh, rfl⟩ := h' hx,
      exact hh } },
  -- Since the fibers of f are finite, each fiber has a smallest member
  have minocc : ∀ x, ∃ x', f x' = f x ∧ ∀ x'', f x'' = f x → x' ≤ x'',
  { intro x,
    let X := {x' | f x' = f x},
    have : finite X := finite_fibers _,
    let X' := this.to_finset,
    have X'_def : ∀ {x'}, x' ∈ X' ↔ f x' = f x := by apply finite.mem_to_finset,
    have : X'.nonempty := ⟨x, X'_def.mpr rfl⟩,
    let x' := X'.min' this,
    refine ⟨x', X'_def.mp (X'.min'_mem _), λ x'' hx'', _⟩,
    rw ←X'_def at hx'',
    apply X'.min'_le,
    exact hx'' },
  -- Let K be the set of all these smallest members
  let K := {x' | ∀ x'', f x' = f x'' → x' ≤ x''},
  have : f '' K = range f,
  { refine subset.antisymm (image_subset_range _ _) _,
    rintros _ ⟨x, rfl⟩,
    obtain ⟨x', hx'₁, hx'₂⟩ := minocc x,
    refine ⟨x', _, hx'₁⟩,
    intros x'' hx'',
    apply hx'₂,
    cc },
  replace : K.infinite,
  { intro kfin,
    replace kfin : (f '' K).finite := kfin.image _,
    rw this at kfin,
    rw ←image_univ at kfin,
    have : (univ : set (Ioo a b)).finite,
    { apply finite_of_finite_image_fibers kfin,
      intro z,
      convert finite_fibers z,
      ext, simp },
    have := Ioo.infinite hab,
    rw [←infinite_coe_iff, ←infinite_univ_iff] at this,
    contradiction },
  have : def_set S (subtype.val '' K) := begin
    apply def_fun.image def_fun_subtype_val,
    -- TODO: automate this proof
    apply def_set.forall,
    apply def_set.imp,
    apply def_set_eq,
    exact hf.comp def_fun.fst,
    exact hf.comp def_fun.snd,
    -- TODO: definable_le instance for Ioo
    change def_set S {p : Ioo a b × Ioo a b | p.1.val ≤ p.2.val},
    apply definable_le,
    exact def_fun_subtype_val.comp def_fun.fst,
    exact def_fun_subtype_val.comp def_fun.snd
  end,
  replace := (o_minimal.tame_of_def this).finite_or_contains_interval,
  cases this with hK hK,
  { exfalso,
    apply ‹K.infinite›,
    exact finite_of_finite_image (subtype.val_injective.inj_on _) hK },
  { obtain ⟨c, d, hcd, hf⟩ := hK,
    have : Ioo c d ⊆ Ioo a b := subset.trans hf (subtype.coe_image_subset _ _),
    refine ⟨c, d, hcd, this, or.inl _⟩,
    rintros ⟨x₁, hx₁⟩ ⟨x₂, hx₂⟩ hx₁₂,
    let x₁' : ↥(Ioo a b) := ⟨x₁, this hx₁⟩, -- ??
    let x₂' : ↥(Ioo a b) := ⟨x₂, this hx₂⟩,
    have x₁K : K x₁', { rcases hf hx₁ with ⟨⟨_,_⟩, h₁, rfl⟩, exact h₁ },
    have x₂K : K x₂', { rcases hf hx₂ with ⟨⟨_,_⟩, h₂, rfl⟩, exact h₂ },
    have l₁ : x₁' ≤ x₂' := x₁K _ hx₁₂,
    have l₂ : x₂' ≤ x₁' := x₂K _ hx₁₂.symm,
    exact le_antisymm l₁ l₂ }
end

end o_minimal