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

! This file was ported from Lean 3 source module category_theory.abelian.injective_resolution
! leanprover-community/mathlib commit 956af7c76589f444f2e1313911bad16366ea476d
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Homology.QuasiIso
import Mathbin.CategoryTheory.Preadditive.InjectiveResolution
import Mathbin.CategoryTheory.Abelian.Homology
import Mathbin.Algebra.Homology.HomotopyCategory

/-!
# Main result

When the underlying category is abelian:
* `category_theory.InjectiveResolution.desc`: Given `I : InjectiveResolution X` and
  `J : InjectiveResolution Y`, any morphism `X ⟶ Y` admits a descent to a chain map
  `J.cocomplex ⟶ I.cocomplex`. It is a descent in the sense that `I.ι` intertwines the descent and
  the original morphism, see `category_theory.InjectiveResolution.desc_commutes`.
* `category_theory.InjectiveResolution.desc_homotopy`: Any two such descents are homotopic.
* `category_theory.InjectiveResolution.homotopy_equiv`: Any two injective resolutions of the same
  object are homotopy equivalent.
* `category_theory.injective_resolutions`: If every object admits an injective resolution, we can
  construct a functor `injective_resolutions C : C ⥤ homotopy_category C`.

* `category_theory.exact_f_d`: `f` and `injective.d f` are exact.
* `category_theory.InjectiveResolution.of`: Hence, starting from a monomorphism `X ⟶ J`, where `J`
  is injective, we can apply `injective.d` repeatedly to obtain an injective resolution of `X`.
-/

noncomputable section

open CategoryTheory

open CategoryTheory.Limits

universe v u

namespace CategoryTheory

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

open Injective

namespace InjectiveResolution

section

variable [HasZeroMorphisms C] [HasZeroObject C] [HasEqualizers C] [HasImages C]

/-- Auxiliary construction for `desc`. -/
def descFZero {Y Z : C} (f : Z ⟶ Y) (I : InjectiveResolution Y) (J : InjectiveResolution Z) :
    J.cocomplex.pt 0 ⟶ I.cocomplex.pt 0 :=
  factorThru (f ≫ I.ι.f 0) (J.ι.f 0)
#align category_theory.InjectiveResolution.desc_f_zero CategoryTheory.InjectiveResolution.descFZero

end

section Abelian

variable [Abelian C]

/-- Auxiliary construction for `desc`. -/
def descFOne {Y Z : C} (f : Z ⟶ Y) (I : InjectiveResolution Y) (J : InjectiveResolution Z) :
    J.cocomplex.pt 1 ⟶ I.cocomplex.pt 1 :=
  Exact.desc (descFZero f I J ≫ I.cocomplex.d 0 1) (J.ι.f 0) (J.cocomplex.d 0 1)
    (Abelian.Exact.op _ _ J.exact₀) (by simp [← category.assoc, desc_f_zero])
#align category_theory.InjectiveResolution.desc_f_one CategoryTheory.InjectiveResolution.descFOne

@[simp]
theorem descFOne_zero_comm {Y Z : C} (f : Z ⟶ Y) (I : InjectiveResolution Y)
    (J : InjectiveResolution Z) :
    J.cocomplex.d 0 1 ≫ descFOne f I J = descFZero f I J ≫ I.cocomplex.d 0 1 := by
  simp [desc_f_zero, desc_f_one]
#align category_theory.InjectiveResolution.desc_f_one_zero_comm CategoryTheory.InjectiveResolution.descFOne_zero_comm

/-- Auxiliary construction for `desc`. -/
def descFSucc {Y Z : C} (I : InjectiveResolution Y) (J : InjectiveResolution Z) (n : ℕ)
    (g : J.cocomplex.pt n ⟶ I.cocomplex.pt n) (g' : J.cocomplex.pt (n + 1) ⟶ I.cocomplex.pt (n + 1))
    (w : J.cocomplex.d n (n + 1) ≫ g' = g ≫ I.cocomplex.d n (n + 1)) :
    Σ'g'' : J.cocomplex.pt (n + 2) ⟶ I.cocomplex.pt (n + 2),
      J.cocomplex.d (n + 1) (n + 2) ≫ g'' = g' ≫ I.cocomplex.d (n + 1) (n + 2) :=
  ⟨@Exact.desc C _ _ _ _ _ _ _ _ _ (g' ≫ I.cocomplex.d (n + 1) (n + 2)) (J.cocomplex.d n (n + 1))
      (J.cocomplex.d (n + 1) (n + 2)) (Abelian.Exact.op _ _ (J.exact _))
      (by simp [← category.assoc, w]),
    by simp⟩
#align category_theory.InjectiveResolution.desc_f_succ CategoryTheory.InjectiveResolution.descFSucc

/-- A morphism in `C` descends to a chain map between injective resolutions. -/
def desc {Y Z : C} (f : Z ⟶ Y) (I : InjectiveResolution Y) (J : InjectiveResolution Z) :
    J.cocomplex ⟶ I.cocomplex :=
  CochainComplex.mkHom _ _ (descFZero f _ _) (descFOne f _ _) (descFOne_zero_comm f I J).symm
    fun n ⟨g, g', w⟩ => ⟨(descFSucc I J n g g' w.symm).1, (descFSucc I J n g g' w.symm).2.symm⟩
#align category_theory.InjectiveResolution.desc CategoryTheory.InjectiveResolution.desc

/-- The resolution maps intertwine the descent of a morphism and that morphism. -/
@[simp, reassoc.1]
theorem desc_commutes {Y Z : C} (f : Z ⟶ Y) (I : InjectiveResolution Y)
    (J : InjectiveResolution Z) : J.ι ≫ desc f I J = (CochainComplex.single₀ C).map f ≫ I.ι :=
  by
  ext n
  rcases n with (_ | _ | n) <;>
    · dsimp [desc, desc_f_one, desc_f_zero]
      simp
#align category_theory.InjectiveResolution.desc_commutes CategoryTheory.InjectiveResolution.desc_commutes

-- Now that we've checked this property of the descent,
-- we can seal away the actual definition.
/-- An auxiliary definition for `desc_homotopy_zero`. -/
def descHomotopyZeroZero {Y Z : C} {I : InjectiveResolution Y} {J : InjectiveResolution Z}
    (f : I.cocomplex ⟶ J.cocomplex) (comm : I.ι ≫ f = 0) : I.cocomplex.pt 1 ⟶ J.cocomplex.pt 0 :=
  Exact.desc (f.f 0) (I.ι.f 0) (I.cocomplex.d 0 1) (Abelian.Exact.op _ _ I.exact₀)
    (congr_fun (congr_arg HomologicalComplex.Hom.f comm) 0)
#align category_theory.InjectiveResolution.desc_homotopy_zero_zero CategoryTheory.InjectiveResolution.descHomotopyZeroZero

/-- An auxiliary definition for `desc_homotopy_zero`. -/
def descHomotopyZeroOne {Y Z : C} {I : InjectiveResolution Y} {J : InjectiveResolution Z}
    (f : I.cocomplex ⟶ J.cocomplex) (comm : I.ι ≫ f = (0 : _ ⟶ J.cocomplex)) :
    I.cocomplex.pt 2 ⟶ J.cocomplex.pt 1 :=
  Exact.desc (f.f 1 - descHomotopyZeroZero f comm ≫ J.cocomplex.d 0 1) (I.cocomplex.d 0 1)
    (I.cocomplex.d 1 2) (Abelian.Exact.op _ _ (I.exact _))
    (by simp [desc_homotopy_zero_zero, ← category.assoc])
#align category_theory.InjectiveResolution.desc_homotopy_zero_one CategoryTheory.InjectiveResolution.descHomotopyZeroOne

/-- An auxiliary definition for `desc_homotopy_zero`. -/
def descHomotopyZeroSucc {Y Z : C} {I : InjectiveResolution Y} {J : InjectiveResolution Z}
    (f : I.cocomplex ⟶ J.cocomplex) (n : ℕ) (g : I.cocomplex.pt (n + 1) ⟶ J.cocomplex.pt n)
    (g' : I.cocomplex.pt (n + 2) ⟶ J.cocomplex.pt (n + 1))
    (w : f.f (n + 1) = I.cocomplex.d (n + 1) (n + 2) ≫ g' + g ≫ J.cocomplex.d n (n + 1)) :
    I.cocomplex.pt (n + 3) ⟶ J.cocomplex.pt (n + 2) :=
  Exact.desc (f.f (n + 2) - g' ≫ J.cocomplex.d _ _) (I.cocomplex.d (n + 1) (n + 2))
    (I.cocomplex.d (n + 2) (n + 3)) (Abelian.Exact.op _ _ (I.exact _))
    (by
      simp [preadditive.comp_sub, ← category.assoc, preadditive.sub_comp,
        show I.cocomplex.d (n + 1) (n + 2) ≫ g' = f.f (n + 1) - g ≫ J.cocomplex.d n (n + 1)
          by
          rw [w]
          simp only [add_sub_cancel]])
#align category_theory.InjectiveResolution.desc_homotopy_zero_succ CategoryTheory.InjectiveResolution.descHomotopyZeroSucc

/-- Any descent of the zero morphism is homotopic to zero. -/
def descHomotopyZero {Y Z : C} {I : InjectiveResolution Y} {J : InjectiveResolution Z}
    (f : I.cocomplex ⟶ J.cocomplex) (comm : I.ι ≫ f = 0) : Homotopy f 0 :=
  Homotopy.mkCoinductive _ (descHomotopyZeroZero f comm) (by simp [desc_homotopy_zero_zero])
    (descHomotopyZeroOne f comm) (by simp [desc_homotopy_zero_one]) fun n ⟨g, g', w⟩ =>
    ⟨descHomotopyZeroSucc f n g g' (by simp only [w, add_comm]), by
      simp [desc_homotopy_zero_succ, w]⟩
#align category_theory.InjectiveResolution.desc_homotopy_zero CategoryTheory.InjectiveResolution.descHomotopyZero

/-- Two descents of the same morphism are homotopic. -/
def descHomotopy {Y Z : C} (f : Y ⟶ Z) {I : InjectiveResolution Y} {J : InjectiveResolution Z}
    (g h : I.cocomplex ⟶ J.cocomplex) (g_comm : I.ι ≫ g = (CochainComplex.single₀ C).map f ≫ J.ι)
    (h_comm : I.ι ≫ h = (CochainComplex.single₀ C).map f ≫ J.ι) : Homotopy g h :=
  Homotopy.equivSubZero.invFun (descHomotopyZero _ (by simp [g_comm, h_comm]))
#align category_theory.InjectiveResolution.desc_homotopy CategoryTheory.InjectiveResolution.descHomotopy

/-- The descent of the identity morphism is homotopic to the identity cochain map. -/
def descIdHomotopy (X : C) (I : InjectiveResolution X) :
    Homotopy (desc (𝟙 X) I I) (𝟙 I.cocomplex) := by apply desc_homotopy (𝟙 X) <;> simp
#align category_theory.InjectiveResolution.desc_id_homotopy CategoryTheory.InjectiveResolution.descIdHomotopy

/-- The descent of a composition is homotopic to the composition of the descents. -/
def descCompHomotopy {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) (I : InjectiveResolution X)
    (J : InjectiveResolution Y) (K : InjectiveResolution Z) :
    Homotopy (desc (f ≫ g) K I) (desc f J I ≫ desc g K J) := by apply desc_homotopy (f ≫ g) <;> simp
#align category_theory.InjectiveResolution.desc_comp_homotopy CategoryTheory.InjectiveResolution.descCompHomotopy

-- We don't care about the actual definitions of these homotopies.
/-- Any two injective resolutions are homotopy equivalent. -/
def homotopyEquiv {X : C} (I J : InjectiveResolution X) : HomotopyEquiv I.cocomplex J.cocomplex
    where
  Hom := desc (𝟙 X) J I
  inv := desc (𝟙 X) I J
  homotopyHomInvId :=
    (descCompHomotopy (𝟙 X) (𝟙 X) I J I).symm.trans <| by
      simpa [category.id_comp] using desc_id_homotopy _ _
  homotopyInvHomId :=
    (descCompHomotopy (𝟙 X) (𝟙 X) J I J).symm.trans <| by
      simpa [category.id_comp] using desc_id_homotopy _ _
#align category_theory.InjectiveResolution.homotopy_equiv CategoryTheory.InjectiveResolution.homotopyEquiv

@[simp, reassoc.1]
theorem homotopyEquiv_hom_ι {X : C} (I J : InjectiveResolution X) :
    I.ι ≫ (homotopyEquiv I J).Hom = J.ι := by simp [HomotopyEquiv]
#align category_theory.InjectiveResolution.homotopy_equiv_hom_ι CategoryTheory.InjectiveResolution.homotopyEquiv_hom_ι

@[simp, reassoc.1]
theorem homotopyEquiv_inv_ι {X : C} (I J : InjectiveResolution X) :
    J.ι ≫ (homotopyEquiv I J).inv = I.ι := by simp [HomotopyEquiv]
#align category_theory.InjectiveResolution.homotopy_equiv_inv_ι CategoryTheory.InjectiveResolution.homotopyEquiv_inv_ι

end Abelian

end InjectiveResolution

section

variable [Abelian C]

/-- An arbitrarily chosen injective resolution of an object. -/
abbrev injectiveResolution (Z : C) [HasInjectiveResolution Z] : CochainComplex C ℕ :=
  (HasInjectiveResolution.out Z).some.cocomplex
#align category_theory.injective_resolution CategoryTheory.injectiveResolution

/-- The cochain map from cochain complex consisting of `Z` supported in degree `0`
back to the arbitrarily chosen injective resolution `injective_resolution Z`. -/
abbrev injectiveResolution.ι (Z : C) [HasInjectiveResolution Z] :
    (CochainComplex.single₀ C).obj Z ⟶ injectiveResolution Z :=
  (HasInjectiveResolution.out Z).some.ι
#align category_theory.injective_resolution.ι CategoryTheory.injectiveResolution.ι

/-- The descent of a morphism to a cochain map between the arbitrarily chosen injective resolutions.
-/
abbrev injectiveResolution.desc {X Y : C} (f : X ⟶ Y) [HasInjectiveResolution X]
    [HasInjectiveResolution Y] : injectiveResolution X ⟶ injectiveResolution Y :=
  InjectiveResolution.desc f _ _
#align category_theory.injective_resolution.desc CategoryTheory.injectiveResolution.desc

variable (C) [HasInjectiveResolutions C]

/-- Taking injective resolutions is functorial,
if considered with target the homotopy category
(`ℕ`-indexed cochain complexes and chain maps up to homotopy).
-/
def injectiveResolutions : C ⥤ HomotopyCategory C (ComplexShape.up ℕ)
    where
  obj X := (HomotopyCategory.quotient _ _).obj (injectiveResolution X)
  map X Y f := (HomotopyCategory.quotient _ _).map (injectiveResolution.desc f)
  map_id' X := by
    rw [← (HomotopyCategory.quotient _ _).map_id]
    apply HomotopyCategory.eq_of_homotopy
    apply InjectiveResolution.desc_id_homotopy
  map_comp' X Y Z f g := by
    rw [← (HomotopyCategory.quotient _ _).map_comp]
    apply HomotopyCategory.eq_of_homotopy
    apply InjectiveResolution.desc_comp_homotopy
#align category_theory.injective_resolutions CategoryTheory.injectiveResolutions

end

section

variable [Abelian C] [EnoughInjectives C]

theorem exact_f_d {X Y : C} (f : X ⟶ Y) : Exact f (d f) :=
  (Abelian.exact_iff _ _).2 <|
    ⟨by simp, zero_of_comp_mono (ι _) <| by rw [category.assoc, kernel.condition]⟩
#align category_theory.exact_f_d CategoryTheory.exact_f_d

end

namespace InjectiveResolution

/-!
Our goal is to define `InjectiveResolution.of Z : InjectiveResolution Z`.
The `0`-th object in this resolution will just be `injective.under Z`,
i.e. an arbitrarily chosen injective object with a map from `Z`.
After that, we build the `n+1`-st object as `injective.syzygies`
applied to the previously constructed morphism,
and the map from the `n`-th object as `injective.d`.
-/

variable [Abelian C] [EnoughInjectives C]

/-- Auxiliary definition for `InjectiveResolution.of`. -/
@[simps]
def ofCocomplex (Z : C) : CochainComplex C ℕ :=
  CochainComplex.mk' (Injective.under Z) (Injective.syzygies (Injective.ι Z))
    (Injective.d (Injective.ι Z)) fun ⟨X, Y, f⟩ =>
    ⟨Injective.syzygies f, Injective.d f, (exact_f_d f).w⟩
#align category_theory.InjectiveResolution.of_cocomplex CategoryTheory.InjectiveResolution.ofCocomplex

/-- In any abelian category with enough injectives,
`InjectiveResolution.of Z` constructs an injective resolution of the object `Z`.
-/
irreducible_def of (Z : C) : InjectiveResolution Z :=
  { cocomplex := ofCocomplex Z
    ι :=
      CochainComplex.mkHom _ _ (Injective.ι Z) 0
        (by
          simp only [of_cocomplex_d, eq_self_iff_true, eq_to_hom_refl, category.comp_id,
            dite_eq_ite, if_true, comp_zero]
          exact (exact_f_d (injective.ι Z)).w)
        fun n _ => ⟨0, by ext⟩
    Injective := by rintro (_ | _ | _ | n) <;> · apply injective.injective_under
    exact₀ := by simpa using exact_f_d (injective.ι Z)
    exact := by
      rintro (_ | n) <;>
        · simp
          apply exact_f_d
    Mono := Injective.ι_mono Z }
#align category_theory.InjectiveResolution.of CategoryTheory.InjectiveResolution.of

instance (priority := 100) (Z : C) : HasInjectiveResolution Z where out := ⟨of Z⟩

instance (priority := 100) : HasInjectiveResolutions C where out _ := inferInstance

end InjectiveResolution

end CategoryTheory

namespace HomologicalComplex.Hom

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

/-- If `X` is a cochain complex of injective objects and we have a quasi-isomorphism
`f : Y[0] ⟶ X`, then `X` is an injective resolution of `Y.` -/
def HomologicalComplex.Hom.fromSingle₀InjectiveResolution (X : CochainComplex C ℕ) (Y : C)
    (f : (CochainComplex.single₀ C).obj Y ⟶ X) [QuasiIso f] (H : ∀ n, Injective (X.pt n)) :
    InjectiveResolution Y where
  cocomplex := X
  ι := f
  Injective := H
  exact₀ := f.from_single₀_exact_f_d_at_zero
  exact := f.from_single₀_exact_at_succ
  Mono := f.from_single₀_mono_at_zero
#align homological_complex.hom.homological_complex.hom.from_single₀_InjectiveResolution HomologicalComplex.Hom.HomologicalComplex.Hom.fromSingle₀InjectiveResolution

end HomologicalComplex.Hom


import topology.basic
import topology.metric_space.basic
import topology.continuous_function.basic

import .disk
import .retraction

-- TODO: see if we can do this via classical.some i.e. ray & circle have ∩
def ray_fn (f : disk → disk) (h_no_fix : ∀x, f x ≠ x) : C(disk, frontier disk) :=
sorry

lemma ray_fn_continuous (f : C(disk, disk)) (h_no_fix : ∀x, f x ≠ x) :
  continuous (ray_fn f h_no_fix) :=
sorry

lemma ray_fn_fdisk_eq_id (f : C(disk, disk)) (h_no_fix : ∀x, f x ≠ x) :
  (ray_fn f h_no_fix) ∘ (set.inclusion frontier_disk_subset_disk) = id :=
begin
  apply funext,
  intro x,
  simp [ray_fn],
  sorry,
end

lemma ray_fn_fdisk_eq_id₂ (f : C(disk, disk)) (h_no_fix : ∀x, f x ≠ x) :
  ∀x, (ray_fn f h_no_fix) (set.inclusion frontier_disk_subset_disk x) = x :=
begin
  intro x,
  rw ← function.comp_app (ray_fn f h_no_fix) _ _,
  rw ray_fn_fdisk_eq_id,
  exact id.def x,
end

theorem brouwer_fixed_point (f : C(disk, disk)) :
  ∃x, f x = x :=
begin
  by_contradiction,
  rw not_exists at h,

  let r : C(disk, frontier disk) :=
    ray_fn f h,

  have hf_retract : retraction r := {
    hy_sub_x := frontier_disk_subset_disk,
    inclusion_right_inv := begin
      simp [r],
      intro x,
      apply ray_fn_fdisk_eq_id₂,
    end,
  },

  have hf_not_retract : ¬ retraction r := no_retraction_theorem r,
  contradiction,
end


import finramsey

noncomputable theory

instance edges_in_finset_fin (Y : finset ℕ) : fintype {e : edge | ∀ x : fin 2 , e x ∈ Y}:=
begin
  apply fintype.of_equiv (fin 2 ↪o Y), apply order_embedding.iso_restricted.symm,
end

def edges_in_finset (Y : finset ℕ):=
{e : edge | ∀ x : fin 2 , e x ∈ Y}.to_finset

def homogenous (f : edge → ℕ) (Y : finset ℕ):=
∃ c : ℕ, ∀ e ∈ edges_in_finset Y, f e = c

def left_monogamous (f : edge → ℕ) (Y: finset ℕ):=
∀ e1 e2 ∈ edges_in_finset Y, f e1 = f e2 ↔ e1 0 = e2 0

def right_monogamous (f : edge → ℕ) (Y: finset ℕ):=
∀ e1 e2 ∈ edges_in_finset Y, f e1 = f e2 ↔ e1 1 = e2 1

def rainbow (f : edge → ℕ) (Y : finset ℕ):=
∀ e1 e2 ∈ edges_in_finset Y, f e1 = f e2 ↔ e1 = e2

theorem can_ramsey:
∀ k : ℕ, ∃ n₀ : ℕ, ∀ coll : finset ℕ, n₀ ≤ coll.card → ∃ x ⊆ coll, x.card=k ∧ ∀ f : edge → ℕ, (rainbow f x) ∨ (homogenous f x) ∨ (left_monogamous f x) ∨ (right_monogamous f x):=
begin

end


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.multiset.erase_dup

/-!
# Preparations for defining operations on `finset`.

The operations here ignore multiplicities,
and preparatory for defining the corresponding operations on `finset`.
-/

namespace multiset
open list

variables {α : Type*} [decidable_eq α]
/-! ### finset insert -/

/-- `ndinsert a s` is the lift of the list `insert` operation. This operation
  does not respect multiplicities, unlike `cons`, but it is suitable as
  an insert operation on `finset`. -/
def ndinsert (a : α) (s : multiset α) : multiset α :=
quot.lift_on s (λ l, (l.insert a : multiset α))
  (λ s t p, quot.sound (p.insert a))

@[simp] theorem coe_ndinsert (a : α) (l : list α) : ndinsert a l = (insert a l : list α) := rfl

@[simp] theorem ndinsert_zero (a : α) : ndinsert a 0 = {a} := rfl

@[simp, priority 980]
theorem ndinsert_of_mem {a : α} {s : multiset α} : a ∈ s → ndinsert a s = s :=
quot.induction_on s $ λ l h, congr_arg coe $ insert_of_mem h

@[simp, priority 980]
theorem ndinsert_of_not_mem {a : α} {s : multiset α} : a ∉ s → ndinsert a s = a ::ₘ s :=
quot.induction_on s $ λ l h, congr_arg coe $ insert_of_not_mem h

@[simp] theorem mem_ndinsert {a b : α} {s : multiset α} : a ∈ ndinsert b s ↔ a = b ∨ a ∈ s :=
quot.induction_on s $ λ l, mem_insert_iff

@[simp] theorem le_ndinsert_self (a : α) (s : multiset α) : s ≤ ndinsert a s :=
quot.induction_on s $ λ l, (sublist_insert _ _).subperm

@[simp] theorem mem_ndinsert_self (a : α) (s : multiset α) : a ∈ ndinsert a s :=
mem_ndinsert.2 (or.inl rfl)

theorem mem_ndinsert_of_mem {a b : α} {s : multiset α} (h : a ∈ s) : a ∈ ndinsert b s :=
mem_ndinsert.2 (or.inr h)

@[simp, priority 980]
theorem length_ndinsert_of_mem {a : α} {s : multiset α} (h : a ∈ s) :
  card (ndinsert a s) = card s :=
by simp [h]

@[simp, priority 980]
theorem length_ndinsert_of_not_mem {a : α} {s : multiset α} (h : a ∉ s) :
  card (ndinsert a s) = card s + 1 :=
by simp [h]

theorem erase_dup_cons {a : α} {s : multiset α} :
  erase_dup (a ::ₘ s) = ndinsert a (erase_dup s) :=
by by_cases a ∈ s; simp [h]

theorem nodup_ndinsert (a : α) {s : multiset α} : nodup s → nodup (ndinsert a s) :=
quot.induction_on s $ λ l, nodup_insert

theorem ndinsert_le {a : α} {s t : multiset α} : ndinsert a s ≤ t ↔ s ≤ t ∧ a ∈ t :=
⟨λ h, ⟨le_trans (le_ndinsert_self _ _) h, mem_of_le h (mem_ndinsert_self _ _)⟩,
 λ ⟨l, m⟩, if h : a ∈ s then by simp [h, l] else
   by rw [ndinsert_of_not_mem h, ← cons_erase m, cons_le_cons_iff,
          ← le_cons_of_not_mem h, cons_erase m]; exact l⟩

lemma attach_ndinsert (a : α) (s : multiset α) :
  (s.ndinsert a).attach =
    ndinsert ⟨a, mem_ndinsert_self a s⟩ (s.attach.map $ λp, ⟨p.1, mem_ndinsert_of_mem p.2⟩) :=
have eq : ∀h : ∀(p : {x // x ∈ s}), p.1 ∈ s,
    (λ (p : {x // x ∈ s}), ⟨p.val, h p⟩ : {x // x ∈ s} → {x // x ∈ s}) = id, from
  assume h, funext $ assume p, subtype.eq rfl,
have ∀t (eq : s.ndinsert a = t), t.attach = ndinsert ⟨a, eq ▸ mem_ndinsert_self a s⟩
  (s.attach.map $ λp, ⟨p.1, eq ▸ mem_ndinsert_of_mem p.2⟩),
begin
  intros t ht,
  by_cases a ∈ s,
  { rw [ndinsert_of_mem h] at ht,
    subst ht,
    rw [eq, map_id, ndinsert_of_mem (mem_attach _ _)] },
  { rw [ndinsert_of_not_mem h] at ht,
    subst ht,
    simp [attach_cons, h] }
end,
this _ rfl

@[simp] theorem disjoint_ndinsert_left {a : α} {s t : multiset α} :
  disjoint (ndinsert a s) t ↔ a ∉ t ∧ disjoint s t :=
iff.trans (by simp [disjoint]) disjoint_cons_left

@[simp] theorem disjoint_ndinsert_right {a : α} {s t : multiset α} :
  disjoint s (ndinsert a t) ↔ a ∉ s ∧ disjoint s t :=
by rw [disjoint_comm, disjoint_ndinsert_left]; tauto

/-! ### finset union -/

/-- `ndunion s t` is the lift of the list `union` operation. This operation
  does not respect multiplicities, unlike `s ∪ t`, but it is suitable as
  a union operation on `finset`. (`s ∪ t` would also work as a union operation
  on finset, but this is more efficient.) -/
def ndunion (s t : multiset α) : multiset α :=
quotient.lift_on₂ s t (λ l₁ l₂, (l₁.union l₂ : multiset α)) $ λ v₁ v₂ w₁ w₂ p₁ p₂,
  quot.sound $ p₁.union p₂

@[simp] theorem coe_ndunion (l₁ l₂ : list α) : @ndunion α _ l₁ l₂ = (l₁ ∪ l₂ : list α) := rfl

@[simp] theorem zero_ndunion (s : multiset α) : ndunion 0 s = s :=
quot.induction_on s $ λ l, rfl

@[simp] theorem cons_ndunion (s t : multiset α) (a : α) :
  ndunion (a ::ₘ s) t = ndinsert a (ndunion s t) :=
quotient.induction_on₂ s t $ λ l₁ l₂, rfl

@[simp] theorem mem_ndunion {s t : multiset α} {a : α} : a ∈ ndunion s t ↔ a ∈ s ∨ a ∈ t :=
quotient.induction_on₂ s t $ λ l₁ l₂, list.mem_union

theorem le_ndunion_right (s t : multiset α) : t ≤ ndunion s t :=
quotient.induction_on₂ s t $ λ l₁ l₂, (suffix_union_right _ _).sublist.subperm

theorem subset_ndunion_right (s t : multiset α) : t ⊆ ndunion s t :=
subset_of_le (le_ndunion_right s t)

theorem ndunion_le_add (s t : multiset α) : ndunion s t ≤ s + t :=
quotient.induction_on₂ s t $ λ l₁ l₂, (union_sublist_append _ _).subperm

theorem ndunion_le {s t u : multiset α} : ndunion s t ≤ u ↔ s ⊆ u ∧ t ≤ u :=
multiset.induction_on s (by simp)
  (by simp [ndinsert_le, and_comm, and.left_comm] {contextual := tt})

theorem subset_ndunion_left (s t : multiset α) : s ⊆ ndunion s t :=
λ a h, mem_ndunion.2 $ or.inl h

theorem le_ndunion_left {s} (t : multiset α) (d : nodup s) : s ≤ ndunion s t :=
(le_iff_subset d).2 $ subset_ndunion_left _ _

theorem ndunion_le_union (s t : multiset α) : ndunion s t ≤ s ∪ t :=
ndunion_le.2 ⟨subset_of_le (le_union_left _ _), le_union_right _ _⟩

theorem nodup_ndunion (s : multiset α) {t : multiset α} : nodup t → nodup (ndunion s t) :=
quotient.induction_on₂ s t $ λ l₁ l₂, list.nodup_union _

@[simp, priority 980]
theorem ndunion_eq_union {s t : multiset α} (d : nodup s) : ndunion s t = s ∪ t :=
le_antisymm (ndunion_le_union _ _) $ union_le (le_ndunion_left _ d) (le_ndunion_right _ _)

theorem erase_dup_add (s t : multiset α) : erase_dup (s + t) = ndunion s (erase_dup t) :=
quotient.induction_on₂ s t $ λ l₁ l₂, congr_arg coe $ erase_dup_append _ _

/-! ### finset inter -/

/-- `ndinter s t` is the lift of the list `∩` operation. This operation
  does not respect multiplicities, unlike `s ∩ t`, but it is suitable as
  an intersection operation on `finset`. (`s ∩ t` would also work as a union operation
  on finset, but this is more efficient.) -/
def ndinter (s t : multiset α) : multiset α := filter (∈ t) s

@[simp] theorem coe_ndinter (l₁ l₂ : list α) : @ndinter α _ l₁ l₂ = (l₁ ∩ l₂ : list α) := rfl

@[simp] theorem zero_ndinter (s : multiset α) : ndinter 0 s = 0 := rfl

@[simp, priority 980]
theorem cons_ndinter_of_mem {a : α} (s : multiset α) {t : multiset α} (h : a ∈ t) :
  ndinter (a ::ₘ s) t = a ::ₘ (ndinter s t) := by simp [ndinter, h]

@[simp, priority 980]
theorem ndinter_cons_of_not_mem {a : α} (s : multiset α) {t : multiset α} (h : a ∉ t) :
  ndinter (a ::ₘ s) t = ndinter s t := by simp [ndinter, h]

@[simp] theorem mem_ndinter {s t : multiset α} {a : α} : a ∈ ndinter s t ↔ a ∈ s ∧ a ∈ t :=
mem_filter

@[simp]
theorem nodup_ndinter {s : multiset α} (t : multiset α) : nodup s → nodup (ndinter s t) :=
nodup_filter _

theorem le_ndinter {s t u : multiset α} : s ≤ ndinter t u ↔ s ≤ t ∧ s ⊆ u :=
by simp [ndinter, le_filter, subset_iff]

theorem ndinter_subset_left (s t : multiset α) : ndinter s t ⊆ s :=
subset_of_le (ndinter_le_left s t)

theorem ndinter_subset_right (s t : multiset α) : ndinter s t ⊆ t :=
(le_ndinter.1 (le_refl _)).2

theorem ndinter_le_right {s} (t : multiset α) (d : nodup s) : ndinter s t ≤ t :=
(le_iff_subset $ nodup_ndinter _ d).2 (ndinter_subset_right _ _)

theorem inter_le_ndinter (s t : multiset α) : s ∩ t ≤ ndinter s t :=
le_ndinter.2 ⟨inter_le_left _ _, subset_of_le $ inter_le_right _ _⟩

@[simp, priority 980]
theorem ndinter_eq_inter {s t : multiset α} (d : nodup s) : ndinter s t = s ∩ t :=
le_antisymm (le_inter (ndinter_le_left _ _) (ndinter_le_right _ d)) (inter_le_ndinter _ _)

theorem ndinter_eq_zero_iff_disjoint {s t : multiset α} : ndinter s t = 0 ↔ disjoint s t :=
by rw ← subset_zero; simp [subset_iff, disjoint]

end multiset


def f (x : Nat) :=
  have y := x+1
  y+y

def g (x : Nat × Nat) :=
  have (y, z) := x
  y + y

theorem ex1 (h : p ∧ q ∧ r) : p := by
  have ⟨h', _, _⟩ := h
  exact h'

theorem ex2 (h : p ∧ q ∧ r) : p :=
  have ⟨h, _, _⟩ := h
  h

theorem ex3 (h : p ∧ q ∧ r) : r :=
  have ⟨_, _, h⟩ := h
  h


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

! This file was ported from Lean 3 source module ring_theory.congruence
! leanprover-community/mathlib commit 9003f28797c0664a49e4179487267c494477d853
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.GroupRingAction.Basic
import Mathlib.Algebra.Hom.Ring
import Mathlib.Algebra.Ring.InjSurj
import Mathlib.GroupTheory.Congruence

/-!
# Congruence relations on rings

This file defines congruence relations on rings, which extend `Con` and `AddCon` on monoids and
additive monoids.

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

## Main Definitions

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

## TODO

* Use this for `RingQuot` too.
* Copy across more API from `Con` and `AddCon` in `GroupTheory/Congruence.lean`, such as:
  * The `CompleteLattice` structure.
  * The `conGen_eq` lemma, stating that
    `ringConGen r = infₛ {s : RingCon M | ∀ x y, r x y → s x y}`.
-/

/- Note: we can't extend both `AddCon R` and `MulCon R` in Lean 3 due to interactions between old-
and new-style structures. We can revisit this in Lean 4. (After and not during the port!) -/
/-- A congruence relation on a type with an addition and multiplication is an equivalence relation
which preserves both. -/
structure RingCon (R : Type _) [Add R] [Mul R] extends Setoid R where
  /-- Ring congruence relations are closed under addition -/
  add' : ∀ {w x y z}, r w x → r y z → r (w + y) (x + z)
  /-- Ring congruence relations are closed under multiplication -/
  mul' : ∀ {w x y z}, r w x → r y z → r (w * y) (x * z)
#align ring_con RingCon

variable {α R : Type _}

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

/-- The inductively defined smallest ring congruence relation containing a given binary
    relation. -/
def ringConGen [Add R] [Mul R] (r : R → R → Prop) : RingCon R
    where
  r := RingConGen.Rel r
  iseqv := ⟨RingConGen.Rel.refl, @RingConGen.Rel.symm _ _ _ _, @RingConGen.Rel.trans _ _ _ _⟩
  add' := RingConGen.Rel.add
  mul' := RingConGen.Rel.mul
#align ring_con_gen ringConGen

namespace RingCon

section Basic

variable [Add R] [Mul R] (c : RingCon R)

/-- Every `ring_con` is also an `AddCon` -/
def toAddCon : AddCon R :=
  { c with }
#align ring_con.to_add_con RingCon.toAddCon

/-- Every `RingCon` is also a `Con` -/
def toCon : Con R :=
  { c with }
#align ring_con.to_con RingCon.toCon

--Porting note: upgrade to `FunLike`
/-- A coercion from a congruence relation to its underlying binary relation. -/
instance : FunLike (RingCon R) R fun _ => R → Prop :=
  { coe := fun c => c.r,
    coe_injective' := fun x y h => by
      rcases x with ⟨⟨x, _⟩, _⟩
      rcases y with ⟨⟨y, _⟩, _⟩
      have : x = y := h
      subst x; rfl }

@[simp]
theorem rel_eq_coe : c.r = c :=
  rfl
#align ring_con.rel_eq_coe RingCon.rel_eq_coe

protected theorem refl (x) : c x x :=
  c.refl' x
#align ring_con.refl RingCon.refl

protected theorem symm {x y} : c x y → c y x :=
  c.symm'
#align ring_con.symm RingCon.symm

protected theorem trans {x y z} : c x y → c y z → c x z :=
  c.trans'
#align ring_con.trans RingCon.trans

protected theorem add {w x y z} : c w x → c y z → c (w + y) (x + z) :=
  c.add'
#align ring_con.add RingCon.add

protected theorem mul {w x y z} : c w x → c y z → c (w * y) (x * z) :=
  c.mul'
#align ring_con.mul RingCon.mul

@[simp]
theorem rel_mk {s : Setoid R} {ha hm a b} : RingCon.mk s ha hm a b ↔ Setoid.r a b :=
  Iff.rfl
#align ring_con.rel_mk RingCon.rel_mk

instance : Inhabited (RingCon R) :=
  ⟨ringConGen EmptyRelation⟩

end Basic

section Quotient

section Basic

variable [Add R] [Mul R] (c : RingCon R)

/-- Defining the quotient by a congruence relation of a type with addition and multiplication. -/
protected def Quotient :=
  Quotient c.toSetoid
#align ring_con.quotient RingCon.Quotient

variable {c}

/-- The morphism into the quotient by a congruence relation -/
@[coe] def toQuotient (r : R) : c.Quotient :=
  @Quotient.mk'' _ c.toSetoid r

variable (c)

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

See Note [use has_coe_t]. -/
instance : CoeTC R c.Quotient :=
  ⟨toQuotient⟩

-- Lower the priority since it unifies with any quotient type.
/-- The quotient by a decidable congruence relation has decidable equality. -/
instance (priority := 500) [d : ∀ a b, Decidable (c a b)] : DecidableEq c.Quotient := by
  delta RingCon.Quotient; infer_instance

@[simp]
theorem quot_mk_eq_coe (x : R) : Quot.mk c x = (x : c.Quotient) :=
  rfl
#align ring_con.quot_mk_eq_coe RingCon.quot_mk_eq_coe

/-- Two elements are related by a congruence relation `c` iff they are represented by the same
element of the quotient by `c`. -/
@[simp]
protected

end Basic

/-! ### Basic notation

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

section Data

section add_mul

variable [Add R] [Mul R] (c : RingCon R)

instance : Add c.Quotient := inferInstanceAs (Add c.toAddCon.Quotient)

@[simp, norm_cast]
theorem coe_add (x y : R) : (↑(x + y) : c.Quotient) = ↑x + ↑y :=
  rfl
#align ring_con.coe_add RingCon.coe_add

instance : Mul c.Quotient := inferInstanceAs (Mul c.toCon.Quotient)

@[simp, norm_cast]
theorem coe_mul (x y : R) : (↑(x * y) : c.Quotient) = ↑x * ↑y :=
  rfl
#align ring_con.coe_mul RingCon.coe_mul

end add_mul

section Zero

variable [AddZeroClass R] [Mul R] (c : RingCon R)

instance : Zero c.Quotient := inferInstanceAs (Zero c.toAddCon.Quotient)

@[simp, norm_cast]
theorem coe_zero : (↑(0 : R) : c.Quotient) = 0 :=
  rfl
#align ring_con.coe_zero RingCon.coe_zero

end Zero

section One

variable [Add R] [MulOneClass R] (c : RingCon R)

instance : One c.Quotient := inferInstanceAs (One c.toCon.Quotient)

@[simp, norm_cast]
theorem coe_one : (↑(1 : R) : c.Quotient) = 1 :=
  rfl
#align ring_con.coe_one RingCon.coe_one

end One

section SMul

variable [Add R] [MulOneClass R] [SMul α R] [IsScalarTower α R R] (c : RingCon R)

instance : SMul α c.Quotient := inferInstanceAs (SMul α c.toCon.Quotient)

@[simp, norm_cast]
theorem coe_smul (a : α) (x : R) : (↑(a • x) : c.Quotient) = a • (x : c.Quotient) :=
  rfl
#align ring_con.coe_smul RingCon.coe_smul

end SMul

section NegSubZsmul

variable [AddGroup R] [Mul R] (c : RingCon R)

instance : Neg c.Quotient := inferInstanceAs (Neg c.toAddCon.Quotient)

@[simp, norm_cast]
theorem coe_neg (x : R) : (↑(-x) : c.Quotient) = -x :=
  rfl
#align ring_con.coe_neg RingCon.coe_neg

instance : Sub c.Quotient := inferInstanceAs (Sub c.toAddCon.Quotient)

@[simp, norm_cast]
theorem coe_sub (x y : R) : (↑(x - y) : c.Quotient) = x - y :=
  rfl
#align ring_con.coe_sub RingCon.coe_sub

instance hasZsmul : SMul ℤ c.Quotient := inferInstanceAs (SMul ℤ c.toAddCon.Quotient)
#align ring_con.has_zsmul RingCon.hasZsmul

@[simp, norm_cast]
theorem coe_zsmul (z : ℤ) (x : R) : (↑(z • x) : c.Quotient) = z • (x : c.Quotient) :=
  rfl
#align ring_con.coe_zsmul RingCon.coe_zsmul

end NegSubZsmul

section Nsmul

variable [AddMonoid R] [Mul R] (c : RingCon R)

instance hasNsmul : SMul ℕ c.Quotient := inferInstanceAs (SMul ℕ c.toAddCon.Quotient)
#align ring_con.has_nsmul RingCon.hasNsmul

@[simp, norm_cast]
theorem coe_nsmul (n : ℕ) (x : R) : (↑(n • x) : c.Quotient) = n • (x : c.Quotient) :=
  rfl
#align ring_con.coe_nsmul RingCon.coe_nsmul

end Nsmul

section Pow

variable [Add R] [Monoid R] (c : RingCon R)

instance : Pow c.Quotient ℕ := inferInstanceAs (Pow c.toCon.Quotient ℕ)

@[simp, norm_cast]
theorem coe_pow (x : R) (n : ℕ) : (↑(x ^ n) : c.Quotient) = (x : c.Quotient) ^ n :=
  rfl
#align ring_con.coe_pow RingCon.coe_pow

end Pow

section NatCast

variable [AddMonoidWithOne R] [Mul R] (c : RingCon R)

instance : NatCast c.Quotient :=
  ⟨fun n => ↑(n : R)⟩

@[simp, norm_cast]
theorem coe_nat_cast (n : ℕ) : (↑(n : R) : c.Quotient) = n :=
  rfl
#align ring_con.coe_nat_cast RingCon.coe_nat_cast

end NatCast

section IntCast

variable [AddGroupWithOne R] [Mul R] (c : RingCon R)

instance : IntCast c.Quotient :=
  ⟨fun z => ↑(z : R)⟩

@[simp, norm_cast]
theorem coe_int_cast (n : ℕ) : (↑(n : R) : c.Quotient) = n :=
  rfl
#align ring_con.coe_int_cast RingCon.coe_int_cast

end IntCast

instance [Inhabited R] [Add R] [Mul R] (c : RingCon R) : Inhabited c.Quotient :=
  ⟨↑(default : R)⟩

end Data

/-! ### Algebraic structure

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

section Algebraic

instance [NonUnitalNonAssocSemiring R] (c : RingCon R) : NonUnitalNonAssocSemiring c.Quotient :=
  Function.Surjective.nonUnitalNonAssocSemiring _ Quotient.surjective_Quotient_mk'' rfl
    (fun _ _ => rfl) (fun _ _ => rfl) fun _ _ => rfl

instance [NonAssocSemiring R] (c : RingCon R) : NonAssocSemiring c.Quotient :=
  Function.Surjective.nonAssocSemiring _ Quotient.surjective_Quotient_mk'' rfl rfl (fun _ _ => rfl)
    (fun _ _ => rfl) (fun _ _ => rfl) fun _ => rfl

instance [NonUnitalSemiring R] (c : RingCon R) : NonUnitalSemiring c.Quotient :=
  Function.Surjective.nonUnitalSemiring _ Quotient.surjective_Quotient_mk'' rfl (fun _ _ => rfl)
    (fun _ _ => rfl) fun _ _ => rfl

instance [Semiring R] (c : RingCon R) : Semiring c.Quotient :=
  Function.Surjective.semiring _ Quotient.surjective_Quotient_mk'' rfl rfl (fun _ _ => rfl)
    (fun _ _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl) fun _ => rfl

instance [CommSemiring R] (c : RingCon R) : CommSemiring c.Quotient :=
  Function.Surjective.commSemiring _ Quotient.surjective_Quotient_mk'' rfl rfl (fun _ _ => rfl)
    (fun _ _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl) fun _ => rfl

instance [NonUnitalNonAssocRing R] (c : RingCon R) : NonUnitalNonAssocRing c.Quotient :=
  Function.Surjective.nonUnitalNonAssocRing _ Quotient.surjective_Quotient_mk'' rfl (fun _ _ => rfl)
    (fun _ _ => rfl) (fun _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl) fun _ _ => rfl

instance [NonAssocRing R] (c : RingCon R) : NonAssocRing c.Quotient :=
  Function.Surjective.nonAssocRing _ Quotient.surjective_Quotient_mk'' rfl rfl (fun _ _ => rfl)
    (fun _ _ => rfl) (fun _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl)
    (fun _ => rfl) fun _ => rfl

instance [NonUnitalRing R] (c : RingCon R) : NonUnitalRing c.Quotient :=
  Function.Surjective.nonUnitalRing _ Quotient.surjective_Quotient_mk'' rfl (fun _ _ => rfl)
    (fun _ _ => rfl) (fun _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl) fun _ _ => rfl

instance [Ring R] (c : RingCon R) : Ring c.Quotient :=
  Function.Surjective.ring _ Quotient.surjective_Quotient_mk'' rfl rfl (fun _ _ => rfl)
    (fun _ _ => rfl) (fun _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) (fun _ => rfl) fun _ => rfl

instance [CommRing R] (c : RingCon R) : CommRing c.Quotient :=
  Function.Surjective.commRing _ Quotient.surjective_Quotient_mk'' rfl rfl (fun _ _ => rfl)
    (fun _ _ => rfl) (fun _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) (fun _ => rfl) fun _ => rfl

instance [Monoid α] [NonAssocSemiring R] [DistribMulAction α R] [IsScalarTower α R R]
    (c : RingCon R) : DistribMulAction α c.Quotient :=
  { c.toCon.mulAction with
    smul := (· • ·)
    smul_zero := fun _ => congr_arg toQuotient <| smul_zero _
    smul_add := fun _ => Quotient.ind₂' fun _ _  => congr_arg toQuotient <| smul_add _ _ _ }

instance [Monoid α] [Semiring R] [MulSemiringAction α R] [IsScalarTower α R R] (c : RingCon R) :
    MulSemiringAction α c.Quotient :=
  { smul_one := fun _ => congr_arg toQuotient <| smul_one _
    smul_mul := fun _ => Quotient.ind₂' fun _ _ => congr_arg toQuotient <|
      MulSemiringAction.smul_mul _ _ _ }

end Algebraic

/-- The natural homomorphism from a ring to its quotient by a congruence relation. -/
def mk' [NonAssocSemiring R] (c : RingCon R) : R →+* c.Quotient
    where
  toFun := toQuotient
  map_zero' := rfl
  map_one' := rfl
  map_add' _ _ := rfl
  map_mul' _ _ := rfl
#align ring_con.mk' RingCon.mk'

end Quotient

end RingCon


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

! This file was ported from Lean 3 source module data.fin_enum
! leanprover-community/mathlib commit cc70d9141824ea8982d1562ce009952f2c3ece30
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Control.Monad.Basic
import Mathbin.Data.Fintype.Basic
import Mathbin.Data.List.ProdSigma

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

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

universe u v

open Finset

/- warning: fin_enum -> FinEnum is a dubious translation:
lean 3 declaration is
  Sort.{u1} -> Sort.{max 1 (imax 1 u1) u1}
but is expected to have type
  Sort.{u1} -> Sort.{max 1 u1}
Case conversion may be inaccurate. Consider using '#align fin_enum FinEnumₓ'. -/
/- ./././Mathport/Syntax/Translate/Command.lean:388:30: infer kinds are unsupported in Lean 4: #[`Equiv] [] -/
/-- `fin_enum α` means that `α` is finite and can be enumerated in some order,
  i.e. `α` has an explicit bijection with `fin n` for some n. -/
class FinEnum (α : Sort _) where
  card : ℕ
  Equiv : α ≃ Fin card
  [decEq : DecidableEq α]
#align fin_enum FinEnum

attribute [instance] FinEnum.decEq

namespace FinEnum

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

#print FinEnum.ofEquiv /-
/-- transport a `fin_enum` instance across an equivalence -/
def ofEquiv (α) {β} [FinEnum α] (h : β ≃ α) : FinEnum β
    where
  card := card α
  Equiv := h.trans (equiv α)
  decEq := (h.trans (equiv _)).DecidableEq
#align fin_enum.of_equiv FinEnum.ofEquiv
-/

#print FinEnum.ofNodupList /-
/-- create a `fin_enum` instance from an exhaustive list without duplicates -/
def ofNodupList [DecidableEq α] (xs : List α) (h : ∀ x : α, x ∈ xs) (h' : List.Nodup xs) : FinEnum α
    where
  card := xs.length
  Equiv :=
    ⟨fun x => ⟨xs.indexOfₓ x, by rw [List.indexOf_lt_length] <;> apply h⟩, fun ⟨i, h⟩ =>
      xs.nthLe _ h, fun x => by simp [of_nodup_list._match_1], fun ⟨i, h⟩ => by
      simp [of_nodup_list._match_1, *] <;> rw [List.nthLe_index_of] <;> apply List.nodup_dedup⟩
#align fin_enum.of_nodup_list FinEnum.ofNodupList
-/

#print FinEnum.ofList /-
/-- create a `fin_enum` instance from an exhaustive list; duplicates are removed -/
def ofList [DecidableEq α] (xs : List α) (h : ∀ x : α, x ∈ xs) : FinEnum α :=
  ofNodupList xs.dedup (by simp [*]) (List.nodup_dedup _)
#align fin_enum.of_list FinEnum.ofList
-/

#print FinEnum.toList /-
/-- create an exhaustive list of the values of a given type -/
def toList (α) [FinEnum α] : List α :=
  (List.finRange (card α)).map (equiv α).symm
#align fin_enum.to_list FinEnum.toList
-/

open Function

#print FinEnum.mem_toList /-
@[simp]
theorem mem_toList [FinEnum α] (x : α) : x ∈ toList α := by
  simp [to_list] <;> exists Equiv α x <;> simp
#align fin_enum.mem_to_list FinEnum.mem_toList
-/

#print FinEnum.nodup_toList /-
@[simp]
theorem nodup_toList [FinEnum α] : List.Nodup (toList α) := by
  simp [to_list] <;> apply List.Nodup.map <;> [apply Equiv.injective, apply List.nodup_finRange]
#align fin_enum.nodup_to_list FinEnum.nodup_toList
-/

#print FinEnum.ofSurjective /-
/-- create a `fin_enum` instance using a surjection -/
def ofSurjective {β} (f : β → α) [DecidableEq α] [FinEnum β] (h : Surjective f) : FinEnum α :=
  ofList ((toList β).map f) (by intro <;> simp <;> exact h _)
#align fin_enum.of_surjective FinEnum.ofSurjective
-/

#print FinEnum.ofInjective /-
/-- create a `fin_enum` instance using an injection -/
noncomputable def ofInjective {α β} (f : α → β) [DecidableEq α] [FinEnum β] (h : Injective f) :
    FinEnum α :=
  ofList ((toList β).filterMap (partialInv f))
    (by
      intro x
      simp only [mem_to_list, true_and_iff, List.mem_filterMap]
      use f x
      simp only [h, Function.partialInv_left])
#align fin_enum.of_injective FinEnum.ofInjective
-/

#print FinEnum.pempty /-
instance pempty : FinEnum PEmpty :=
  ofList [] fun x => PEmpty.elim x
#align fin_enum.pempty FinEnum.pempty
-/

#print FinEnum.empty /-
instance empty : FinEnum Empty :=
  ofList [] fun x => Empty.elim x
#align fin_enum.empty FinEnum.empty
-/

#print FinEnum.punit /-
instance punit : FinEnum PUnit :=
  ofList [PUnit.unit] fun x => by cases x <;> simp
#align fin_enum.punit FinEnum.punit
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print FinEnum.prod /-
instance prod {β} [FinEnum α] [FinEnum β] : FinEnum (α × β) :=
  ofList (toList α ×ˢ toList β) fun x => by cases x <;> simp
#align fin_enum.prod FinEnum.prod
-/

#print FinEnum.sum /-
instance sum {β} [FinEnum α] [FinEnum β] : FinEnum (Sum α β) :=
  ofList ((toList α).map Sum.inl ++ (toList β).map Sum.inr) fun x => by cases x <;> simp
#align fin_enum.sum FinEnum.sum
-/

#print FinEnum.fin /-
instance fin {n} : FinEnum (Fin n) :=
  ofList (List.finRange _) (by simp)
#align fin_enum.fin FinEnum.fin
-/

#print FinEnum.Quotient.enum /-
instance Quotient.enum [FinEnum α] (s : Setoid α) [DecidableRel ((· ≈ ·) : α → α → Prop)] :
    FinEnum (Quotient s) :=
  FinEnum.ofSurjective Quotient.mk' fun x => Quotient.inductionOn x fun x => ⟨x, rfl⟩
#align fin_enum.quotient.enum FinEnum.Quotient.enum
-/

#print FinEnum.Finset.enum /-
/-- enumerate all finite sets of a given type -/
def Finset.enum [DecidableEq α] : List α → List (Finset α)
  | [] => [∅]
  | x :: xs => do
    let r ← finset.enum xs
    [r, {x} ∪ r]
#align fin_enum.finset.enum FinEnum.Finset.enum
-/

#print FinEnum.Finset.mem_enum /-
@[simp]
theorem Finset.mem_enum [DecidableEq α] (s : Finset α) (xs : List α) :
    s ∈ Finset.enum xs ↔ ∀ x ∈ s, x ∈ xs :=
  by
  induction xs generalizing s <;> simp [*, finset.enum]
  · simp [Finset.eq_empty_iff_forall_not_mem, (· ∉ ·)]
    rfl
  · constructor
    rintro ⟨a, h, h'⟩ x hx
    cases h'
    · right
      apply h
      subst a
      exact hx
    · simp only [h', mem_union, mem_singleton] at hx⊢
      cases hx
      · exact Or.inl hx
      · exact Or.inr (h _ hx)
    intro h
    exists s \ ({xs_hd} : Finset α)
    simp only [and_imp, mem_sdiff, mem_singleton]
    simp only [or_iff_not_imp_left] at h
    exists h
    by_cases xs_hd ∈ s
    · have : {xs_hd} ⊆ s
      simp only [HasSubset.Subset, *, forall_eq, mem_singleton]
      simp only [union_sdiff_of_subset this, or_true_iff, Finset.union_sdiff_of_subset,
        eq_self_iff_true]
    · left
      symm
      simp only [sdiff_eq_self]
      intro a
      simp only [and_imp, mem_inter, mem_singleton]
      rintro h₀ rfl
      apply h h₀
#align fin_enum.finset.mem_enum FinEnum.Finset.mem_enum
-/

#print FinEnum.Finset.finEnum /-
instance Finset.finEnum [FinEnum α] : FinEnum (Finset α) :=
  ofList (Finset.enum (toList α)) (by intro <;> simp)
#align fin_enum.finset.fin_enum FinEnum.Finset.finEnum
-/

#print FinEnum.Subtype.finEnum /-
instance Subtype.finEnum [FinEnum α] (p : α → Prop) [DecidablePred p] : FinEnum { x // p x } :=
  ofList ((toList α).filterMap fun x => if h : p x then some ⟨_, h⟩ else none)
    (by rintro ⟨x, h⟩ <;> simp <;> exists x <;> simp [*])
#align fin_enum.subtype.fin_enum FinEnum.Subtype.finEnum
-/

instance (β : α → Type v) [FinEnum α] [∀ a, FinEnum (β a)] : FinEnum (Sigma β) :=
  ofList ((toList α).bind fun a => (toList (β a)).map <| Sigma.mk a)
    (by intro x <;> cases x <;> simp)

#print FinEnum.PSigma.finEnum /-
instance PSigma.finEnum [FinEnum α] [∀ a, FinEnum (β a)] : FinEnum (Σ'a, β a) :=
  FinEnum.ofEquiv _ (Equiv.psigmaEquivSigma _)
#align fin_enum.psigma.fin_enum FinEnum.PSigma.finEnum
-/

#print FinEnum.PSigma.finEnumPropLeft /-
instance PSigma.finEnumPropLeft {α : Prop} {β : α → Type v} [∀ a, FinEnum (β a)] [Decidable α] :
    FinEnum (Σ'a, β a) :=
  if h : α then ofList ((toList (β h)).map <| PSigma.mk h) fun ⟨a, Ba⟩ => by simp
  else ofList [] fun ⟨a, Ba⟩ => (h a).elim
#align fin_enum.psigma.fin_enum_prop_left FinEnum.PSigma.finEnumPropLeft
-/

#print FinEnum.PSigma.finEnumPropRight /-
instance PSigma.finEnumPropRight {β : α → Prop} [FinEnum α] [∀ a, Decidable (β a)] :
    FinEnum (Σ'a, β a) :=
  FinEnum.ofEquiv { a // β a }
    ⟨fun ⟨x, y⟩ => ⟨x, y⟩, fun ⟨x, y⟩ => ⟨x, y⟩, fun ⟨x, y⟩ => rfl, fun ⟨x, y⟩ => rfl⟩
#align fin_enum.psigma.fin_enum_prop_right FinEnum.PSigma.finEnumPropRight
-/

#print FinEnum.PSigma.finEnumPropProp /-
instance PSigma.finEnumPropProp {α : Prop} {β : α → Prop} [Decidable α] [∀ a, Decidable (β a)] :
    FinEnum (Σ'a, β a) :=
  if h : ∃ a, β a then ofList [⟨h.fst, h.snd⟩] (by rintro ⟨⟩ <;> simp)
  else ofList [] fun a => (h ⟨a.fst, a.snd⟩).elim
#align fin_enum.psigma.fin_enum_prop_prop FinEnum.PSigma.finEnumPropProp
-/

instance (priority := 100) [FinEnum α] : Fintype α
    where
  elems := univ.map (equiv α).symm.toEmbedding
  complete := by intros <;> simp <;> exists Equiv α x <;> simp

#print FinEnum.Pi.cons /-
/-- For `pi.cons x xs y f` create a function where every `i ∈ xs` is mapped to `f i` and
`x` is mapped to `y`  -/
def Pi.cons [DecidableEq α] (x : α) (xs : List α) (y : β x) (f : ∀ a, a ∈ xs → β a) :
    ∀ a, a ∈ (x :: xs : List α) → β a
  | b, h => if h' : b = x then cast (by rw [h']) y else f b (List.mem_of_ne_of_mem h' h)
#align fin_enum.pi.cons FinEnum.Pi.cons
-/

#print FinEnum.Pi.tail /-
/-- Given `f` a function whose domain is `x :: xs`, produce a function whose domain
is restricted to `xs`.  -/
def Pi.tail {x : α} {xs : List α} (f : ∀ a, a ∈ (x :: xs : List α) → β a) : ∀ a, a ∈ xs → β a
  | a, h => f a (List.mem_cons_of_mem _ h)
#align fin_enum.pi.tail FinEnum.Pi.tail
-/

#print FinEnum.pi /-
/-- `pi xs f` creates the list of functions `g` such that, for `x ∈ xs`, `g x ∈ f x` -/
def pi {β : α → Type max u v} [DecidableEq α] :
    ∀ xs : List α, (∀ a, List (β a)) → List (∀ a, a ∈ xs → β a)
  | [], fs => [fun x h => h.elim]
  | x :: xs, fs => FinEnum.Pi.cons x xs <$> fs x <*> pi xs fs
#align fin_enum.pi FinEnum.pi
-/

/- warning: fin_enum.mem_pi -> FinEnum.mem_pi is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : α -> Type.{max u1 u2}} [_inst_1 : FinEnum.{succ u1} α] [_inst_2 : forall (a : α), FinEnum.{succ (max u1 u2)} (β a)] (xs : List.{u1} α) (f : forall (a : α), (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) a xs) -> (β a)), Membership.Mem.{max u1 u2, max u1 u2} (forall (a : α), (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) a xs) -> (β a)) (List.{max u1 u2} (forall (a : α), (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) a xs) -> (β a))) (List.hasMem.{max u1 u2} (forall (a : α), (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) a xs) -> (β a))) f (FinEnum.pi.{u1, u2} α (fun (x : α) => β x) (fun (a : α) (b : α) => FinEnum.decEq.{succ u1} α _inst_1 a b) xs (fun (x : α) => FinEnum.toList.{max u1 u2} (β x) (_inst_2 x)))
but is expected to have type
  forall {α : Type.{u2}} {β : α -> Type.{max u2 u1}} [_inst_1 : FinEnum.{succ u2} α] [_inst_2 : forall (a : α), FinEnum.{succ (max u2 u1)} (β a)] (xs : List.{u2} α) (f : forall (a : α), (Membership.mem.{u2, u2} α (List.{u2} α) (List.instMembershipList.{u2} α) a xs) -> (β a)), Membership.mem.{max u2 u1, max u2 u1} (forall (a : α), (Membership.mem.{u2, u2} α (List.{u2} α) (List.instMembershipList.{u2} α) a xs) -> (β a)) (List.{max u2 u1} (forall (a : α), (Membership.mem.{u2, u2} α (List.{u2} α) (List.instMembershipList.{u2} α) a xs) -> (β a))) (List.instMembershipList.{max u2 u1} (forall (a : α), (Membership.mem.{u2, u2} α (List.{u2} α) (List.instMembershipList.{u2} α) a xs) -> (β a))) f (FinEnum.pi.{u2, u1} α (fun (x : α) => β x) (fun (a : α) (b : α) => FinEnum.decEq.{succ u2} α _inst_1 a b) xs (fun (x : α) => FinEnum.toList.{max u2 u1} (β x) (_inst_2 x)))
Case conversion may be inaccurate. Consider using '#align fin_enum.mem_pi FinEnum.mem_piₓ'. -/
theorem mem_pi {β : α → Type max u v} [FinEnum α] [∀ a, FinEnum (β a)] (xs : List α)
    (f : ∀ a, a ∈ xs → β a) : f ∈ pi xs fun x => toList (β x) :=
  by
  induction xs <;> simp [pi, -List.map_eq_map, monad_norm, functor_norm]
  · ext (a⟨⟩)
  · exists pi.cons xs_hd xs_tl (f _ (List.mem_cons_self _ _))
    constructor
    exact ⟨_, rfl⟩
    exists pi.tail f
    constructor
    · apply xs_ih
    · ext (x h)
      simp [pi.cons]
      split_ifs
      subst x
      rfl
      rfl
#align fin_enum.mem_pi FinEnum.mem_pi

#print FinEnum.pi.enum /-
/-- enumerate all functions whose domain and range are finitely enumerable -/
def pi.enum (β : α → Type max u v) [FinEnum α] [∀ a, FinEnum (β a)] : List (∀ a, β a) :=
  (pi (toList α) fun x => toList (β x)).map fun f x => f x (mem_toList _)
#align fin_enum.pi.enum FinEnum.pi.enum
-/

#print FinEnum.pi.mem_enum /-
theorem pi.mem_enum {β : α → Type max u v} [FinEnum α] [∀ a, FinEnum (β a)] (f : ∀ a, β a) :
    f ∈ pi.enum β := by simp [pi.enum] <;> refine' ⟨fun a h => f a, mem_pi _ _, rfl⟩
#align fin_enum.pi.mem_enum FinEnum.pi.mem_enum
-/

#print FinEnum.pi.finEnum /-
instance pi.finEnum {β : α → Type max u v} [FinEnum α] [∀ a, FinEnum (β a)] : FinEnum (∀ a, β a) :=
  ofList (pi.enum _) fun x => pi.mem_enum _
#align fin_enum.pi.fin_enum FinEnum.pi.finEnum
-/

/- warning: fin_enum.pfun_fin_enum -> FinEnum.pfunFinEnum is a dubious translation:
lean 3 declaration is
  forall (p : Prop) [_inst_1 : Decidable p] (α : p -> Type.{u_1}) [_inst_2 : forall (hp : p), FinEnum.{succ u_1} (α hp)], FinEnum.{succ u_1} (forall (hp : p), α hp)
but is expected to have type
  forall (p : Prop) [_inst_1 : Decidable p] (α : p -> Type) [_inst_2 : forall (hp : p), FinEnum.{1} (α hp)], FinEnum.{1} (forall (hp : p), α hp)
Case conversion may be inaccurate. Consider using '#align fin_enum.pfun_fin_enum FinEnum.pfunFinEnumₓ'. -/
instance pfunFinEnum (p : Prop) [Decidable p] (α : p → Type _) [∀ hp, FinEnum (α hp)] :
    FinEnum (∀ hp : p, α hp) :=
  if hp : p then
    ofList ((toList (α hp)).map fun x hp' => x) (by intro <;> simp <;> exact ⟨x hp, rfl⟩)
  else ofList [fun hp' => (hp hp').elim] (by intro <;> simp <;> ext hp' <;> cases hp hp')
#align fin_enum.pfun_fin_enum FinEnum.pfunFinEnum

end FinEnum


import Myint.Canon

namespace myint

theorem ne_irrefl (a : myint) : ¬ a ≉ a := by
  rw [mynotequal]
  rw [Ne]
  have := refl a
  rw [myequal] at this
  rw [this]
  have : ¬ a.y + a.x = a.y + a.x → False := by
    intro h
    rw [← Ne] at h
    exact Ne.irrefl h
  exact this

theorem ne_symm {a b : myint} (hab : mynotequal a b) : mynotequal b a := by
  rw [mynotequal] at hab ⊢
  have hres := Ne.symm hab
  rw [mynat.add_comm a.y, mynat.add_comm a.x] at hres
  exact hres

-- Warning: this is not the usual transitivity.
-- this says that if a ≠ b and b = c then a ≠ c
theorem ne_trans {a b c : myint} (hab : mynotequal a b) (hbc : myequal b c) : mynotequal a c := by
  rw [myequal] at hbc
  rw [mynotequal] at hab ⊢
  have : a.x + b.y + (b.x + c.y) ≠ a.y + b.x + (b.y + c.x) := by
    rw [hbc]
    intro h
    have := mynat.add_right_cancel (a.x + b.y) (b.y + c.x) (a.y + b.x) h
    exact hab this
  repeat rw [← mynat.add_assoc] at this
  rw [mynat.add_assoc a.x] at this
  rw [mynat.add_comm b.y] at this
  rw [mynat.add_comm a.x] at this
  rw [mynat.add_assoc a.y] at this
  rw [mynat.add_comm a.y] at this
  repeat rw [mynat.add_assoc (b.x + b.y)] at this
  intro hfalse
  rw [hfalse] at this
  exact this (Eq.refl (b.x + b.y + (a.y + c.x)))

theorem ne_implies_exists_offset (a b : myint) : a ≉ b → ∃ c : myint, c ≉ 0 ∧ a ≈ b + c := by
  intro h
  rw [mynotequal] at h
  cases mynat.le_total (a.x + b.y) (a.y + b.x)
  case inl hle =>
    rw [mynat.le_iff_exists_add] at hle
    cases hle with
    | intro d hd =>
      exists myint.mk 0 d
      apply And.intro
      . rw [mynotequal]
        rw [destruct_x, destruct_y _ d]
        rw [default_nat_has_no_y, default_nat_has_same_x]
        rw [mynat.myofnat, mynat.mynat_zero_eq_zero]
        repeat rw [mynat.add_zero]
        cases d
        case zero =>
          apply False.elim _
          rw [mynat.mynat_zero_eq_zero, mynat.add_zero] at hd
          exact h (Eq.symm hd)
        case succ d' =>
          exact Ne.symm (mynat.succ_ne_zero d')
      . rw [equiv_is_myequal, myequal]
        rw [add_y, destruct_y _ d]
        rw [add_x, destruct_x 0 _]
        rw [mynat.add_zero]
        rw [← mynat.add_assoc]
        exact Eq.symm hd
  case inr hle =>
    rw [mynat.le_iff_exists_add] at hle
    cases hle with
    | intro d hd =>
      exists myint.mk d 0
      apply And.intro
      . rw [mynotequal]
        rw [destruct_x, destruct_y _ 0]
        rw [default_nat_has_no_y, default_nat_has_same_x]
        rw [mynat.myofnat, mynat.mynat_zero_eq_zero]
        repeat rw [mynat.zero_add]
        cases d
        case zero =>
          apply False.elim _
          rw [mynat.mynat_zero_eq_zero, mynat.add_zero] at hd
          exact h hd
        case succ d' =>
          rw [mynat.add_zero]
          exact mynat.succ_ne_zero d'
      . rw [equiv_is_myequal, myequal]
        rw [add_y, destruct_y _ 0]
        rw [add_x, destruct_x d _]
        rw [mynat.add_zero]
        rw [← mynat.add_assoc]
        exact hd

theorem ne_iff_exists_offset (a b : myint) : a ≉ b ↔ ∃ c : myint, c ≉ 0 ∧ a ≈ b + c := by
  apply Iff.intro
  . exact ne_implies_exists_offset a b
  . intro h
    cases h with
    | intro d hd =>
      have hdnz := hd.left
      have hab := hd.right
      rw [mynotequal]
      rw [equiv_is_myequal, myequal] at hab
      rw [add_y, add_x] at hab
      rw [mynotequal, zerox, zeroy, mynat.add_zero, mynat.add_zero] at hdnz
      intro hcont
      repeat rw [← mynat.add_assoc] at hab
      rw [hcont] at hab
      have := (mynat.add_left_cancel _ _ _) hab
      exact hdnz (Eq.symm this)

theorem ne_mul_still_ne (a b t : myint) : a ≉ b ∧ t ≉ 0 → a * t ≉ b * t := by
  intro h
  have hab := h.left
  have htnz := h.right
  have hoffset := (ne_iff_exists_offset a b).mp hab
  cases hoffset with
  | intro c hc =>
    have hcnz := hc.left
    have habc := hc.right
    have htimes := mul_right a (b + c) t habc
    have : a * t ≈ b * t + c * t := trans htimes (add_mul b c t)
    intro hfalse
    rw [← myequal, ← equiv_is_myequal] at hfalse
    have := trans (symm hfalse) this
    have := add_left_cancel (b * t) 0 (c * t) this
    have := eq_zero_or_eq_zero_of_mul_eq_zero c t (symm this)
    cases this
    case inl h' =>
      exact hcnz h'
    case inr h' =>
      exact htnz h'

theorem mul_nonzero (a b : myint) : a ≉ 0 → b ≉ 0 → a * b ≉ 0 := by
  intro ha
  intro hb
  have := ne_mul_still_ne a 0 b ⟨ ha, hb ⟩
  have := ne_trans this (zero_mul b)
  exact this

def myle (a b : myint) :=  ∃ (c : mynat), b ≈ a + (myint.mk c 0)
instance : LE myint where
  le := myle
theorem le_iff_exists_add (a b : myint) : a ≤ b ↔ ∃ (c : mynat), b ≈ a + (myint.mk c 0) := Iff.rfl

theorem le_refl (x : myint) : x ≤ x := by
  exists 0
  exact add_zero x

theorem le_refl_equiv (x y : myint) : x ≈ y → x ≤ y := by
  intro h
  exists 0
  exact trans (symm h) (add_zero x)

theorem le_trans (a b c : myint) (hab : a ≤ b) (hbc : b ≤ c) : a ≤ c := by
  cases hab with
  | intro d hd =>
    cases hbc with
    | intro e he =>
      have hdp := add_right b (a + myint.mk d 0) (myint.mk e 0) hd
      have heq : c ≈ (a + (myint.mk d 0) + (myint.mk e 0)) := trans he hdp
      exists d + e
      have heqasc : c ≈ a + ((myint.mk d 0) + (myint.mk e 0)) := trans heq (add_assoc a (myint.mk d 0) (myint.mk e 0))
      conv at heqasc =>
        rhs
        arg 2
        rw [add_eq_myadd, myadd]
        rw [destruct_x, destruct_y, destruct_x, mynat.add_zero]
      exact heqasc

theorem le_trans_equiv (a b c : myint) (hab : a ≤ b) (hbc : b ≈ c) : a ≤ c := by
  have := le_refl_equiv b c hbc
  exact le_trans a b c hab this

theorem le_equiv_trans (a b c : myint) (hab : a ≈ b) (hbc : b ≤ c) : a ≤ c := by
  have := le_refl_equiv a b hab
  exact le_trans a b c this hbc

theorem le_antisymm (a b : myint) (hab : a ≤ b) (hba : b ≤ a) : a ≈ b := by
  cases hab with
  | intro c hc =>
    cases hba with
    | intro d hd =>
      have hadd : b + (myint.mk d 0) ≈ a + (myint.mk c 0) + (myint.mk d 0) := add_right _ _ _ hc
      have hassoc : b + (myint.mk d 0) ≈ a + ((myint.mk c 0) + (myint.mk d 0)) := trans hadd (add_assoc _ _ _)
      have := trans hd hassoc
      have := add_left_cancel a 0 _ this
      rw [equiv_is_myequal, myequal] at this
      rw [add_x, destruct_x c _, destruct_x d _, zerox] at this
      rw [add_y, destruct_y, zeroy] at this
      repeat rw [mynat.zero_add] at this
      have hdz := mynat.add_left_eq_zero (Eq.symm this)
      rw [hdz] at hd
      have hzz : myint.mk 0 0 ≈ 0 := rfl
      have := trans hd (add_left b _ _ hzz)
      have := trans this (add_zero b)
      exact this

theorem add_le_add_right {a b : myint} : a ≤ b → ∀ t, (a + t) ≤ (b + t) := by
  intro h
  rw [le_iff_exists_add] at h
  cases h with
  | intro c hc =>
    intro t
    exists c
    have ht1 := add_right b (a + myint.mk c 0) t hc
    have ht2 : a + { x := c, y := 0 } + t ≈ a + t + { x := c, y := 0} := by
      have hst1 : a + (myint.mk c 0) + t ≈ a + ((myint.mk c 0) + t) := add_assoc _ _ _
      have hst2 : a + ((myint.mk c 0) + t) ≈ a + (t + (myint.mk c 0)) := add_left a _ _ (add_comm _ _)
      have hst3 : a + (t + (myint.mk c 0)) ≈ a + t + (myint.mk c 0) := symm (add_assoc _ _ _)
      exact trans (trans hst1 hst2) hst3
    exact trans ht1 ht2

theorem le_total (a b : myint) : a ≤ b ∨ b ≤ a := by
  have hlemma (n : myint) : n ≤ 0 ∨ 0 ≤ n := by
    let pn := n.x ≤ n.y
    cases Classical.em pn
    case inl h =>
      have : n.x ≤ n.y := h
      apply Or.intro_left
      rw [le_iff_exists_add]
      have := canon_neg n this
      cases this with
      | intro c hc =>
        exists c.y
        have ht1 : c + (myint.mk c.y 0) ≈ n + (myint.mk c.y 0) := add_right c n _ hc.right
        have : myint.mk 0 c.y ≈ c := by
          apply if_x_and_y_equal_then_equiv
          rw [destruct_x, destruct_y]
          exact ⟨ Eq.symm hc.left, rfl ⟩
        have ht2 : (myint.mk 0 c.y) + (myint.mk c.y 0) ≈ c + (myint.mk c.y 0) := add_right (myint.mk 0 c.y) c (myint.mk c.y 0) this
        have ht3 : 0 ≈ (myint.mk 0 c.y) + (myint.mk c.y 0) := by
          rw [equiv_is_myequal, myequal]
          rw [add_y, destruct_y, destruct_y _ 0]
          rw [add_x, destruct_x 0, destruct_x c.y]
          rw [zerox, zeroy, mynat.zero_add, mynat.add_zero, mynat.zero_add, mynat.zero_add]
        exact trans (trans ht3 ht2) ht1
    case inr h =>
      have : ¬ n.x ≤ n.y := h
      have := mynat.le_total n.x n.y
      cases this
      case inl hh =>
        apply False.elim
        exact this hh
      case inr hh =>
        apply Or.intro_right
        rw [le_iff_exists_add]
        have := canon_pos n hh
        cases this with
        | intro c hc =>
          have ⟨ cx, cy ⟩ := c
          exists cx
          have : cy = 0 := hc.left
          rw [← this]
          exact trans (symm hc.right) (symm (zero_add (myint.mk cx cy)))
  have : a - b ≤ 0 ∨ 0 ≤ a - b := hlemma (a - b)
  have hmain : a ≈ a - b + b := by
    have hm := add_left a 0 (-b + b) (symm (trans (add_comm (-b) b) (neg_is_inv b)))
    have := equal_implies_equiv _ _ (Eq.symm (sub_eq_plusneg a b))
    have := add_right (a + -b) (a - b) b this
    have hl := symm (add_zero a)
    have hr : a + (-b + b) ≈ a + -b + b := symm (add_assoc a (-b) b)
    exact trans (trans hl hm) hr
  have haux : 0 + b ≈ b := zero_add b
  cases this
  case inl h =>
    have : (a - b) + b ≤ 0 + b := add_le_add_right h b
    apply Or.intro_left
    exact le_trans_equiv _ _ _ (le_equiv_trans _ _ _ hmain this) haux
  case inr h =>
    have : 0 + b ≤ (a - b) + b := add_le_add_right h b
    apply Or.intro_right
    exact le_trans_equiv _ _ _ (le_equiv_trans _ _ _ (symm haux) this) (symm hmain)

  -- This law is called "material implication" and I'm not sure if there is a better way to maintain this law?
  -- have : (¬ a ≤ b → b ≤ a) → a ≤ b ∨ b ≤ a := by
  --   intro h1
  --   let p : Prop := a ≤ b
  --   cases (Classical.em p)
  --   case inl hp =>
  --     apply Or.intro_left
  --     have h : a ≤ b := hp
  --     exact h
  --   case inr hnotp =>
  --     apply Or.intro_right
  --     have h : ¬ a ≤ b := hnotp
  --     exact h1 h
  -- apply this
  -- intro h
  -- rw [LE.le, instLEMyint] at h
  -- simp at h
  -- rw [myle] at h
  -- -- Another logic law
  -- sorry

theorem add_le_add_left {a b : myint} (h : a ≤ b) (t : myint) : t + a ≤ t + b := by
  have := add_le_add_right h t
  exact le_trans_equiv _ _ _ (le_equiv_trans _ _ _ (add_comm t a) this) (add_comm b t)

theorem pos_iff_y_le_x (n : myint) : 0 ≤ n ↔ n.y ≤ n.x := by
  apply Iff.intro
  . intro h
    rw [le_iff_exists_add] at h
    cases h with
    | intro c hc =>
      have ⟨ nx, ny ⟩ := n
      rw [equiv_is_myequal, myequal] at hc
      rw [destruct_x, destruct_y _ ny] at hc
      rw [add_y, add_x] at hc
      rw [destruct_y _ 0, destruct_x c _] at hc
      rw [destruct_y, destruct_x]
      exists c
      rw [zeroy, zerox, mynat.add_zero, mynat.zero_add, mynat.add_zero] at hc
      exact hc
  . intro h
    have := canon_pos n h
    cases this with
    | intro c hc =>
      have ⟨ cx, cy ⟩ := c
      rw [destruct_y] at hc
      have ⟨ hc1, hc2 ⟩ := hc
      rw [hc1] at hc2
      have : 0 ≤ myint.mk cx 0 := by
        exists cx
        exact symm (zero_add (myint.mk cx 0))
      exact le_trans_equiv _ _ _ this hc2

theorem le_mul_pos (a b : myint) (h : a ≤ b) (t : myint) (ht : 0 ≤ t) : a * t ≤ b * t := by
  have hpos := ht
  rw [le_iff_exists_add] at hpos
  cases h with
  | intro c hc =>
    have := mul_right b (a + myint.mk c 0) t hc
    have huse : b * t ≈ a * t + (myint.mk c 0) * t := trans this (add_mul _ _ _)
    have := canon_pos t ((pos_iff_y_le_x t).mp ht)
    cases this with
    | intro d hd =>
      have ⟨ dx, dy ⟩ := d
      rw [destruct_y] at hd
      have ⟨ hd1, hd2 ⟩ := hd
      rw [hd1] at hd2
      have hhelper : a * t + { x := c, y := 0 } * t ≈ a * t + { x := c, y := 0 } * { x := dx, y := 0} := (add_left (a * t) _ _) (mul_left (myint.mk c 0) t (myint.mk dx 0) (symm hd2))
      have hthis := trans huse hhelper
      conv at hthis =>
        rhs
        arg 2
        rw [mul_eq_mymul, mymul]
        rw [destruct_x, destruct_x, destruct_y]
        rw [mynat.mul_zero, mynat.mul_zero, mynat.zero_mul, mynat.add_zero, mynat.add_zero]
      exists c * dx

theorem le_mul_neg (a b : myint) (h : a ≤ b) (t : myint) (ht : t ≤ 0) : b * t ≤ a * t := by
  have : a * (-t) ≤ b * (-t) := by
    have : 0 ≤ -t := by
      have := add_le_add_right ht (-t)
      have := le_equiv_trans _ _ _ (symm (neg_is_inv t)) this
      exact le_trans_equiv _ _ _ this (zero_add _)
    exact le_mul_pos a b h (-t) this
  have hlemma (f g : myint) : f * g + f * -g ≈ 0 := by
    have : f * g + f * g * -1 ≈ f * g + f * -g := add_left _ _ _ (trans (mul_assoc _ _ _) (mul_left f _ _ (mul_negone g)))
    have hs3 : f * g * -1 ≈ - (f * g) := mul_negone (f * g)
    have hs : f * g + -(f * g) ≈ f * g + f * -g := trans (symm (add_left (f * g) _ _ hs3)) this
    have ht := trans (symm (neg_is_inv (f * g))) hs
    exact symm ht
  have : 0 ≤ a * t + b * (-t) := by
    have hthis := add_le_add_left this (a * t)
    exact le_equiv_trans _ _ _ (symm (hlemma a t)) hthis
  have hthis := add_le_add_right this (b * t)
  have := le_trans_equiv _ _ _ hthis (add_assoc _ _ _)
  have hadjust := add_left (a * t) _ _ (trans (add_comm _ _) (hlemma b t))
  have := le_trans_equiv _ _ _ this hadjust
  exact le_equiv_trans _ _ _ (symm (zero_add (b * t))) this

theorem sq_pos (n : myint) : 0 ≤ n * n := by
  let pn := 0 ≤ n
  cases Classical.em pn
  case inl h =>
    have : 0 ≤ n := h
    have := le_mul_pos 0 n this n this
    exact le_equiv_trans _ _ _ (symm (zero_mul n)) this
  case inr h =>
    have : ¬ 0 ≤ n := h
    have := le_total 0 n
    cases this
    case inl hh =>
      apply False.elim
      exact this hh
    case inr hh =>
      have := le_mul_neg n 0 hh n hh
      exact le_equiv_trans _ _ _ (symm (zero_mul n)) this

-- actually this obviously implies the simple case of AM-GM inequality...

def mylt (a b : mynat) := a ≤ b ∧ ¬ (b ≤ a)
instance : LT mynat := ⟨mylt⟩
theorem lt_def (a b : mynat) : a < b ↔ a ≤ b ∧ ¬ (b ≤ a) := Iff.rfl

end myint