/-
Copyright (c) 2019 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton, Scott Morrison

! This file was ported from Lean 3 source module category_theory.epi_mono
! leanprover-community/mathlib commit e97cf15cd1aec9bd5c193b2ffac5a6dc9118912b
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Opposites
import Mathbin.CategoryTheory.Groupoid

/-!
# Facts about epimorphisms and monomorphisms.

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

The definitions of `epi` and `mono` are in `category_theory.category`,
since they are used by some lemmas for `iso`, which is used everywhere.
-/

universe v₁ v₂ u₁ u₂

namespace CategoryTheory

variable {C : Type u₁} [Category.{v₁} C]

#print CategoryTheory.unop_mono_of_epi /-
instance unop_mono_of_epi {A B : Cᵒᵖ} (f : A ⟶ B) [Epi f] : Mono f.unop :=
  ⟨fun Z g h eq => Quiver.Hom.op_inj ((cancel_epi f).1 (Quiver.Hom.unop_inj Eq))⟩
#align category_theory.unop_mono_of_epi CategoryTheory.unop_mono_of_epi
-/

#print CategoryTheory.unop_epi_of_mono /-
instance unop_epi_of_mono {A B : Cᵒᵖ} (f : A ⟶ B) [Mono f] : Epi f.unop :=
  ⟨fun Z g h eq => Quiver.Hom.op_inj ((cancel_mono f).1 (Quiver.Hom.unop_inj Eq))⟩
#align category_theory.unop_epi_of_mono CategoryTheory.unop_epi_of_mono
-/

#print CategoryTheory.op_mono_of_epi /-
instance op_mono_of_epi {A B : C} (f : A ⟶ B) [Epi f] : Mono f.op :=
  ⟨fun Z g h eq => Quiver.Hom.unop_inj ((cancel_epi f).1 (Quiver.Hom.op_inj Eq))⟩
#align category_theory.op_mono_of_epi CategoryTheory.op_mono_of_epi
-/

#print CategoryTheory.op_epi_of_mono /-
instance op_epi_of_mono {A B : C} (f : A ⟶ B) [Mono f] : Epi f.op :=
  ⟨fun Z g h eq => Quiver.Hom.unop_inj ((cancel_mono f).1 (Quiver.Hom.op_inj Eq))⟩
#align category_theory.op_epi_of_mono CategoryTheory.op_epi_of_mono
-/

#print CategoryTheory.SplitMono /-
/-- A split monomorphism is a morphism `f : X ⟶ Y` with a given retraction `retraction f : Y ⟶ X`
such that `f ≫ retraction f = 𝟙 X`.

Every split monomorphism is a monomorphism.
-/
@[ext, nolint has_nonempty_instance]
structure SplitMono {X Y : C} (f : X ⟶ Y) where
  retraction : Y ⟶ X
  id' : f ≫ retraction = 𝟙 X := by obviously
#align category_theory.split_mono CategoryTheory.SplitMono
-/

restate_axiom split_mono.id'

attribute [simp, reassoc.1] split_mono.id

#print CategoryTheory.IsSplitMono /-
/-- `is_split_mono f` is the assertion that `f` admits a retraction -/
class IsSplitMono {X Y : C} (f : X ⟶ Y) : Prop where
  exists_splitMono : Nonempty (SplitMono f)
#align category_theory.is_split_mono CategoryTheory.IsSplitMono
-/

#print CategoryTheory.IsSplitMono.mk' /-
/-- A constructor for `is_split_mono f` taking a `split_mono f` as an argument -/
theorem IsSplitMono.mk' {X Y : C} {f : X ⟶ Y} (sm : SplitMono f) : IsSplitMono f :=
  ⟨Nonempty.intro sm⟩
#align category_theory.is_split_mono.mk' CategoryTheory.IsSplitMono.mk'
-/

#print CategoryTheory.SplitEpi /-
/-- A split epimorphism is a morphism `f : X ⟶ Y` with a given section `section_ f : Y ⟶ X`
such that `section_ f ≫ f = 𝟙 Y`.
(Note that `section` is a reserved keyword, so we append an underscore.)

Every split epimorphism is an epimorphism.
-/
@[ext, nolint has_nonempty_instance]
structure SplitEpi {X Y : C} (f : X ⟶ Y) where
  section_ : Y ⟶ X
  id' : section_ ≫ f = 𝟙 Y := by obviously
#align category_theory.split_epi CategoryTheory.SplitEpi
-/

restate_axiom split_epi.id'

attribute [simp, reassoc.1] split_epi.id

#print CategoryTheory.IsSplitEpi /-
/-- `is_split_epi f` is the assertion that `f` admits a section -/
class IsSplitEpi {X Y : C} (f : X ⟶ Y) : Prop where
  exists_splitEpi : Nonempty (SplitEpi f)
#align category_theory.is_split_epi CategoryTheory.IsSplitEpi
-/

#print CategoryTheory.IsSplitEpi.mk' /-
/-- A constructor for `is_split_epi f` taking a `split_epi f` as an argument -/
theorem IsSplitEpi.mk' {X Y : C} {f : X ⟶ Y} (se : SplitEpi f) : IsSplitEpi f :=
  ⟨Nonempty.intro se⟩
#align category_theory.is_split_epi.mk' CategoryTheory.IsSplitEpi.mk'
-/

#print CategoryTheory.retraction /-
/-- The chosen retraction of a split monomorphism. -/
noncomputable def retraction {X Y : C} (f : X ⟶ Y) [hf : IsSplitMono f] : Y ⟶ X :=
  hf.exists_splitMono.some.retraction
#align category_theory.retraction CategoryTheory.retraction
-/

#print CategoryTheory.IsSplitMono.id /-
@[simp, reassoc.1]
theorem IsSplitMono.id {X Y : C} (f : X ⟶ Y) [hf : IsSplitMono f] : f ≫ retraction f = 𝟙 X :=
  hf.exists_splitMono.some.id
#align category_theory.is_split_mono.id CategoryTheory.IsSplitMono.id
-/

#print CategoryTheory.SplitMono.splitEpi /-
/-- The retraction of a split monomorphism has an obvious section. -/
def SplitMono.splitEpi {X Y : C} {f : X ⟶ Y} (sm : SplitMono f) : SplitEpi sm.retraction
    where section_ := f
#align category_theory.split_mono.split_epi CategoryTheory.SplitMono.splitEpi
-/

#print CategoryTheory.retraction_isSplitEpi /-
/-- The retraction of a split monomorphism is itself a split epimorphism. -/
instance retraction_isSplitEpi {X Y : C} (f : X ⟶ Y) [hf : IsSplitMono f] :
    IsSplitEpi (retraction f) :=
  IsSplitEpi.mk' (SplitMono.splitEpi _)
#align category_theory.retraction_is_split_epi CategoryTheory.retraction_isSplitEpi
-/

#print CategoryTheory.isIso_of_epi_of_isSplitMono /-
/-- A split mono which is epi is an iso. -/
theorem isIso_of_epi_of_isSplitMono {X Y : C} (f : X ⟶ Y) [IsSplitMono f] [Epi f] : IsIso f :=
  ⟨⟨retraction f, ⟨by simp, by simp [← cancel_epi f]⟩⟩⟩
#align category_theory.is_iso_of_epi_of_is_split_mono CategoryTheory.isIso_of_epi_of_isSplitMono
-/

#print CategoryTheory.section_ /-
/-- The chosen section of a split epimorphism.
(Note that `section` is a reserved keyword, so we append an underscore.)
-/
noncomputable def section_ {X Y : C} (f : X ⟶ Y) [hf : IsSplitEpi f] : Y ⟶ X :=
  hf.exists_splitEpi.some.section_
#align category_theory.section_ CategoryTheory.section_
-/

#print CategoryTheory.IsSplitEpi.id /-
@[simp, reassoc.1]
theorem IsSplitEpi.id {X Y : C} (f : X ⟶ Y) [hf : IsSplitEpi f] : section_ f ≫ f = 𝟙 Y :=
  hf.exists_splitEpi.some.id
#align category_theory.is_split_epi.id CategoryTheory.IsSplitEpi.id
-/

#print CategoryTheory.SplitEpi.splitMono /-
/-- The section of a split epimorphism has an obvious retraction. -/
def SplitEpi.splitMono {X Y : C} {f : X ⟶ Y} (se : SplitEpi f) : SplitMono se.section_
    where retraction := f
#align category_theory.split_epi.split_mono CategoryTheory.SplitEpi.splitMono
-/

#print CategoryTheory.section_isSplitMono /-
/-- The section of a split epimorphism is itself a split monomorphism. -/
instance section_isSplitMono {X Y : C} (f : X ⟶ Y) [hf : IsSplitEpi f] : IsSplitMono (section_ f) :=
  IsSplitMono.mk' (SplitEpi.splitMono _)
#align category_theory.section_is_split_mono CategoryTheory.section_isSplitMono
-/

#print CategoryTheory.isIso_of_mono_of_isSplitEpi /-
/-- A split epi which is mono is an iso. -/
theorem isIso_of_mono_of_isSplitEpi {X Y : C} (f : X ⟶ Y) [Mono f] [IsSplitEpi f] : IsIso f :=
  ⟨⟨section_ f, ⟨by simp [← cancel_mono f], by simp⟩⟩⟩
#align category_theory.is_iso_of_mono_of_is_split_epi CategoryTheory.isIso_of_mono_of_isSplitEpi
-/

#print CategoryTheory.IsSplitMono.of_iso /-
/-- Every iso is a split mono. -/
instance (priority := 100) IsSplitMono.of_iso {X Y : C} (f : X ⟶ Y) [IsIso f] : IsSplitMono f :=
  IsSplitMono.mk' { retraction := inv f }
#align category_theory.is_split_mono.of_iso CategoryTheory.IsSplitMono.of_iso
-/

#print CategoryTheory.IsSplitEpi.of_iso /-
/-- Every iso is a split epi. -/
instance (priority := 100) IsSplitEpi.of_iso {X Y : C} (f : X ⟶ Y) [IsIso f] : IsSplitEpi f :=
  IsSplitEpi.mk' { section_ := inv f }
#align category_theory.is_split_epi.of_iso CategoryTheory.IsSplitEpi.of_iso
-/

#print CategoryTheory.SplitMono.mono /-
theorem SplitMono.mono {X Y : C} {f : X ⟶ Y} (sm : SplitMono f) : Mono f :=
  { right_cancellation := fun Z g h w => by replace w := w =≫ sm.retraction; simpa using w }
#align category_theory.split_mono.mono CategoryTheory.SplitMono.mono
-/

#print CategoryTheory.IsSplitMono.mono /-
/-- Every split mono is a mono. -/
instance (priority := 100) IsSplitMono.mono {X Y : C} (f : X ⟶ Y) [hf : IsSplitMono f] : Mono f :=
  hf.exists_splitMono.some.Mono
#align category_theory.is_split_mono.mono CategoryTheory.IsSplitMono.mono
-/

#print CategoryTheory.SplitEpi.epi /-
theorem SplitEpi.epi {X Y : C} {f : X ⟶ Y} (se : SplitEpi f) : Epi f :=
  { left_cancellation := fun Z g h w => by replace w := se.section_ ≫= w; simpa using w }
#align category_theory.split_epi.epi CategoryTheory.SplitEpi.epi
-/

#print CategoryTheory.IsSplitEpi.epi /-
/-- Every split epi is an epi. -/
instance (priority := 100) IsSplitEpi.epi {X Y : C} (f : X ⟶ Y) [hf : IsSplitEpi f] : Epi f :=
  hf.exists_splitEpi.some.Epi
#align category_theory.is_split_epi.epi CategoryTheory.IsSplitEpi.epi
-/

#print CategoryTheory.IsIso.of_mono_retraction' /-
/-- Every split mono whose retraction is mono is an iso. -/
theorem IsIso.of_mono_retraction' {X Y : C} {f : X ⟶ Y} (hf : SplitMono f) [Mono <| hf.retraction] :
    IsIso f :=
  ⟨⟨hf.retraction, ⟨by simp, (cancel_mono_id <| hf.retraction).mp (by simp)⟩⟩⟩
#align category_theory.is_iso.of_mono_retraction' CategoryTheory.IsIso.of_mono_retraction'
-/

#print CategoryTheory.IsIso.of_mono_retraction /-
/-- Every split mono whose retraction is mono is an iso. -/
theorem IsIso.of_mono_retraction {X Y : C} (f : X ⟶ Y) [hf : IsSplitMono f]
    [hf' : Mono <| retraction f] : IsIso f :=
  @IsIso.of_mono_retraction' _ _ _ _ _ hf.exists_splitMono.some hf'
#align category_theory.is_iso.of_mono_retraction CategoryTheory.IsIso.of_mono_retraction
-/

#print CategoryTheory.IsIso.of_epi_section' /-
/-- Every split epi whose section is epi is an iso. -/
theorem IsIso.of_epi_section' {X Y : C} {f : X ⟶ Y} (hf : SplitEpi f) [Epi <| hf.section_] :
    IsIso f :=
  ⟨⟨hf.section_, ⟨(cancel_epi_id <| hf.section_).mp (by simp), by simp⟩⟩⟩
#align category_theory.is_iso.of_epi_section' CategoryTheory.IsIso.of_epi_section'
-/

#print CategoryTheory.IsIso.of_epi_section /-
/-- Every split epi whose section is epi is an iso. -/
theorem IsIso.of_epi_section {X Y : C} (f : X ⟶ Y) [hf : IsSplitEpi f] [hf' : Epi <| section_ f] :
    IsIso f :=
  @IsIso.of_epi_section' _ _ _ _ _ hf.exists_splitEpi.some hf'
#align category_theory.is_iso.of_epi_section CategoryTheory.IsIso.of_epi_section
-/

#print CategoryTheory.Groupoid.ofTruncSplitMono /-
-- FIXME this has unnecessarily become noncomputable!
/-- A category where every morphism has a `trunc` retraction is computably a groupoid. -/
noncomputable def Groupoid.ofTruncSplitMono
    (all_split_mono : ∀ {X Y : C} (f : X ⟶ Y), Trunc (IsSplitMono f)) : Groupoid.{v₁} C :=
  by
  apply groupoid.of_is_iso
  intro X Y f
  trunc_cases all_split_mono f
  trunc_cases all_split_mono (retraction f)
  apply is_iso.of_mono_retraction
#align category_theory.groupoid.of_trunc_split_mono CategoryTheory.Groupoid.ofTruncSplitMono
-/

section

variable (C)

#print CategoryTheory.SplitMonoCategory /-
/-- A split mono category is a category in which every monomorphism is split. -/
class SplitMonoCategory where
  isSplitMono_of_mono : ∀ {X Y : C} (f : X ⟶ Y) [Mono f], IsSplitMono f
#align category_theory.split_mono_category CategoryTheory.SplitMonoCategory
-/

#print CategoryTheory.SplitEpiCategory /-
/-- A split epi category is a category in which every epimorphism is split. -/
class SplitEpiCategory where
  isSplitEpi_of_epi : ∀ {X Y : C} (f : X ⟶ Y) [Epi f], IsSplitEpi f
#align category_theory.split_epi_category CategoryTheory.SplitEpiCategory
-/

end

#print CategoryTheory.isSplitMono_of_mono /-
/-- In a category in which every monomorphism is split, every monomorphism splits. This is not an
    instance because it would create an instance loop. -/
theorem isSplitMono_of_mono [SplitMonoCategory C] {X Y : C} (f : X ⟶ Y) [Mono f] : IsSplitMono f :=
  SplitMonoCategory.isSplitMono_of_mono _
#align category_theory.is_split_mono_of_mono CategoryTheory.isSplitMono_of_mono
-/

#print CategoryTheory.isSplitEpi_of_epi /-
/-- In a category in which every epimorphism is split, every epimorphism splits. This is not an
    instance because it would create an instance loop. -/
theorem isSplitEpi_of_epi [SplitEpiCategory C] {X Y : C} (f : X ⟶ Y) [Epi f] : IsSplitEpi f :=
  SplitEpiCategory.isSplitEpi_of_epi _
#align category_theory.is_split_epi_of_epi CategoryTheory.isSplitEpi_of_epi
-/

section

variable {D : Type u₂} [Category.{v₂} D]

/- warning: category_theory.split_mono.map -> CategoryTheory.SplitMono.map is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] {D : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u2, u4} D] {X : C} {Y : C} {f : Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) X Y}, (CategoryTheory.SplitMono.{u1, u3} C _inst_1 X Y f) -> (forall (F : CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2), CategoryTheory.SplitMono.{u2, u4} D _inst_2 (CategoryTheory.Functor.obj.{u1, u2, u3, u4} C _inst_1 D _inst_2 F X) (CategoryTheory.Functor.obj.{u1, u2, u3, u4} C _inst_1 D _inst_2 F Y) (CategoryTheory.Functor.map.{u1, u2, u3, u4} C _inst_1 D _inst_2 F X Y f))
but is expected to have type
  forall {C : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] {D : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u2, u4} D] {X : C} {Y : C} {f : Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) X Y}, (CategoryTheory.SplitMono.{u1, u3} C _inst_1 X Y f) -> (forall (F : CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2), CategoryTheory.SplitMono.{u2, u4} D _inst_2 (Prefunctor.obj.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 F) X) (Prefunctor.obj.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 F) Y) (Prefunctor.map.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 F) X Y f))
Case conversion may be inaccurate. Consider using '#align category_theory.split_mono.map CategoryTheory.SplitMono.mapₓ'. -/
/-- Split monomorphisms are also absolute monomorphisms. -/
@[simps]
def SplitMono.map {X Y : C} {f : X ⟶ Y} (sm : SplitMono f) (F : C ⥤ D) : SplitMono (F.map f)
    where
  retraction := F.map sm.retraction
  id' := by rw [← functor.map_comp, split_mono.id, Functor.map_id]
#align category_theory.split_mono.map CategoryTheory.SplitMono.map

/- warning: category_theory.split_epi.map -> CategoryTheory.SplitEpi.map is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] {D : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u2, u4} D] {X : C} {Y : C} {f : Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) X Y}, (CategoryTheory.SplitEpi.{u1, u3} C _inst_1 X Y f) -> (forall (F : CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2), CategoryTheory.SplitEpi.{u2, u4} D _inst_2 (CategoryTheory.Functor.obj.{u1, u2, u3, u4} C _inst_1 D _inst_2 F X) (CategoryTheory.Functor.obj.{u1, u2, u3, u4} C _inst_1 D _inst_2 F Y) (CategoryTheory.Functor.map.{u1, u2, u3, u4} C _inst_1 D _inst_2 F X Y f))
but is expected to have type
  forall {C : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] {D : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u2, u4} D] {X : C} {Y : C} {f : Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) X Y}, (CategoryTheory.SplitEpi.{u1, u3} C _inst_1 X Y f) -> (forall (F : CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2), CategoryTheory.SplitEpi.{u2, u4} D _inst_2 (Prefunctor.obj.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 F) X) (Prefunctor.obj.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 F) Y) (Prefunctor.map.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 F) X Y f))
Case conversion may be inaccurate. Consider using '#align category_theory.split_epi.map CategoryTheory.SplitEpi.mapₓ'. -/
/-- Split epimorphisms are also absolute epimorphisms. -/
@[simps]
def SplitEpi.map {X Y : C} {f : X ⟶ Y} (se : SplitEpi f) (F : C ⥤ D) : SplitEpi (F.map f)
    where
  section_ := F.map se.section_
  id' := by rw [← functor.map_comp, split_epi.id, Functor.map_id]
#align category_theory.split_epi.map CategoryTheory.SplitEpi.map

instance {X Y : C} (f : X ⟶ Y) [hf : IsSplitMono f] (F : C ⥤ D) : IsSplitMono (F.map f) :=
  IsSplitMono.mk' (hf.exists_splitMono.some.map F)

instance {X Y : C} (f : X ⟶ Y) [hf : IsSplitEpi f] (F : C ⥤ D) : IsSplitEpi (F.map f) :=
  IsSplitEpi.mk' (hf.exists_splitEpi.some.map F)

end

end CategoryTheory


/-
Copyright (c) 2021 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen, Paul Lezeau
-/

import ring_theory.algebra_tower
import ring_theory.dedekind_domain.ideal
import ring_theory.is_adjoin_root

/-!
# Kummer-Dedekind theorem

This file proves the monogenic version of the Kummer-Dedekind theorem on the splitting of prime
ideals in an extension of the ring of integers. This states that if `I` is a prime ideal of
Dedekind domain `R` and `S = R[α]` for some `α` that is integral over `R` with minimal polynomial
`f`, then the prime factorisations of `I * S` and `f mod I` have the same shape, i.e. they have the
same number of prime factors, and each prime factors of `I * S` can be paired with a prime factor
of `f mod I` in a way that ensures multiplicities match (in fact, this pairing can be made explicit
with a formula).

## Main definitions

 * `normalized_factors_map_equiv_normalized_factors_min_poly_mk` : The bijection in the
    Kummer-Dedekind theorem. This is the pairing between the prime factors of `I * S` and the prime
    factors of `f mod I`.

## Main results

 * `normalized_factors_ideal_map_eq_normalized_factors_min_poly_mk_map` : The Kummer-Dedekind
    theorem.
 * `ideal.irreducible_map_of_irreducible_minpoly` : `I.map (algebra_map R S)` is irreducible if
    `(map I^.quotient.mk (minpoly R pb.gen))` is irreducible, where `pb` is a power basis of `S`
    over `R`.

## TODO

 * Prove the Kummer-Dedekind theorem in full generality.

 * Prove the converse of `ideal.irreducible_map_of_irreducible_minpoly`.

 * Prove that `normalized_factors_map_equiv_normalized_factors_min_poly_mk` can be expressed as
    `normalized_factors_map_equiv_normalized_factors_min_poly_mk g = ⟨I, G(α)⟩` for `g` a prime
    factor of `f mod I` and `G` a lift of `g` to `R[X]`.

## References

 * [J. Neukirch, *Algebraic Number Theory*][Neukirch1992]

## Tags

kummer, dedekind, kummer dedekind, dedekind-kummer, dedekind kummer
-/

variables (R : Type*) {S : Type*} [comm_ring R] [comm_ring S] [algebra R S]

open ideal polynomial double_quot unique_factorization_monoid algebra ring_hom

local notation R`<`:std.prec.max_plus x `>` := adjoin R ({x} : set S)

/-- Let `S / R` be a ring extension and `x : S`, then the conductor of `R<x>` is the
    biggest ideal of `S` contained in `R<x>`. -/
def conductor (x : S) : ideal S :=
{ carrier := {a | ∀ (b : S), a * b ∈ R<x> },
  zero_mem' := λ b, by simpa only [zero_mul] using subalgebra.zero_mem _,
  add_mem' := λ a b ha hb c, by simpa only [add_mul] using subalgebra.add_mem _ (ha c) (hb c),
  smul_mem' := λ c a ha b, by simpa only [smul_eq_mul, mul_left_comm, mul_assoc] using ha (c * b) }

variables {R} {x : S}

lemma conductor_eq_of_eq {y : S} (h : (R<x> : set S) = R<y>):
  conductor R x = conductor R y :=
ideal.ext $ λ a, forall_congr $ λ b, set.ext_iff.mp h _

lemma conductor_subset_adjoin : (conductor R x : set S) ⊆ R<x> :=
λ y hy, by simpa only [mul_one] using hy 1

lemma mem_conductor_iff {y : S} : y ∈ conductor R x ↔ ∀ (b : S), y * b ∈ R<x> :=
⟨λ h, h, λ h, h⟩

lemma conductor_eq_top_of_adjoin_eq_top (h : R<x> = ⊤) : conductor R x = ⊤ :=
by simp only [ideal.eq_top_iff_one, mem_conductor_iff, h, mem_top, forall_const]

lemma conductor_eq_top_of_power_basis (pb : power_basis R S) : conductor R pb.gen = ⊤ :=
conductor_eq_top_of_adjoin_eq_top pb.adjoin_gen_eq_top

variables {I : ideal R}

/-- This technical lemma tell us that if `C` is the conductor of `R<x>` and `I` is an ideal of `R`
  then `p * (I * S) ⊆ I * R<x>` for any `p` in `C ∩ R` -/
lemma prod_mem_ideal_map_of_mem_conductor {p : R} {z : S}
  (hp : p ∈ ideal.comap (algebra_map R S) (conductor R x)) (hz' : z ∈ (I.map (algebra_map R S))) :
  (algebra_map R S p) * z ∈
    algebra_map R<x> S '' ↑(I.map (algebra_map R R<x>)) :=
begin
  rw [ideal.map, ideal.span, finsupp.mem_span_image_iff_total] at hz',
  obtain ⟨l, H, H'⟩ := hz',
  rw finsupp.total_apply at H',
  rw [← H', mul_comm, finsupp.sum_mul],
  have lem : ∀ {a : R}, a ∈ I → (l a • (algebra_map R S a) * (algebra_map R S p)) ∈
    (algebra_map R<x> S) '' (I.map (algebra_map R R<x>)),
  { intros a ha,
    rw [algebra.id.smul_eq_mul, mul_assoc, mul_comm, mul_assoc, set.mem_image],
    refine exists.intro (algebra_map R R<x> a * ⟨l a * algebra_map R S p,
      show l a * algebra_map R S p ∈ R<x>, from _ ⟩) _,
    { rw mul_comm,
      exact mem_conductor_iff.mp (ideal.mem_comap.mp hp) _ },
    refine ⟨_, by simpa only [ring_hom.map_mul, mul_comm (algebra_map R S p) (l a)]⟩,
    rw mul_comm,
    apply ideal.mul_mem_left (I.map (algebra_map R R<x>)) _
      (ideal.mem_map_of_mem _ ha) },
  refine finset.sum_induction _ (λ u, u ∈ (algebra_map R<x> S) ''
    (I.map (algebra_map R R<x>)))
    (λ a b, _) _ _,
  rintro ⟨z, hz, rfl⟩ ⟨y, hy, rfl⟩,
  rw [← ring_hom.map_add],
  exact ⟨z + y, ideal.add_mem _ (set_like.mem_coe.mp hz) hy, rfl⟩,
  { refine ⟨0, set_like.mem_coe.mpr $ ideal.zero_mem _, ring_hom.map_zero _⟩ },
  { intros y hy,
    exact lem ((finsupp.mem_supported _ l).mp H hy) },
end

/-- A technical result telling us that `(I * S) ∩ R<x> = I * R<x>` for any ideal `I` of `R`. -/
lemma comap_map_eq_map_adjoin_of_coprime_conductor
  (hx : (conductor R x).comap (algebra_map R S) ⊔ I = ⊤)
  (h_alg : function.injective (algebra_map R<x> S)):
  (I.map (algebra_map R S)).comap (algebra_map R<x> S) = I.map (algebra_map R R<x>) :=
begin
  apply le_antisymm,
  { -- This is adapted from [Neukirch1992]. Let `C = (conductor R x)`. The idea of the proof
    -- is that since `I` and `C ∩ R` are coprime, we have
    -- `(I * S) ∩ R<x> ⊆ (I + C) * ((I * S) ∩ R<x>) ⊆ I * R<x> + I * C * S ⊆ I * R<x>`.
    intros y hy,
    obtain ⟨z, hz⟩ := y,
    obtain ⟨p, hp, q, hq, hpq⟩ := submodule.mem_sup.mp ((ideal.eq_top_iff_one _).mp hx),
    have temp : (algebra_map R S p)*z + (algebra_map R S q)*z = z,
    { simp only [←add_mul, ←ring_hom.map_add (algebra_map R S), hpq, map_one, one_mul] },
    suffices : z ∈ algebra_map R<x> S '' (I.map (algebra_map R R<x>)) ↔ (⟨z, hz⟩ : R<x>) ∈
      I.map (algebra_map R R<x>),
    { rw [← this, ← temp],
      obtain ⟨a, ha⟩ := (set.mem_image _ _ _).mp (prod_mem_ideal_map_of_mem_conductor hp
        (show z ∈ I.map (algebra_map R S), by rwa ideal.mem_comap at hy )),
      use a + (algebra_map R R<x> q) * ⟨z, hz⟩,
      refine ⟨ ideal.add_mem (I.map (algebra_map R R<x>)) ha.left _,
        by simpa only [ha.right, map_add, alg_hom.map_mul, add_right_inj] ⟩,
      rw mul_comm,
        exact ideal.mul_mem_left (I.map (algebra_map R R<x>)) _ (ideal.mem_map_of_mem _ hq) },
    refine ⟨ λ h, _, λ h, (set.mem_image _ _ _).mpr (exists.intro ⟨z, hz⟩ ⟨by simp [h], rfl⟩ ) ⟩,
    { obtain ⟨x₁, hx₁, hx₂⟩ := (set.mem_image _ _ _).mp h,
      have : x₁ = ⟨z, hz⟩,
      { apply h_alg,
        simpa [hx₂], },
      rwa ← this }  },

  { -- The converse inclusion is trivial
    have : algebra_map R S = (algebra_map _ S).comp (algebra_map R R<x>) := by { ext, refl },
    rw [this, ← ideal.map_map],
    apply ideal.le_comap_map }
end

/-- The canonical morphism of rings from `R<x> ⧸ (I*R<x>)` to `S ⧸ (I*S)` is an isomorphism
    when `I` and `(conductor R x) ∩ R` are coprime. -/
noncomputable def quot_adjoin_equiv_quot_map (hx : (conductor R x).comap (algebra_map R S) ⊔ I = ⊤)
  (h_alg : function.injective (algebra_map R<x> S)) :
  R<x> ⧸ (I.map (algebra_map R R<x>)) ≃+* S ⧸ (I.map (algebra_map R S)) :=
ring_equiv.of_bijective (ideal.quotient.lift (I.map (algebra_map R R<x>))
  (((I.map (algebra_map R S))^.quotient.mk).comp (algebra_map R<x> S )) (λ r hr,
    begin
      have : algebra_map R S = (algebra_map R<x> S).comp
        (algebra_map R R<x>) := by { ext, refl },
      rw [ring_hom.comp_apply, ideal.quotient.eq_zero_iff_mem, this, ← ideal.map_map],
      exact ideal.mem_map_of_mem _ hr
    end))
begin
  split,
  { --the kernel of the map is clearly `(I * S) ∩ R<x>`. To get injectivity, we need to show that
    --this is contained in `I * R<x>`, which is the content of the previous lemma.
    refine ring_hom.lift_injective_of_ker_le_ideal _ _ (λ u hu, _),
    rwa [ring_hom.mem_ker, ring_hom.comp_apply, ideal.quotient.eq_zero_iff_mem,
      ← ideal.mem_comap, comap_map_eq_map_adjoin_of_coprime_conductor hx h_alg] at hu },
  { -- Surjectivity follows from the surjectivity of the canonical map `R<x> → S ⧸ (I * S)`,
    -- which in turn follows from the fact that `I * S + (conductor R x) = S`.
    refine ideal.quotient.lift_surjective_of_surjective _ _ (λ y, _),
    obtain ⟨z, hz⟩ := ideal.quotient.mk_surjective y,
    have : z ∈ conductor R x ⊔ (I.map (algebra_map R S)),
    { suffices : conductor R x ⊔ (I.map (algebra_map R S)) = ⊤,
      { simp only [this] },
      rw ideal.eq_top_iff_one at hx ⊢,
      replace hx := ideal.mem_map_of_mem (algebra_map R S) hx,
      rw [ideal.map_sup, ring_hom.map_one] at hx,
      exact (sup_le_sup (show  ((conductor R x).comap (algebra_map R S)).map (algebra_map R S) ≤
        conductor R x, from ideal.map_comap_le) (le_refl (I.map (algebra_map R S)))) hx },
    rw [← ideal.mem_quotient_iff_mem_sup, hz, ideal.mem_map_iff_of_surjective] at this,
    obtain ⟨u, hu, hu'⟩ := this,
    use ⟨u, conductor_subset_adjoin hu⟩,
    simpa only [← hu'],
    { exact ideal.quotient.mk_surjective } }
end

@[simp]
lemma quot_adjoin_equiv_quot_map_apply_mk (hx : (conductor R x).comap (algebra_map R S) ⊔ I = ⊤)
  (h_alg : function.injective (algebra_map R<x> S)) (a : R<x>) :
   quot_adjoin_equiv_quot_map hx h_alg ((I.map (algebra_map R R<x>))^.quotient.mk a)
   = (I.map (algebra_map R S))^.quotient.mk ↑a :=
rfl

namespace kummer_dedekind

open_locale big_operators polynomial classical

variables [is_domain R] [is_integrally_closed R]
variables [is_domain S] [is_dedekind_domain S]
variable [no_zero_smul_divisors R S]

local attribute [instance] ideal.quotient.field

/-- The first half of the **Kummer-Dedekind Theorem** in the monogenic case, stating that the prime
    factors of `I*S` are in bijection with those of the minimal polynomial of the generator of `S`
    over `R`, taken `mod I`.-/
noncomputable def normalized_factors_map_equiv_normalized_factors_min_poly_mk (hI : is_maximal I)
  (hI' : I ≠ ⊥) (hx : (conductor R x).comap (algebra_map R S) ⊔ I = ⊤)
  (hx' : is_integral R x) :
  {J : ideal S | J ∈ normalized_factors (I.map (algebra_map R S) )} ≃
    {d : (R ⧸ I)[X] | d ∈ normalized_factors (map I^.quotient.mk (minpoly R x))} :=
(normalized_factors_equiv_of_quot_equiv
  ((quot_adjoin_equiv_quot_map hx
    (by { apply no_zero_smul_divisors.algebra_map_injective (algebra.adjoin R {x}) S,
          exact subalgebra.no_zero_smul_divisors_top (algebra.adjoin R {x}) })).symm.trans
  (((algebra.adjoin.power_basis' hx').quotient_equiv_quotient_minpoly_map I).to_ring_equiv.trans
    (quot_equiv_of_eq (show (ideal.span ({(minpoly R (algebra.adjoin.power_basis' hx').gen).map
    I^.quotient.mk})) = (ideal.span ({(minpoly R x).map I^.quotient.mk})),
      by rw algebra.adjoin.power_basis'_minpoly_gen hx'))))
  --show that `I * S` ≠ ⊥
  (show I.map (algebra_map R S) ≠ ⊥,
    by rwa [ne.def, map_eq_bot_iff_of_injective (no_zero_smul_divisors.algebra_map_injective R S),
         ← ne.def])
  --show that the ideal spanned by `(minpoly R pb.gen) mod I` is non-zero
  (by {by_contra, exact (show (map I^.quotient.mk (minpoly R x) ≠ 0), from
    polynomial.map_monic_ne_zero (minpoly.monic hx')) (span_singleton_eq_bot.mp h) } )).trans
  (normalized_factors_equiv_span_normalized_factors
    (show (map I^.quotient.mk (minpoly R x)) ≠ 0, from
      polynomial.map_monic_ne_zero (minpoly.monic hx'))).symm

/-- The second half of the **Kummer-Dedekind Theorem** in the monogenic case, stating that the
    bijection `factors_equiv'` defined in the first half preserves multiplicities. -/
theorem multiplicity_factors_map_eq_multiplicity (hI : is_maximal I) (hI' : I ≠ ⊥)
  (hx : (conductor R x).comap (algebra_map R S) ⊔ I = ⊤) (hx' : is_integral R x)
  {J : ideal S} (hJ : J ∈ normalized_factors (I.map (algebra_map R S))) :
  multiplicity J (I.map (algebra_map R S)) =
    multiplicity ↑(normalized_factors_map_equiv_normalized_factors_min_poly_mk hI hI' hx hx'
      ⟨J, hJ⟩) (map I^.quotient.mk (minpoly R x)) :=
by rw [normalized_factors_map_equiv_normalized_factors_min_poly_mk, equiv.coe_trans,
       function.comp_app,
       multiplicity_normalized_factors_equiv_span_normalized_factors_symm_eq_multiplicity,
       normalized_factors_equiv_of_quot_equiv_multiplicity_eq_multiplicity]

/-- The **Kummer-Dedekind Theorem**. -/
theorem normalized_factors_ideal_map_eq_normalized_factors_min_poly_mk_map (hI : is_maximal I)
  (hI' : I ≠ ⊥) (hx : (conductor R x).comap (algebra_map R S) ⊔ I = ⊤)
  (hx' : is_integral R x) :
  normalized_factors (I.map (algebra_map R S)) =
    multiset.map
      (λ f, ((normalized_factors_map_equiv_normalized_factors_min_poly_mk hI hI' hx hx').symm f :
        ideal S))
      (normalized_factors (polynomial.map I^.quotient.mk (minpoly R x))).attach :=
begin
  ext J,
  -- WLOG, assume J is a normalized factor
  by_cases hJ : J ∈ normalized_factors (I.map (algebra_map R S)), swap,
  { rw [multiset.count_eq_zero.mpr hJ, eq_comm, multiset.count_eq_zero, multiset.mem_map],
    simp only [multiset.mem_attach, true_and, not_exists],
    rintros J' rfl,
    exact hJ
      ((normalized_factors_map_equiv_normalized_factors_min_poly_mk hI hI' hx hx').symm J').prop },

  -- Then we just have to compare the multiplicities, which we already proved are equal.
  have := multiplicity_factors_map_eq_multiplicity hI hI' hx hx' hJ,
  rw [multiplicity_eq_count_normalized_factors, multiplicity_eq_count_normalized_factors,
      unique_factorization_monoid.normalize_normalized_factor _ hJ,
      unique_factorization_monoid.normalize_normalized_factor,
      part_enat.coe_inj]
    at this,
  refine this.trans _,
  -- Get rid of the `map` by applying the equiv to both sides.
  generalize hJ' : (normalized_factors_map_equiv_normalized_factors_min_poly_mk hI hI' hx hx')
    ⟨J, hJ⟩ = J',
  have : ((normalized_factors_map_equiv_normalized_factors_min_poly_mk hI hI' hx hx').symm J' :
    ideal S) = J,
  { rw [← hJ', equiv.symm_apply_apply _ _, subtype.coe_mk] },
  subst this,
  -- Get rid of the `attach` by applying the subtype `coe` to both sides.
  rw [multiset.count_map_eq_count' (λ f,
      ((normalized_factors_map_equiv_normalized_factors_min_poly_mk hI hI' hx hx').symm f
        : ideal S)),
      multiset.attach_count_eq_count_coe],
  { exact subtype.coe_injective.comp (equiv.injective _) },
  { exact (normalized_factors_map_equiv_normalized_factors_min_poly_mk hI hI' hx hx' _).prop},
  { exact irreducible_of_normalized_factor _
    (normalized_factors_map_equiv_normalized_factors_min_poly_mk hI hI' hx hx' _).prop },
  { exact polynomial.map_monic_ne_zero (minpoly.monic hx') },
  { exact irreducible_of_normalized_factor _ hJ },
  { rwa [← bot_eq_zero, ne.def, map_eq_bot_iff_of_injective
    (no_zero_smul_divisors.algebra_map_injective R S)] },
end

theorem ideal.irreducible_map_of_irreducible_minpoly (hI : is_maximal I) (hI' : I ≠ ⊥)
  (hx : (conductor R x).comap (algebra_map R S) ⊔ I = ⊤)
  (hx' : is_integral R x) (hf : irreducible (map I^.quotient.mk (minpoly R x))) :
  irreducible (I.map (algebra_map R S)) :=
begin
  have mem_norm_factors : normalize (map I^.quotient.mk (minpoly R x)) ∈ normalized_factors
    (map I^.quotient.mk (minpoly R x)) := by simp [normalized_factors_irreducible hf],
  suffices : ∃ y, normalized_factors (I.map (algebra_map R S)) = {y},
  { obtain ⟨y, hy⟩ := this,
    have h := normalized_factors_prod (show I.map (algebra_map R S) ≠ 0, by rwa [← bot_eq_zero,
      ne.def, map_eq_bot_iff_of_injective (no_zero_smul_divisors.algebra_map_injective R S)]),
    rw [associated_iff_eq, hy, multiset.prod_singleton] at h,
    rw ← h,
    exact irreducible_of_normalized_factor y
      (show y ∈ normalized_factors (I.map (algebra_map R S)), by simp [hy]) },
  rw normalized_factors_ideal_map_eq_normalized_factors_min_poly_mk_map hI hI' hx hx',
  use ((normalized_factors_map_equiv_normalized_factors_min_poly_mk hI hI' hx hx').symm
    ⟨normalize (map I^.quotient.mk (minpoly R x)), mem_norm_factors⟩ : ideal S),
  rw multiset.map_eq_singleton,
  use ⟨normalize (map I^.quotient.mk (minpoly R x)), mem_norm_factors⟩,
  refine ⟨_, rfl⟩,
  apply multiset.map_injective subtype.coe_injective,
  rw [multiset.attach_map_coe, multiset.map_singleton, subtype.coe_mk],
  exact normalized_factors_irreducible hf
end

end kummer_dedekind


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

! This file was ported from Lean 3 source module algebraic_topology.dold_kan.n_comp_gamma
! leanprover-community/mathlib commit 19d6240dcc5e5c8bd6e1e3c588b92e837af76f9e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.AlgebraicTopology.DoldKan.GammaCompN
import Mathbin.AlgebraicTopology.DoldKan.NReflectsIso

/-! The unit isomorphism of the Dold-Kan equivalence

In order to construct the unit isomorphism of the Dold-Kan equivalence,
we first construct natural transformations
`Γ₂N₁.nat_trans : N₁ ⋙ Γ₂ ⟶ to_karoubi (simplicial_object C)` and
`Γ₂N₂.nat_trans : N₂ ⋙ Γ₂ ⟶ 𝟭 (simplicial_object C)`.
It is then shown that `Γ₂N₂.nat_trans` is an isomorphism by using
that it becomes an isomorphism after the application of the functor
`N₂ : karoubi (simplicial_object C) ⥤ karoubi (chain_complex C ℕ)`
which reflects isomorphisms.

-/

noncomputable section

open
  CategoryTheory CategoryTheory.Category CategoryTheory.Limits CategoryTheory.Idempotents SimplexCategory Opposite SimplicialObject

open Simplicial DoldKan

namespace AlgebraicTopology

namespace DoldKan

variable {C : Type _} [Category C] [Preadditive C]

theorem pInfty_comp_map_mono_eq_zero (X : SimplicialObject C) {n : ℕ} {Δ' : SimplexCategory}
    (i : Δ' ⟶ [n]) [hi : Mono i] (h₁ : Δ'.len ≠ n) (h₂ : ¬Isδ₀ i) : pInfty.f n ≫ X.map i.op = 0 :=
  by
  induction' Δ' using SimplexCategory.rec with m
  obtain ⟨k, hk⟩ :=
    Nat.exists_eq_add_of_lt
      (len_lt_of_mono i fun h => by
        rw [← h] at h₁
        exact h₁ rfl)
  simp only [len_mk] at hk
  cases k
  · change n = m + 1 at hk
    subst hk
    obtain ⟨j, rfl⟩ := eq_δ_of_mono i
    rw [is_δ₀.iff] at h₂
    have h₃ : 1 ≤ (j : ℕ) := by
      by_contra
      exact h₂ (by simpa only [Fin.ext_iff, not_le, Nat.lt_one_iff] using h)
    exact (higher_faces_vanish.of_P (m + 1) m).comp_δ_eq_zero j h₂ (by linarith)
  · simp only [Nat.succ_eq_add_one, ← add_assoc] at hk
    clear h₂ hi
    subst hk
    obtain ⟨j₁, i, rfl⟩ :=
      eq_comp_δ_of_not_surjective i fun h =>
        by
        have h' := len_le_of_epi (SimplexCategory.epi_iff_surjective.2 h)
        dsimp at h'
        linarith
    obtain ⟨j₂, i, rfl⟩ :=
      eq_comp_δ_of_not_surjective i fun h =>
        by
        have h' := len_le_of_epi (SimplexCategory.epi_iff_surjective.2 h)
        dsimp at h'
        linarith
    by_cases hj₁ : j₁ = 0
    · subst hj₁
      rw [assoc, ← SimplexCategory.δ_comp_δ'' (Fin.zero_le _)]
      simp only [op_comp, X.map_comp, assoc, P_infty_f]
      erw [(higher_faces_vanish.of_P _ _).comp_δ_eq_zero_assoc _ j₂.succ_ne_zero, zero_comp]
      rw [Fin.val_succ]
      linarith
    · simp only [op_comp, X.map_comp, assoc, P_infty_f]
      erw [(higher_faces_vanish.of_P _ _).comp_δ_eq_zero_assoc _ hj₁, zero_comp]
      by_contra
      exact
        hj₁
          (by
            simp only [Fin.ext_iff, Fin.val_zero]
            linarith)
#align algebraic_topology.dold_kan.P_infty_comp_map_mono_eq_zero AlgebraicTopology.DoldKan.pInfty_comp_map_mono_eq_zero

@[reassoc.1]
theorem Γ₀_obj_termwise_mapMono_comp_pInfty (X : SimplicialObject C) {Δ Δ' : SimplexCategory}
    (i : Δ ⟶ Δ') [Mono i] :
    Γ₀.Obj.Termwise.mapMono (AlternatingFaceMapComplex.obj X) i ≫ pInfty.f Δ.len =
      pInfty.f Δ'.len ≫ X.map i.op :=
  by
  induction' Δ using SimplexCategory.rec with n
  induction' Δ' using SimplexCategory.rec with n'
  dsimp
  -- We start with the case `i` is an identity
  by_cases n = n'
  · subst h
    simp only [SimplexCategory.eq_id_of_mono i, Γ₀.obj.termwise.map_mono_id, op_id, X.map_id]
    dsimp
    simp only [id_comp, comp_id]
  by_cases hi : is_δ₀ i
  -- The case `i = δ 0`
  · have h' : n' = n + 1 := hi.left
    subst h'
    simp only [Γ₀.obj.termwise.map_mono_δ₀' _ i hi]
    dsimp
    rw [← P_infty.comm' _ n rfl, alternating_face_map_complex.obj_d_eq]
    simp only [eq_self_iff_true, id_comp, if_true, preadditive.comp_sum]
    rw [Finset.sum_eq_single (0 : Fin (n + 2))]
    rotate_left
    · intro b hb hb'
      rw [preadditive.comp_zsmul]
      erw [P_infty_comp_map_mono_eq_zero X (SimplexCategory.δ b) h
          (by
            rw [is_δ₀.iff]
            exact hb'),
        zsmul_zero]
    · simp only [Finset.mem_univ, not_true, IsEmpty.forall_iff]
    · simpa only [hi.eq_δ₀, Fin.val_zero, pow_zero, one_zsmul]
  -- The case `i ≠ δ 0`
  · rw [Γ₀.obj.termwise.map_mono_eq_zero _ i _ hi, zero_comp]
    swap
    · by_contra h'
      exact h (congr_arg SimplexCategory.len h'.symm)
    rw [P_infty_comp_map_mono_eq_zero]
    · exact h
    · by_contra h'
      exact hi h'
#align algebraic_topology.dold_kan.Γ₀_obj_termwise_map_mono_comp_P_infty AlgebraicTopology.DoldKan.Γ₀_obj_termwise_mapMono_comp_pInfty

variable [HasFiniteCoproducts C]

namespace Γ₂N₁

/-- The natural transformation `N₁ ⋙ Γ₂ ⟶ to_karoubi (simplicial_object C)`. -/
@[simps]
def natTrans : (n₁ : SimplicialObject C ⥤ _) ⋙ Γ₂ ⟶ toKaroubi _
    where
  app X :=
    { f :=
        { app := fun Δ => (Γ₀.splitting K[X]).desc Δ fun A => pInfty.f A.1.unop.len ≫ X.map A.e.op
          naturality' := fun Δ Δ' θ =>
            by
            apply (Γ₀.splitting K[X]).hom_ext'
            intro A
            change _ ≫ (Γ₀.obj K[X]).map θ ≫ _ = _
            simp only [splitting.ι_desc_assoc, assoc, Γ₀.obj.map_on_summand'_assoc,
              splitting.ι_desc]
            erw [Γ₀_obj_termwise_map_mono_comp_P_infty_assoc X (image.ι (θ.unop ≫ A.e))]
            dsimp only [to_karoubi]
            simp only [← X.map_comp]
            congr 2
            simp only [eq_to_hom_refl, id_comp, comp_id, ← op_comp]
            exact Quiver.Hom.unop_inj (A.fac_pull θ) }
      comm := by
        apply (Γ₀.splitting K[X]).hom_ext
        intro n
        dsimp [N₁]
        simp only [← splitting.ι_summand_id, splitting.ι_desc, comp_id, splitting.ι_desc_assoc,
          assoc, P_infty_f_idem_assoc] }
  naturality' X Y f := by
    ext1
    apply (Γ₀.splitting K[X]).hom_ext
    intro n
    dsimp [N₁, to_karoubi]
    simpa only [← splitting.ι_summand_id, splitting.ι_desc, splitting.ι_desc_assoc, assoc,
      P_infty_f_idem_assoc, karoubi.comp_f, nat_trans.comp_app, Γ₂_map_f_app,
      HomologicalComplex.comp_f, alternating_face_map_complex.map_f, P_infty_f_naturality_assoc,
      nat_trans.naturality]
#align algebraic_topology.dold_kan.Γ₂N₁.nat_trans AlgebraicTopology.DoldKan.Γ₂N₁.natTrans

end Γ₂N₁

/-- The compatibility isomorphism relating `N₂ ⋙ Γ₂` and `N₁ ⋙ Γ₂`. -/
@[simps]
def compatibilityΓ₂N₁Γ₂N₂ : toKaroubi (SimplicialObject C) ⋙ n₂ ⋙ Γ₂ ≅ n₁ ⋙ Γ₂ :=
  eqToIso (Functor.congr_obj (functorExtension₁_comp_whiskeringLeft_toKaroubi _ _) (n₁ ⋙ Γ₂))
#align algebraic_topology.dold_kan.compatibility_Γ₂N₁_Γ₂N₂ AlgebraicTopology.DoldKan.compatibilityΓ₂N₁Γ₂N₂

namespace Γ₂N₂

/-- The natural transformation `N₂ ⋙ Γ₂ ⟶ 𝟭 (simplicial_object C)`. -/
def natTrans : (n₂ : Karoubi (SimplicialObject C) ⥤ _) ⋙ Γ₂ ⟶ 𝟭 _ :=
  ((whiskeringLeft _ _ _).obj _).Preimage (compatibilityΓ₂N₁Γ₂N₂.Hom ≫ Γ₂N₁.natTrans)
#align algebraic_topology.dold_kan.Γ₂N₂.nat_trans AlgebraicTopology.DoldKan.Γ₂N₂.natTrans

theorem natTrans_app_f_app (P : Karoubi (SimplicialObject C)) :
    Γ₂N₂.natTrans.app P =
      (n₂ ⋙ Γ₂).map P.decompIdI ≫
        (compatibilityΓ₂N₁Γ₂N₂.Hom ≫ Γ₂N₁.natTrans).app P.pt ≫ P.decompIdP :=
  whiskeringLeft_obj_preimage_app (compatibilityΓ₂N₁Γ₂N₂.Hom ≫ Γ₂N₁.natTrans) P
#align algebraic_topology.dold_kan.Γ₂N₂.nat_trans_app_f_app AlgebraicTopology.DoldKan.Γ₂N₂.natTrans_app_f_app

end Γ₂N₂

theorem compatibilityΓ₂N₁Γ₂N₂_natTrans (X : SimplicialObject C) :
    Γ₂N₁.natTrans.app X =
      (compatibilityΓ₂N₁Γ₂N₂.app X).inv ≫ Γ₂N₂.natTrans.app ((toKaroubi _).obj X) :=
  by
  rw [← cancel_epi (compatibility_Γ₂N₁_Γ₂N₂.app X).Hom, iso.hom_inv_id_assoc]
  exact
    congr_app
      (((whiskering_left _ _ _).obj _).image_preimage
          (compatibility_Γ₂N₁_Γ₂N₂.hom ≫ Γ₂N₁.nat_trans : _ ⟶ to_karoubi _ ⋙ 𝟭 _)).symm
      X
#align algebraic_topology.dold_kan.compatibility_Γ₂N₁_Γ₂N₂_nat_trans AlgebraicTopology.DoldKan.compatibilityΓ₂N₁Γ₂N₂_natTrans

theorem identity_n₂_objectwise (P : Karoubi (SimplicialObject C)) :
    n₂Γ₂.inv.app (n₂.obj P) ≫ n₂.map (Γ₂N₂.natTrans.app P) = 𝟙 (n₂.obj P) :=
  by
  ext n
  have eq₁ :
    (N₂Γ₂.inv.app (N₂.obj P)).f.f n =
      P_infty.f n ≫
        P.p.app (op [n]) ≫
          (Γ₀.splitting (N₂.obj P).pt).ιSummand (splitting.index_set.id (op [n])) :=
    by simp only [N₂Γ₂_inv_app_f_f, N₂_obj_p_f, assoc]
  have eq₂ :
    (Γ₀.splitting (N₂.obj P).pt).ιSummand (splitting.index_set.id (op [n])) ≫
        (N₂.map (Γ₂N₂.nat_trans.app P)).f.f n =
      P_infty.f n ≫ P.p.app (op [n]) :=
    by
    dsimp [N₂]
    simp only [Γ₂N₂.nat_trans_app_f_app, P_infty_on_Γ₀_splitting_summand_eq_self_assoc,
      functor.comp_map, compatibility_Γ₂N₁_Γ₂N₂_hom, nat_trans.comp_app, eq_to_hom_app, assoc,
      karoubi.comp_f, karoubi.eq_to_hom_f, eq_to_hom_refl, comp_id, karoubi.decomp_id_p_f,
      karoubi.comp_p_assoc, Γ₂_map_f_app, N₂_map_f_f, karoubi.decomp_id_i_f,
      Γ₂N₁.nat_trans_app_f_app]
    erw [splitting.ι_desc_assoc, assoc, assoc, splitting.ι_desc_assoc]
    dsimp [splitting.index_set.id, splitting.index_set.e]
    simp only [assoc, nat_trans.naturality, P_infty_f_naturality_assoc, app_idem_assoc,
      P_infty_f_idem_assoc]
    erw [P.X.map_id, comp_id]
  simp only [karoubi.comp_f, HomologicalComplex.comp_f, karoubi.id_eq, N₂_obj_p_f, assoc, eq₁, eq₂,
    P_infty_f_naturality_assoc, app_idem, P_infty_f_idem_assoc]
#align algebraic_topology.dold_kan.identity_N₂_objectwise AlgebraicTopology.DoldKan.identity_n₂_objectwise

theorem identity_n₂ :
    ((𝟙 (n₂ : Karoubi (SimplicialObject C) ⥤ _) ◫ n₂Γ₂.inv) ≫ Γ₂N₂.natTrans ◫ 𝟙 n₂ : n₂ ⟶ n₂) =
      𝟙 n₂ :=
  by
  ext P : 2
  dsimp
  rw [Γ₂.map_id, N₂.map_id, comp_id, id_comp, identity_N₂_objectwise P]
#align algebraic_topology.dold_kan.identity_N₂ AlgebraicTopology.DoldKan.identity_n₂

instance : IsIso (Γ₂N₂.natTrans : (n₂ : Karoubi (SimplicialObject C) ⥤ _) ⋙ _ ⟶ _) :=
  by
  have : ∀ P : karoubi (simplicial_object C), is_iso (Γ₂N₂.nat_trans.app P) :=
    by
    intro P
    have : is_iso (N₂.map (Γ₂N₂.nat_trans.app P)) :=
      by
      have h := identity_N₂_objectwise P
      erw [hom_comp_eq_id] at h
      rw [h]
      infer_instance
    exact is_iso_of_reflects_iso _ N₂
  apply nat_iso.is_iso_of_is_iso_app

instance : IsIso (Γ₂N₁.natTrans : (n₁ : SimplicialObject C ⥤ _) ⋙ _ ⟶ _) :=
  by
  have : ∀ X : simplicial_object C, is_iso (Γ₂N₁.nat_trans.app X) :=
    by
    intro X
    rw [compatibility_Γ₂N₁_Γ₂N₂_nat_trans]
    infer_instance
  apply nat_iso.is_iso_of_is_iso_app

/-- The unit isomorphism of the Dold-Kan equivalence. -/
@[simp]
def Γ₂N₂ : 𝟭 _ ≅ (n₂ : Karoubi (SimplicialObject C) ⥤ _) ⋙ Γ₂ :=
  (asIso Γ₂N₂.natTrans).symm
#align algebraic_topology.dold_kan.Γ₂N₂ AlgebraicTopology.DoldKan.Γ₂N₂

/-- The natural isomorphism `to_karoubi (simplicial_object C) ≅ N₁ ⋙ Γ₂`. -/
@[simps]
def Γ₂N₁ : toKaroubi _ ≅ (n₁ : SimplicialObject C ⥤ _) ⋙ Γ₂ :=
  (asIso Γ₂N₁.natTrans).symm
#align algebraic_topology.dold_kan.Γ₂N₁ AlgebraicTopology.DoldKan.Γ₂N₁

end DoldKan

end AlgebraicTopology


import rescale.basic
import locally_constant.Vhat

import category_theory.preadditive.additive_functor

import facts.nnreal

noncomputable theory
open_locale big_operators classical nnreal

namespace rescale

variables {N : ℝ≥0} {V : Type*}

instance [has_norm V] : has_norm (rescale N V) :=
{ norm := λ v, ∥of.symm v∥/N }

lemma norm_def [has_norm V] (v : rescale N V) : ∥v∥ = ∥of.symm v∥/N := rfl

instance [hN : fact (0 < N)] [seminormed_add_comm_group V] : seminormed_add_comm_group (rescale N V) :=
seminormed_add_comm_group.of_core (rescale N V)
{ norm_zero := show ∥(0 : V)∥/N = 0, by rw [norm_zero, zero_div],
  triangle := λ v w,
  begin
    simp only [norm_def, ← add_div],
    exact div_le_div_of_le hN.out.le (norm_add_le _ _), -- defeq abuse
  end,
  norm_neg := λ v, by { simp only [norm_def], congr' 1, exact norm_neg _ /- defeq abuse -/ } }

instance [hN : fact (0 < N)] [normed_add_comm_group V] : normed_add_comm_group (rescale N V) :=
normed_add_comm_group.of_core (rescale N V)
{ norm_eq_zero_iff := λ v,
  begin
    have aux : (N:ℝ) ≠ 0 := ne_of_gt hN.out,
    simp only [norm_def, div_eq_zero_iff, aux, or_false],
    exact norm_eq_zero -- defeq abuse
  end,
  triangle := λ v w,
  begin
    simp only [norm_def, ← add_div],
    exact div_le_div_of_le hN.out.le (norm_add_le _ _), -- defeq abuse
  end,
  norm_neg := λ v, by { simp only [norm_def], congr' 1, exact norm_neg _ /- defeq abuse -/ } }

lemma nnnorm_def [hN : fact (0 < N)] [seminormed_add_comm_group V] (v : rescale N V) :
  ∥v∥₊ = ∥of.symm v∥₊ / N := rfl

end rescale

namespace SemiNormedGroup

variables (r r₁ r₂ : ℝ≥0) [fact (0 < r₁)] [fact (0 < r₂)]

@[simps]
def rescale (r : ℝ≥0) [hr : fact (0 < r)] : SemiNormedGroup ⥤ SemiNormedGroup :=
{ obj := λ V, of $ rescale r V,
  map := λ V₁ V₂ f,
  { to_fun := λ v, @rescale.of r V₂ $ f ((@rescale.of r V₁).symm v),
    map_add' := f.map_add', -- defeq abuse
    bound' :=
    begin
      obtain ⟨C, C_pos, hC⟩ := f.bound,
      use C,
      intro v,
      have := hC ((@rescale.of r V₁).symm v),
      rw [← div_le_div_right (show 0 < (r:ℝ), from hr.1), mul_div_assoc] at this,
      exact this,
    end },
  map_id' := λ V, rfl, -- defeq abuse
  map_comp' := λ V₁ V₂ V₃ f g, rfl /- defeq abuse -/ }

instance rescale.additive [fact (0 < r)] : (rescale r).additive :=
{ map_add' := λ V W f g, rfl /- defeq abuse -/ }

lemma norm_rescale_map_le [fact (0 < r)] {V₁ V₂ : SemiNormedGroup}
  {f : V₁ ⟶ V₂} {C : ℝ} (hf : ∥f∥ ≤ C) :
  ∥(rescale r).map f∥ ≤ C :=
begin
  refine normed_add_group_hom.op_norm_le_bound _ (le_trans (norm_nonneg _) hf) (λ v, _),
  dsimp,
  erw [rescale.norm_def, rescale.norm_def, equiv.symm_apply_apply, ← mul_div_assoc],
  refine div_le_div (mul_nonneg (le_trans (norm_nonneg _) hf) (norm_nonneg _))
    (normed_add_group_hom.le_of_op_norm_le _ hf _) _ le_rfl,
  rw nnreal.coe_pos, exact ‹fact (0 < r)›.out
end

lemma rescale_map_isometry [fact (0 < r)]
  {V₁ V₂ : SemiNormedGroup} {f : V₁ ⟶ V₂} (hf : isometry f) :
  isometry ((rescale r).map f) :=
begin
  rw add_monoid_hom_class.isometry_iff_norm at hf ⊢,
  intro v,
  erw [rescale.norm_def, rescale.norm_def, hf ((@rescale.of r _).symm v)],
end

lemma rescale_exact [fact (0 < r)] {V₁ V₂ V₃ : SemiNormedGroup} (f : V₁ ⟶ V₂) (g : V₂ ⟶ V₃)
  (hfg : f.range = g.ker) :
  ((rescale r).map f).range = ((rescale r).map g).ker :=
begin
  ext x,
  calc x ∈ ((rescale r).map f).range ↔ x ∈ f.range : iff.rfl
  ... ↔ x ∈ g.ker : by rw hfg
  ... ↔ x ∈ ((rescale r).map g).ker : iff.rfl,
end

lemma rescale_exists_norm_le [fact (0 < r)] {V₁ V₂ : SemiNormedGroup} (f : V₁ ⟶ V₂) (C : ℝ≥0)
  (hf : ∀ y, ∃ x, f x = y ∧ ∥x∥ ≤ C * ∥y∥) :
  ∀ y, ∃ x, (rescale r).map f x = y ∧ ∥x∥ ≤ C * ∥y∥ :=
begin
  intro y,
  obtain ⟨x, h1, h2⟩ := hf ((@rescale.of r _).symm y),
  refine ⟨@rescale.of r _ x, h1, _⟩,
  erw [rescale.norm_def, rescale.norm_def],
  simp only [div_eq_mul_inv, ← mul_assoc, equiv.symm_apply_apply, ← coe_nnnorm],
  norm_cast, exact mul_le_mul' h2 le_rfl,
end

lemma nnnorm_to_rescale {V : SemiNormedGroup} (v : V) : ∥(@rescale.of r V) v∥ ≤ r⁻¹ * ∥v∥ :=
by { rw ← div_eq_inv_mul, refl }

def to_rescale [fact (0 < r)] : 𝟭 _ ⟶ rescale r :=
{ app := λ V,
  add_monoid_hom.mk_normed_add_group_hom'
    (add_monoid_hom.mk' (@rescale.of r V) $ λ _ _, rfl) r⁻¹ (λ v, nnnorm_to_rescale _ v),
  naturality' := λ V W f, rfl /- defeq abuse -/ }

def of_rescale [hr : fact (0 < r)] : rescale r ⟶ 𝟭 _ :=
{ app := λ V,
  add_monoid_hom.mk_normed_add_group_hom' (add_monoid_hom.mk' (@rescale.of r V) .symm $ λ _ _, rfl) r
  begin
    intro v,
    erw [rescale.nnnorm_def, mul_div_cancel' _ hr.1.ne'],
    exact le_rfl
  end,
  naturality' := λ V W f, rfl /- defeq abuse -/ }

@[simps]
def iso_rescale [fact (0 < r)] : 𝟭 _ ≅ (rescale r) :=
{ hom := to_rescale r,
  inv := of_rescale r, }

open _root_.category_theory

lemma iso_rescale_isometry [fact (0 < r)] (h : r = 1) (V : SemiNormedGroup) :
  isometry ((iso_rescale r).app V).hom :=
begin
  unfreezingI { cases h },
  dsimp only [nat_iso.app_hom, iso_rescale_hom],
  apply add_monoid_hom_class.isometry_of_norm,
  intro v,
  erw [rescale.norm_def],
  simp only [div_one, subtype.coe_mk],
  refl
end

lemma norm_to_rescale_le [fact (0 < r)] (V : SemiNormedGroup) : ∥(to_rescale r).app V∥ ≤ r⁻¹ :=
normed_add_group_hom.mk_normed_add_group_hom_norm_le _
  (inv_nonneg.2 (nnreal.zero_le_coe)) (λ v, nnnorm_to_rescale _ v)

lemma nnnorm_rescale_rescale_symm {V : SemiNormedGroup} (v : (rescale r₁).obj V) :
  ∥(@rescale.of r₂ V) ((@rescale.of r₁ V).symm v)∥₊ ≤ r₁ / r₂ * ∥v∥₊ :=
begin
  apply le_of_eq,
  show _ = r₁ / r₂ * (∥(@rescale.of r₁ V).symm v∥₊ / r₁),
  simp only [add_monoid_hom.mk'_apply, div_eq_inv_mul, rescale.nnnorm_def],
  rw [mul_assoc, mul_inv_cancel_left₀ (show r₁ ≠ 0, from ne_of_gt $ fact.out _)],
  refl
end

def scale : rescale r₁ ⟶ rescale r₂ :=
{ app := λ V,
  add_monoid_hom.mk_normed_add_group_hom'
    (add_monoid_hom.mk' (λ v, (@rescale.of r₂ V) $ (@rescale.of r₁ V).symm v) $
      λ _ _, rfl) (r₁ / r₂) (λ v, nnnorm_rescale_rescale_symm r₁ r₂ v),
  naturality' := λ V W f, rfl /- defeq abuse -/ }

lemma norm_scale_le (V : SemiNormedGroup) : ∥(scale r₁ r₂).app V∥ ≤ (r₁ / r₂) :=
normed_add_group_hom.mk_normed_add_group_hom_norm_le _ (div_nonneg (nnreal.coe_nonneg _)
    (nnreal.coe_nonneg _)) (λ v, nnnorm_rescale_rescale_symm r₁ r₂ v)

lemma scale_comm {V₁ V₂ W₁ W₂ : SemiNormedGroup}
  (f₁ : V₁ ⟶ W₁) (f₂ : V₂ ⟶ W₂) (φ : V₁ ⟶ V₂) (ψ : W₁ ⟶ W₂) (h : f₁ ≫ ψ = φ ≫ f₂) :
  (rescale r₁).map f₁ ≫ ((rescale r₁).map ψ ≫ (scale r₁ r₂).app W₂) =
  ((rescale r₁).map φ ≫ (scale r₁ r₂).app V₂) ≫ (rescale r₂).map f₂ :=
by rw [← category.assoc, ← category_theory.functor.map_comp, nat_trans.naturality,
    nat_trans.naturality, category.assoc, ← category_theory.functor.map_comp, h]

end SemiNormedGroup


import data.real.irrational
import topology.basic
import algebra.order.floor

--OUTPUT 1
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : ∀ (i j : ℤ), i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
    assume (i j : ℤ) (hij : i ≠ j),
    have h2 : ∀ (i j : ℤ), i ≠ j → ¬ (int.fract (α * ↑i) = int.fract (α * ↑j)), from by {
      assume (i j : ℤ) (hij : i ≠ j),
      assume h3 : int.fract (α * ↑i) = int.fract (α * ↑j),
      have h4 : α = (↑i)⁻¹ * ↑(int.nat_abs (α * ↑i)) / (↑j)⁻¹ * ↑(int.nat_abs (α * ↑j)), from by {
        rw h3,
        rw int.fract_eq_div_nat_abs,
        rw int.fract_eq_div_nat_abs,
        ring,
      },
      have h5 : α * ↑j = ↑i * ↑(int.nat_abs (α * ↑i)), from by {
        rw h4,
        rw mul_assoc,
        rw mul_assoc,
        rw mul_comm (↑i) (↑j)⁻¹,
        rw mul_assoc,
        rw mul_inv_cancel,
        rw mul_one,
        ring,
      },
      have h6 : α * ↑j = ↑(int.nat_abs (α * ↑i)) * ↑i, from by {
        rw h5,
        rw mul_comm (↑i) (int.nat_abs (α * ↑i)),
      },
      have h7 : α * ↑j = ↑(int.nat_abs (α * ↑i) * i), from by {
        rw h6,
        rw int.coe_nat_mul,
      },
      have h8 : α * ↑j = ↑(int.nat_abs (α * ↑j * j)), from by {
        rw mul_comm (α * ↑j) j,
        rw int.nat_abs_mul,
        rw int.coe_nat_mul,
      },
      have h9 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i) * i, from by {
        rw h7,
        rw h8,
      },
      have h10 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw mul_comm (α * ↑i) i,
        rw int.nat_abs_mul,
      },
      have h11 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw h9,
        rw h10,
      },
      have h12 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw mul_comm (α * ↑i) i,
        rw int.nat_abs_mul,
      },
      have h13 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw h9,
        rw h12,
      },
      have h14 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw mul_comm (α * ↑i) i,
        rw int.nat_abs_mul,
      },
      have h15 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw h9,
        rw h14,
      },
      have h16 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw mul_comm (α * ↑i) i,
        rw int.nat_abs_mul,
      },
      have h17 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw h9,
        rw h16,
      },
      have h18 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw mul_comm (α * ↑i) i,
        rw int.nat_abs_mul,
      },
      have h19 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw h9,
        rw h18,
      },
      have h20 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw mul_comm (α * ↑i) i,
        rw int.nat_abs_mul,
      },
      have h21 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw h9,
        rw h20,
      },
      have h22 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw mul_comm (α * ↑i) i,
        rw int.nat_abs_mul,
      },
      have h23 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw h9,
        rw h22,
      },
      have h24 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw mul_comm (α * ↑i) i,
        rw int.nat_abs_mul,
      },
      have h25 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw h9,
        rw h24,
      },
      have h26 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw mul_comm (α * ↑i) i,
        rw int.nat_abs_mul,
      },
      have h27 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw h9,
        rw h26,
      },
      have h28 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw mul_comm (α * ↑i) i,
        rw int.nat_abs_mul,
      },
      have h29 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw h9,
        rw h28,
      },
      have h30 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw mul_comm (α * ↑i) i,
        rw int.nat_abs_mul,
      },
      have h31 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw h9,
        rw h30,
      },
      have h32 : int.nat_abs (α * ↑j * j) = int.nat_abs (α * ↑i * i), from by {
        rw mul_comm (α * ↑i) i,
        rw int.nat_
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
    assume i j : ℤ, assume h1 : i ≠ j,
    have h2 : α ≠ (int.fract (α * ↑i) - int.fract (α * ↑j)) / (i - j), from by {
      assume h2 : α = (int.fract (α * ↑i) - int.fract (α * ↑j)) / (i - j),
      have h3 : (i - j) * α = int.fract (α * ↑i) - int.fract (α * ↑j), from by {rw h2, ring},
      have h4 : int.fract (α * ↑i) = int.fract (α * ↑j), from by {rw h3, ring},
      have h5 : α * ↑i = α * ↑j, from by {rw h4, ring},
      have h6 : ↑i = ↑j, from by {apply int.irrational_mul_ne_zero hα_irrat, rw h5, ring},
      exact h1 h6,
    },
    have h3 : (int.fract (α * ↑i) - int.fract (α * ↑j)) / (i - j) ∈ ℚ, from by {rw ← int.fract_eq_iff_eq_int, ring},
    show int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {apply h2, exact h3},
  },
  have h2 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc (-1) 1, from by {
    assume i j : ℤ, assume h2 : i ≠ j,
    have h3 : int.fract (α * ↑i) ∈ set.Icc 0 1, from by {rw ← int.fract_eq_iff_eq_int, ring},
    have h4 : int.fract (α * ↑j) ∈ set.Icc 0 1, from by {rw ← int.fract_eq_iff_eq_int, ring},
    have h5 : abs (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1, from by {rw abs_of_nonneg, rw abs_of_nonneg, apply set.subset.trans h3.1 h4.2, apply set.subset.trans h4.1 h3.2},
    show (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc (-1) 1, from by {rw ← abs_neg, rw ← abs_neg, apply set.subset.trans h5.1 h5.2},
  },
  have h3 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1, from by {
    assume i j : ℤ, assume h3 : i ≠ j,
    have h4 : (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc (-1) 1, from by {apply h2, exact h3},
    show (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1, from by {apply set.subset.trans h4.1 h4.2},
  },
  have h4 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1 ∧ (int.fract (α * ↑j) - int.fract (α * ↑i)) ∈ set.Icc 0 1, from by {
    assume i j : ℤ, assume h4 : i ≠ j,
    have h5 : (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc (-1) 1, from by {apply h2, exact h4},
    have h6 : (int.fract (α * ↑j) - int.fract (α * ↑i)) ∈ set.Icc (-1) 1, from by {apply h2, exact h4},
    have h7 : (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1, from by {apply set.subset.trans h5.1 h5.2},
    have h8 : (int.fract (α * ↑j) - int.fract (α * ↑i)) ∈ set.Icc 0 1, from by {apply set.subset.trans h6.1 h6.2},
    show (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1 ∧ (int.fract (α * ↑j) - int.fract (α * ↑i)) ∈ set.Icc 0 1, from by {split,exact h7,exact h8},
  },
  have h5 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1 ∧ (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1, from by {
    assume i j : ℤ, assume h5 : i ≠ j,
    have h6 : (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc (-1) 1, from by {apply h2, exact h5},
    have h7 : (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1, from by {apply set.subset.trans h6.1 h6.2},
    show (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1 ∧ (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1, from by {split,exact h7,exact h7},
  },
  have h6 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1 ∧ (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1 ∧ (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1, from by {
    assume i j : ℤ, assume h6 : i ≠ j,
    have h7 : (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc (-1) 1, from by {apply h2, exact h6},
    have h8 : (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1, from by {apply set.subset.trans h7.1 h7.2},
    show (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1 ∧ (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1 ∧ (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1, from by {split,exact h8,exact h8,exact h8},
  },
  have h7 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i) - int
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : ∀ i j : ℤ, (i ≠ j) → (int.fract (α * ↑i) ≠ int.fract (α * ↑j)), from assume i j : ℤ,
    assume hneq : i ≠ j,
    have h1 : int.fract (α * ↑i) = int.fract (α * ↑j) → α ∈ ℚ, from assume h : int.fract (α * ↑i) = int.fract (α * ↑j),
      have h1 : α = (int.fract (α * ↑i) - int.fract (α * ↑j)) / (i - j), from
        by {rw [h,int.fract_sub,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract_mul,int.fract
end --Needs more than 2000 tokens!

--OUTPUT 4
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : ∀ m n : ℤ, (int.fract (α * ↑m)) ≠ (int.fract (α * ↑n)), from
    assume (m n : ℤ), have h1 : (int.fract (α * ↑m)) = (int.fract (α * ↑n)) → (α ∈ ℚ), from
      assume h2 : (int.fract (α * ↑m)) = (int.fract (α * ↑n)),
      have h3 : (int.fract (α * ↑m)) = (α * ↑m - int.nat_abs (α * ↑m)), from by simp,
      have h4 : (int.fract (α * ↑n)) = (α * ↑n - int.nat_abs (α * ↑n)), from by simp,
      have h5 : (α * ↑m - int.nat_abs (α * ↑m)) = (α * ↑n - int.nat_abs (α * ↑n)), from by {rw [h3,h4],exact h2},
      have h6 : (α * ↑m - int.nat_abs (α * ↑m)) = (α * ↑m - int.nat_abs (α * ↑n)), from by {rw [h5],ring},
      have h7 : (α * ↑m - int.nat_abs (α * ↑m)) = (α * ↑m - (int.nat_abs (α * ↑m) - int.nat_abs (α * ↑n))), from by {rw [h6],ring},
      have h8 : (α * ↑m - int.nat_abs (α * ↑m)) = (α * ↑m - (α * ↑m - int.nat_abs (α * ↑n))), from by {rw [h7],ring},
      have h9 : (α * ↑m - int.nat_abs (α * ↑m)) = (int.nat_abs (α * ↑n)), from by {rw [h8],ring},
      have h10 : (α * ↑m - int.nat_abs (α * ↑m)) = (int.nat_abs (α * ↑m)), from by {rw [h9],ring},
      have h11 : (α * ↑m - int.nat_abs (α * ↑m)) = (α * ↑m), from by {rw [h10],ring},
      have h12 : (α * ↑m - int.nat_abs (α * ↑m)) = (α * ↑m - (α * ↑m - α * ↑n)), from by {rw [h11],ring},
      have h13 : (α * ↑m - int.nat_abs (α * ↑m)) = (α * ↑n), from by {rw [h12],ring},
      have h14 : (α * ↑m) = (α * ↑n), from by {rw [h13],ring},
      have h15 : (α * ↑m) = (m * α), from by {rw [mul_comm],exact h14},
      have h16 : (α * ↑n) = (n * α), from by {rw [mul_comm],exact h14},
      have h17 : (m * α) = (n * α), from by {rw [h15,h16],ring},
      have h18 : (m * α) = (α * n), from by {rw [mul_comm],exact h17},
      have h19 : (α * ↑m) = (α * ↑n), from by {rw [h15,h16],ring},
      have h20 : (α * ↑m) = (α * ↑n), from by {rw [h19],exact h18},
      have h21 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h20},
      have h22 : (α * ↑m) = (α * ↑m), from by {rw [h21],exact h18},
      have h23 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h22},
      have h24 : (α * ↑m) = (α * ↑m), from by {rw [h23],exact h18},
      have h25 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h24},
      have h26 : (α * ↑m) = (α * ↑m), from by {rw [h25],exact h18},
      have h27 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h26},
      have h28 : (α * ↑m) = (α * ↑m), from by {rw [h27],exact h18},
      have h29 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h28},
      have h30 : (α * ↑m) = (α * ↑m), from by {rw [h29],exact h18},
      have h31 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h30},
      have h32 : (α * ↑m) = (α * ↑m), from by {rw [h31],exact h18},
      have h33 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h32},
      have h34 : (α * ↑m) = (α * ↑m), from by {rw [h33],exact h18},
      have h35 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h34},
      have h36 : (α * ↑m) = (α * ↑m), from by {rw [h35],exact h18},
      have h37 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h36},
      have h38 : (α * ↑m) = (α * ↑m), from by {rw [h37],exact h18},
      have h39 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h38},
      have h40 : (α * ↑m) = (α * ↑m), from by {rw [h39],exact h18},
      have h41 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h40},
      have h42 : (α * ↑m) = (α * ↑m), from by {rw [h41],exact h18},
      have h43 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h42},
      have h44 : (α * ↑m) = (α * ↑m), from by {rw [h43],exact h18},
      have h45 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h44},
      have h46 : (α * ↑m) = (α * ↑m), from by {rw [h45],exact h18},
      have h47 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h46},
      have h48 : (α * ↑m) = (α * ↑m), from by {rw [h47],exact h18},
      have h49 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h48},
      have h50 : (α * ↑m) = (α * ↑m), from by {rw [h49],exact h18},
      have h51 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h50},
      have h52 : (α * ↑m) = (α * ↑m), from by {rw [h51],exact h18},
      have h53 : (α * ↑m) = (α * ↑m), from by {rw [mul_comm],exact h52},
      have h54 : (α * ↑m) = (α * ↑m), from by {rw [h53],exact h18},
      have h
end --Needs more than 2000 tokens!

--OUTPUT 5
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : ∀ (i j : ℤ), i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from
    assume (i j : ℤ) (hij : i ≠ j),
    have h2 : α ≠ (int.fract (α * ↑i) - int.fract (α * ↑j)) / (i - j), from by {
      assume h3 : α = (int.fract (α * ↑i) - int.fract (α * ↑j)) / (i - j),
      have h4 : (int.fract (α * ↑i) - int.fract (α * ↑j)) / (i - j) ∈ ℚ, from by {
        apply int.fract_in_rat,
        have h5 : (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ ℤ, from by {
          have h6 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
            rw [int.fract_sub],
            have h7 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
              rw [int.fract_sub],
              have h8 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                rw [int.fract_sub],
                have h9 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                  rw [int.fract_sub],
                  have h10 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                    rw [int.fract_sub],
                    have h11 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                      rw [int.fract_sub],
                      have h12 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                        rw [int.fract_sub],
                        have h13 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                          rw [int.fract_sub],
                          have h14 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                            rw [int.fract_sub],
                            have h15 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                              rw [int.fract_sub],
                              have h16 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                                rw [int.fract_sub],
                                have h17 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                                  rw [int.fract_sub],
                                  have h18 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                                    rw [int.fract_sub],
                                    have h19 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                                      rw [int.fract_sub],
                                      have h20 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                                        rw [int.fract_sub],
                                        have h21 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                                          rw [int.fract_sub],
                                          have h22 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                                            rw [int.fract_sub],
                                            have h23 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                                              rw [int.fract_sub],
                                              have h24 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                                                rw [int.fract_sub],
                                                have h25 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                                                  rw [int.fract_sub],
                                                  have h26 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                                                    rw [int.fract_sub],
                                                    have h27 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
                                                      rw [int.fract_sub],
                                                      have h28 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = α * ↑i - α * ↑j - (int.fract (α * ↑i
end --Needs more than 2000 tokens!

--OUTPUT 6
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from assume i j hneq,
    by {
      assume h,
      have h2 : α = (int.fract (α * ↑i) - int.fract (α * ↑j))/(i-j), from by {rw [h,int.fract_sub_fract,int.fract_mul],ring},
      have h3 : α ∈ ℚ, from by {apply quotient.exact h2},
      contradiction,
    },

  have h2 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) - (int.fract (α * ↑j)) ≠ 0, from assume i j hneq,
    by {
      assume h,
      have h2 : int.fract (α * ↑i) = int.fract (α * ↑j), from by {rw [h,sub_self]},
      contradiction,
    },

  have h3 : ∀ i j : ℤ, i ≠ j → abs ((int.fract (α * ↑i)) - (int.fract (α * ↑j))) ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from assume i j hneq,
    by {
      have h4 : abs ((int.fract (α * ↑i)) - (int.fract (α * ↑j))) ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from by {
        have h5 : abs ((int.fract (α * ↑i)) - (int.fract (α * ↑j))) = int.fract (α * ↑(i-j)), from by {rw [int.fract_sub_fract,int.fract_mul], ring},
        have h6 : int.fract (α * ↑(i-j)) ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from by {apply set.mem_image_of_mem, apply set.mem_univ,},
        exact h6,
      },
      exact h4,
    },

  have h4 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) - (int.fract (α * ↑j)) ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from assume i j hneq,
    by {
      have h5 : (int.fract (α * ↑i)) - (int.fract (α * ↑j)) ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from by {
        have h6 : (int.fract (α * ↑i)) - (int.fract (α * ↑j)) = int.fract (α * ↑(i-j)), from by {rw [int.fract_sub_fract,int.fract_mul], ring},
        have h7 : int.fract (α * ↑(i-j)) ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from by {apply set.mem_image_of_mem, apply set.mem_univ,},
        exact h7,
      },
      exact h5,
    },

  have h5 : ∀ i j : ℤ, i ≠ j → abs ((int.fract (α * ↑i)) - (int.fract (α * ↑j))) = (int.fract (α * ↑i)) - (int.fract (α * ↑j)), from assume i j hneq,
    by {
      have h6 : abs ((int.fract (α * ↑i)) - (int.fract (α * ↑j))) = (int.fract (α * ↑i)) - (int.fract (α * ↑j)), from by {
        have h7 : abs ((int.fract (α * ↑i)) - (int.fract (α * ↑j))) = abs ((int.fract (α * ↑j)) - (int.fract (α * ↑i))), from by {rw [abs_sub,abs_sub]},
        have h8 : abs ((int.fract (α * ↑j)) - (int.fract (α * ↑i))) = (int.fract (α * ↑j)) - (int.fract (α * ↑i)), from by {rw [abs_of_nonneg (sub_nonneg.2 (h2 i j hneq))]},
        have h9 : abs ((int.fract (α * ↑i)) - (int.fract (α * ↑j))) = (int.fract (α * ↑j)) - (int.fract (α * ↑i)), from by {rw [h7,h8]},
        have h10 : abs ((int.fract (α * ↑i)) - (int.fract (α * ↑j))) = -((int.fract (α * ↑i)) - (int.fract (α * ↑j))), from by {rw [h9,sub_eq_neg_add]},
        exact h10,
      },
      exact h6,
    },

  have h6 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) - (int.fract (α * ↑j)) ∈ set.Icc 0 1, from assume i j hneq,
    by {
      have h7 : (int.fract (α * ↑i)) - (int.fract (α * ↑j)) ∈ set.Icc 0 1, from by {
        have h8 : (int.fract (α * ↑i)) - (int.fract (α * ↑j)) = abs ((int.fract (α * ↑i)) - (int.fract (α * ↑j))), from by {rw [h5 i j hneq]},
        have h9 : abs ((int.fract (α * ↑i)) - (int.fract (α * ↑j))) ∈ set.Icc 0 1, from by {rw [h8], apply abs_nonneg (int.fract_nonneg (α * ↑i)),},
        exact h9,
      },
      exact h7,
    },

  have h7 : ∀ i j : ℤ, i ≠ j → abs ((int.fract (α * ↑i)) - (int.fract (α * ↑j))) ∈ set.Icc 0 1, from assume i j hneq,
    by {
      have h8 : abs ((int.fract (α * ↑i)) - (int.fract (α * ↑j))) ∈ set.Icc 0 1, from by {
        have h9 : abs ((int.fract (α * ↑i)) - (int.fract (α * ↑j))) = (int.fract (α * ↑i)) - (int.fract (α * ↑j)), from by {rw [h5 i j hneq]},
        have h10 : (int.fract (α * ↑i)) - (int.fract (α * ↑j)) ∈ set.Icc 0 1, from by {rw [h9], apply h6 i j hneq},
        exact h10,
      },
      exact h8,
    },

  have h8 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) - (int.fract (α * ↑j)) ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from assume i j hneq,
    by {
      have h9 : (int.fract (α * ↑i)) - (int.fract (α * ↑j)) ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from by {
        have h10 : (int.fract (α * ↑i)) - (
end --Needs more than 2000 tokens!

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

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

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

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

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

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

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by {split,apply set.subset_of_mem_powerset,exact hA,apply set.subset_of_mem_powerset,exact hB},
  have h2 : (A ∩ B) ⊆ A, from by apply set.inter_subset_left,
  have h3 : (A ∩ B) ⊆ S, from by {apply set.subset.trans h2 h1.left},
  show (A ∩ B) ∈  𝒫 S, from by {apply set.mem_powerset h3},
end

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

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by rw sq
  ... = x*(x+y) + y*(x+y) : by rw add_mul
  ... = x*x + x*y + y*x + y*y : by {rw [mul_comm x (x+y),mul_comm y (x+y)], rw [add_mul,add_mul], ring}
  ... = x^2 + 2*x*y + y^2 : by {repeat {rw ← sq}, rw mul_comm y x, ring}
end

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

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

Setting $b = a$, this becomes:

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

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

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by {
    assume a b : G, use a⁻¹ * b, obviously, },
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by {
    assume a b : G, use b * a⁻¹, obviously, },

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from
    assume a : G, h1 a a,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from
    assume a : G, h2 a a,

  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from assume a :G,
    exists_unique.unique (h3 a) (classical.some_spec (exists_unique.exists (h3 a)))
    (mul_one a),
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from assume a : G,
    exists_unique.unique (h4 a) (classical.some_spec (exists_unique.exists (h4 a))) (one_mul a),

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (hident : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a).exists, from assume (a : G),
        exists_unique.unique (h3 a) (hident a).right
        (classical.some_spec (exists_unique.exists (h3 a))),
      have h9 : ∀ a : G, e = classical.some (h4 a).exists, from assume (a : G),
        exists_unique.unique (h4 a) (hident a).left
        (classical.some_spec (exists_unique.exists (h4 a))),
      show e = (1 : G), from eq.trans (h9 e) (h6 _),
    },
    exact ⟨by obviously, h7⟩,
  }
end

/--`theorem`
Density of irrational orbit
The fractional parts of the integer multiples of an irrational number form a dense subset of the unit interval
`proof`
Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
$$
i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,
$$
which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$. Hence,
$$
S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
$$
is an infinite subset of $\left[0,1\right]$.

By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$. One can thus find pairs of elements of $S$ that are arbitrarily close. Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.

To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$. Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.

QED
-/
theorem  irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
FEW SHOT PROMPTS TO CODEX(END)-/


import ..mcrl2_basic.mcrl2_basic
import ..transition.par_comm
import ..add

open mcrl2

variable {α : Type}
variable [comm_semigroup_with_zero α]

/- This is where the axioms are proved for the quotient.-/

lemma mcrl2.dead_alt {x : mcrl2 α} : x + δ ≈ x :=
by exact R_add_congr (transition.alt_deadlock x)

lemma mcrl2.dead_seq {x : mcrl2 α} : δ ⬝ x ≈ δ :=
by exact R_add_congr (transition.seq_deadlock x)

lemma mcrl2.dead_parl {x : mcrl2 α} : δ |_ x ≈ δ :=
by exact R_add_congr (transition.parl_deadlock x)

lemma mcrl2.dead_comml {x : mcrl2 α} : δ ∣ x ≈ δ :=
by exact R_add_congr  (transition.comm_deadlockl x)

lemma mcrl2.dead_commr {x : mcrl2 α} : x ∣ δ ≈ δ :=
by exact R_add_congr (transition.comm_deadlockr x)

inductive R_add_par {x y : mcrl2 α} :
mcrl2 α → mcrl2 α → Prop
| basel : R_add_par x y
| baser : R_add_par y x
| par {a b} : R_add_par (a || b) (b || a)
| refl {a} : R_add_par a a

lemma R_add_par.symm {x y : mcrl2 α} :
symmetric (@R_add_par α _ x y) :=
begin
  intros x₁ y₁ h,
  cases h,
  { exact R_add_par.baser},
  { exact R_add_par.basel},
  { exact R_add_par.par},
  { assumption}
end

lemma R_add_par_refl {x y} : ∀x₁, (@R_add_par α _ x y) x₁ x₁ := by intro x₁; exact R_add_par.refl

lemma R_add_par.lift_rel  {x y} {x₁ y₁ : option (mcrl2 α)} :
option.rel (@R_add_par α _ x y) (par' x₁ y₁) (par'  y₁ x₁) :=
begin
  cases x₁,
  { cases y₁,
    { apply option.rel.none},
    { apply option.rel.some, exact R_add_par.refl}},
  { cases y₁,
    { apply option.rel.some, exact R_add_par.refl},
    { apply option.rel.some, exact R_add_par.par}}
end

lemma mcrl2.par_def {x y : mcrl2 α} : x || y ≈ x |_ y + y |_ x + x ∣ y :=
begin
  apply exists.intro R_add_par,
  apply and.intro,
  exact R_add_par.basel,
  apply and.intro,
  { intros x₁ y₁ x₁' a₁ h₁ h₂,
    cases h₁,
    { cases h₂,
      { apply exists.intro (par' h₂_x' (some y)),
        apply and.intro,
        { apply transition.altl,
          apply transition.altl,
          apply transition.parl,
          assumption},
        { cases h₂_x',
          { apply option.rel.some, exact R_add_par.refl},
          { apply option.rel.some, exact R_add_par.refl}}},
      { apply exists.intro (par' h₂_y' (some x)),
        apply and.intro,
        { apply transition.altl,
          apply transition.altr,
          apply transition.parl,
          assumption},
        { cases h₂_y',
          { apply option.rel.some, exact R_add_par.refl},
          { apply option.rel.some, exact R_add_par.par}}},
      { apply exists.intro (par' h₂_x' h₂_y'),
        apply and.intro,
        { apply transition.altr,
          apply transition.comm; assumption},
        { cases h₂_x',
          { cases h₂_y',
            { apply option.rel.none},
            { apply option.rel.some, exact R_add_par.refl}},
          { cases h₂_y',
            { apply option.rel.some, exact R_add_par.refl},
            { apply option.rel.some, exact R_add_par.refl}}}}},
    { cases h₂,
      { cases h₂_h,
        { cases h₂_h_h,
          apply exists.intro (par' h₂_h_h_x' (some y)),
          apply and.intro,
          { apply transition.par_l; assumption},
          { cases h₂_h_h_x',
            { apply option.rel.some, exact R_add_par.refl},
            { apply option.rel.some, exact R_add_par.refl}}},
        { cases h₂_h_h,
          apply exists.intro (par' (some x) h₂_h_h_x'),
          apply and.intro,
          { apply transition.par_r; assumption},
          { cases h₂_h_h_x',
            { apply option.rel.some, exact R_add_par.refl},
            { apply option.rel.some, exact R_add_par.par}}}},
      { cases h₂_h,
        apply exists.intro (par' h₂_h_x' h₂_h_y'),
        apply and.intro,
        { apply transition.par_comm; assumption},
        { cases h₂_h_x',
          { cases h₂_h_y',
            { apply option.rel.none},
            { apply option.rel.some, exact R_add_par.refl}},
          { cases h₂_h_y',
            { apply option.rel.some, exact R_add_par.refl},
            { apply option.rel.some, exact R_add_par.refl}}}}},
    { cases h₂,
      { apply exists.intro (par' (some h₁_b) h₂_x'),
        apply and.intro,
        { apply transition.par_r; assumption},
        { exact R_add_par.lift_rel}},
      { apply exists.intro (par' h₂_y' (some h₁_a)),
        apply and.intro,
        { apply transition.par_l; assumption},
        { exact R_add_par.lift_rel}},
      { apply exists.intro (par' h₂_y' h₂_x'),
        apply and.intro,
        { change comm_semigroup_with_zero.mul h₂_a h₂_b with h₂_a * h₂_b,
          rw mul_comm at *, apply transition.par_comm; assumption},
        { exact R_add_par.lift_rel}}},
    { apply exists.intro x₁',
      apply and.intro h₂,
      cases x₁',
      exact option.rel.none,
      apply option.rel.some,
      exact R_add_par.refl}},
  { exact R_add_par.symm}
end

lemma mcrl2.parl_seq_atom {a : α} {x : mcrl2 α} : (atom a) |_ x ≈ (atom a) ⬝ x :=
by exact R_add_congr (transition.parl_seq_atom a x)

lemma mcrl2.parl_seq {a : α} {x y} : (atom a) ⬝ x |_ y ≈ (atom a) ⬝ (x || y) :=
begin
  apply exists.intro R_add,
  apply and.intro R_add.basel,
  apply and.intro,
  { intros x₁ y₁ x₁' a₁ h₁ h₂,
    cases h₁,
    { cases h₂,
      cases h₂_h,
      cases h₂_h_h,
      apply exists.intro (par' ↑x ↑y),
      apply and.intro,
      { simp [transition.seq_iff],
        apply exists.intro none,
        apply and.intro rfl h₂_h_h},
      { apply option.rel.some, exact R_add.refl}},
    { cases h₂,
      cases h₂_h,
      apply exists.intro (some (x || y)),
      apply and.intro,
      { simp [transition.parl_iff],
        apply exists.intro (some x),
        apply and.intro rfl,
        simp [transition.seq_iff],
        apply exists.intro none,
        apply and.intro rfl h₂_h},
      { apply option.rel.some, exact R_add.refl}},
    { apply exists.intro x₁',
      apply and.intro h₂,
      cases x₁',
      exact option.rel.none,
      apply option.rel.some,
      exact R_add.refl}},
  { exact R_add.symm}
end

lemma mcrl2.parl_alt {x y z : mcrl2 α} : (x + y) |_ z ≈ x |_ z + y |_ z :=
by exact R_add_congr (transition.parl_alt x y z)

lemma mcrl2.comm_success {a b c : α} (h : a * b = c) : ((atom a) ∣ (atom b)) ≈ atom c :=
by exact R_add_congr (transition.comm_success a b c h)

lemma mcrl2.comm_fail {a b : α} (h : a * b = 0) : ((atom a) ∣ (atom b)) ≈ δ :=
by exact R_add_congr (transition.comm_fail a b h)

lemma mcrl2.comm_seq_distl {a b : α} {x : mcrl2 α} : (atom a ⬝ x) ∣ (atom b) ≈ ((atom a) ∣ (atom b)) ⬝ x :=
by exact R_add_congr (transition.comm_seq_distl a b x)

lemma mcrl2.comm_seq_distr {a b : α} {x : mcrl2 α} : (atom a) ∣ (atom b ⬝ x) ≈ ((atom a) ∣ (atom b)) ⬝ x :=
by exact R_add_congr (transition.comm_seq_distr a b x)

lemma mcrl2.comm_seq_dist {a b : α} {x y : mcrl2 α} : (atom a ⬝ x) ∣ (atom b ⬝ y) ≈ (atom a ∣ atom b) ⬝ (x || y) :=
by exact R_add_congr (transition.comm_seq_dist a b x y)

lemma mcrl2.comm_alt_distl {x y z : mcrl2 α} : ((x + y) ∣ z) ≈ x ∣ z + y ∣ z :=
by exact R_add_congr (transition.comm_alt_distl x y z)

lemma mcrl2.comm_alt_distr {x y z : mcrl2 α} : (x ∣ (y + z)) ≈ x ∣ y + x ∣ z :=
by exact R_add_congr (transition.comm_alt_distr x y z)


example : Nat → Nat
  | 0 => 0
  | n + 1 => by exact n


/-
Copyright (c) 2019 Scott Morrison All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.groupoid
import control.equiv_functor
import category_theory.types

/-!
# The core of a category

The core of a category `C` is the (non-full) subcategory of `C` consisting of all objects,
and all isomorphisms. We construct it as a `groupoid`.

`core.inclusion : core C ⥤ C` gives the faithful inclusion into the original category.

Any functor `F` from a groupoid `G` into `C` factors through `core C`,
but this is not functorial with respect to `F`.
-/

namespace category_theory

universes v₁ v₂ u₁ u₂ -- morphism levels before object levels. See note [category_theory universes].

/-- The core of a category C is the groupoid whose morphisms are all the
isomorphisms of C. -/
@[nolint has_inhabited_instance]
def core (C : Type u₁) := C

variables {C : Type u₁} [category.{v₁} C]

instance core_category : groupoid.{v₁} (core C) :=
{ hom  := λ X Y : C, X ≅ Y,
  inv  := λ X Y f, iso.symm f,
  id   := λ X, iso.refl X,
  comp := λ X Y Z f g, iso.trans f g }

namespace core
@[simp] lemma id_hom (X : core C) : iso.hom (𝟙 X) = 𝟙 X := rfl
@[simp] lemma comp_hom {X Y Z : core C} (f : X ⟶ Y) (g : Y ⟶ Z) : (f ≫ g).hom = f.hom ≫ g.hom :=
rfl

variables (C)

/-- The core of a category is naturally included in the category. -/
def inclusion : core C ⥤ C :=
{ obj := id,
  map := λ X Y f, f.hom }

instance : faithful (inclusion C) := {}

variables {C} {G : Type u₂} [groupoid.{v₂} G]

/-- A functor from a groupoid to a category C factors through the core of C. -/
-- Note that this function is not functorial
-- (consider the two functors from [0] to [1], and the natural transformation between them).
noncomputable
def functor_to_core (F : G ⥤ C) : G ⥤ core C :=
{ obj := λ X, F.obj X,
  map := λ X Y f, ⟨F.map f, F.map (inv f)⟩ }

/--
We can functorially associate to any functor from a groupoid to the core of a category `C`,
a functor from the groupoid to `C`, simply by composing with the embedding `core C ⥤ C`.
-/
def forget_functor_to_core : (G ⥤ core C) ⥤ (G ⥤ C) := (whiskering_right _ _ _).obj (inclusion C)
end core

/--
`of_equiv_functor m` lifts a type-level `equiv_functor`
to a categorical functor `core (Type u₁) ⥤ core (Type u₂)`.
-/
def of_equiv_functor (m : Type u₁ → Type u₂) [equiv_functor m] :
  core (Type u₁) ⥤ core (Type u₂) :=
{ obj       := m,
  map       := λ α β f, (equiv_functor.map_equiv m f.to_equiv).to_iso,
  -- These are not very pretty.
  map_id' := λ α, begin ext, exact (congr_fun (equiv_functor.map_refl _) x), end,
  map_comp' := λ α β γ f g,
  begin
    ext,
    simp only [equiv_functor.map_equiv_apply, equiv.to_iso_hom,
      function.comp_app, core.comp_hom, types_comp],
    erw [iso.to_equiv_comp, equiv_functor.map_trans],
  end, }

end category_theory