/-
Copyright (c) 2021 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import combinatorics.simplicial_complex.basic

namespace affine
open set
open_locale classical
variables {a b m n : ℕ} {E : Type*} [normed_group E] [normed_space ℝ E] {S : simplicial_complex E}
  {X : finset E}

/--
A simplicial complex is pure of dimension n iff all its facets have dimension n.
-/
def simplicial_complex.pure_of (S : simplicial_complex E) (n : ℕ) :
  Prop :=
∀ ⦃X⦄, X ∈ S.facets → (X : finset _).card = n

/--
A simplicial complex is pure iff all its facets have the same dimension.
-/
def simplicial_complex.pure (S : simplicial_complex E) :
  Prop :=
∃ n : ℕ, S.pure_of n

def simplicial_complex.full_dimensional (S : simplicial_complex E) :
  Prop :=
sorry --S.pure_of (S.dim + 1)

/--
The pureness of a pure simplicial complex is the cardinality of its facets. Set to 0 for non pure
complexes.
-/
noncomputable def simplicial_complex.pureness (S : simplicial_complex E) :
  ℕ :=
if hS : S.pure then nat.find hS else 0

lemma pureness_def (hS : S.pure) :
  S.pure_of S.pureness :=
begin
  unfold simplicial_complex.pureness,
  rw dif_pos hS,
  exact nat.find_spec hS,
end

lemma pure_of_empty (h : S.faces = {∅}) :
  S.pure :=
begin
  use 0,
  rintro X hX,
  have := facets_subset hX,
  rw h at this,
  change X = ∅ at this,
  rw this,
  exact finset.card_empty,
end

variables [finite_dimensional ℝ E]

lemma face_card_le_pureness (hS : S.pure_of n) (hX : X ∈ S.faces) :
  X.card ≤ n :=
begin
  obtain ⟨Y, hY, hXY⟩ := subfacet hX,
  rw ← hS hY,
  exact finset.card_le_of_subset hXY,
end

lemma pureness_unique_of_nonempty (hS : S.faces.nonempty)
  (ha : S.pure_of a) (hb : S.pure_of b) :
  a = b :=
begin
  obtain ⟨X, hX⟩ := hS,
  obtain ⟨Y, hY, hYX⟩ := subfacet hX,
  rw [←ha hY, ←hb hY],
end

lemma pureness_def' (hSnonempty : S.faces.nonempty) (hS : S.pure_of n) :
  S.pureness = n :=
pureness_unique_of_nonempty hSnonempty (pureness_def ⟨_, hS⟩) hS

lemma facet_iff_dimension_eq_pureness (hS : S.pure_of n) (hX : X ∈ S.faces) :
  X ∈ S.facets ↔ X.card = n :=
begin
  refine ⟨λ hXfacet, hS hXfacet, λ hXcard, ⟨hX, λ Y hY hXY, finset.eq_of_subset_of_card_le hXY _⟩⟩,
  rw hXcard,
  exact face_card_le_pureness hS hY,
end

/--
A simplicial complex is pure iff there exists n such that all faces are subfaces of some
(n - 1)-dimensional face.
-/
lemma pure_iff :
  S.pure ↔ ∃ n : ℕ, ∀ {X}, X ∈ S.faces → ∃ {Y}, Y ∈ S.faces ∧ finset.card Y = n ∧ X ⊆ Y :=
begin
  split,
  { rintro hS,
    use S.pureness,
    rintro X hX,
    obtain ⟨Y, hY, hXY⟩ := subfacet hX,
    exact ⟨Y, facets_subset hY, pureness_def hS hY, hXY⟩ },
  { rintro ⟨n, hS⟩,
    use n,
    rintro X ⟨hX, hXmax⟩,
    obtain ⟨Y, hY, hYcard, hXY⟩ := hS hX,
    rw hXmax hY hXY,
    exact hYcard }
end

lemma facets_subset_facets_of_pureness_eq_pureness_of_subcomplex {S₁ S₂ : simplicial_complex E}
  (hS : S₁.faces ⊆ S₂.faces) (hS₁ : S₁.pure_of n) (hS₂ : S₂.pure_of n) :
  S₁.facets ⊆ S₂.facets :=
begin
  rintro X hX,
  use hS hX.1,
  rintro Y hY hXY,
  apply finset.eq_of_subset_of_card_le hXY,
  rw hS₁ hX,
  exact face_card_le_pureness hS₂ hY,
end

end affine


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

! This file was ported from Lean 3 source module combinatorics.set_family.compression.down
! leanprover-community/mathlib commit 9003f28797c0664a49e4179487267c494477d853
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Finset.Card
import Mathlib.Tactic.ScopedNS

/-!
# Down-compressions

This file defines down-compression.

Down-compressing `𝒜 : Finset (Finset α)` along `a : α` means removing `a` from the elements of `𝒜`,
when the resulting set is not already in `𝒜`.

## Main declarations

* `Finset.nonMemberSubfamily`: `𝒜.nonMemberSubfamily a` is the subfamily of sets not containing
  `a`.
* `Finset.memberSubfamily`: `𝒜.memberSubfamily a` is the image of the subfamily of sets containing
  `a` under removing `a`.
* `Down.compression`: Down-compression.

## Notation

`𝓓 a 𝒜` is notation for `Down.compress a 𝒜` in locale `SetFamily`.

## References

* https://github.com/b-mehta/maths-notes/blob/master/iii/mich/combinatorics.pdf

## Tags

compression, down-compression
-/

variable {α : Type _} [DecidableEq α] {𝒜 ℬ : Finset (Finset α)} {s : Finset α} {a : α}

namespace Finset

/-- Elements of `𝒜` that do not contain `a`. -/
def nonMemberSubfamily (a : α) (𝒜 : Finset (Finset α)) : Finset (Finset α) :=
  𝒜.filter fun s => a ∉ s
#align finset.non_member_subfamily Finset.nonMemberSubfamily

/-- Image of the elements of `𝒜` which contain `a` under removing `a`. Finsets that do not contain
`a` such that `insert a s ∈ 𝒜`. -/
def memberSubfamily (a : α) (𝒜 : Finset (Finset α)) : Finset (Finset α) :=
  (𝒜.filter fun s => a ∈ s).image fun s => erase s a
#align finset.member_subfamily Finset.memberSubfamily

@[simp]
theorem mem_nonMemberSubfamily : s ∈ 𝒜.nonMemberSubfamily a ↔ s ∈ 𝒜 ∧ a ∉ s := by
  simp [nonMemberSubfamily]
#align finset.mem_non_member_subfamily Finset.mem_nonMemberSubfamily

@[simp]
theorem mem_memberSubfamily : s ∈ 𝒜.memberSubfamily a ↔ insert a s ∈ 𝒜 ∧ a ∉ s :=
  by
  simp_rw [memberSubfamily, mem_image, mem_filter]
  refine' ⟨_, fun h => ⟨insert a s, ⟨h.1, by simp⟩, erase_insert h.2⟩⟩
  rintro ⟨s, ⟨hs1, hs2⟩, rfl⟩
  rw [insert_erase hs2]
  exact ⟨hs1, not_mem_erase _ _⟩
#align finset.mem_member_subfamily Finset.mem_memberSubfamily

theorem nonMemberSubfamily_inter (a : α) (𝒜 ℬ : Finset (Finset α)) :
    (𝒜 ∩ ℬ).nonMemberSubfamily a = 𝒜.nonMemberSubfamily a ∩ ℬ.nonMemberSubfamily a :=
  filter_inter_distrib _ _ _
#align finset.non_member_subfamily_inter Finset.nonMemberSubfamily_inter

theorem memberSubfamily_inter (a : α) (𝒜 ℬ : Finset (Finset α)) :
    (𝒜 ∩ ℬ).memberSubfamily a = 𝒜.memberSubfamily a ∩ ℬ.memberSubfamily a :=
  by
  unfold memberSubfamily
  rw [filter_inter_distrib, image_inter_of_injOn _ _ ((erase_injOn' _).mono _)]
  simp
#align finset.member_subfamily_inter Finset.memberSubfamily_inter

theorem memberSubfamily_union (a : α) (𝒜 ℬ : Finset (Finset α)) :
    (𝒜 ∪ ℬ).memberSubfamily a = 𝒜.memberSubfamily a ∪ ℬ.memberSubfamily a := by
  simp_rw [memberSubfamily, filter_union, image_union]
#align finset.member_subfamily_union Finset.memberSubfamily_union

theorem card_memberSubfamily_add_card_nonMemberSubfamily (a : α) (𝒜 : Finset (Finset α)) :
    (𝒜.memberSubfamily a).card + (𝒜.nonMemberSubfamily a).card = 𝒜.card :=
  by
  rw [memberSubfamily, nonMemberSubfamily, card_image_of_injOn]
  · conv_rhs => rw [← filter_card_add_filter_neg_card_eq_card (fun s => (a ∈ s))]
  · apply (erase_injOn' _).mono
    simp
#align finset.card_member_subfamily_add_card_non_member_subfamily Finset.card_memberSubfamily_add_card_nonMemberSubfamily

theorem memberSubfamily_union_nonMemberSubfamily (a : α) (𝒜 : Finset (Finset α)) :
    𝒜.memberSubfamily a ∪ 𝒜.nonMemberSubfamily a = 𝒜.image fun s => s.erase a :=
  by
  ext s
  simp only [mem_union, mem_memberSubfamily, mem_nonMemberSubfamily, mem_image, exists_prop]
  constructor
  · rintro (h | h)
    · exact ⟨_, h.1, erase_insert h.2⟩
    · exact ⟨_, h.1, erase_eq_of_not_mem h.2⟩
  · rintro ⟨s, hs, rfl⟩
    by_cases ha : a ∈ s
    · exact Or.inl ⟨by rwa [insert_erase ha], not_mem_erase _ _⟩
    · exact Or.inr ⟨by rwa [erase_eq_of_not_mem ha], not_mem_erase _ _⟩
#align finset.member_subfamily_union_non_member_subfamily Finset.memberSubfamily_union_nonMemberSubfamily

@[simp]
theorem memberSubfamily_memberSubfamily : (𝒜.memberSubfamily a).memberSubfamily a = ∅ :=
  by
  ext
  simp
#align finset.member_subfamily_member_subfamily Finset.memberSubfamily_memberSubfamily

@[simp]
theorem memberSubfamily_nonMemberSubfamily : (𝒜.nonMemberSubfamily a).memberSubfamily a = ∅ :=
  by
  ext
  simp
#align finset.member_subfamily_non_member_subfamily Finset.memberSubfamily_nonMemberSubfamily

@[simp]
theorem nonMemberSubfamily_memberSubfamily :
    (𝒜.memberSubfamily a).nonMemberSubfamily a = 𝒜.memberSubfamily a :=
  by
  ext
  simp
#align finset.non_member_subfamily_member_subfamily Finset.nonMemberSubfamily_memberSubfamily

@[simp]
theorem nonMemberSubfamily_nonMemberSubfamily :
    (𝒜.nonMemberSubfamily a).nonMemberSubfamily a = 𝒜.nonMemberSubfamily a :=
  by
  ext
  simp
#align finset.non_member_subfamily_non_member_subfamily Finset.nonMemberSubfamily_nonMemberSubfamily

end Finset

open Finset

-- The namespace is here to distinguish from other compressions.
namespace Down

/-- `a`-down-compressing `𝒜` means removing `a` from the elements of `𝒜` that contain it, when the
resulting Finset is not already in `𝒜`. -/
def compression (a : α) (𝒜 : Finset (Finset α)) : Finset (Finset α) :=
  (𝒜.filter fun s => erase s a ∈ 𝒜).disjUnion
      ((𝒜.image fun s => erase s a).filter fun s => s ∉ 𝒜) <|
    disjoint_left.2 fun s h₁ h₂ => by
      have := (mem_filter.1 h₂).2
      exact this (mem_filter.1 h₁).1
#align down.compression Down.compression

-- mathport name: down.compression
@[inherit_doc]
scoped[FinsetFamily] notation "𝓓 " => Down.compression
-- Porting note: had to open this
open FinsetFamily

/-- `a` is in the down-compressed family iff it's in the original and its compression is in the
original, or it's not in the original but it's the compression of something in the original. -/
theorem mem_compression : s ∈ 𝓓 a 𝒜 ↔ s ∈ 𝒜 ∧ s.erase a ∈ 𝒜 ∨ s ∉ 𝒜 ∧ insert a s ∈ 𝒜 :=
  by
  simp_rw [compression, mem_disjUnion, mem_filter, mem_image,
    decide_eq_true_eq, and_comm (a := (¬ s ∈ 𝒜))]
  refine'
    or_congr_right
      (and_congr_left fun hs =>
        ⟨_, fun h => ⟨_, h, erase_insert <| insert_ne_self.1 <| ne_of_mem_of_not_mem h hs⟩⟩)
  rintro ⟨t, ht, rfl⟩
  rwa [insert_erase (erase_ne_self.1 (ne_of_mem_of_not_mem ht hs).symm)]
#align down.mem_compression Down.mem_compression

theorem erase_mem_compression (hs : s ∈ 𝒜) : s.erase a ∈ 𝓓 a 𝒜 :=
  by
  simp_rw [mem_compression, erase_idem, and_self_iff]
  refine' (em _).imp_right fun h => ⟨h, _⟩
  rwa [insert_erase (erase_ne_self.1 (ne_of_mem_of_not_mem hs h).symm)]
#align down.erase_mem_compression Down.erase_mem_compression

-- This is a special case of `erase_mem_compression` once we have `compression_idem`.
theorem erase_mem_compression_of_mem_compression : s ∈ 𝓓 a 𝒜 → s.erase a ∈ 𝓓 a 𝒜 :=
  by
  simp_rw [mem_compression, erase_idem]
  refine' Or.imp (fun h => ⟨h.2, h.2⟩) fun h => _
  rwa [erase_eq_of_not_mem (insert_ne_self.1 <| ne_of_mem_of_not_mem h.2 h.1)]
#align down.erase_mem_compression_of_mem_compression Down.erase_mem_compression_of_mem_compression

theorem mem_compression_of_insert_mem_compression (h : insert a s ∈ 𝓓 a 𝒜) : s ∈ 𝓓 a 𝒜 :=
  by
  by_cases ha : a ∈ s
  · rwa [insert_eq_of_mem ha] at h
  · rw [← erase_insert ha]
    exact erase_mem_compression_of_mem_compression h
#align down.mem_compression_of_insert_mem_compression Down.mem_compression_of_insert_mem_compression

/-- Down-compressing a family is idempotent. -/
@[simp]
theorem compression_idem (a : α) (𝒜 : Finset (Finset α)) : 𝓓 a (𝓓 a 𝒜) = 𝓓 a 𝒜 :=
  by
  ext s
  refine' mem_compression.trans ⟨_, fun h => Or.inl ⟨h, erase_mem_compression_of_mem_compression h⟩⟩
  rintro (h | h)
  · exact h.1
  · cases h.1 (mem_compression_of_insert_mem_compression h.2)
#align down.compression_idem Down.compression_idem

/-- Down-compressing a family doesn't change its size. -/
@[simp]
theorem card_compression (a : α) (𝒜 : Finset (Finset α)) : (𝓓 a 𝒜).card = 𝒜.card :=
  by
  rw [compression, card_disjUnion, image_filter,
    card_image_of_injOn ((erase_injOn' _).mono fun s hs => _), ← card_disjoint_union]
  · conv_rhs => rw [← filter_union_filter_neg_eq (fun s => (erase s a ∈ 𝒜)) 𝒜]
  · exact disjoint_filter_filter_neg 𝒜 𝒜 (fun s => (erase s a ∈ 𝒜))
  intro s hs
  rw [mem_coe, mem_filter, Function.comp_apply] at hs
  exact not_imp_comm.1 erase_eq_of_not_mem (ne_of_mem_of_not_mem hs.1 hs.2).symm
#align down.card_compression Down.card_compression

end Down


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Tim Baumann, Stephen Morgan, Scott Morrison, Floris van Doorn

! This file was ported from Lean 3 source module category_theory.natural_isomorphism
! leanprover-community/mathlib commit 6eb334bd8f3433d5b08ba156b8ec3e6af47e1904
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Functor.Category
import Mathlib.CategoryTheory.Iso

/-!
# Natural isomorphisms

For the most part, natural isomorphisms are just another sort of isomorphism.

We provide some special support for extracting components:
* if `α : F ≅ G`, then `a.app X : F.obj X ≅ G.obj X`,
and building natural isomorphisms from components:
*
```
NatIso.ofComponents
  (app : ∀ X : C, F.obj X ≅ G.obj X)
  (naturality : ∀ {X Y : C} (f : X ⟶ Y), F.map f ≫ (app Y).hom = (app X).hom ≫ G.map f) :
F ≅ G
```
only needing to check naturality in one direction.

## Implementation

Note that `NatIso` is a namespace without a corresponding definition;
we put some declarations that are specifically about natural isomorphisms in the `Iso`
namespace so that they are available using dot notation.
-/

open CategoryTheory

-- declare the `v`'s first; see `CategoryTheory.Category` for an explanation
universe v₁ v₂ v₃ v₄ u₁ u₂ u₃ u₄

namespace CategoryTheory

open NatTrans

variable {C : Type u₁} [Category.{v₁} C] {D : Type u₂} [Category.{v₂} D] {E : Type u₃}
  [Category.{v₃} E]

namespace Iso

/-- The application of a natural isomorphism to an object. We put this definition in a different
namespace, so that we can use `α.app` -/
@[simps]
def app {F G : C ⥤ D} (α : F ≅ G) (X : C) :
    F.obj X ≅ G.obj X where
  hom := α.hom.app X
  inv := α.inv.app X
  hom_inv_id := by rw [← comp_app, Iso.hom_inv_id]; rfl
  inv_hom_id := by rw [← comp_app, Iso.inv_hom_id]; rfl
#align category_theory.iso.app CategoryTheory.Iso.app
#align category_theory.iso.app_hom CategoryTheory.Iso.app_hom
#align category_theory.iso.app_inv CategoryTheory.Iso.app_inv

/--
This unexpander will pretty print `η.app X` properly.
Without this, we would have `Iso.app η X`.
-/
@[app_unexpander Iso.app] def
  unexpandIsoApp : Lean.PrettyPrinter.Unexpander
  | `($_ $η $(X)*)  => set_option hygiene false in `($(η).app $(X)*)
  | _            => throw ()

@[reassoc (attr := simp)]
theorem hom_inv_id_app {F G : C ⥤ D} (α : F ≅ G) (X : C) :
    α.hom.app X ≫ α.inv.app X = 𝟙 (F.obj X) :=
  congr_fun (congr_arg NatTrans.app α.hom_inv_id) X
#align category_theory.iso.hom_inv_id_app CategoryTheory.Iso.hom_inv_id_app
#align category_theory.iso.hom_inv_id_app_assoc CategoryTheory.Iso.hom_inv_id_app_assoc

@[reassoc (attr := simp)]
theorem inv_hom_id_app {F G : C ⥤ D} (α : F ≅ G) (X : C) :
    α.inv.app X ≫ α.hom.app X = 𝟙 (G.obj X) :=
  congr_fun (congr_arg NatTrans.app α.inv_hom_id) X
#align category_theory.iso.inv_hom_id_app CategoryTheory.Iso.inv_hom_id_app
#align category_theory.iso.inv_hom_id_app_assoc CategoryTheory.Iso.inv_hom_id_app_assoc

end Iso

namespace NatIso

open CategoryTheory.Category CategoryTheory.Functor

@[simp]
theorem trans_app {F G H : C ⥤ D} (α : F ≅ G) (β : G ≅ H) (X : C) :
    (α ≪≫ β).app X = α.app X ≪≫ β.app X :=
  rfl
#align category_theory.nat_iso.trans_app CategoryTheory.NatIso.trans_app

theorem app_hom {F G : C ⥤ D} (α : F ≅ G) (X : C) : (α.app X).hom = α.hom.app X :=
  rfl
#align category_theory.nat_iso.app_hom CategoryTheory.NatIso.app_hom

theorem app_inv {F G : C ⥤ D} (α : F ≅ G) (X : C) : (α.app X).inv = α.inv.app X :=
  rfl
#align category_theory.nat_iso.app_inv CategoryTheory.NatIso.app_inv

variable {F G : C ⥤ D}

instance hom_app_isIso (α : F ≅ G) (X : C) : IsIso (α.hom.app X) :=
  ⟨⟨α.inv.app X,
    ⟨by rw [← comp_app, Iso.hom_inv_id, ← id_app], by rw [← comp_app, Iso.inv_hom_id, ← id_app]⟩⟩⟩
#align category_theory.nat_iso.hom_app_is_iso CategoryTheory.NatIso.hom_app_isIso

instance inv_app_isIso (α : F ≅ G) (X : C) : IsIso (α.inv.app X) :=
  ⟨⟨α.hom.app X,
    ⟨by rw [← comp_app, Iso.inv_hom_id, ← id_app], by rw [← comp_app, Iso.hom_inv_id, ← id_app]⟩⟩⟩
#align category_theory.nat_iso.inv_app_is_iso CategoryTheory.NatIso.inv_app_isIso

section

/-!
Unfortunately we need a separate set of cancellation lemmas for components of natural isomorphisms,
because the `simp` normal form is `α.hom.app X`, rather than `α.app.hom X`.

(With the later, the morphism would be visibly part of an isomorphism, so general lemmas about
isomorphisms would apply.)

In the future, we should consider a redesign that changes this simp norm form,
but for now it breaks too many proofs.
-/

variable (α : F ≅ G)

@[simp]
theorem cancel_natIso_hom_left {X : C} {Z : D} (g g' : G.obj X ⟶ Z) :
    α.hom.app X ≫ g = α.hom.app X ≫ g' ↔ g = g' := by simp only [cancel_epi, refl]
#align category_theory.nat_iso.cancel_nat_iso_hom_left CategoryTheory.NatIso.cancel_natIso_hom_left

@[simp]
theorem cancel_natIso_inv_left {X : C} {Z : D} (g g' : F.obj X ⟶ Z) :
    α.inv.app X ≫ g = α.inv.app X ≫ g' ↔ g = g' := by simp only [cancel_epi, refl]
#align category_theory.nat_iso.cancel_nat_iso_inv_left CategoryTheory.NatIso.cancel_natIso_inv_left

@[simp]
theorem cancel_natIso_hom_right {X : D} {Y : C} (f f' : X ⟶ F.obj Y) :
    f ≫ α.hom.app Y = f' ≫ α.hom.app Y ↔ f = f' := by simp only [cancel_mono, refl]
#align category_theory.nat_iso.cancel_nat_iso_hom_right CategoryTheory.NatIso.cancel_natIso_hom_right

@[simp]
theorem cancel_natIso_inv_right {X : D} {Y : C} (f f' : X ⟶ G.obj Y) :
    f ≫ α.inv.app Y = f' ≫ α.inv.app Y ↔ f = f' := by simp only [cancel_mono, refl]
#align category_theory.nat_iso.cancel_nat_iso_inv_right CategoryTheory.NatIso.cancel_natIso_inv_right

@[simp]
theorem cancel_natIso_hom_right_assoc {W X X' : D} {Y : C} (f : W ⟶ X) (g : X ⟶ F.obj Y)
    (f' : W ⟶ X') (g' : X' ⟶ F.obj Y) :
    f ≫ g ≫ α.hom.app Y = f' ≫ g' ≫ α.hom.app Y ↔ f ≫ g = f' ≫ g' := by
  simp only [← Category.assoc, cancel_mono, refl]
#align category_theory.nat_iso.cancel_nat_iso_hom_right_assoc CategoryTheory.NatIso.cancel_natIso_hom_right_assoc

@[simp]
theorem cancel_natIso_inv_right_assoc {W X X' : D} {Y : C} (f : W ⟶ X) (g : X ⟶ G.obj Y)
    (f' : W ⟶ X') (g' : X' ⟶ G.obj Y) :
    f ≫ g ≫ α.inv.app Y = f' ≫ g' ≫ α.inv.app Y ↔ f ≫ g = f' ≫ g' := by
  simp only [← Category.assoc, cancel_mono, refl]
#align category_theory.nat_iso.cancel_nat_iso_inv_right_assoc CategoryTheory.NatIso.cancel_natIso_inv_right_assoc

@[simp]
theorem inv_inv_app {F G : C ⥤ D} (e : F ≅ G) (X : C) : inv (e.inv.app X) = e.hom.app X := by
  aesop_cat
#align category_theory.nat_iso.inv_inv_app CategoryTheory.NatIso.inv_inv_app

end

variable {X Y : C}

theorem naturality_1 (α : F ≅ G) (f : X ⟶ Y) : α.inv.app X ≫ F.map f ≫ α.hom.app Y = G.map f := by
  simp
#align category_theory.nat_iso.naturality_1 CategoryTheory.NatIso.naturality_1

theorem naturality_2 (α : F ≅ G) (f : X ⟶ Y) : α.hom.app X ≫ G.map f ≫ α.inv.app Y = F.map f := by
  simp
#align category_theory.nat_iso.naturality_2 CategoryTheory.NatIso.naturality_2

theorem naturality_1' (α : F ⟶ G) (f : X ⟶ Y) [IsIso (α.app X)] :
    inv (α.app X) ≫ F.map f ≫ α.app Y = G.map f := by simp
#align category_theory.nat_iso.naturality_1' CategoryTheory.NatIso.naturality_1'

@[reassoc (attr := simp)]
theorem naturality_2' (α : F ⟶ G) (f : X ⟶ Y) [IsIso (α.app Y)] :
    α.app X ≫ G.map f ≫ inv (α.app Y) = F.map f := by
  rw [← Category.assoc, ← naturality, Category.assoc, IsIso.hom_inv_id, Category.comp_id]
#align category_theory.nat_iso.naturality_2' CategoryTheory.NatIso.naturality_2'
#align category_theory.nat_iso.naturality_2'_assoc CategoryTheory.NatIso.naturality_2'_assoc

/-- The components of a natural isomorphism are isomorphisms.
-/
instance isIso_app_of_isIso (α : F ⟶ G) [IsIso α] (X) : IsIso (α.app X) :=
  ⟨⟨(inv α).app X,
      ⟨congr_fun (congr_arg NatTrans.app (IsIso.hom_inv_id α)) X,
        congr_fun (congr_arg NatTrans.app (IsIso.inv_hom_id α)) X⟩⟩⟩
#align category_theory.nat_iso.is_iso_app_of_is_iso CategoryTheory.NatIso.isIso_app_of_isIso

@[simp]
theorem isIso_inv_app (α : F ⟶ G) [IsIso α] (X) : (inv α).app X = inv (α.app X) := by
  -- Porting note: the next lemma used to be in `ext`, but that is no longer allowed.
  -- We've added an aesop apply rule;
  -- it would be nice to have a hook to run those without aesop warning it didn't close the goal.
  apply IsIso.eq_inv_of_hom_inv_id
  rw [← NatTrans.comp_app]
  simp
#align category_theory.nat_iso.is_iso_inv_app CategoryTheory.NatIso.isIso_inv_app

@[simp]
theorem inv_map_inv_app (F : C ⥤ D ⥤ E) {X Y : C} (e : X ≅ Y) (Z : D) :
    inv ((F.map e.inv).app Z) = (F.map e.hom).app Z := by
  aesop_cat
#align category_theory.nat_iso.inv_map_inv_app CategoryTheory.NatIso.inv_map_inv_app

/-- Construct a natural isomorphism between functors by giving object level isomorphisms,
and checking naturality only in the forward direction.
-/
@[simps]
def ofComponents (app : ∀ X : C, F.obj X ≅ G.obj X)
    (naturality : ∀ {X Y : C} (f : X ⟶ Y), F.map f ≫ (app Y).hom = (app X).hom ≫ G.map f) :
    F ≅ G where
  hom := { app := fun X => (app X).hom }
  inv :=
    { app := fun X => (app X).inv,
      naturality := fun X Y f => by
        have h := congr_arg (fun f => (app X).inv ≫ f ≫ (app Y).inv) (naturality f).symm
        simp only [Iso.inv_hom_id_assoc, Iso.hom_inv_id, assoc, comp_id, cancel_mono] at h
        exact h }
#align category_theory.nat_iso.of_components CategoryTheory.NatIso.ofComponents
#align category_theory.nat_iso.of_components_hom_app CategoryTheory.NatIso.ofComponents_hom_app
#align category_theory.nat_iso.of_components_inv_app CategoryTheory.NatIso.ofComponents_inv_app

@[simp]
theorem ofComponents.app (app' : ∀ X : C, F.obj X ≅ G.obj X) (naturality) (X) :
    (ofComponents app' naturality).app X = app' X := by aesop
#align category_theory.nat_iso.of_components.app CategoryTheory.NatIso.ofComponents.app

-- Making this an instance would cause a typeclass inference loop with `isIso_app_of_isIso`.
/-- A natural transformation is an isomorphism if all its components are isomorphisms.
-/
theorem isIso_of_isIso_app (α : F ⟶ G) [∀ X : C, IsIso (α.app X)] : IsIso α :=
  ⟨(IsIso.of_iso (ofComponents (fun X => asIso (α.app X)) (by aesop))).1⟩
#align category_theory.nat_iso.is_iso_of_is_iso_app CategoryTheory.NatIso.isIso_of_isIso_app

/-- Horizontal composition of natural isomorphisms. -/
@[simps]
def hcomp {F G : C ⥤ D} {H I : D ⥤ E} (α : F ≅ G) (β : H ≅ I) : F ⋙ H ≅ G ⋙ I := by
  refine' ⟨α.hom ◫ β.hom, α.inv ◫ β.inv, _, _⟩
  · ext
    rw [← NatTrans.exchange]
    simp
  ext; rw [← NatTrans.exchange]; simp
#align category_theory.nat_iso.hcomp CategoryTheory.NatIso.hcomp
#align category_theory.nat_iso.hcomp_inv CategoryTheory.NatIso.hcomp_inv
#align category_theory.nat_iso.hcomp_hom CategoryTheory.NatIso.hcomp_hom

theorem isIso_map_iff {F₁ F₂ : C ⥤ D} (e : F₁ ≅ F₂) {X Y : C} (f : X ⟶ Y) :
    IsIso (F₁.map f) ↔ IsIso (F₂.map f) := by
  revert F₁ F₂
  suffices ∀ {F₁ F₂ : C ⥤ D} (_ : F₁ ≅ F₂) (_ : IsIso (F₁.map f)), IsIso (F₂.map f) by
    exact fun F₁ F₂ e => ⟨this e, this e.symm⟩
  intro F₁ F₂ e hf
  refine' IsIso.mk ⟨e.inv.app Y ≫ inv (F₁.map f) ≫ e.hom.app X, _, _⟩
  · simp only [NatTrans.naturality_assoc, IsIso.hom_inv_id_assoc, Iso.inv_hom_id_app]
  · simp only [assoc, ← e.hom.naturality, IsIso.inv_hom_id_assoc, Iso.inv_hom_id_app]
#align category_theory.nat_iso.is_iso_map_iff CategoryTheory.NatIso.isIso_map_iff

end NatIso

end CategoryTheory


import Lake
import Init
import Mathlib.Data.Real.Basic

#eval 2-1

--Repr : we can use #eval on it
--DecidableEq : allows you to say that two points are equal

axiom Point : Type
axiom Line : Type
structure Line_Segment where
  p : Point
  q : Point

axiom between (a b c: Point) : Prop

axiom lies_on (a : Point) (ln : Line) : Prop

axiom congruence {A : Type} : A → A → Prop

axiom distance (a b : Point) : ℝ

-- distance axioms
axiom distance_not_neg {p1 p2 : Point} : 0 ≤ distance p1 p2
axiom distance_pos {p1 p2 : Point} :
  p1 ≠ p2 ↔ 0 < distance p1 p2
axiom distance_zero_segment {p : Point} : distance p p = 0

axiom distance_is_symm :
  ∀ (p1 p2 : Point), distance p1 p2 = distance p2 p1

axiom distance_between {a b c : Point} :
  between a b c ↔ distance a b + distance b c = distance a c
axiom between_refl_left (a b : Point) : between a a b
axiom between_refl_right (a b : Point) : between a b b
axiom between_symm {x y z : Point} :
  between x y z → between z y x

-- Congruency axioms

--- Congruency is equivalence relation

#check Equivalence

--#check cong_is_equiv
axiom CongEquiv {A : Type} : IsEquiv A congruence

lemma CongRefl {A : Type} : ∀ a : A, congruence a a :=
  CongEquiv.refl

lemma CongSymm {A : Type} :
  ∀ a b : A, congruence a b → congruence b a :=
  CongEquiv.symm

lemma CongTrans {A : Type} :
  ∀ a b c : A,
    congruence a b → congruence b c → congruence a c :=
  CongEquiv.trans

--lemma Cong_is_refl (A : Type) : ∀ a ∈ A, @congruence A a a :=
 -- Cong_is_equiv


import
  IMO2020.N5.additive_map
  number_theory.legendre_symbol.jacobi_symbol
  extra.number_theory.dirichlet_thm_arithmetic_progression

/-!
# "Legendre stack" maps

Let `p : ℕ → ℕ := p_0 < p_1 < p_2 < ...` be an ascending chain of primes.
We call it a **Legendre stack** if `p_{n + 1} ≡ p_n (mod 4(p_n - 1)!)` for all `n ≥ 0`.
We prove one important property related to the Legendre stack:
* For any `m : ℤ` and `j k : ℕ` with `|m| < min{p_j, p_k}`, we have `(m | p_j) = (m | p_k)`.
Here, `(a | b)` denotes the Jacobi/Legendre symbol.

Now, let `p` be a Legendre stack.
Let `M` be an additive monoid and `c` be a 2-torsion element of `M`.
The **Legendre stack map associated with `p` and `c`** is the map `φ` given by
  `φ(n) = c` if `(n | p_n) = -1` and `φ(n) = 0` otherwise.
We construct it as an additive map; it turns out that this map is additive.

The Legendre symbol is implemented as Jacobi symbol to avoid requiring primality instances.
-/

namespace IMOSL
namespace IMO2020N5

open zmod
open_locale number_theory_symbols

structure legendre_stack :=
(prime_chain : ℕ → ℕ)
(is_prime' : ∀ n : ℕ, (prime_chain n).prime)
(ascending' : strict_mono prime_chain)
(stacking' : ∀ n : ℕ, prime_chain n.succ ≡ prime_chain n [MOD 4 * (prime_chain n).pred.factorial])

namespace legendre_stack

instance : has_coe_to_fun legendre_stack (λ _, ℕ → ℕ) := ⟨legendre_stack.prime_chain⟩

variable (p : legendre_stack)

lemma is_prime : ∀ n : ℕ, (p n).prime := p.is_prime'
lemma ascending : strict_mono p := p.ascending'
lemma stacking : ∀ n : ℕ, p n.succ ≡ p n [MOD 4 * (p n).pred.factorial] := p.stacking'

/-- A raw bound: `n < p_n` for any `n : ℕ`. -/
lemma self_lt : ∀ n : ℕ, n < p n :=
  λ n, nat.rec_on n (p.is_prime 0).pos
    (λ n h, lt_of_le_of_lt (nat.succ_le_iff.mpr h) (p.ascending n.lt_succ_self))

/-- Equivalence of primes in the chain modulo `4`. -/
lemma eq_mod_four (k m : ℕ) : p k ≡ p m [MOD 4] :=
begin
  wlog : k ≤ m,
  refine nat.le_induction rfl (λ n _ h, h.trans _) m case,
  exact (nat.modeq.of_modeq_mul_right _ (p.stacking n)).symm
end

/-- Each prime in the chain must be odd. -/
lemma odd (n : ℕ) : odd (p n) :=
begin
  have h := p.eq_mod_four n 2,
  rw [bit0, ← two_mul] at h,
  replace h := nat.modeq.of_modeq_mul_right _ h,
  rw nat.modeq at h,
  rw [nat.odd_iff, h],
  exact (or_iff_right (ne_of_gt (p.self_lt 2))).mp (p.is_prime 2).eq_two_or_odd
end

/-- Stronger modular equivalence; for any `k ≤ m`, `p_m ≡ p_k (mod 4(p_k - 1)!). -/
lemma eq_mod_factorial {k m : ℕ} (h : k ≤ m) : p m ≡ p k [MOD 4 * (p k).pred.factorial] :=
begin
  refine nat.le_induction rfl (λ n h0 h1, nat.modeq.trans _ h1) _ h,
  obtain ⟨c, h2⟩ : (p k).pred.factorial ∣ (p n).pred.factorial :=
    nat.factorial_dvd_factorial (nat.pred_le_pred (p.ascending.monotone h0)),
  refine nat.modeq.of_modeq_mul_right c _,
  rw [mul_assoc, ← h2],
  exact p.stacking n
end

/-- For any `k : ℕ`, `(0 | p k) = 0`. -/
theorem legendre_zero_left (k : ℕ) : J(0 | p k) = 0 :=
  jacobi_sym.zero_left (p.is_prime k).one_lt

/-- For any `n : ℤ` with `n ≠ 0`, `(n | p n) = ±1`. -/
theorem legendre_ne_zero {n : ℕ} (h : n ≠ 0) : J(n | p n) = 1 ∨ J(n | p n) = -1 :=
begin
  apply jacobi_sym.eq_one_or_neg_one,
  rw [int.gcd_eq_nat_abs, int.nat_abs_of_nat, int.nat_abs_of_nat,
      ← nat.coprime_iff_gcd_eq_one, nat.coprime_comm, (p.is_prime n).coprime_iff_not_dvd],
  exact nat.not_dvd_of_pos_of_lt (zero_lt_iff.mpr h) (p.self_lt n)
end

/-- For any `b : ℤ` and `k m : ℕ` with `|b| < p_k` and `k ≤ m`, we have `(b | p_k) = (b | p_m)`. -/
theorem legendre_equiv_int' {b : ℤ} {k m : ℕ} (hk : b.nat_abs < p k) (hkm : k ≤ m) :
  J(b | p k) = J(b | p m) :=
begin
  rcases eq_or_ne b 0 with rfl | hb,
  rw [legendre_zero_left, legendre_zero_left],
  rw [jacobi_sym.mod_right _ (odd p k), jacobi_sym.mod_right _ (odd p m)],
  congr' 1; rw ← nat.modeq,
  suffices : b.nat_abs ∣ (p k).pred.factorial,
  { cases this with c h,
    refine (nat.modeq.of_modeq_mul_right c _).symm,
    rw [mul_assoc, ← h]; exact eq_mod_factorial p hkm },
  refine nat.dvd_factorial (int.nat_abs_pos_of_ne_zero hb) _,
  rwa [nat.pred_eq_sub_one, ← nat.lt_iff_le_pred (p.is_prime k).pos]
end

/-- For any `b : ℤ` and `k m : ℕ` with `|b| < min{p_k, p_m}`, we have `(b | p_k) = (b | p_m)`. -/
theorem legendre_equiv_int {b : ℤ} {k m : ℕ} (hk : b.nat_abs < p k) (hm : b.nat_abs < p m) :
  J(b | p k) = J(b | p m) :=
  by wlog : k ≤ m; exact legendre_equiv_int' p hk case

/-- For any `b k m : ℕ` with `b < p_k` and `k ≤ m`, we have `(b | p_k) = (b | p_m)`. -/
theorem legendre_equiv_nat' {b k m : ℕ} (hk : b < p k) (hkm : k ≤ m) : J(b | p k) = J(b | p m) :=
  by convert legendre_equiv_int' p _ hkm; rwa int.nat_abs_of_nat

/-- For any `b k m : ℕ` with `b < min{p_k, p_m}`, we have `(b | p_k) = (b | p_m)`. -/
theorem legendre_equiv_nat {b k m : ℕ} (hk : b < p k) (hm : b < p m) : J(b | p k) = J(b | p m) :=
  by wlog : k ≤ m; exact legendre_equiv_nat' p hk case

/-- An invariant for `p` based on congruence mod `4`, taking values `-1` or `1`. -/
def χ₄ := χ₄ (p 0)

/-- For any `k : ℕ`, `(-1 | p k) = χ₄ p`. -/
theorem legendre_equiv_χ₄ (k : ℕ) : J(-1 | p k) = p.χ₄ :=
begin
  rw [← legendre_equiv_int' p _ k.zero_le, jacobi_sym.at_neg_one (p.odd 0), χ₄],
  rw [int.nat_abs_neg, int.nat_abs_one]; exact (p.is_prime 0).one_lt
end

/-- `χ₄ p = ± 1`. -/
theorem χ₄_eq_one_or_neg_one : p.χ₄ = 1 ∨ p.χ₄ = -1 :=
begin
  rw ← p.legendre_equiv_χ₄ 0,
  apply jacobi_sym.eq_one_or_neg_one,
  rw [int.gcd_eq_nat_abs, int.nat_abs_of_nat, int.nat_abs_neg, int.nat_abs_one, nat.gcd_one_left]
end

/-- For any `b : ℤ` and `k : ℕ`, `(-b | p k) = χ₄ p * (b | p k)` -/
theorem legendre_neg (b : ℤ) (k : ℕ) : J(-b | p k) = χ₄ p * J(b | p k) :=
  by rw [← legendre_equiv_χ₄ p k, ← jacobi_sym.mul_left, neg_one_mul]

section monoid_map

/-- The Legendre stack map associated with `p` and `c` as an additive map. -/
def map {M : Type*} [add_monoid M] (c : M) (hc : 2 • c = 0) : additive_map M :=
{ to_fun := λ n, ite (J(n | p n) = -1) c 0,
  map_zero' := by rw [nat.cast_zero, legendre_zero_left, if_neg (by norm_num : (0 : ℤ) ≠ -1)],
  map_one' := by rw [nat.cast_one, jacobi_sym.one_left, if_neg (by norm_num : (1 : ℤ) ≠ -1)],
  map_mul' := λ x y hx hy, begin
    have X : ∀ {a b : ℕ}, b ≠ 0 → J(a | p a) = J(a | p (a * b)) := λ a b hb,
      legendre_equiv_nat' p (p.self_lt a) (nat.le_mul_of_pos_right (zero_lt_iff.mpr hb)),
    rw [nat.cast_mul, jacobi_sym.mul_left, ← X hy, mul_comm x y, ← X hx],
    replace X : (1 : ℤ) ≠ -1 := by norm_num,
    cases legendre_ne_zero p hx with hx0 hx0; cases legendre_ne_zero p hy with hy0 hy0,
    all_goals { simp only [hx0, hy0,if_true, eq_self_iff_true, if_false, X,
      zero_add, add_zero, one_mul, mul_one, neg_mul_neg] },
    rw [← two_nsmul, ← hc]
  end }

variables {M : Type*} [add_comm_monoid M] {c : M} (hc : 2 • c = 0)
include hc

theorem map_val (n : ℕ) : p.map c hc n = ite (J(n | p n) = -1) c 0 := rfl

theorem map_val' {n k : ℕ} (h : n < p k) : p.map c hc n = ite (J(n | p k) = -1) c 0 :=
  by rw [map_val, p.legendre_equiv_nat (p.self_lt n) h]

/-- The map is never zero if `c ≠ 0`. -/
theorem map_is_non_zero (h : c ≠ 0) : p.map c hc ≠ 0 :=
begin
  haveI : fact (p 0).prime := ⟨p.is_prime 0⟩,
  obtain ⟨a, ha, h0⟩ : ∃ a : ℕ, a < p 0 ∧ ¬is_square ((a : ℤ) : zmod (p 0)) :=
  begin
    suffices : ∃ a : zmod (p 0), ¬is_square a,
    { cases this with a h0,
      refine ⟨a.val, val_lt a, _⟩,
      rwa [zmod.nat_cast_val, zmod.int_cast_cast, zmod.cast_id', id.def] },
    refine finite_field.exists_nonsquare (λ h0, _),
    rw zmod.ring_char_zmod_n at h0,
    have h1 := p.odd 0,
    rw [h0, nat.odd_iff_not_even] at h1,
    exact h1 even_two
  end,
  rw [← zmod.nonsquare_iff_jacobi_sym_eq_neg_one, legendre_equiv_nat' p ha a.zero_le] at h0,
  intros h1; replace h1 := fun_like.congr_fun h1 a,
  rw [additive_map.zero_apply, p.map_val, if_pos h0] at h1,
  exact h h1
end

/-- The map is zero iff `c = 0`. -/
theorem map_is_zero_iff : p.map c hc = 0 ↔ c = 0 :=
begin
  split; intros h,
  by_contra h0; exact p.map_is_non_zero hc h0 h,
  ext n; rw [additive_map.zero_apply, map_val, h, if_t_t]
end

theorem map_mul_mod {a b m : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) (ha0 : a < p m) (hb0 : b < p m) :
  p.map c hc a + p.map c hc b = p.map c hc (a * b % p m) :=
begin
  rw [p.map_val, p.map_val, p.map_val' hc (nat.mod_lt _ (p.is_prime m).pos),
      int.coe_nat_mod, ← jacobi_sym.mod_left, nat.cast_mul, jacobi_sym.mul_left,
      p.legendre_equiv_nat ha0 (p.self_lt a), p.legendre_equiv_nat hb0 (p.self_lt b)],
  have X : (1 : ℤ) ≠ -1 := by norm_num,
  cases legendre_ne_zero p ha with ha1 ha1; cases legendre_ne_zero p hb with hb1 hb1,
  all_goals { simp only [ha1, hb1, if_true, eq_self_iff_true, if_false, X,
    zero_add, add_zero, one_mul, mul_one, neg_mul_neg] },
  rw [← two_nsmul, ← hc]
end

theorem map_p_sub {n k : ℕ} (h : n ≠ 0) (h0 : n < p k) :
  p.map c hc (p k - n) = ite (p.χ₄ = -1) c 0 + p.map c hc n :=
begin
  have h1 : 0 < n := by rwa zero_lt_iff,
  rw [p.map_val' hc (nat.sub_lt (lt_trans h1 h0) h1), nat.cast_sub (le_of_lt h0),
      sub_eq_add_neg, jacobi_sym.mod_left, int.add_mod_self_left, ← jacobi_sym.mod_left,
      ← neg_one_mul, jacobi_sym.mul_left, p.legendre_equiv_χ₄ k, p.map_val' hc h0,
      p.legendre_equiv_nat h0 (p.self_lt n)],
  have X : (1 : ℤ) ≠ -1 := by norm_num,
  cases legendre_ne_zero p h with h2 h2; cases p.χ₄_eq_one_or_neg_one with h3 h3,
  all_goals { simp only [h2, h3, if_true, eq_self_iff_true, if_false, X,
    zero_add, add_zero, one_mul, mul_one, neg_mul_neg] },
  rw [← two_nsmul, ← hc]
end

theorem map_p_sub_χ₄_eq_one (h : p.χ₄ = 1) {n k : ℕ} (h0 : n ≠ 0) (h1 : n < p k) :
  p.map c hc (p k - n) = p.map c hc n :=
  by rw [p.map_p_sub hc h0 h1, h, if_neg (by norm_num : (1 : ℤ) ≠ -1), zero_add]

theorem map_p_sub_χ₄_eq_neg_one (h : p.χ₄ = -1) {n k : ℕ} (h0 : n ≠ 0) (h1 : n < p k)  :
  p.map c hc (p k - n) = c + p.map c hc n :=
  by rw [p.map_p_sub hc h0 h1, h, if_pos rfl]

end monoid_map

end legendre_stack

section construction

private lemma lt_four_times_pred_factorial (p : ℕ) : p < 4 * p.pred.factorial :=
begin
  cases p with p p_ih,
  rw [nat.pred_zero, nat.factorial_zero, mul_one]; norm_num,
  rw nat.pred_succ; induction p with p h,
  rw [nat.factorial_zero, mul_one]; norm_num,
  rcases p.eq_zero_or_pos with rfl | h0,
  rw [nat.factorial_one, mul_one]; norm_num,
  rw [nat.factorial_succ, mul_comm (p + 1), ← mul_assoc],
  rw ← nat.succ_le_iff at h; refine lt_of_lt_of_le _ (nat.mul_le_mul_right _ h),
  rwa [lt_mul_iff_one_lt_right p.succ.succ_pos, lt_add_iff_pos_left]
end

private lemma coprime_four_times_pred_factorial {p : ℕ} (hp : p.prime) (h : 2 < p) :
  p.coprime (4 * p.pred.factorial) :=
begin
  rw [nat.coprime_mul_iff_right, bit0, ← two_mul, ← sq]; split,
  exact nat.coprime.pow_right _ ((nat.coprime_primes hp nat.prime_two).mpr (ne_of_gt h)),
  replace h := nat.pred_lt (ne_of_gt (pos_of_gt h)),
  generalize_hyp : p.pred = k at h ⊢,
  induction k with k k_ih,
  rw nat.factorial_zero; exact p.coprime_one_right,
  rw [nat.factorial_succ, nat.coprime_mul_iff_right, and_comm]; split,
  exact k_ih (nat.lt_of_succ_lt h),
  rw hp.coprime_iff_not_dvd; exact nat.not_dvd_of_pos_of_lt k.succ_pos h
end

private lemma exists_next_stack {p : ℕ} (hp : p.prime) (h : 2 < p) :
  ∃ q : ℕ, p < q ∧ q.prime ∧ q ≡ p [MOD 4 * p.pred.factorial] :=
begin
  have X := lt_four_times_pred_factorial p,
  obtain ⟨q, h0, h1, h2⟩ :=
    extra.exists_infinite_primes_mod_eq X (coprime_four_times_pred_factorial hp h) p,
  refine ⟨q, h0, h1, _⟩,
  rw [nat.modeq, nat.mod_eq_of_lt X, h2]
end

private def next_stack_term {p : ℕ} (hp : p.prime) (h : 2 < p) :=
  nat.find (exists_next_stack hp h)

private lemma next_stack_term_prime {p : ℕ} (hp : p.prime) (h : 2 < p) :
  nat.prime (next_stack_term hp h) :=
  (nat.find_spec (exists_next_stack hp h)).2.1

private lemma next_stack_term_self_lt {p : ℕ} (hp : p.prime) (h : 2 < p) :
  p < next_stack_term hp h :=
  (nat.find_spec (exists_next_stack hp h)).1

private lemma next_stack_term_two_lt {p : ℕ} (hp : p.prime) (h : 2 < p) :
  2 < next_stack_term hp h :=
  lt_trans h (next_stack_term_self_lt hp h)

private lemma next_stack_term_mod_pred_factorial {p : ℕ} (hp : p.prime) (h : 2 < p) :
  next_stack_term hp h ≡ p [MOD 4 * p.pred.factorial] :=
  (nat.find_spec (exists_next_stack hp h)).2.2

private def bundled_next_stack_term (p' : {p : ℕ | p.prime ∧ 2 < p}) : {p : ℕ | p.prime ∧ 2 < p} :=
  ⟨next_stack_term p'.2.1 p'.2.2, next_stack_term_prime p'.2.1 p'.2.2,
   next_stack_term_two_lt p'.2.1 p'.2.2⟩

private def bundled_stack_map (p' : {p : ℕ | p.prime ∧ 2 < p}) : legendre_stack :=
{ prime_chain := λ n, (bundled_next_stack_term^[n] p').1,
  is_prime' := λ n, (bundled_next_stack_term^[n] p').2.1,
  ascending' := strict_mono_nat_of_lt_succ (λ n, by
    rw [function.iterate_succ', function.comp_app]; exact next_stack_term_self_lt _ _),
  stacking' := λ n, by rw [function.iterate_succ', function.comp_app];
    exact next_stack_term_mod_pred_factorial _ _ }

/-- Concrete legendre stack map, starting at given odd prime. -/
def concrete_stack_map {p : ℕ} (hp : p.prime) (h : 2 < p) : legendre_stack :=
  bundled_stack_map ⟨p, hp, h⟩

/-- The `χ₄` value of a concrete legendre stack map. -/
theorem concrete_stack_χ₄ {p : ℕ} (hp : p.prime) (h : 2 < p) :
  (concrete_stack_map hp h).χ₄ = χ₄ p := rfl

/-- The "standard" legendre stack map starting with `p = 5`. -/
def standard_stack_map :=
  concrete_stack_map (by norm_num : nat.prime 5) (by norm_num : 2 < 5)

/-- The `χ₄` value of the standard legendre stack map is `1`. -/
theorem standard_stack_χ₄ : standard_stack_map.χ₄ = 1 := rfl

/-- An abstraction of the existence of the standard stack. -/
theorem exists_legendre_stack_χ₄_eq_one : ∃ p : legendre_stack, p.χ₄ = 1 :=
  ⟨standard_stack_map, standard_stack_χ₄⟩

end construction

end IMO2020N5
end IMOSL


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import measure_theory.measure.lebesgue

/-!
# Lebesgue measure on `ℂ`

In this file we define Lebesgue measure on `ℂ`. Since `ℂ` is defined as a `structure` as the
push-forward of the volume on `ℝ²` under the natural isomorphism. There are (at least) two
frequently used ways to represent `ℝ²` in `mathlib`: `ℝ × ℝ` and `fin 2 → ℝ`. We define measurable
equivalences (`measurable_equiv`) to both types and prove that both of them are volume preserving
(in the sense of `measure_theory.measure_preserving`).
-/

open measure_theory
noncomputable theory

namespace complex

/-- Lebesgue measure on `ℂ`. -/
instance measure_space : measure_space ℂ :=
⟨measure.map basis_one_I.equiv_fun.symm volume⟩

/-- Measurable equivalence between `ℂ` and `ℝ² = fin 2 → ℝ`. -/
def measurable_equiv_pi : ℂ ≃ᵐ (fin 2 → ℝ) :=
basis_one_I.equiv_fun.to_continuous_linear_equiv.to_homeomorph.to_measurable_equiv

/-- Measurable equivalence between `ℂ` and `ℝ × ℝ`. -/
def measurable_equiv_real_prod : ℂ ≃ᵐ (ℝ × ℝ) :=
equiv_real_prodₗ.to_homeomorph.to_measurable_equiv

lemma volume_preserving_equiv_pi :
  measure_preserving measurable_equiv_pi :=
(measurable_equiv_pi.symm.measurable.measure_preserving _).symm

lemma volume_preserving_equiv_real_prod : measure_preserving measurable_equiv_real_prod :=
(volume_preserving_fin_two_arrow ℝ).comp volume_preserving_equiv_pi

end complex


import .posets

namespace impossible
    open nat

    open posets

    -- bool:
    instance bool_order:
        bot_order bool := {
            le := λ x y: bool, x = ff ∨ (x = tt ∧ y = tt),
            le_refl := begin
                intros,
                induction a;
                simp,
            end,
            le_trans := begin
                intros,
                induction a_1,
                case or.inl {
                    simp,
                    left,
                    assumption,
                },
                case or.inr {
                    simp,
                    simp at a_2,
                    cases a_2,
                    case or.inl {
                        induction b,
                        case bool.ff {
                            apply false.elim,
                            apply ff_eq_tt_eq_false,
                            apply a_1.2,
                        },
                        case bool.tt {
                            apply false.elim,
                            apply tt_eq_ff_eq_false,
                            assumption,
                        },
                    },
                    case or.inr {
                        right,
                        split,
                        apply a_1.1,
                        apply a_2.2,
                    },
                },
            end,
            le_antisymm := begin
                intros,
                cases a_1,
                case or.inl {
                    cases a_2,
                    case or.inl {
                        rw [a_1, a_2],
                    },
                    case or.inr {
                        apply false.elim,
                        apply ff_eq_tt_eq_false,
                        rw [←a_1, ←a_2.2],
                    },
                },
                case or.inr {
                    cases a_2,
                    case or.inl {
                        apply false.elim,
                        apply ff_eq_tt_eq_false,
                        rw [←a_1.2, a_2],
                    },
                    case or.inr {
                        rw [a_1.1, a_2.1],
                    },
                },
            end,
            bot := ff,
            bot_le := begin
                intros,
                left,
                refl,
            end,
        }

    @[reducible, pattern] instance bool.has_zero:
        has_zero bool :=
            (| ff |)

    @[reducible, pattern] instance bool.has_one:
        has_one bool :=
            (| tt |)

    theorem bool.le_tt (x: bool):
        x ≤ 1 := begin
            induction x,
            apply bot_le,
            refl,
        end

    instance bool.coe_to_nat:
        has_coe bool nat := {
            coe := λ x: bool, match x with
                | 0 := 0
                | 1 := 1
                end,
        }

    -- bitstream:
    structure bitstream :=
        (bit: ℕ → bool)

    instance bitstream.coe_to_fun:
        has_coe_to_fun bitstream := {
            F := λ b: bitstream, ℕ → bool,
            coe := bitstream.bit,
        }

    @[simp] theorem bitstream.bit.of_coe (b: bitstream) (n: ℕ):
        b n = b.bit n := rfl

    def bitstream.cons (x: bool) (b: bitstream): bitstream := {
        bit := λ n: ℕ, match n with
            | 0 := x
            | (succ m) := b m
            end,
    }

    infixr ` # `:67 := bitstream.cons

    def all (x: bool): bitstream := {
        bit := λ n, x,
    }

    @[simp] theorem all.of_bit (x: bool) (n: ℕ):
        (all x) n = x := rfl

    -- find:
    def findN: ℕ → (bitstream → bool) → bitstream
    | 0 P := all 0
    | (succ N) P :=
        let find0 := 0 # findN N (λ b, P (0 # b)) in
        let find1 := 1 # findN N (λ b, P (1 # b)) in
        match P find0 with
        | tt := find0
        | ff := find1
        end

    def find (P: bitstream → bool): bitstream := {
        bit := λ n: ℕ, (findN (succ n) P) n,
    }

    def forsome (P: bitstream → bool): bool :=
        P (find P)

    def forevery (P: bitstream → bool): bool :=
        bnot (forsome (bnot ∘ P))

    def equal {T: Sort _} [decidable_eq T] (P1 P2: bitstream → T): bool :=
        forevery (λ b: bitstream, P1 b = P2 b)

    -- tests:
    namespace find_test
        def f (b: bitstream): ℤ :=
            b (7 * (b 4) + 4 * (b 7) + 4)

        def g (b: bitstream): ℤ :=
            b ((b 4) + 11 * (b 7))

        def h (b: bitstream): ℤ :=
            if b 7 = 0 then
                if b 4 = 0 then
                    b 4
                else
                    b 11
            else
                if b 4 = 1 then
                    b 15
                else
                    b 8

        #eval equal f g
        #eval equal f h
        #eval equal g h
        #eval equal f f
        #eval equal g g
        #eval equal h h
    end find_test

    -- conat:
    structure conat extends bitstream :=
        [mono: monotone.decreasing bit]

    instance conat.coe_to_fun:
        has_coe_to_fun conat := {
            F := λ cn: conat, ℕ → bool,
            coe := λ cn: conat, cn.bit,
        }

    @[simp] theorem conat.bit.of_coe (cn: conat) (n: ℕ):
        cn n = cn.bit n := rfl

    def conat.zero: conat := {
        bit := all 0,
        mono := begin
            split,
            intros,
            refl,
        end,
    }

    instance conat.has_zero:
        has_zero conat :=
            (| conat.zero |)

    def conat.inf: conat := {
        bit := all 1,
        mono := begin
            split,
            intros,
            refl,
        end,
    }

    def conat.succ (cn: conat): conat := {
        bit := λ n: ℕ, match n with
            | 0 := 1
            | (succ m) := cn m
            end,
        mono := begin
            split,
            intros,
            simp,
            induction x,
            case nat.zero {
                rw [conat.succ._match_1],
                apply bool.le_tt,
            },
            case nat.succ {
                induction y,
                case nat.zero {
                    apply false.elim,
                    apply not_succ_le_zero x_n a,
                },
                case nat.succ {
                    rw [conat.succ._match_1, conat.succ._match_1],
                    apply cn.mono.elim,
                    apply le_of_succ_le_succ,
                    assumption,
                },
            },
        end,
    }
end impossible


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

/-!
# Groups with an adjoined zero element

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

Examples are:

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

## Main definitions

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

## Implementation details

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

-/

set_option old_structure_cmd true
open_locale classical
open function

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

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

attribute [field_simps] mul_div_assoc'

section

section mul_zero_class

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

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

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

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

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

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

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

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

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

/-- To match `one_mul_eq_id`. -/
lemma zero_mul_eq_const : ((*) (0 : M₀)) = function.const _ 0 := funext zero_mul

/-- To match `mul_one_eq_id`. -/
lemma mul_zero_eq_const : (* (0 : M₀)) = function.const _ 0 := funext mul_zero

end mul_zero_class

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

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

section

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

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

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

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

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

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

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

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

end

end

section

variables [mul_zero_one_class M₀]

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

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

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

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

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

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

alias subsingleton_iff_zero_eq_one ↔ subsingleton_of_zero_eq_one _

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

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

section

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

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

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

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

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

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

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

end

section semigroup_with_zero

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

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

end semigroup_with_zero

section monoid_with_zero

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

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

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

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

variables [monoid_with_zero M₀]

namespace units

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

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

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

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

end units

namespace is_unit

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

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

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

end is_unit

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

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

namespace ring
open_locale classical

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

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

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

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

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

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

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

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

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

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

variables (M₀)

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

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

variables {M₀}

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

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

end ring

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

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

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

variable (M₀)

end monoid_with_zero

section cancel_monoid_with_zero

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

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

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

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

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

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

lemma mul_right_eq_self₀ : a * b = a ↔ b = 1 ∨ a = 0 :=
calc a * b = a ↔ a * b = a * 1 : by rw mul_one
     ...       ↔ b = 1 ∨ a = 0 : mul_eq_mul_left_iff

lemma mul_left_eq_self₀ : a * b = b ↔ a = 1 ∨ b = 0 :=
calc a * b = b ↔ a * b = 1 * b : by rw one_mul
     ...       ↔ a = 1 ∨ b = 0 : mul_eq_mul_right_iff

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

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

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

end cancel_monoid_with_zero

section cancel_comm_monoid_with_zero

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

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

end cancel_comm_monoid_with_zero

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

alias div_eq_mul_inv ← division_def

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

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

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

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

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

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

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

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

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

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

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

@[priority 100]
instance group_with_zero.to_has_involutive_inv : has_involutive_inv G₀ :=
{ inv := has_inv.inv,
  inv_inv := λ a, begin
    by_cases h : a = 0, { simp [h] },
    calc a⁻¹⁻¹ = a * (a⁻¹ * a⁻¹⁻¹) : by simp [h]
          ... = a                 : by simp [inv_ne_zero h]
  end }

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

end group_with_zero

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

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

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

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

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

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

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

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

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

/-- In a group with zero, an existential over a unit can be rewritten in terms of `units.mk0`. -/
lemma exists0 {p : G₀ˣ → Prop} : (∃ g : G₀ˣ, p g) ↔ ∃ (g : G₀) (hg : g ≠ 0), p (units.mk0 g hg) :=
⟨λ ⟨g, pg⟩, ⟨g, g.ne_zero, (g.mk0_coe g.ne_zero).symm ▸ pg⟩, λ ⟨g, hg, pg⟩, ⟨units.mk0 g hg, pg⟩⟩

/-- An alternative version of `units.exists0`. This one is useful if Lean cannot
figure out `p` when using `units.exists0` from right to left. -/
lemma exists0' {p : Π g : G₀, g ≠ 0 → Prop} :
  (∃ (g : G₀) (hg : g ≠ 0), p g hg) ↔ ∃ g : G₀ˣ, p g g.ne_zero :=
iff.trans (by simp_rw [coe_mk0]) exists0.symm

@[simp] lemma exists_iff_ne_zero {x : G₀} : (∃ u : G₀ˣ, ↑u = x) ↔ x ≠ 0 :=
by simp [exists0]

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

end units

section group_with_zero
variables [group_with_zero G₀]

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

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

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

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

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

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

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

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

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

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

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

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

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

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

local attribute [simp] div_eq_mul_inv mul_comm mul_assoc mul_left_comm

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

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

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

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

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

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

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

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

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

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

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

variables {a b c : G₀}

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

end group_with_zero

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

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

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

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

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

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

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

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

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

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

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

local attribute [simp] mul_assoc mul_comm mul_left_comm

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

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

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

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

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

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

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

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

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

end comm_group_with_zero

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

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

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

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

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

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

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

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

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

end comm_group_with_zero

namespace semiconj_by

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

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

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

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

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

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

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

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

end semiconj_by

namespace commute

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

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

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

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

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

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

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

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

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

end commute

namespace monoid_with_zero_hom

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

section monoid_with_zero

variables (f : G₀ →*₀ M₀) {a : G₀}

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

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

end monoid_with_zero

section group_with_zero

variables (f : G₀ →*₀ G₀') (a b : G₀)

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

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

end group_with_zero

end monoid_with_zero_hom

/-- Inversion on a commutative group with zero, considered as a monoid with zero homomorphism. -/
def inv_monoid_with_zero_hom {G₀ : Type*} [comm_group_with_zero G₀] : G₀ →*₀ G₀ :=
{ to_fun := has_inv.inv,
  map_zero' := inv_zero,
  map_one' := inv_one,
  map_mul' := λ _ _, mul_inv₀ }

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

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

section noncomputable_defs

variables {M : Type*} [nontrivial M]

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

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

end noncomputable_defs


import data.list data.list.sort

namespace list
section sorted
variables {α : Type*} (r : α → α → Prop)

lemma sorted_tail {l : list α} (h : sorted r l) : sorted r l.tail := begin
    cases l; simp,
    exact sorted_of_sorted_cons h,
end

lemma sorted_nodup_ext [is_antisymm _ r] :
∀ {l₁ l₂ : list α}, sorted r l₁ → sorted r l₂ → (nodup l₁) → (nodup l₂)
    → (∀ a, a ∈ l₁ ↔ a ∈ l₂) → l₁ = l₂
|[] [] := by intros; refl
|[] (hd :: tl) := begin simp, intros _ _ _ _ h, apply h hd, simp, end
| (hd :: tl) [] := begin simp, intros _ _ _ _ h, apply h hd, simp, end
|(hd₁ :: tl₁) (hd₂ :: tl₂) := begin
    simp, intros hs₁ hs₁' hs₂ hs₂' hhd₁ nl₁ hhd₂ nl₂ h,
    have h₁ := h hd₁, simp at h₁,
    have h₂ := h hd₂, simp at h₂,
    cases h₁; cases h₂,
    any_goals {
        try {apply and.intro h₁}, try {apply and.intro h₂}, try {apply and.intro h₂.symm},
        try {
            have h₃ := antisymm (hs₁ hd₂ h₂) (hs₂ hd₁ h₁),
            apply and.intro h₃,
            clear h₁ h₂, rename h₃ h₁,
        },
        apply sorted_nodup_ext hs₁' hs₂' nl₁ nl₂,
        intro a, split,
    },
    all_goals {
        intro ha,
        have ha₁ : a ≠ hd₁,
            intro hahd, rw hahd at ha, {rw h₁ at ha, exact hhd₂ ha} <|> {rw ←h₂ at ha, exact hhd₂ ha} <|> {exact hhd₁ ha},
        have ha₂ : a ≠ hd₂,
            intro hahd, rw hahd at ha, {rw h₂ at ha, exact hhd₁ ha} <|> {rw ←h₁ at ha, exact hhd₁ ha} <|> {exact hhd₂ ha},
        let ha' := h a,
        simpa [ha₁, ha₂, ha] using ha',
    },
end

/-
lemma sorted_filter (l : list α) (h : l.sorted r) (p : α → Prop) [decidable_pred p] :
(l.filter p).sorted r := begin
    induction l, simp,
    by_cases hp : p l_hd;
    simp [hp] at ⊢ h,
    refine ⟨λ b hb _, h.left b hb, l_ih h.right⟩,
    exact l_ih h.right,
end

@[simp] lemma merge_nil_left [decidable_rel r] (l : list α) : merge r [] l = l := by induction l; simp [merge]
@[simp] lemma merge_nil_right [decidable_rel r] (l : list α) : merge r l [] = l := by induction l; simp [merge]

@[simp] lemma mem_merge [decidable_rel r] : ∀ (l₁ l₂ : list α) (a), a ∈ merge r l₁ l₂ ↔ a ∈ l₁ ∨ a ∈ l₂
| [] _ := by simp
| _ [] := by simp
| (hd₁ :: tl₁) (hd₂ :: tl₂) := begin
    by_cases h : r hd₁ hd₂; simp [merge, h]; intro a; split; intro h';
    try {simp [mem_merge tl₁ (hd₂ :: tl₂)] at *}; try{simp [mem_merge (hd₁ :: tl₁) tl₂] at *},
    simp [or_assoc], assumption,
    simp [or_assoc] at h', assumption,
    simp [or_assoc], rw [or.left_comm, or_assoc] at h', assumption,
    simp [or_assoc (a = hd₁), @or.left_comm (a = hd₂)], rw [or_assoc] at h', assumption,
end

lemma sorted_of_sorted_erase_dup [decidable_eq α] (l : list α) (h : l.sorted r) : l.erase_dup.sorted r :=
begin
    induction l, simp,
    simp at h,
    by_cases hed : l_hd ∈ erase_dup l_tl,
    rw [erase_dup_cons_of_mem' hed], exact l_ih h.right,
    rw [erase_dup_cons_of_not_mem' hed], simp, exact ⟨h.left, l_ih h.right⟩,
end
-/
end sorted

end list