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

! This file was ported from Lean 3 source module category_theory.preadditive.generator
! leanprover-community/mathlib commit 09f981f72d43749f1fa072deade828d9c1e185bb
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Generator
import Mathbin.CategoryTheory.Preadditive.Yoneda.Basic

/-!
# Separators in preadditive categories

This file contains characterizations of separating sets and objects that are valid in all
preadditive categories.

-/

universe v u

open CategoryTheory Opposite

namespace CategoryTheory

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

theorem Preadditive.isSeparating_iff (𝒢 : Set C) :
    IsSeparating 𝒢 ↔ ∀ ⦃X Y : C⦄ (f : X ⟶ Y), (∀ G ∈ 𝒢, ∀ (h : G ⟶ X), h ≫ f = 0) → f = 0 :=
  ⟨fun h𝒢 X Y f hf => h𝒢 _ _ (by simpa only [limits.comp_zero] using hf), fun h𝒢 X Y f g hfg =>
    sub_eq_zero.1 <| h𝒢 _ (by simpa only [preadditive.comp_sub, sub_eq_zero] using hfg)⟩
#align category_theory.preadditive.is_separating_iff CategoryTheory.Preadditive.isSeparating_iff

theorem Preadditive.isCoseparating_iff (𝒢 : Set C) :
    IsCoseparating 𝒢 ↔ ∀ ⦃X Y : C⦄ (f : X ⟶ Y), (∀ G ∈ 𝒢, ∀ (h : Y ⟶ G), f ≫ h = 0) → f = 0 :=
  ⟨fun h𝒢 X Y f hf => h𝒢 _ _ (by simpa only [limits.zero_comp] using hf), fun h𝒢 X Y f g hfg =>
    sub_eq_zero.1 <| h𝒢 _ (by simpa only [preadditive.sub_comp, sub_eq_zero] using hfg)⟩
#align category_theory.preadditive.is_coseparating_iff CategoryTheory.Preadditive.isCoseparating_iff

theorem Preadditive.isSeparator_iff (G : C) :
    IsSeparator G ↔ ∀ ⦃X Y : C⦄ (f : X ⟶ Y), (∀ h : G ⟶ X, h ≫ f = 0) → f = 0 :=
  ⟨fun hG X Y f hf => hG.def _ _ (by simpa only [limits.comp_zero] using hf), fun hG =>
    (isSeparator_def _).2 fun X Y f g hfg =>
      sub_eq_zero.1 <| hG _ (by simpa only [preadditive.comp_sub, sub_eq_zero] using hfg)⟩
#align category_theory.preadditive.is_separator_iff CategoryTheory.Preadditive.isSeparator_iff

theorem Preadditive.isCoseparator_iff (G : C) :
    IsCoseparator G ↔ ∀ ⦃X Y : C⦄ (f : X ⟶ Y), (∀ h : Y ⟶ G, f ≫ h = 0) → f = 0 :=
  ⟨fun hG X Y f hf => hG.def _ _ (by simpa only [limits.zero_comp] using hf), fun hG =>
    (isCoseparator_def _).2 fun X Y f g hfg =>
      sub_eq_zero.1 <| hG _ (by simpa only [preadditive.sub_comp, sub_eq_zero] using hfg)⟩
#align category_theory.preadditive.is_coseparator_iff CategoryTheory.Preadditive.isCoseparator_iff

theorem isSeparator_iff_faithful_preadditiveCoyoneda (G : C) :
    IsSeparator G ↔ Faithful (preadditiveCoyoneda.obj (op G)) :=
  by
  rw [is_separator_iff_faithful_coyoneda_obj, ← whiskering_preadditive_coyoneda, functor.comp_obj,
    whiskering_right_obj_obj]
  exact ⟨fun h => faithful.of_comp _ (forget AddCommGroupCat), fun h => faithful.comp _ _⟩
#align category_theory.is_separator_iff_faithful_preadditive_coyoneda CategoryTheory.isSeparator_iff_faithful_preadditiveCoyoneda

theorem isSeparator_iff_faithful_preadditiveCoyonedaObj (G : C) :
    IsSeparator G ↔ Faithful (preadditiveCoyonedaObj (op G)) :=
  by
  rw [is_separator_iff_faithful_preadditive_coyoneda, preadditive_coyoneda_obj_2]
  exact ⟨fun h => faithful.of_comp _ (forget₂ _ AddCommGroupCat.{v}), fun h => faithful.comp _ _⟩
#align category_theory.is_separator_iff_faithful_preadditive_coyoneda_obj CategoryTheory.isSeparator_iff_faithful_preadditiveCoyonedaObj

theorem isCoseparator_iff_faithful_preadditiveYoneda (G : C) :
    IsCoseparator G ↔ Faithful (preadditiveYoneda.obj G) :=
  by
  rw [is_coseparator_iff_faithful_yoneda_obj, ← whiskering_preadditive_yoneda, functor.comp_obj,
    whiskering_right_obj_obj]
  exact ⟨fun h => faithful.of_comp _ (forget AddCommGroupCat), fun h => faithful.comp _ _⟩
#align category_theory.is_coseparator_iff_faithful_preadditive_yoneda CategoryTheory.isCoseparator_iff_faithful_preadditiveYoneda

theorem isCoseparator_iff_faithful_preadditiveYonedaObj (G : C) :
    IsCoseparator G ↔ Faithful (preadditiveYonedaObj G) :=
  by
  rw [is_coseparator_iff_faithful_preadditive_yoneda, preadditive_yoneda_obj_2]
  exact ⟨fun h => faithful.of_comp _ (forget₂ _ AddCommGroupCat.{v}), fun h => faithful.comp _ _⟩
#align category_theory.is_coseparator_iff_faithful_preadditive_yoneda_obj CategoryTheory.isCoseparator_iff_faithful_preadditiveYonedaObj

end CategoryTheory


/-
Copyright (c) 2021 Julian Kuelshammer. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Julian Kuelshammer
-/
import algebra.pempty_instances
import algebra.hom.equiv
import category_theory.concrete_category.bundled_hom
import category_theory.functor.reflects_isomorphisms
import category_theory.elementwise

/-!
# Category instances for has_mul, has_add, semigroup and add_semigroup

We introduce the bundled categories:
* `Magma`
* `AddMagma`
* `Semigroup`
* `AddSemigroup`
along with the relevant forgetful functors between them.

This closely follows `algebra.category.Mon.basic`.

## TODO

* Limits in these categories
* free/forgetful adjunctions
-/

universes u v

open category_theory

/-- The category of magmas and magma morphisms. -/
@[to_additive AddMagma]
def Magma : Type (u+1) := bundled has_mul

/-- The category of additive magmas and additive magma morphisms. -/
add_decl_doc AddMagma

namespace Magma

@[to_additive]
instance bundled_hom : bundled_hom @mul_hom :=
⟨@mul_hom.to_fun, @mul_hom.id, @mul_hom.comp, @mul_hom.coe_inj⟩

attribute [derive [large_category, concrete_category]] Magma
attribute [to_additive] Magma.large_category Magma.concrete_category

@[to_additive] instance : has_coe_to_sort Magma Type* := bundled.has_coe_to_sort

/-- Construct a bundled `Magma` from the underlying type and typeclass. -/
@[to_additive]
def of (M : Type u) [has_mul M] : Magma := bundled.of M

/-- Construct a bundled `AddMagma` from the underlying type and typeclass. -/
add_decl_doc AddMagma.of

/-- Typecheck a `mul_hom` as a morphism in `Magma`. -/
@[to_additive] def of_hom {X Y : Type u} [has_mul X] [has_mul Y] (f : X →ₙ* Y) :
  of X ⟶ of Y := f

/-- Typecheck a `add_hom` as a morphism in `AddMagma`. -/
add_decl_doc AddMagma.of_hom

@[simp, to_additive] lemma of_hom_apply {X Y : Type u} [has_mul X] [has_mul Y] (f : X →ₙ* Y)
  (x : X) : of_hom f x = f x := rfl

@[to_additive]
instance : inhabited Magma := ⟨Magma.of pempty⟩

@[to_additive]
instance (M : Magma) : has_mul M := M.str

@[simp, to_additive] lemma coe_of (R : Type u) [has_mul R] : (Magma.of R : Type u) = R := rfl

end Magma

/-- The category of semigroups and semigroup morphisms. -/
@[to_additive AddSemigroup]
def Semigroup : Type (u+1) := bundled semigroup

/-- The category of additive semigroups and semigroup morphisms. -/
add_decl_doc AddSemigroup

namespace Semigroup

@[to_additive]
instance : bundled_hom.parent_projection semigroup.to_has_mul := ⟨⟩

attribute [derive [large_category, concrete_category]] Semigroup
attribute [to_additive] Semigroup.large_category Semigroup.concrete_category

@[to_additive] instance : has_coe_to_sort Semigroup Type* := bundled.has_coe_to_sort

/-- Construct a bundled `Semigroup` from the underlying type and typeclass. -/
@[to_additive]
def of (M : Type u) [semigroup M] : Semigroup := bundled.of M

/-- Construct a bundled `AddSemigroup` from the underlying type and typeclass. -/
add_decl_doc AddSemigroup.of

/-- Typecheck a `mul_hom` as a morphism in `Semigroup`. -/
@[to_additive] def of_hom {X Y : Type u} [semigroup X] [semigroup Y] (f : X →ₙ* Y) :
  of X ⟶ of Y := f

/-- Typecheck a `add_hom` as a morphism in `AddSemigroup`. -/
add_decl_doc AddSemigroup.of_hom

@[simp, to_additive] lemma of_hom_apply {X Y : Type u} [semigroup X] [semigroup Y] (f : X →ₙ* Y)
  (x : X) : of_hom f x = f x := rfl

@[to_additive]
instance : inhabited Semigroup := ⟨Semigroup.of pempty⟩

@[to_additive]
instance (M : Semigroup) : semigroup M := M.str

@[simp, to_additive] lemma coe_of (R : Type u) [semigroup R] : (Semigroup.of R : Type u) = R := rfl

@[to_additive has_forget_to_AddMagma]
instance has_forget_to_Magma : has_forget₂ Semigroup Magma := bundled_hom.forget₂ _ _

end Semigroup

variables {X Y : Type u}

section
variables [has_mul X] [has_mul Y]

/-- Build an isomorphism in the category `Magma` from a `mul_equiv` between `has_mul`s. -/
@[to_additive add_equiv.to_AddMagma_iso "Build an isomorphism in the category `AddMagma` from
an `add_equiv` between `has_add`s.", simps]
def mul_equiv.to_Magma_iso (e : X ≃* Y) : Magma.of X ≅ Magma.of Y :=
{ hom := e.to_mul_hom,
  inv := e.symm.to_mul_hom }

end

section
variables [semigroup X] [semigroup Y]

/-- Build an isomorphism in the category `Semigroup` from a `mul_equiv` between `semigroup`s. -/
@[to_additive add_equiv.to_AddSemigroup_iso "Build an isomorphism in the category
`AddSemigroup` from an `add_equiv` between `add_semigroup`s.", simps]
def mul_equiv.to_Semigroup_iso (e : X ≃* Y) : Semigroup.of X ≅ Semigroup.of Y :=
{ hom := e.to_mul_hom,
  inv := e.symm.to_mul_hom }

end

namespace category_theory.iso

/-- Build a `mul_equiv` from an isomorphism in the category `Magma`. -/
@[to_additive AddMagma_iso_to_add_equiv "Build an `add_equiv` from an isomorphism in the category
`AddMagma`."]
def Magma_iso_to_mul_equiv {X Y : Magma} (i : X ≅ Y) : X ≃* Y :=
{ to_fun := i.hom,
  inv_fun := i.inv,
  left_inv := λ x, by simp,
  right_inv := λ y, by simp,
  map_mul' := by simp }

/-- Build a `mul_equiv` from an isomorphism in the category `Semigroup`. -/
@[to_additive "Build an `add_equiv` from an isomorphism in the category
`AddSemigroup`."]
def Semigroup_iso_to_mul_equiv {X Y : Semigroup} (i : X ≅ Y) : X ≃* Y :=
{ to_fun := i.hom,
  inv_fun := i.inv,
  left_inv := λ x, by simp,
  right_inv := λ y, by simp,
  map_mul' := by simp }

end category_theory.iso

/-- multiplicative equivalences between `has_mul`s are the same as (isomorphic to) isomorphisms
in `Magma` -/
@[to_additive add_equiv_iso_AddMagma_iso "additive equivalences between `has_add`s are the same
as (isomorphic to) isomorphisms in `AddMagma`"]
def mul_equiv_iso_Magma_iso {X Y : Type u} [has_mul X] [has_mul Y] :
  (X ≃* Y) ≅ (Magma.of X ≅ Magma.of Y) :=
{ hom := λ e, e.to_Magma_iso,
  inv := λ i, i.Magma_iso_to_mul_equiv }

/-- multiplicative equivalences between `semigroup`s are the same as (isomorphic to) isomorphisms
in `Semigroup` -/
@[to_additive add_equiv_iso_AddSemigroup_iso "additive equivalences between `add_semigroup`s are
the same as (isomorphic to) isomorphisms in `AddSemigroup`"]
def mul_equiv_iso_Semigroup_iso {X Y : Type u} [semigroup X] [semigroup Y] :
  (X ≃* Y) ≅ (Semigroup.of X ≅ Semigroup.of Y) :=
{ hom := λ e, e.to_Semigroup_iso,
  inv := λ i, i.Semigroup_iso_to_mul_equiv }

@[to_additive]
instance Magma.forget_reflects_isos : reflects_isomorphisms (forget Magma.{u}) :=
{ reflects := λ X Y f _,
  begin
    resetI,
    let i := as_iso ((forget Magma).map f),
    let e : X ≃* Y := { ..f, ..i.to_equiv },
    exact ⟨(is_iso.of_iso e.to_Magma_iso).1⟩,
  end }

@[to_additive]
instance Semigroup.forget_reflects_isos : reflects_isomorphisms (forget Semigroup.{u}) :=
{ reflects := λ X Y f _,
  begin
    resetI,
    let i := as_iso ((forget Semigroup).map f),
    let e : X ≃* Y := { ..f, ..i.to_equiv },
    exact ⟨(is_iso.of_iso e.to_Semigroup_iso).1⟩,
  end }

/-!
Once we've shown that the forgetful functors to type reflect isomorphisms,
we automatically obtain that the `forget₂` functors between our concrete categories
reflect isomorphisms.
-/
example : reflects_isomorphisms (forget₂ Semigroup Magma) := by apply_instance


/- Copyright (c) Heather Macbeth, 2022.  All rights reserved. -/
import BrownCs22.Library.ModEq.Defs
import BrownCs22.Library.Tactics
-- import Mathlib.Data.Int.ModEq

namespace BrownCs22

instance (n) : DecidableRel (Int.ModEq n) := λ a b =>
  if h : Int.mod (a - b) n = 0 then Decidable.isTrue (Int.dvd_of_mod_eq_zero h) else Decidable.isFalse (λ h' => h (Int.mod_eq_zero_of_dvd h'))

protected theorem Int.ModEq.refl (a : ℤ) : a ≡ a [ZMOD n] := ⟨0, by ring⟩

protected theorem Int.ModEq.add (h1 : a ≡ b [ZMOD n]) (h2 : c ≡ d [ZMOD n]) :
    a + c ≡ b + d [ZMOD n] := by
  obtain ⟨x, hx⟩ := h1
  obtain ⟨y, hy⟩ := h2
  exact ⟨x + y, by linear_combination hx + hy⟩

protected theorem Int.ModEq.add_left (h : a ≡ b [ZMOD n]) : c + a ≡ c + b [ZMOD n] :=
(Int.ModEq.refl _).add h

protected theorem Int.ModEq.add_right (h : a ≡ b [ZMOD n]) : a + c ≡ b + c [ZMOD n] :=
h.add (Int.ModEq.refl _)

protected theorem Int.ModEq.sub (h1 : a ≡ b [ZMOD n]) (h2 : c ≡ d [ZMOD n]) :
    a - c ≡ b - d [ZMOD n] := by
  obtain ⟨x, hx⟩ := h1
  obtain ⟨y, hy⟩ := h2
  exact ⟨x - y, by linear_combination hx - hy⟩

protected theorem Int.ModEq.sub_left (h : a ≡ b [ZMOD n]) : c - a ≡ c - b [ZMOD n] :=
(Int.ModEq.refl _).sub h

protected theorem Int.ModEq.sub_right (h : a ≡ b [ZMOD n]) : a - c ≡ b - c [ZMOD n] :=
h.sub (Int.ModEq.refl _)

protected theorem Int.ModEq.neg (h1 : a ≡ b [ZMOD n]) : -a ≡ -b [ZMOD n] := by
  obtain ⟨x, hx⟩ := h1
  exact ⟨-x, by linear_combination -hx⟩

protected theorem Int.ModEq.mul (h1 : a ≡ b [ZMOD n]) (h2 : c ≡ d [ZMOD n]) :
    a * c ≡ b * d [ZMOD n] := by
  obtain ⟨x, hx⟩ := h1
  obtain ⟨y, hy⟩ := h2
  exact ⟨x * c + b * y, by linear_combination c * hx + b * hy⟩

protected theorem Int.ModEq.mul_left (h : a ≡ b [ZMOD n]) : c * a ≡ c * b [ZMOD n] :=
(Int.ModEq.refl _).mul h

protected theorem Int.ModEq.mul_right (h : a ≡ b [ZMOD n]) : a * c ≡ b * c [ZMOD n] :=
h.mul (Int.ModEq.refl _)

protected theorem Int.ModEq.pow (k : ℕ) (h : a ≡ b [ZMOD n]) : a ^ k ≡ b ^ k [ZMOD n] := by
  induction k
  case zero => exact Int.ModEq.refl _
  case succ k hk => exact Int.ModEq.mul hk h

protected theorem Int.ModEq.symm (h : a ≡ b [ZMOD n]) : b ≡ a [ZMOD n] := by
  obtain ⟨x, hx⟩ := h
  exact ⟨-x, by linear_combination - hx⟩

@[trans]
protected theorem Int.ModEq.trans (h1 : a ≡ b [ZMOD n]) (h2 : b ≡ c [ZMOD n]) : a ≡ c [ZMOD n] := by
  obtain ⟨x, hx⟩ := h1
  obtain ⟨y, hy⟩ := h2
  exact ⟨x + y, by linear_combination hx + hy⟩

instance : IsTrans ℤ (Int.ModEq n) where
  trans := @Int.ModEq.trans n

theorem Int.modEq_fac_zero : n * t ≡ 0 [ZMOD n] := ⟨t, by ring⟩
theorem Int.modEq_fac_zero' : t * n ≡ 0 [ZMOD n] := ⟨t, by ring⟩
theorem Int.modEq_zero_fac : 0 ≡ n * t [ZMOD n] := ⟨-t, by ring⟩
theorem Int.modEq_zero_fac' : 0 ≡ t * n [ZMOD n] := ⟨-t, by ring⟩
theorem Int.modEq_add_fac_self : a + n * t ≡ a [ZMOD n] := ⟨t, by ring⟩
theorem Int.modEq_add_fac_self' : n * t + a ≡ a [ZMOD n] := ⟨t, by ring⟩
theorem Int.modEq_add_fac_self'' : a + t * n ≡ a [ZMOD n] := ⟨t, by ring⟩
theorem Int.modEq_add_fac_self''' : t * n + a ≡ a [ZMOD n] := ⟨t, by ring⟩
theorem Int.modEq_sub_fac_self : a - n * t ≡ a [ZMOD n] := ⟨-t, by ring⟩
theorem Int.modEq_sub_fac_self' : n * t - a ≡ -a [ZMOD n] := ⟨t, by ring⟩
theorem Int.modEq_sub_fac_self'' : a - t * n ≡ a [ZMOD n] := ⟨-t, by ring⟩
theorem Int.modEq_sub_fac_self''' : t * n - a ≡ -a [ZMOD n] := ⟨t, by ring⟩
theorem Int.modEq_add_fac_self_symm : a ≡ a + n * t [ZMOD n] := ⟨-t, by ring⟩
theorem Int.modEq_add_fac_self_symm' : a ≡ n * t + a [ZMOD n] := ⟨-t, by ring⟩
theorem Int.modEq_add_fac_self_symm'' : a ≡ a + t * n [ZMOD n] := ⟨-t, by ring⟩
theorem Int.modEq_add_fac_self_symm''' : a ≡ t * n + a [ZMOD n] := ⟨-t, by ring⟩
theorem Int.modEq_sub_fac_self_symm : a ≡ a - n * t [ZMOD n] := ⟨t, by ring⟩
theorem Int.modEq_sub_fac_self_symm' : -a ≡ n * t - a [ZMOD n] := ⟨-t, by ring⟩
theorem Int.modEq_sub_fac_self_symm'' : a ≡ a - t * n [ZMOD n] := ⟨t, by ring⟩
theorem Int.modEq_sub_fac_self_symm''' : -a ≡ t * n - a [ZMOD n] := ⟨-t, by ring⟩

-- theorem Int.existsUnique_modEq_lt (a : ℤ) {b : ℤ} (hb : 0 < b) :
--     ∃! r : ℤ, 0 ≤ r ∧ r < b ∧ a ≡ r [ZMOD b] := by
--   obtain ⟨r, ⟨rpos, rlt, q, hq⟩, hr2⟩ := a.existsUnique_quotient_remainder b hb
--   refine ⟨r, ⟨rpos, rlt, q, ?_⟩, ?_⟩ <;> dsimp at *
--   . linear_combination hq
--   rintro r' ⟨rpos', rlt', q', hq'⟩
--   refine hr2 r' ⟨rpos', rlt', q', ?_⟩
--   linear_combination hq'


/-
Copyright (c) 2019 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import algebra.hom.equiv.units.basic
import category_theory.endomorphism

/-!
# Conjugate morphisms by isomorphisms

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

An isomorphism `α : X ≅ Y` defines
- a monoid isomorphism `conj : End X ≃* End Y` by `α.conj f = α.inv ≫ f ≫ α.hom`;
- a group isomorphism `conj_Aut : Aut X ≃* Aut Y` by `α.conj_Aut f = α.symm ≪≫ f ≪≫ α`.

For completeness, we also define `hom_congr : (X ≅ X₁) → (Y ≅ Y₁) → (X ⟶ Y) ≃ (X₁ ⟶ Y₁)`,
cf. `equiv.arrow_congr`.
-/

universes v u

namespace category_theory

namespace iso

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

/-- If `X` is isomorphic to `X₁` and `Y` is isomorphic to `Y₁`, then
there is a natural bijection between `X ⟶ Y` and `X₁ ⟶ Y₁`. See also `equiv.arrow_congr`. -/
def hom_congr {X Y X₁ Y₁ : C} (α : X ≅ X₁) (β : Y ≅ Y₁) :
  (X ⟶ Y) ≃ (X₁ ⟶ Y₁) :=
{ to_fun := λ f, α.inv ≫ f ≫ β.hom,
  inv_fun := λ f, α.hom ≫ f ≫ β.inv,
  left_inv := λ f, show α.hom ≫ (α.inv ≫ f ≫ β.hom) ≫ β.inv = f,
    by rw [category.assoc, category.assoc, β.hom_inv_id, α.hom_inv_id_assoc, category.comp_id],
  right_inv := λ f, show α.inv ≫ (α.hom ≫ f ≫ β.inv) ≫ β.hom = f,
    by rw [category.assoc, category.assoc, β.inv_hom_id, α.inv_hom_id_assoc, category.comp_id] }

@[simp]
lemma hom_congr_apply {X Y X₁ Y₁ : C} (α : X ≅ X₁) (β : Y ≅ Y₁) (f : X ⟶ Y) :
  α.hom_congr β f = α.inv ≫ f ≫ β.hom :=
rfl

lemma hom_congr_comp {X Y Z X₁ Y₁ Z₁ : C} (α : X ≅ X₁) (β : Y ≅ Y₁) (γ : Z ≅ Z₁)
  (f : X ⟶ Y) (g : Y ⟶ Z) :
  α.hom_congr γ (f ≫ g) = α.hom_congr β f ≫ β.hom_congr γ g :=
by simp

@[simp] lemma hom_congr_refl {X Y : C} (f : X ⟶ Y) :
  (iso.refl X).hom_congr (iso.refl Y) f = f :=
by simp

@[simp] lemma hom_congr_trans {X₁ Y₁ X₂ Y₂ X₃ Y₃ : C}
  (α₁ : X₁ ≅ X₂) (β₁ : Y₁ ≅ Y₂) (α₂ : X₂ ≅ X₃) (β₂ : Y₂ ≅ Y₃) (f : X₁ ⟶ Y₁) :
  (α₁ ≪≫ α₂).hom_congr (β₁ ≪≫ β₂) f = (α₁.hom_congr β₁).trans (α₂.hom_congr β₂) f :=
by simp

@[simp] lemma hom_congr_symm {X₁ Y₁ X₂ Y₂ : C} (α : X₁ ≅ X₂) (β : Y₁ ≅ Y₂) :
  (α.hom_congr β).symm = α.symm.hom_congr β.symm :=
rfl

variables {X Y : C} (α : X ≅ Y)

/-- An isomorphism between two objects defines a monoid isomorphism between their
monoid of endomorphisms. -/
def conj : End X ≃* End Y :=
{ map_mul' := λ f g, hom_congr_comp α α α g f,
  .. hom_congr α α }

lemma conj_apply (f : End X) : α.conj f = α.inv ≫ f ≫ α.hom := rfl

@[simp] lemma conj_comp (f g : End X) : α.conj (f ≫ g) = (α.conj f) ≫ (α.conj g) :=
α.conj.map_mul g f

@[simp] lemma conj_id : α.conj (𝟙 X) = 𝟙 Y :=
α.conj.map_one

@[simp] lemma refl_conj (f : End X) : (iso.refl X).conj f = f :=
by rw [conj_apply, iso.refl_inv, iso.refl_hom, category.id_comp, category.comp_id]

@[simp] lemma trans_conj {Z : C} (β : Y ≅ Z) (f : End X) : (α ≪≫ β).conj f = β.conj (α.conj f) :=
hom_congr_trans α α β β f

@[simp] lemma symm_self_conj (f : End X) : α.symm.conj (α.conj f) = f :=
by rw [← trans_conj, α.self_symm_id, refl_conj]

@[simp] lemma self_symm_conj (f : End Y) : α.conj (α.symm.conj f) = f :=
α.symm.symm_self_conj f

@[simp] lemma conj_pow (f : End X) (n : ℕ) : α.conj (f^n) = (α.conj f)^n :=
α.conj.to_monoid_hom.map_pow f n

/-- `conj` defines a group isomorphisms between groups of automorphisms -/
def conj_Aut : Aut X ≃* Aut Y :=
(Aut.units_End_equiv_Aut X).symm.trans $
(units.map_equiv α.conj).trans $
Aut.units_End_equiv_Aut Y

lemma conj_Aut_apply (f : Aut X) : α.conj_Aut f = α.symm ≪≫ f ≪≫ α :=
by cases f; cases α; ext; refl

@[simp] lemma conj_Aut_hom (f : Aut X) : (α.conj_Aut f).hom = α.conj f.hom := rfl

@[simp] lemma trans_conj_Aut {Z : C} (β : Y ≅ Z) (f : Aut X) :
  (α ≪≫ β).conj_Aut f = β.conj_Aut (α.conj_Aut f) :=
by simp only [conj_Aut_apply, iso.trans_symm, iso.trans_assoc]

@[simp] lemma conj_Aut_mul (f g : Aut X) : α.conj_Aut (f * g) = α.conj_Aut f * α.conj_Aut g :=
α.conj_Aut.map_mul f g

@[simp] lemma conj_Aut_trans (f g : Aut X) : α.conj_Aut (f ≪≫ g) = α.conj_Aut f ≪≫ α.conj_Aut g :=
conj_Aut_mul α g f

@[simp] lemma conj_Aut_pow (f : Aut X) (n : ℕ) : α.conj_Aut (f^n) = (α.conj_Aut f)^n :=
α.conj_Aut.to_monoid_hom.map_pow f n

@[simp] lemma conj_Aut_zpow (f : Aut X) (n : ℤ) : α.conj_Aut (f^n) = (α.conj_Aut f)^n :=
α.conj_Aut.to_monoid_hom.map_zpow f n

end iso

namespace functor

universes v₁ u₁

variables {C : Type u} [category.{v} C] {D : Type u₁} [category.{v₁} D] (F : C ⥤ D)

lemma map_hom_congr {X Y X₁ Y₁ : C} (α : X ≅ X₁) (β : Y ≅ Y₁) (f : X ⟶ Y) :
  F.map (iso.hom_congr α β f) = iso.hom_congr (F.map_iso α) (F.map_iso β) (F.map f) :=
by simp

lemma map_conj {X Y : C} (α : X ≅ Y) (f : End X) :
  F.map (α.conj f) = (F.map_iso α).conj (F.map f) :=
map_hom_congr F α α f

lemma map_conj_Aut (F : C ⥤ D) {X Y : C} (α : X ≅ Y) (f : Aut X) :
  F.map_iso (α.conj_Aut f) = (F.map_iso α).conj_Aut (F.map_iso f) :=
by ext; simp only [map_iso_hom, iso.conj_Aut_hom, F.map_conj]
-- alternative proof: by simp only [iso.conj_Aut_apply, F.map_iso_trans, F.map_iso_symm]

end functor
end category_theory


import computability.regular_expressions
import group_theory.free_group
import computability.language
import dyck.basic
import old.extras
import bRMA
import permissible_paddings

open sum prod
open regular_expression
open list
open relation

universes u
variables {α : Type u}

def cst.minimum  (x : free_group α) (L : list (α × bool)):=
(∃ p : list (α × bool), list.is_prefix p L ∧ free_group.mk p = x) ∧
(∀ p s : list (α × bool), L = p ++ s ∧ free_group.mk p = x → (s = []) ∨ (∃ (a : α) (s' : list (α × bool)), s = (a, tt) :: s'))

section PROP14

theorem free_group_one_dyck_one_iff_prefix_pos_or_one {L : list (α × bool)} (H : free_group.mk L = 1) :
 dyck.mk L = 1 ↔ (∀ p, list.is_prefix p L → free_group.positive p ∨ free_group.mk p = 1) :=
begin
  split,
  intro h,
  rw dyck.free_group_prefix_pos_or_one_dyck_prefix_pos_or_one,
  exact dyck.dyck_one_prefix_pos_or_one h,
  intro h,
  have h₁ := dyck.free_group_prefix_pos_or_one_dyck_prefix_pos_or_one.mp h,
  have h₂ := dyck.free_group_suffix_neg_or_one_dyck_suffix_neg_or_one (free_group.one_prefix_pos_or_one_suffix_neg_or_one H h),
  rw dyck.dyck_one_iff,
  exact ⟨h₂, h₁⟩,
end

lemma prefix_pos_or_one_minimum_one {L : list (α × bool)} (H : free_group.mk L = 1):
(∀ p, list.is_prefix p L → free_group.positive p ∨ free_group.mk p = 1) → cst.minimum 1 L :=
begin
  intro h,
  rw cst.minimum,
  use L,
  split,
  exact list.prefix_rfl,
  exact H,

  rintros p s ⟨h₁, h₂⟩,
  specialize h,
  cases s,
  left,
  refl,

  specialize h (p ++ [s_hd]) _,
  use s_tl,
  simp,
  exact h₁.symm,

  induction h,
  right,
  rw free_group.positive at *,
  rcases h with ⟨L₁, hnil, hmk, hpos⟩,
  rw [← free_group.mul_mk, h₂, one_mul, free_group.red.exact] at hmk,
  rcases hmk with ⟨c, hmkl, hmkr⟩,
  rw free_group.red.singleton_iff at hmkl,
  rw hmkl at hmkr,
  have h₃ := free_group.red.sublist hmkr,
  simp at *,
  induction s_hd with a b,
  specialize hpos a b h₃,
  use a,
  simp,
  exact hpos,

  rw [← free_group.mul_mk, h₂, one_mul,
  free_group.one_eq_mk, free_group.red.exact] at h,
  rcases h with ⟨c, hl, hr⟩,
  rw free_group.red.singleton_iff at hl,
  rw [hl, free_group.red.nil_iff] at hr,
  simp at *,
  contradiction,
end

lemma prefix_pos_or_one_only_minimum_one {L : list (α × bool)} (H : free_group.mk L = 1):
(∀ p, list.is_prefix p L → free_group.positive p ∨ free_group.mk p = 1) → (¬∃ x, cst.minimum x L ∧ x ≠ 1) :=
begin
  intro h,
   assume h',
  rcases h' with ⟨x, hl, hr⟩,
  rw cst.minimum at *,
  cases hl with h₁ h₂,
  have h₃ := free_group.one_prefix_pos_or_one_suffix_neg_or_one H h,
  rcases h₁ with ⟨p, ⟨t, ht⟩, hp⟩,
  specialize h p (by use t; exact ht),
  cases h,
  {
    specialize h₃ t (by use p; exact ht),
    cases h₃,
    {
      have h₄ := free_group.negative_exists_prefix h₃,
      rcases h₄ with ⟨e, x, ⟨t', ht'⟩, he⟩,
      specialize h₂ (p ++ e) ((x, ff) :: t') _,
      split,
      subst_vars,
      simp,
      rw [← free_group.mul_mk, he, mul_one, hp],
      cases h₂,
      {
        contradiction,
      },
      {
        rcases h₂ with ⟨a, s', h₅⟩,
        simp at h₅,
        exact h₅,
      }
    },
    {
      rw [← ht, ← free_group.mul_mk, h₃, mul_one, hp] at H,
      contradiction,
    }
  },
  {
      rw hp at h,
      contradiction,
  },
end

lemma only_minimum_one_prefix_pos_or_one {L : list (α × bool)} (H : free_group.mk L = 1) :
(¬∃ x, cst.minimum x L ∧ x ≠ 1) →  (∀ p, list.is_prefix p L → free_group.positive p ∨ free_group.mk p = 1) :=
begin
  sorry,
end

theorem prefix_pos_or_one_iff_only_minimum_one {L : list (α × bool)} (H : free_group.mk L = 1):
(∀ p, list.is_prefix p L → free_group.positive p ∨ free_group.mk p = 1) ↔ (¬∃ x, cst.minimum x L ∧ x ≠ 1) :=
⟨prefix_pos_or_one_only_minimum_one H, only_minimum_one_prefix_pos_or_one H⟩

theorem dyck_one_iff_only_minimum_one {L : list (α × bool)} (H : free_group.mk L = 1):
dyck.mk L = 1 ↔ (¬∃ x, cst.minimum x L ∧ x ≠ 1) :=
begin
  rw free_group_one_dyck_one_iff_prefix_pos_or_one,
  exact prefix_pos_or_one_iff_only_minimum_one H,
  exact H,
end

end PROP14

section LEMMA_15

lemma dyck_append_cons_eq_one_exists_prefix_eq_one {α} {L L₁ : list (α × bool)} {x : α} :
dyck.mk (L ++ (x, tt) :: L₁) = 1 → ∃ e : list (α × bool), list.is_prefix (e ++ [(x, ff)]) L₁ ∧ dyck.mk e = 1 := sorry

lemma dyck.mk_append_eq_one_exists_padded_eq_one {L L₁ : list ((α ⊕ unit) × bool)} :
dyck.mk (L ++ L₁) = 1 →
∃ s t, (L₁ = s ++ t) ∧ (t = [] ∨ ∃ t' x, t = (x, ff) :: t') ∧
dyck.mk (L ++ (inr (), tt) :: s ++ (inr (), ff) :: t) = 1 :=
begin
  intro h,
  have h₁ := dyck.dyck_one_prefix_pos_or_one h,
  specialize h₁ L (by simp),
  cases h₁,
  {
    rcases h₁ with ⟨L', hnil, hmk, hpos⟩,
    rw [← dyck.mul_mk, hmk, dyck.mul_mk] at h,
    have h₂ := last_split hnil,
    rcases h₂ with ⟨L'', h₂⟩,
    generalize eq₁ : L'.last hnil = x,
    rw eq₁ at *,
    cases x with a b,
    cases b,
    {
      subst_vars,
      specialize hpos (a, ff) (by simp),
      contradiction,
    },
    {
      rw h₂ at h,
      simp at h,
      have h₃ := dyck_append_cons_eq_one_exists_prefix_eq_one h,
      rcases h₃ with ⟨e, ⟨t, ht⟩, he⟩,
      use e,
      use ((a, ff) :: t),
      split,
      simp at ht,
      exact ht.symm,
      split,
      right,
      use t,
      use a,
      rw ← list.singleton_append,
      repeat {rw ← dyck.mul_mk},
      rw he,
      rw mul_one,
      rw hmk,
      rw h₂,
      rw ← dyck.mul_mk,
      simp,
      subst_vars,
      have : dyck.mk (L'' ++ (a, tt) :: (e ++ [(a, ff)] ++ t)) = dyck.mk (L'' ++ (a, tt) :: (a, ff) :: t), {
        rw ← dyck.mul_mk,
        rw ← list.singleton_append,
        rw ← dyck.mul_mk,
        rw ← dyck.mul_mk,
        rw ← dyck.mul_mk,
        rw he,
        rw one_mul,
        simp,
      },
      rw this at h,
      clear this,
      have : L'' ++ (a, tt) :: (inr (), tt) :: (inr (), ff) :: (a, ff) :: t =
             L'' ++ [(a, tt)] ++ [(inr (), tt), (inr (), ff)] ++ (a, ff) :: t := by simp,
      rw this,
      rw ← dyck.mul_mk,
        rw ← dyck.mul_mk,
        rw ← dyck.mul_mk,
        rw dyck.mk_mul_inv,
        rw mul_one,
        simp,
        exact h,
    }
  },
  {
    rw ← dyck.mul_mk at h,
    rw h₁ at h,
    rw one_mul at h,
    use L₁,
    use ([]),
    split,
    simp,
    split,
    left,
    simp,
    rw ← dyck.mul_mk,
    rw ← dyck.mul_mk,
    rw h₁,
    rw one_mul,
    rw ← list.singleton_append,
    rw ← dyck.mul_mk,
    rw h,
    rw mul_one,
    simp,
    rw dyck.mk_mul_inv,
  }
end

end LEMMA_15

section PROP16

lemma free_group_drop_units {L : list ((α ⊕ unit) × bool)} :
free_group.mk L = 1 → free_group.mk (drop_units L) = 1 :=
begin
  intro h,
  rw free_group.mk_one_iff at h,
  apply h.head_induction_on,
  {
    rw drop_units,
    simp,
    rw free_group.one_eq_mk,
  },
  {
    intros a c h₁ h₂ h₃,
    induction h₁ with L₁ L₂ x b,
    rw ← free_group.red at *,
    cases x,
    rw drop_units,
    simp,
    rw [reduce_option_append,
    reduce_option_cons_of_some, reduce_option_cons_of_some,
    free_group.append_bnot_cons_eq, ← reduce_option_append],
    rw [drop_units, map_append] at h₃,
    exact h₃,
    rw drop_units,
    simp,
    rw drop_unit,
    rw drop_unit,
    rw [reduce_option_append,
    reduce_option_cons_of_none, reduce_option_cons_of_none, ← reduce_option_append],
    rw [drop_units, map_append] at h₃,
    exact h₃,
  },
end

lemma dyck_one_exists_padding_free_group_eq_one {L : list (α × bool)}:
dyck.mk L = 1 → ∃ L₁ : list ((α ⊕ unit) × bool), L₁ ∈ paddings L ∧ dyck.mk L₁ = 1 :=
begin
  intro h,
  rw dyck.mk_one_iff at h,
  apply h.head_induction_on,
  use ([]),
  split,
  exact paddings.nil_padding_nil ,
  rw dyck.one_eq_mk,
  intros a c h₁ h₂ h₃,
  induction h₁ with L₁ L₂ x,
  rcases h₃ with ⟨L', hpad, hmk⟩,
  have h₄ := paddings.split_paddings₁ hpad,
  rcases h₄ with ⟨L₃, L₄, h₄, h₅, h₆⟩,
  rw h₆ at hmk,
  have h₇ := dyck.mk_append_eq_one_exists_padded_eq_one hmk,
  rcases h₇ with ⟨s, t, h₇, h₈, h₉⟩,
  have hpad₁ : [(inl x, tt), (inr (), tt), (inr (), ff), (inl x, ff), (inr (), tt)] ∈ (pad_all [(x, tt), (x, ff)]).matches, {
      have hpad₁ : [(inl x, tt), (inr (), tt)] ∈ (pad_letter (x, tt)).matches, {
        rw pad_letter,
        simp,
        rw language.mem_mul,
        use ([(inl x, tt)]),
        use ([(inr (), tt)]),
        simp,
      },
      have hpad₂ : [(inr (), ff), (inl x, ff), (inr (), tt)] ∈ (pad_letter (x, ff)).matches, {
        rw pad_letter,
        simp,
        rw language.mem_mul,
        use ([(inr (), ff), (inl x, ff)]),
        use ([(inr (), tt)]),
        split,
        rw language.mem_mul,
        use ([(inr (), ff)]),
        use ([(inl x, ff)]),
        split,
        rw language.mem_star,
        use ([[(inr (), ff)]]),
        split,
        simp,
        intros y hy,
        simp at *,
        exact hy,
        simp,
        simp,
      },
      have hpad₃ := paddings.pad_all_append (paddings.pad_letter_to_pad_all hpad₁) (paddings.pad_letter_to_pad_all hpad₂),
      simp at hpad₃,
      exact hpad₃,
  },
  have hpad₂ := paddings.pad_all_append h₄ hpad₁,
  generalize ppad : (L₃ ++ (inl x, tt) :: (inr (), tt) :: (inr (), ff) ::
                           (inl x, ff) :: (inr (), tt) :: (s ++ (inr (), ff) :: t) = Lp),
  use Lp,
  cases h₈,
  subst_vars,
  simp at *,
  split,
  have hpad₃ := paddings.pad_all_append_paddings hpad₂ h₅,
  have hpad₄ := (paddings.paddings_append_neg hpad₃),
  simp at hpad₄,
  exact hpad₄,
  have : L₃ ++ (inl x, tt) :: (inr (), tt) :: (inr (), ff) :: (inl x, ff) :: (inr (), tt) :: (s ++ [(inr (), ff)]) =
         L₃ ++ [(inl x, tt)] ++ [(inr (), tt), (inr (), ff)] ++ [(inl x, ff)] ++ (inr (), tt) :: (s ++ [(inr (), ff)]) := by simp,
  rw this,
  clear this,
  repeat {rw ← dyck.mul_mk},
  rw [dyck.mk_mul_inv, mul_one],
  have : dyck.mk [(inl x, tt)] * dyck.mk [(inl x, ff)] = 1, {
    rw [dyck.mul_mk, list.singleton_append, dyck.mk_mul_inv],
  },
  assoc_rw this,
  rw [mul_one, dyck.mul_mk],
  subst_vars,
  exact h₉,

  rcases h₈ with ⟨t', x', ht'⟩,
  subst_vars,
  split,
  have hpad₃ := paddings.pad_append_neg_cons_is_padding h₅,
  have hpad₄ := paddings.pad_all_append_paddings hpad₂ hpad₃,
  simp at hpad₄,
  exact hpad₄,
  have : L₃ ++ (inl x, tt) :: (inr (), tt) :: (inr (), ff) :: (inl x, ff) :: (inr (), tt) :: (s ++ (inr (), ff) :: (x', ff) :: t') =
         L₃ ++ [(inl x, tt)] ++ [(inr (), tt), (inr (), ff)] ++ [(inl x, ff)] ++ (inr (), tt) :: (s ++ (inr (), ff) :: (x', ff) :: t') := by simp,
  rw this,
  clear this,
  repeat {rw ← dyck.mul_mk},
  rw [dyck.mk_mul_inv, mul_one],
  have : dyck.mk [(inl x, tt)] * dyck.mk [(inl x, ff)] = 1, {
    rw [dyck.mul_mk, list.singleton_append, dyck.mk_mul_inv],
  },
  assoc_rw this,
  rw [mul_one, dyck.mul_mk],
  subst_vars,
  simp at h₉,
  exact h₉,
end

lemma exists_padding_dyck_eq_one_exists_padding_free_group_eq_one {L : list (α × bool)}:
(∃ L₁ : list ((α ⊕ unit) × bool), L₁ ∈ paddings L ∧ dyck.mk L₁ = 1) → ∃ L₁ : list ((α ⊕ unit) × bool), L₁ ∈ paddings L ∧ free_group.mk L₁ = 1 :=
begin
  rintros ⟨L₁, hpad, hmk⟩,
  use L₁,
  split,
  exact hpad,
  exact dyck.mk_free_group hmk,
end

private lemma pad_all_of_no_one_suffix  {p : list (α × bool)} {p' : list ((α ⊕ unit) × bool)} {x : α} {b : bool}
(H : ¬ ∃ s, list.is_suffix s p ∧ s ≠ [] ∧ free_group.mk s = 1) (H' : free_group.mk p ≠ 1):
drop_units (p' ++ [(inl x, b)]) = p → ¬ ∃ s, list.is_suffix s (p' ++ [(inl x, b)]) ∧ s ≠ [] ∧ free_group.mk s = 1 :=
begin
  rintros h ⟨s, hs, hnil, hmk⟩,
  cases s,
  contradiction,
  have h₀ : p ≠ [], {
    assume this,
    rw [this, free_group.one_eq_mk] at H',
    contradiction },
  have h₁ : [(sum.inl x, b)] <:+ s_hd :: s_tl, {
    cases hs with t ht,
    rw list.append_eq_append_iff at ht,
    cases ht,
    {
      rcases ht with ⟨a', hl, hr⟩,
      rw list.cons_eq_append_iff at hr,
      cases hr,
      {
        cases hr with hrl hrr,
        simp at *,
        cases hrr,
        subst_vars,
      },
      {
        rcases hr with ⟨b', hrl, hrr⟩,
        subst_vars,
        use (s_hd :: b'),
        simp,
      }
    },
    {
      rcases ht with ⟨c', hl, hr⟩,
      rw list.singleton_eq_append_iff at *,
      cases hr,
      cases hr,
      subst_vars,
      rw hr_right,
      cases hr,
      contradiction,
    },
  },
  generalize eq₁ : s_hd :: s_tl = s,
  rw eq₁ at *,
  have h₃ : drop_units s <:+ drop_units (p' ++ [(inl x, b)]) := paddings.suffix_drop_units_suffix hs,
  have h₄ : drop_units s ≠ [], {
      cases h₁ with t ht,
      rw [← ht, drop_units],
      simp,
      rw [list.reduce_option_append, list.reduce_option_cons_of_some],
      simp, },
  have hmk' := free_group_drop_units hmk,
  simp at H,
  specialize H (drop_units s) _ _,
  rw ← h,
  exact h₃,
  exact h₄,
  contradiction
end

private lemma exists_padding_eq_one_dyck_eq_one_aux {L : list (α × bool)}:
(∃ L₁ : list ((α ⊕ unit) × bool), L₁ ∈ paddings L ∧ free_group.mk L₁ = 1) → ¬(dyck.mk L = 1) → false :=
begin
  rintros ⟨L₁, h₁, h₂⟩ h,
  cases L,
  contradiction,
  have h₃ := paddings.paddings_drop_units_eq _ h₁,
  have h₄ := free_group_drop_units h₂,
  rw h₃ at h₄,
  have h₅ := dyck_one_iff_only_minimum_one h₄,
  rw h₅ at h,
  push_neg at h,
  rcases h with ⟨x, h₆, h₇⟩,
  rw cst.minimum at h₆,
  cases h₆ with h₆ h₈,
  cases h₆ with p h₆,
  have h_min_prefix := list.min_prefix h₆.1 h₆.2,
  rcases h_min_prefix with ⟨p', hp', heq, hmin⟩,
  have h_no_one_suffix : ¬ ∃ s, list.is_suffix s p' ∧ s ≠ [] ∧ free_group.mk s = 1, {
    assume h',
    rcases h' with ⟨s, ⟨t, ht⟩, hnil, hmk⟩,
    specialize hmin t _ _,
    {
      cases hp' with t' ht',
      use s ++ t',
      rw [← ht', ← ht, list.append_assoc],
    },
    {
      rw [← heq, ← ht, ← free_group.mul_mk, hmk, mul_one],
    },
    cases s,
    contradiction,
    rw ← ht at hmin,
    simp at hmin,
    exact hmin,
  },
  cases hp' with t ht,
  rw ← ht at *,
  have hsplit := paddings.split_paddings₁ h₁,
  rcases hsplit with ⟨p₁, t₁, hp₁, ht₁, heq₁⟩,
  have hpad_end := paddings.pad_all_end_letter _ hp₁,
  rcases hpad_end with ⟨p₁', x' , b, hp₁'⟩,
  rw hp₁' at heq₁,
  have h_drop_units : drop_units (p₁' ++ [(inl x', b)]) = p', {
    have := paddings.pad_all_drop_units_eq _ hp₁,
    rw [hp₁', drop_units] at this,
    simp at this,
    rw list.reduce_option_append at this,
    simp at this,
    rw drop_units,
    simp,
    rw list.reduce_option_append,
    simp,
    exact this,
    {
      assume this,
      rw this at heq,
      rw ← heq at h₇,
      rw free_group.one_eq_mk at h₇,
      contradiction,
    },
  },
  have h₁_no_one_suffix := pad_all_of_no_one_suffix h_no_one_suffix _ h_drop_units,
  have heq₂ : L₁ = (p₁' ++ [(inl x', b)]) ++ (inr (), tt) :: t₁ := by {simp at *, rw heq₁},
  rw heq₂ at h₂,
  have h_suf_pref := free_group.append_cons_one_exists_suffix_or_prefix_eq_one h₂,
  cases h_suf_pref,
  {
    rcases h_suf_pref with ⟨e, ⟨t₃, ht₃⟩, he⟩,
    have : e = [], {
      cases e,
      refl,
      simp at h₁_no_one_suffix,
      specialize h₁_no_one_suffix (e_hd :: e_tl) _ _,
      use (t₃ ++ [(inr (), ff)]),
      simp,
      simp at ht₃,
      exact ht₃,
      exact list.cons_ne_nil e_hd e_tl,
      contradiction,
    },
    rw this at *,
    simp at ht₃,
    have := list.append_singleton_eq_append_singleton ht₃,
    simp at this,
    contradiction,
  },
  {
    rcases h_suf_pref with ⟨e, ⟨t₃, ht₃⟩, he⟩,
    subst_vars,
    simp at *,
    have : p₁' ++ (inl x', b) :: (inr (), tt) :: (e ++ (inr (), ff) :: t₃) =
           p₁' ++ (inl x', b) :: (inr (), tt) :: e  ++ (inr (), ff) :: t₃ := by simp,
    rw this at *,
    have h_nil_or_neg := paddings.pad_append_neg_cons_drop_units_nil_or_exists h₁,
    cases h_nil_or_neg,
    {
      rw ← h₃ at h₄,
      have heq₃ : p₁' ++ (inl x', b) :: (inr (), tt) :: e ++ (inr (), ff) :: t₃ =
                  (p₁' ++ (inl x', b) :: (inr (), tt) :: e ++ [(inr (), ff)]) ++ t₃ := by simp,
      rw heq₃ at h₄,
      rw drop_units at h₄,
      simp at h₄,
      repeat {
        rw list.reduce_option_append at h₄,
        simp at h₄ },
      repeat { rw ← drop_units at h₄ },
      rw h_nil_or_neg at h₄,
      simp at h₄,
      have he_drop := free_group_drop_units he,
      rw [← free_group.mul_mk, ← list.singleton_append,
          ← free_group.mul_mk, he_drop, mul_one, free_group.mul_mk] at h₄,
      rw drop_units at h₇,
      simp at h₇,
      rw list.reduce_option_append at h₇,
      simp at h₇,
      rw ← drop_units at h₇,
      contradiction,
    },
    {
      rcases h_nil_or_neg with ⟨L₂, x₁', hneg⟩,
      specialize h₈ (drop_units (p₁' ++ (inl x', b) :: (inr (), tt) :: e ++ [(inr (), ff)])) (drop_units t₃) _ _,
      rw ← h₃,
      simp,
      repeat {rw drop_units} ,
      rw ← list.reduce_option_append,
      simp,
      simp,
      repeat {rw list.reduce_option_append, simp},
      repeat {rw ← drop_units},
      have he_drop := free_group_drop_units he,
      rw [← free_group.mul_mk, ← list.singleton_append,
          ← free_group.mul_mk, he_drop, mul_one, free_group.mul_mk],
      cases h₈,
      rw h₈ at *,
      simp at hneg,
      contradiction,
      rcases h₈ with ⟨a, s', h₈⟩,
      rw h₈ at *,
      simp at hneg,
      contradiction,
    },
  },
  subst_vars,
  exact h₇,
  assume this,
  rw this at heq,
  rw ← heq at h₇,
  rw free_group.one_eq_mk at h₇,
  contradiction,
  simp,
end

lemma exists_padding_eq_one_dyck_eq_one {L : list (α × bool)}:
(∃ L₁ : list ((α ⊕ unit) × bool), L₁ ∈ paddings L ∧ free_group.mk L₁ = 1) → (dyck.mk L = 1) :=
begin
  intro h,
  by_contradiction h',
  exact exists_padding_eq_one_dyck_eq_one_aux h h',
end

end PROP16


import number_theory.bernoulli

--OUTPUT 1
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  -- We apply strong induction on $n$. So, for all $m < d$, we have $B_{m} (1 + x) = B_{m} (x) + m x^{m - 1}$ and we want to show that $$B_{d} (1 + x) = B_{d} (x) + d x^{d - 1}$$
  have h1 : ∀ (m : ℕ) (h : m < n), (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from
    assume (m : ℕ) (h : m < n),
    begin
      induction m with d hd,
      -- base case
      show (polynomial.bernoulli 0).eval (1 + x) = (polynomial.bernoulli 0).eval x + 0 * x^(0 - 1), from by {
        rw polynomial.bernoulli,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C,
        rw polynomial.eval_C
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  -- We apply strong induction on $n$. So, for all $m < d$, we have $B_{m} (1 + x) = B_{m} (x) + m x^{m - 1}$ and we want to show that $$B_{d} (1 + x) = B_{d} (x) + d x^{d - 1}$$
  have h1 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from
    assume (m : ℕ) (h : m < n),
    begin
      -- Multiplying both sides by $d + 1$, and using the fact that, for all $l \in \mathbb{N}$, $\sum_{k = 0}^{l} {l + 1 \choose k} B_k = (l + 1) X^l$ (where $B_k$ is the $k$-th Bernoulli number), we get that
      -- $$ (d + 1) (1 + x)^d - (d + 1) x^d = \sum_{l = 0}^{d} {d + 1 \choose l} l x^{l - 1} $$
      have h2 : (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from
        begin
          -- Multiplying both sides by $d + 1$, and using the fact that, for all $l \in \mathbb{N}$, $\sum_{k = 0}^{l} {l + 1 \choose k} B_k = (l + 1) X^l$ (where $B_k$ is the $k$-th Bernoulli number), we get that
          -- $$ (d + 1) (1 + x)^d - (d + 1) x^d = \sum_{l = 0}^{d} {d + 1 \choose l} l x^{l - 1} $$
          have h3 : (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from
            begin
              -- Multiplying both sides by $d + 1$, and using the fact that, for all $l \in \mathbb{N}$, $\sum_{k = 0}^{l} {l + 1 \choose k} B_k = (l + 1) X^l$ (where $B_k$ is the $k$-th Bernoulli number), we get that
              -- $$ (d + 1) (1 + x)^d - (d + 1) x^d = \sum_{l = 0}^{d} {d + 1 \choose l} l x^{l - 1} $$
              have h4 : (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from
                begin
                  -- Multiplying both sides by $d + 1$, and using the fact that, for all $l \in \mathbb{N}$, $\sum_{k = 0}^{l} {l + 1 \choose k} B_k = (l + 1) X^l$ (where $B_k$ is the $k$-th Bernoulli number), we get that
                  -- $$ (d + 1) (1 + x)^d - (d + 1) x^d = \sum_{l = 0}^{d} {d + 1 \choose l} l x^{l - 1} $$
                  have h5 : (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from
                    begin
                      -- Multiplying both sides by $d + 1$, and using the fact that, for all $l \in \mathbb{N}$, $\sum_{k = 0}^{l} {l + 1 \choose k} B_k = (l + 1) X^l$ (where $B_k$ is the $k$-th Bernoulli number), we get that
                      -- $$ (d + 1) (1 + x)^d - (d + 1) x^d = \sum_{l = 0}^{d} {d + 1 \choose l} l x^{l - 1} $$
                      have h6 : (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from
                        begin
                          -- Multiplying both sides by $d + 1$, and using the fact that, for all $l \in \mathbb{N}$, $\sum_{k = 0}^{l} {l + 1 \choose k} B_k = (l + 1) X^l$ (where $B_k$ is the $k$-th Bernoulli number), we get that
                          -- $$ (d + 1) (1 + x)^d - (d + 1) x^d = \sum_{l = 0}^{d} {d + 1 \choose l} l x^{l - 1} $$
                          have h7 : (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from
                            begin
                              -- Multiplying both sides by $d + 1$, and using the fact that, for all $l \in \mathbb{N}$, $\sum_{k = 0}^{l} {l + 1 \choose k} B_k = (l + 1) X^l$ (where $B_k$ is the $k$-th Bernoulli number), we get that
                              -- $$ (d + 1) (1 + x)^d - (d + 1) x^d = \sum_{l = 0}^{d} {d + 1 \choose l} l x^{l - 1} $$
                              have h8 : (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from
                                begin
                                  -- Multiplying both sides by $d + 1$, and using the fact that, for all $l \in \mathbb{N}$, $\sum_{k = 0}^{l} {l + 1 \choose k} B_k = (l + 1) X^l$ (where $B_k$ is the $k$-th Bernoulli number), we get that
                                  -- $$ (d + 1) (1 + x)^d - (d + 1) x^d = \sum_{l = 0}^{d} {d + 1 \choose l} l x^{l - 1} $$
                                  have h9 : (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from
                                    begin
                                      -- Multiplying both sides by $d + 1$, and using the fact that, for all $l \in \mathbb{N}$, $\sum_{k = 0}^{l} {l + 1 \choose k} B_k = (l + 1) X^l$ (where $B_k$ is the $k$-th Bernoulli number), we get that
                                      -- $$ (d + 1) (1 + x)^d - (d + 1) x^d = \sum_{l = 0}^{d} {d + 1 \choose l} l x^{l - 1} $$
                                      have h10 : (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from
                                        begin
                                          -- Multiplying both sides by $d + 1$, and using the fact that, for all $l \in \mathbb{N}$, $\sum_{k = 0}^{l} {l + 1 \choose k} B_k = (l + 1) X^l$ (where $B_k$ is the $k$-th Bernoulli number), we get that
                                          -- $$ (d + 1) (1 + x)^d - (d +
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  -- We apply strong induction on $n$. So, for all $m < d$, we have $B_{m} (1 + x) = B_{m} (x) + m x^{m - 1}$ and we want to show that $$B_{d} (1 + x) = B_{d} (x) + d x^{d - 1}$$
  induction n with d hd,
  { -- base case
    show (polynomial.bernoulli 0).eval (1 + x) = (polynomial.bernoulli 0).eval x + 0 * x^(0 - 1), from by {
      rw polynomial.bernoulli,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_X,
      rw polynomial.eval_X,
      rw polynomial.eval_add,
      rw polynomial.eval_add,
      rw polynomial.eval_mul,
      rw polynomial.eval_mul,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_X,
      rw polynomial.eval_X,
      rw polynomial.eval_add,
      rw polynomial.eval_add,
      rw polynomial.eval_mul,
      rw polynomial.eval_mul,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_X,
      rw polynomial.eval_X,
      rw polynomial.eval_add,
      rw polynomial.eval_add,
      rw polynomial.eval_mul,
      rw polynomial.eval_mul,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_X,
      rw polynomial.eval_X,
      rw polynomial.eval_add,
      rw polynomial.eval_add,
      rw polynomial.eval_mul,
      rw polynomial.eval_mul,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_X,
      rw polynomial.eval_X,
      rw polynomial.eval_add,
      rw polynomial.eval_add,
      rw polynomial.eval_mul,
      rw polynomial.eval_mul,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_X,
      rw polynomial.eval_X,
      rw polynomial.eval_add,
      rw polynomial.eval_add,
      rw polynomial.eval_mul,
      rw polynomial.eval_mul,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_X,
      rw polynomial.eval_X,
      rw polynomial.eval_add,
      rw polynomial.eval_add,
      rw polynomial.eval_mul,
      rw polynomial.eval_mul,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_X,
      rw polynomial.eval_X,
      rw polynomial.eval_add,
      rw polynomial.eval_add,
      rw polynomial.eval_mul,
      rw polynomial.eval_mul,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_X,
      rw polynomial.eval_X,
      rw polynomial.eval_add,
      rw polynomial.eval_add,
      rw polynomial.eval_mul,
      rw polynomial.eval_mul,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_X,
      rw polynomial.eval_X,
      rw polynomial.eval_add,
      rw polynomial.eval_add,
      rw polynomial.eval_mul,
      rw polynomial.eval_mul,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_X,
      rw polynomial.eval_X,
      rw polynomial.eval_add,
      rw polynomial.eval_add,
      rw polynomial.eval_mul,
      rw polynomial.eval_mul,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_X,
      rw polynomial.eval_X,
      rw polynomial.eval_add,
      rw polynomial.eval_add,
      rw polynomial.eval_mul,
      rw polynomial.eval_mul,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_X,
      rw polynomial.eval_X,
      rw polynomial.eval_add,
      rw polynomial.eval_add,
      rw polynomial.eval_mul,
      rw polynomial.eval_mul,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_X,
      rw polynomial.eval_X,
      rw polynomial.eval_add,
      rw polynomial.eval_add,
      rw polynomial.eval_mul,
      rw polynomial.eval_mul,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_X,
      rw polynomial.eval_X,
      rw polynomial.eval_add,
      rw polynomial.eval_add,
      rw polynomial.eval_mul,
      rw polynomial.eval_mul,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_X,
      rw polynomial.eval_X,
      rw polynomial.eval_add,
      rw polynomial.eval_add,
      rw polynomial.eval_mul,
      rw polynomial.eval_mul,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_X,
      rw polynomial.eval_X,
      rw polynomial.eval_add,
      rw polynomial.eval_add,
      rw polynomial.eval_mul,
      rw polynomial.eval_mul,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_X,
      rw polynomial.eval_X,
      rw polynomial.eval_add,
      rw polynomial.eval_add,
      rw polynomial.eval_mul,
      rw polynomial.eval_mul,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_X,
      rw polynomial.eval_X,
      rw polynomial.eval_add,
      rw polynomial.eval_add,
      rw polynomial.
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
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  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},
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by apply set.inter_subset_left,
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by {apply set.subset.trans h2 h1.left},
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  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
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by rw sq
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by rw add_mul
  -- applying the above property further gives:
  ... = 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}
  -- rearranging the terms using commutativity and adding gives:
  ... = 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
  -- Group has Latin Square Property
  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, },

  -- Setting $b = a$, this becomes:
  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,

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  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`
Bernoulli polynomial evaluation
Given a natural number $n$ and a rational $x$, let $B_n (x)$ denote the $n$-th Bernoulli polynomial evaluated at $x$. Then, $$B_n (1 + x) = B_n (x) + n x^{n - 1}$$
`proof`
We apply strong induction on $n$. So, for all $m < d$, we have $B_{m} (1 + x) = B_{m} (x) + m x^{m - 1}$ and we want to show that $$B_{d} (1 + x) = B_{d} (x) + d x^{d - 1}$$
Multiplying both sides by $d + 1$, and using the fact that, for all $l \in \mathbb{N}$, $\sum_{k = 0}^{l} {l + 1 \choose k} B_k = (l + 1) X^l$ (where $B_k$ is the $k$-th Bernoulli number), we get that
$$ (d + 1) (1 + x)^d - (d + 1) x^d = \sum_{l = 0}^{d} {d + 1 \choose l} l x^{l - 1} $$
The conclusion then follows easily.

QED

-/
theorem  bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
FEW SHOT PROMPTS TO CODEX(END)-/


/-
Copyright (c) 2015 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Robert Y. Lewis
-/
import algebra.divisibility.basic
import algebra.group.commute
import algebra.group.type_tags

/-!
# Power operations on monoids and groups

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

The power operation on monoids and groups.
We separate this from group, because it depends on `ℕ`,
which in turn depends on other parts of algebra.

This module contains lemmas about `a ^ n` and `n • a`, where `n : ℕ` or `n : ℤ`.
Further lemmas can be found in `algebra.group_power.lemmas`.

The analogous results for groups with zero can be found in `algebra.group_with_zero.power`.

## Notation

- `a ^ n` is used as notation for `has_pow.pow a n`; in this file `n : ℕ` or `n : ℤ`.
- `n • a` is used as notation for `has_smul.smul n a`; in this file `n : ℕ` or `n : ℤ`.

## Implementation details

We adopt the convention that `0^0 = 1`.
-/

universes u v w x y z u₁ u₂

variables {α : Type*} {M : Type u} {N : Type v} {G : Type w} {H : Type x} {A : Type y} {B : Type z}
  {R : Type u₁} {S : Type u₂}

/-!
### Commutativity

First we prove some facts about `semiconj_by` and `commute`. They do not require any theory about
`pow` and/or `nsmul` and will be useful later in this file.
-/

section has_pow
variables [has_pow M ℕ]

@[simp] lemma pow_ite (P : Prop) [decidable P] (a : M) (b c : ℕ) :
  a ^ (if P then b else c) = if P then a ^ b else a ^ c :=
by split_ifs; refl

@[simp] lemma ite_pow (P : Prop) [decidable P] (a b : M) (c : ℕ) :
  (if P then a else b) ^ c = if P then a ^ c else b ^ c :=
by split_ifs; refl

end has_pow

section monoid
variables [monoid M] [monoid N] [add_monoid A] [add_monoid B]

@[simp, to_additive one_nsmul]
theorem pow_one (a : M) : a^1 = a :=
by rw [pow_succ, pow_zero, mul_one]

/-- Note that most of the lemmas about powers of two refer to it as `sq`. -/
@[to_additive two_nsmul, nolint to_additive_doc]
theorem pow_two (a : M) : a^2 = a * a :=
by rw [pow_succ, pow_one]

alias pow_two ← sq

theorem pow_three' (a : M) : a^3 = a * a * a := by rw [pow_succ', pow_two]

theorem pow_three (a : M) : a^3 = a * (a * a) := by rw [pow_succ, pow_two]

@[to_additive]
theorem pow_mul_comm' (a : M) (n : ℕ) : a^n * a = a * a^n := commute.pow_self a n

@[to_additive add_nsmul]
theorem pow_add (a : M) (m n : ℕ) : a^(m + n) = a^m * a^n :=
by induction n with n ih; [rw [nat.add_zero, pow_zero, mul_one],
  rw [pow_succ', ← mul_assoc, ← ih, ← pow_succ', nat.add_assoc]]

@[simp] lemma pow_boole (P : Prop) [decidable P] (a : M) :
  a ^ (if P then 1 else 0) = if P then a else 1 :=
by simp

-- the attributes are intentionally out of order. `smul_zero` proves `nsmul_zero`.
@[to_additive nsmul_zero, simp] theorem one_pow (n : ℕ) : (1 : M)^n = 1 :=
by induction n with n ih; [exact pow_zero _, rw [pow_succ, ih, one_mul]]

@[to_additive mul_nsmul']
theorem pow_mul (a : M) (m n : ℕ) : a^(m * n) = (a^m)^n :=
begin
  induction n with n ih,
  { rw [nat.mul_zero, pow_zero, pow_zero] },
  { rw [nat.mul_succ, pow_add, pow_succ', ih] }
end

@[to_additive nsmul_left_comm]
lemma pow_right_comm (a : M) (m n : ℕ) : (a^m)^n = (a^n)^m :=
by rw [←pow_mul, nat.mul_comm, pow_mul]

@[to_additive mul_nsmul]
theorem pow_mul' (a : M) (m n : ℕ) : a^(m * n) = (a^n)^m :=
by rw [nat.mul_comm, pow_mul]

@[to_additive nsmul_add_sub_nsmul]
theorem pow_mul_pow_sub (a : M) {m n : ℕ} (h : m ≤ n) : a ^ m * a ^ (n - m) = a ^ n :=
by rw [←pow_add, nat.add_comm, nat.sub_add_cancel h]

@[to_additive sub_nsmul_nsmul_add]
theorem pow_sub_mul_pow (a : M) {m n : ℕ} (h : m ≤ n) : a ^ (n - m) * a ^ m = a ^ n :=
by rw [←pow_add, nat.sub_add_cancel h]

/-- If `x ^ n = 1`, then `x ^ m` is the same as `x ^ (m % n)` -/
@[to_additive nsmul_eq_mod_nsmul "If `n • x = 0`, then `m • x` is the same as `(m % n) • x`"]
lemma pow_eq_pow_mod {M : Type*} [monoid M] {x : M} (m : ℕ) {n : ℕ} (h : x ^ n = 1) :
  x ^ m = x ^ (m % n) :=
begin
  have t := congr_arg (λ a, x ^ a) ((nat.add_comm _ _).trans (nat.mod_add_div _ _)).symm,
  dsimp at t,
  rw [t, pow_add, pow_mul, h, one_pow, one_mul],
end

@[to_additive bit0_nsmul]
theorem pow_bit0 (a : M) (n : ℕ) : a ^ bit0 n = a^n * a^n := pow_add _ _ _

@[to_additive bit1_nsmul]
theorem pow_bit1 (a : M) (n : ℕ) : a ^ bit1 n = a^n * a^n * a :=
by rw [bit1, pow_succ', pow_bit0]

@[to_additive]
theorem pow_mul_comm (a : M) (m n : ℕ) : a^m * a^n = a^n * a^m :=
commute.pow_pow_self a m n

@[to_additive]
lemma commute.mul_pow {a b : M} (h : commute a b) (n : ℕ) : (a * b) ^ n = a ^ n * b ^ n :=
nat.rec_on n (by simp only [pow_zero, one_mul]) $ λ n ihn,
by simp only [pow_succ, ihn, ← mul_assoc, (h.pow_left n).right_comm]

@[to_additive bit0_nsmul']
theorem pow_bit0' (a : M) (n : ℕ) : a ^ bit0 n = (a * a) ^ n :=
by rw [pow_bit0, (commute.refl a).mul_pow]

@[to_additive bit1_nsmul']
theorem pow_bit1' (a : M) (n : ℕ) : a ^ bit1 n = (a * a) ^ n * a :=
by rw [bit1, pow_succ', pow_bit0']

@[to_additive]
lemma pow_mul_pow_eq_one {a b : M} (n : ℕ) (h : a * b = 1) :
  a ^ n * b ^ n = 1 :=
begin
  induction n with n hn,
  { simp },
  { calc a ^ n.succ * b ^ n.succ = a ^ n * a * (b * b ^ n) : by rw [pow_succ', pow_succ]
    ... = a ^ n * (a * b) * b ^ n : by simp only [mul_assoc]
    ... = 1 : by simp [h, hn] }
end

lemma dvd_pow {x y : M} (hxy : x ∣ y) :
  ∀ {n : ℕ} (hn : n ≠ 0), x ∣ y^n
| 0       hn := (hn rfl).elim
| (n + 1) hn := by { rw pow_succ, exact hxy.mul_right _ }

alias dvd_pow ← has_dvd.dvd.pow

lemma dvd_pow_self (a : M) {n : ℕ} (hn : n ≠ 0) : a ∣ a^n :=
dvd_rfl.pow hn

end monoid

/-!
### Commutative (additive) monoid
-/

section comm_monoid
variables [comm_monoid M] [add_comm_monoid A]

@[to_additive nsmul_add]
theorem mul_pow (a b : M) (n : ℕ) : (a * b)^n = a^n * b^n :=
(commute.all a b).mul_pow n

/-- The `n`th power map on a commutative monoid for a natural `n`, considered as a morphism of
monoids. -/
@[to_additive "Multiplication by a natural `n` on a commutative additive
monoid, considered as a morphism of additive monoids.", simps]
def pow_monoid_hom (n : ℕ) : M →* M :=
{ to_fun := (^ n),
  map_one' := one_pow _,
  map_mul' := λ a b, mul_pow a b n }

-- the below line causes the linter to complain :-/
-- attribute [simps] pow_monoid_hom nsmul_add_monoid_hom

end comm_monoid

section div_inv_monoid
variable [div_inv_monoid G]

open int

@[simp, to_additive one_zsmul]
theorem zpow_one (a : G) : a ^ (1:ℤ) = a :=
by { convert pow_one a using 1, exact zpow_coe_nat a 1 }

@[to_additive two_zsmul]
theorem zpow_two (a : G) : a ^ (2 : ℤ) = a * a :=
by { convert pow_two a using 1, exact zpow_coe_nat a 2 }

@[to_additive neg_one_zsmul]
theorem zpow_neg_one (x : G) : x ^ (-1:ℤ) = x⁻¹ :=
(zpow_neg_succ_of_nat x 0).trans $ congr_arg has_inv.inv (pow_one x)

@[to_additive]
theorem zpow_neg_coe_of_pos (a : G) : ∀ {n : ℕ}, 0 < n → a ^ -(n:ℤ) = (a ^ n)⁻¹
| (n+1) _ := zpow_neg_succ_of_nat _ _

end div_inv_monoid

section division_monoid
variables [division_monoid α] {a b : α}

@[simp, to_additive] lemma inv_pow (a : α) : ∀ n : ℕ, (a⁻¹) ^ n = (a ^ n)⁻¹
| 0       := by rw [pow_zero, pow_zero, inv_one]
| (n + 1) := by rw [pow_succ', pow_succ, inv_pow, mul_inv_rev]

-- the attributes are intentionally out of order. `smul_zero` proves `zsmul_zero`.
@[to_additive zsmul_zero, simp] lemma one_zpow : ∀ (n : ℤ), (1 : α) ^ n = 1
| (n : ℕ) := by rw [zpow_coe_nat, one_pow]
| -[1+ n] := by rw [zpow_neg_succ_of_nat, one_pow, inv_one]

@[simp, to_additive neg_zsmul] lemma zpow_neg (a : α) : ∀ (n : ℤ), a ^ -n = (a ^ n)⁻¹
| (n+1:ℕ) := div_inv_monoid.zpow_neg' _ _
| 0       := by { change a ^ (0 : ℤ) = (a ^ (0 : ℤ))⁻¹, simp }
| -[1+ n] := by { rw [zpow_neg_succ_of_nat, inv_inv, ← zpow_coe_nat], refl }

@[to_additive neg_one_zsmul_add]
lemma mul_zpow_neg_one (a b : α) : (a * b) ^ (-1 : ℤ) = b ^ (-1 : ℤ) * a ^ (-1 : ℤ) :=
by simp_rw [zpow_neg_one, mul_inv_rev]

@[to_additive zsmul_neg] lemma inv_zpow (a : α) : ∀ n : ℤ, a⁻¹ ^ n = (a ^ n)⁻¹
| (n : ℕ) := by rw [zpow_coe_nat, zpow_coe_nat, inv_pow]
| -[1+ n] := by rw [zpow_neg_succ_of_nat, zpow_neg_succ_of_nat, inv_pow]

@[simp, to_additive zsmul_neg']
lemma inv_zpow' (a : α) (n : ℤ) : a⁻¹ ^ n = a ^ (-n) := by rw [inv_zpow, zpow_neg]

@[to_additive nsmul_zero_sub]
lemma one_div_pow (a : α) (n : ℕ) : (1 / a) ^ n = 1 / a ^ n := by simp_rw [one_div, inv_pow]

@[to_additive zsmul_zero_sub]
lemma one_div_zpow (a : α) (n : ℤ) :  (1 / a) ^ n = 1 / a ^ n := by simp_rw [one_div, inv_zpow]

@[to_additive add_commute.zsmul_add]
protected lemma commute.mul_zpow (h : commute a b) : ∀ (i : ℤ), (a * b) ^ i = a ^ i * b ^ i
| (n : ℕ) := by simp [h.mul_pow n]
| -[1+n]  := by simp [h.mul_pow, (h.pow_pow _ _).eq, mul_inv_rev]

end division_monoid

section division_comm_monoid
variables [division_comm_monoid α]

@[to_additive zsmul_add] lemma mul_zpow (a b : α) : ∀ n : ℤ, (a * b) ^ n = a ^ n * b ^ n :=
(commute.all a b).mul_zpow

@[simp, to_additive nsmul_sub] lemma div_pow (a b : α) (n : ℕ) : (a / b) ^ n = a ^ n / b ^ n :=
by simp only [div_eq_mul_inv, mul_pow, inv_pow]

@[simp, to_additive zsmul_sub] lemma div_zpow (a b : α) (n : ℤ) : (a / b) ^ n = a ^ n / b ^ n :=
by simp only [div_eq_mul_inv, mul_zpow, inv_zpow]

/-- The `n`-th power map (for an integer `n`) on a commutative group, considered as a group
homomorphism. -/
@[to_additive "Multiplication by an integer `n` on a commutative additive group, considered as an
additive group homomorphism.", simps]
def zpow_group_hom (n : ℤ) : α →* α :=
{ to_fun := (^ n),
  map_one' := one_zpow n,
  map_mul' := λ a b, mul_zpow a b n }

end division_comm_monoid

section group
variables [group G] [group H] [add_group A] [add_group B]

@[to_additive sub_nsmul] lemma pow_sub (a : G) {m n : ℕ} (h : n ≤ m) : a^(m - n) = a^m * (a^n)⁻¹ :=
eq_mul_inv_of_mul_eq $ by rw [←pow_add, nat.sub_add_cancel h]

@[to_additive] lemma pow_inv_comm (a : G) (m n : ℕ) : (a⁻¹)^m * a^n = a^n * (a⁻¹)^m :=
(commute.refl a).inv_left.pow_pow _ _

@[to_additive sub_nsmul_neg]
lemma inv_pow_sub (a : G) {m n : ℕ} (h : n ≤ m) : a⁻¹^(m - n) = (a^m)⁻¹ * a^n :=
by rw [pow_sub a⁻¹ h, inv_pow, inv_pow, inv_inv]

end group

lemma pow_dvd_pow [monoid R] (a : R) {m n : ℕ} (h : m ≤ n) :
  a ^ m ∣ a ^ n := ⟨a ^ (n - m), by rw [← pow_add, nat.add_comm, nat.sub_add_cancel h]⟩

lemma of_add_nsmul [add_monoid A] (x : A) (n : ℕ) :
  multiplicative.of_add (n • x) = (multiplicative.of_add x)^n := rfl

lemma of_add_zsmul [sub_neg_monoid A] (x : A) (n : ℤ) :
  multiplicative.of_add (n • x) = (multiplicative.of_add x)^n := rfl

lemma of_mul_pow [monoid A] (x : A) (n : ℕ) :
  additive.of_mul (x ^ n) = n • (additive.of_mul x) := rfl

lemma of_mul_zpow [div_inv_monoid G] (x : G) (n : ℤ) :
  additive.of_mul (x ^ n) = n • additive.of_mul x :=
rfl

@[simp, to_additive]
lemma semiconj_by.zpow_right [group G] {a x y : G} (h : semiconj_by a x y) :
  ∀ m : ℤ, semiconj_by a (x^m) (y^m)
| (n : ℕ) := by simp [zpow_coe_nat, h.pow_right n]
| -[1+n] := by simp [(h.pow_right n.succ).inv_right]

namespace commute

variables [group G] {a b : G}

@[simp, to_additive] lemma zpow_right (h : commute a b) (m : ℤ) : commute a (b^m) := h.zpow_right m

@[simp, to_additive] lemma zpow_left (h : commute a b) (m : ℤ) : commute (a^m) b :=
(h.symm.zpow_right m).symm

@[to_additive]
lemma zpow_zpow (h : commute a b) (m n : ℤ) : commute (a^m) (b^n) := (h.zpow_left m).zpow_right n

variables (a) (m n : ℤ)

@[simp, to_additive] lemma self_zpow : commute a (a ^ n) := (commute.refl a).zpow_right n
@[simp, to_additive] lemma zpow_self : commute (a ^ n) a := (commute.refl a).zpow_left n
@[simp, to_additive] lemma zpow_zpow_self : commute (a ^ m) (a ^ n) :=
(commute.refl a).zpow_zpow m n

end commute


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Violeta Hernández Palacios, Grayson Burton, Floris van Doorn

! This file was ported from Lean 3 source module order.cover
! leanprover-community/mathlib commit 207cfac9fcd06138865b5d04f7091e46d9320432
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Set.Intervals.OrdConnected
import Mathlib.Order.Antisymmetrization

/-!
# The covering relation

This file defines the covering relation in an order. `b` is said to cover `a` if `a < b` and there
is no element in between. We say that `b` weakly covers `a` if `a ≤ b` and there is no element
between `a` and `b`. In a partial order this is equivalent to `a ⋖ b ∨ a = b`, in a preorder this
is equivalent to `a ⋖ b ∨ (a ≤ b ∧ b ≤ a)`

## Notation

* `a ⋖ b` means that `b` covers `a`.
* `a ⩿ b` means that `b` weakly covers `a`.
-/

open Set OrderDual

variable {α β : Type _}

section WeaklyCovers

section Preorder

variable [Preorder α] [Preorder β] {a b c : α}

/-- `Wcovby a b` means that `a = b` or `b` covers `a`.
This means that `a ≤ b` and there is no element in between.
-/
def Wcovby (a b : α) : Prop :=
  a ≤ b ∧ ∀ ⦃c⦄, a < c → ¬c < b
#align wcovby Wcovby

/-- Notation for `Wcovby a b`. -/
infixl:50 " ⩿ " => Wcovby

theorem Wcovby.le (h : a ⩿ b) : a ≤ b :=
  h.1
#align wcovby.le Wcovby.le

theorem Wcovby.refl (a : α) : a ⩿ a :=
  ⟨le_rfl, fun _ hc => hc.not_lt⟩
#align wcovby.refl Wcovby.refl

theorem Wcovby.rfl : a ⩿ a :=
  Wcovby.refl a
#align wcovby.rfl Wcovby.rfl

protected theorem Eq.wcovby (h : a = b) : a ⩿ b :=
  h ▸ Wcovby.rfl
#align eq.wcovby Eq.wcovby

theorem wcovby_of_le_of_le (h1 : a ≤ b) (h2 : b ≤ a) : a ⩿ b :=
  ⟨h1, fun _ hac hcb => (hac.trans hcb).not_le h2⟩
#align wcovby_of_le_of_le wcovby_of_le_of_le

alias wcovby_of_le_of_le ← LE.le.wcovby_of_le

theorem AntisymmRel.wcovby (h : AntisymmRel (· ≤ ·) a b) : a ⩿ b :=
  wcovby_of_le_of_le h.1 h.2
#align antisymm_rel.wcovby AntisymmRel.wcovby

theorem Wcovby.wcovby_iff_le (hab : a ⩿ b) : b ⩿ a ↔ b ≤ a :=
  ⟨fun h => h.le, fun h => h.wcovby_of_le hab.le⟩
#align wcovby.wcovby_iff_le Wcovby.wcovby_iff_le

theorem wcovby_of_eq_or_eq (hab : a ≤ b) (h : ∀ c, a ≤ c → c ≤ b → c = a ∨ c = b) : a ⩿ b :=
  ⟨hab, fun c ha hb => (h c ha.le hb.le).elim ha.ne' hb.ne⟩
#align wcovby_of_eq_or_eq wcovby_of_eq_or_eq

theorem AntisymmRel.trans_wcovby (hab : AntisymmRel (· ≤ ·) a b) (hbc : b ⩿ c) : a ⩿ c :=
  ⟨hab.1.trans hbc.le, fun _ had hdc => hbc.2 (hab.2.trans_lt had) hdc⟩
#align antisymm_rel.trans_wcovby AntisymmRel.trans_wcovby

theorem wcovby_congr_left (hab : AntisymmRel (· ≤ ·) a b) : a ⩿ c ↔ b ⩿ c :=
  ⟨hab.symm.trans_wcovby, hab.trans_wcovby⟩
#align wcovby_congr_left wcovby_congr_left

theorem Wcovby.trans_antisymm_rel (hab : a ⩿ b) (hbc : AntisymmRel (· ≤ ·) b c) : a ⩿ c :=
  ⟨hab.le.trans hbc.1, fun _ had hdc => hab.2 had <| hdc.trans_le hbc.2⟩
#align wcovby.trans_antisymm_rel Wcovby.trans_antisymm_rel

theorem wcovby_congr_right (hab : AntisymmRel (· ≤ ·) a b) : c ⩿ a ↔ c ⩿ b :=
  ⟨fun h => h.trans_antisymm_rel hab, fun h => h.trans_antisymm_rel hab.symm⟩
#align wcovby_congr_right wcovby_congr_right

/-- If `a ≤ b`, then `b` does not cover `a` iff there's an element in between. -/
theorem not_wcovby_iff (h : a ≤ b) : ¬a ⩿ b ↔ ∃ c, a < c ∧ c < b := by
  simp_rw [Wcovby, h, true_and_iff, not_forall, exists_prop, not_not]
#align not_wcovby_iff not_wcovby_iff

instance Wcovby.isRefl : IsRefl α (· ⩿ ·) :=
  ⟨Wcovby.refl⟩
#align wcovby.is_refl Wcovby.isRefl

theorem Wcovby.Ioo_eq (h : a ⩿ b) : Ioo a b = ∅ :=
  eq_empty_iff_forall_not_mem.2 fun _ hx => h.2 hx.1 hx.2
#align wcovby.Ioo_eq Wcovby.Ioo_eq

theorem wcovby_iff_Ioo_eq : a ⩿ b ↔ a ≤ b ∧ Ioo a b = ∅ :=
  and_congr_right' <| by simp [eq_empty_iff_forall_not_mem]
#align wcovby_iff_Ioo_eq wcovby_iff_Ioo_eq

theorem Wcovby.of_image (f : α ↪o β) (h : f a ⩿ f b) : a ⩿ b :=
  ⟨f.le_iff_le.mp h.le, fun _ hac hcb => h.2 (f.lt_iff_lt.mpr hac) (f.lt_iff_lt.mpr hcb)⟩
#align wcovby.of_image Wcovby.of_image

theorem Wcovby.image (f : α ↪o β) (hab : a ⩿ b) (h : (range f).OrdConnected) : f a ⩿ f b := by
  refine' ⟨f.monotone hab.le, fun c ha hb => _⟩
  obtain ⟨c, rfl⟩ := h.out (mem_range_self _) (mem_range_self _) ⟨ha.le, hb.le⟩
  rw [f.lt_iff_lt] at ha hb
  exact hab.2 ha hb
#align wcovby.image Wcovby.image

theorem Set.OrdConnected.apply_wcovby_apply_iff (f : α ↪o β) (h : (range f).OrdConnected) :
    f a ⩿ f b ↔ a ⩿ b :=
  ⟨fun h2 => h2.of_image f, fun hab => hab.image f h⟩
#align set.ord_connected.apply_wcovby_apply_iff Set.OrdConnected.apply_wcovby_apply_iff

@[simp]
theorem apply_wcovby_apply_iff {E : Type _} [OrderIsoClass E α β] (e : E) : e a ⩿ e b ↔ a ⩿ b :=
  (ordConnected_range (e : α ≃o β)).apply_wcovby_apply_iff ((e : α ≃o β) : α ↪o β)
#align apply_wcovby_apply_iff apply_wcovby_apply_iff

@[simp]
theorem toDual_wcovby_toDual_iff : toDual b ⩿ toDual a ↔ a ⩿ b :=
  and_congr_right' <| forall_congr' fun _ => forall_swap
#align to_dual_wcovby_to_dual_iff toDual_wcovby_toDual_iff

@[simp]
theorem ofDual_wcovby_ofDual_iff {a b : αᵒᵈ} : ofDual a ⩿ ofDual b ↔ b ⩿ a :=
  and_congr_right' <| forall_congr' fun _ => forall_swap
#align of_dual_wcovby_of_dual_iff ofDual_wcovby_ofDual_iff

alias toDual_wcovby_toDual_iff ↔ _ Wcovby.toDual
#align wcovby.to_dual Wcovby.toDual

alias ofDual_wcovby_ofDual_iff ↔ _ Wcovby.ofDual
#align wcovby.of_dual Wcovby.ofDual

end Preorder

section PartialOrder

variable [PartialOrder α] {a b c : α}

theorem Wcovby.eq_or_eq (h : a ⩿ b) (h2 : a ≤ c) (h3 : c ≤ b) : c = a ∨ c = b := by
  rcases h2.eq_or_lt with (h2 | h2); · exact Or.inl h2.symm
  rcases h3.eq_or_lt with (h3 | h3); · exact Or.inr h3
  exact (h.2 h2 h3).elim
#align wcovby.eq_or_eq Wcovby.eq_or_eq

/-- An `iff` version of `Wcovby.eq_or_eq` and `wcovby_of_eq_or_eq`. -/
theorem wcovby_iff_le_and_eq_or_eq : a ⩿ b ↔ a ≤ b ∧ ∀ c, a ≤ c → c ≤ b → c = a ∨ c = b :=
  ⟨fun h => ⟨h.le, fun _ => h.eq_or_eq⟩, And.rec wcovby_of_eq_or_eq⟩
#align wcovby_iff_le_and_eq_or_eq wcovby_iff_le_and_eq_or_eq

theorem Wcovby.le_and_le_iff (h : a ⩿ b) : a ≤ c ∧ c ≤ b ↔ c = a ∨ c = b := by
  refine' ⟨fun h2 => h.eq_or_eq h2.1 h2.2, _⟩; rintro (rfl | rfl);
  exacts[⟨le_rfl, h.le⟩, ⟨h.le, le_rfl⟩]
#align wcovby.le_and_le_iff Wcovby.le_and_le_iff

theorem Wcovby.Icc_eq (h : a ⩿ b) : Icc a b = {a, b} := by
  ext c
  exact h.le_and_le_iff
#align wcovby.Icc_eq Wcovby.Icc_eq

theorem Wcovby.Ico_subset (h : a ⩿ b) : Ico a b ⊆ {a} := by
  rw [← Icc_diff_right, h.Icc_eq, diff_singleton_subset_iff, pair_comm]
#align wcovby.Ico_subset Wcovby.Ico_subset

theorem Wcovby.Ioc_subset (h : a ⩿ b) : Ioc a b ⊆ {b} := by
  rw [← Icc_diff_left, h.Icc_eq, diff_singleton_subset_iff]
#align wcovby.Ioc_subset Wcovby.Ioc_subset

end PartialOrder

section SemilatticeSup

variable [SemilatticeSup α] {a b c : α}

theorem Wcovby.sup_eq (hac : a ⩿ c) (hbc : b ⩿ c) (hab : a ≠ b) : a ⊔ b = c :=
  (sup_le hac.le hbc.le).eq_of_not_lt fun h =>
    hab.lt_sup_or_lt_sup.elim (fun h' => hac.2 h' h) fun h' => hbc.2 h' h
#align wcovby.sup_eq Wcovby.sup_eq

end SemilatticeSup

section SemilatticeInf

variable [SemilatticeInf α] {a b c : α}

theorem Wcovby.inf_eq (hca : c ⩿ a) (hcb : c ⩿ b) (hab : a ≠ b) : a ⊓ b = c :=
  (le_inf hca.le hcb.le).eq_of_not_gt fun h => hab.inf_lt_or_inf_lt.elim (hca.2 h) (hcb.2 h)
#align wcovby.inf_eq Wcovby.inf_eq

end SemilatticeInf

end WeaklyCovers

section LT

variable [LT α] {a b : α}

/-- `Covby a b` means that `b` covers `a`: `a < b` and there is no element in between. -/
def Covby (a b : α) : Prop :=
  a < b ∧ ∀ ⦃c⦄, a < c → ¬c < b
#align covby Covby

/-- Notation for `Covby a b`. -/
infixl:50 " ⋖ " => Covby

theorem Covby.lt (h : a ⋖ b) : a < b :=
  h.1
#align covby.lt Covby.lt

/-- If `a < b`, then `b` does not cover `a` iff there's an element in between. -/
theorem not_covby_iff (h : a < b) : ¬a ⋖ b ↔ ∃ c, a < c ∧ c < b := by
  simp_rw [Covby, h, true_and_iff, not_forall, exists_prop, not_not]
#align not_covby_iff not_covby_iff

alias not_covby_iff ↔ exists_lt_lt_of_not_covby _
#align exists_lt_lt_of_not_covby exists_lt_lt_of_not_covby

alias exists_lt_lt_of_not_covby ← LT.lt.exists_lt_lt

/-- In a dense order, nothing covers anything. -/
theorem not_covby [DenselyOrdered α] : ¬a ⋖ b := fun h =>
  let ⟨_, hc⟩ := exists_between h.1
  h.2 hc.1 hc.2
#align not_covby not_covby

theorem densely_ordered_iff_forall_not_covby : DenselyOrdered α ↔ ∀ a b : α, ¬a ⋖ b :=
  ⟨fun h _ _ => @not_covby _ _ _ _ h, fun h =>
    ⟨fun _ _ hab => exists_lt_lt_of_not_covby hab <| h _ _⟩⟩
#align densely_ordered_iff_forall_not_covby densely_ordered_iff_forall_not_covby

@[simp]
theorem toDual_covby_toDual_iff : toDual b ⋖ toDual a ↔ a ⋖ b :=
  and_congr_right' <| forall_congr' fun _ => forall_swap
#align to_dual_covby_to_dual_iff toDual_covby_toDual_iff

@[simp]
theorem ofDual_covby_ofDual_iff {a b : αᵒᵈ} : ofDual a ⋖ ofDual b ↔ b ⋖ a :=
  and_congr_right' <| forall_congr' fun _ => forall_swap
#align of_dual_covby_of_dual_iff ofDual_covby_ofDual_iff

alias toDual_covby_toDual_iff ↔ _ Covby.toDual
#align covby.to_dual Covby.toDual

alias ofDual_covby_ofDual_iff ↔ _ Covby.ofDual
#align covby.of_dual Covby.ofDual

end LT

section Preorder

variable [Preorder α] [Preorder β] {a b c : α}

theorem Covby.le (h : a ⋖ b) : a ≤ b :=
  h.1.le
#align covby.le Covby.le

protected theorem Covby.ne (h : a ⋖ b) : a ≠ b :=
  h.lt.ne
#align covby.ne Covby.ne

theorem Covby.ne' (h : a ⋖ b) : b ≠ a :=
  h.lt.ne'
#align covby.ne' Covby.ne'

protected theorem Covby.wcovby (h : a ⋖ b) : a ⩿ b :=
  ⟨h.le, h.2⟩
#align covby.wcovby Covby.wcovby

theorem Wcovby.covby_of_not_le (h : a ⩿ b) (h2 : ¬b ≤ a) : a ⋖ b :=
  ⟨h.le.lt_of_not_le h2, h.2⟩
#align wcovby.covby_of_not_le Wcovby.covby_of_not_le

theorem Wcovby.covby_of_lt (h : a ⩿ b) (h2 : a < b) : a ⋖ b :=
  ⟨h2, h.2⟩
#align wcovby.covby_of_lt Wcovby.covby_of_lt

theorem not_covby_of_lt_of_lt (h₁ : a < b) (h₂ : b < c) : ¬a ⋖ c :=
  (not_covby_iff (h₁.trans h₂)).2 ⟨b, h₁, h₂⟩
#align not_covby_of_lt_of_lt not_covby_of_lt_of_lt

theorem covby_iff_wcovby_and_lt : a ⋖ b ↔ a ⩿ b ∧ a < b :=
  ⟨fun h => ⟨h.wcovby, h.lt⟩, fun h => h.1.covby_of_lt h.2⟩
#align covby_iff_wcovby_and_lt covby_iff_wcovby_and_lt

theorem covby_iff_wcovby_and_not_le : a ⋖ b ↔ a ⩿ b ∧ ¬b ≤ a :=
  ⟨fun h => ⟨h.wcovby, h.lt.not_le⟩, fun h => h.1.covby_of_not_le h.2⟩
#align covby_iff_wcovby_and_not_le covby_iff_wcovby_and_not_le

theorem wcovby_iff_covby_or_le_and_le : a ⩿ b ↔ a ⋖ b ∨ a ≤ b ∧ b ≤ a :=
  ⟨fun h => or_iff_not_imp_right.mpr fun h' => h.covby_of_not_le fun hba => h' ⟨h.le, hba⟩,
    fun h' => h'.elim (fun h => h.wcovby) fun h => h.1.wcovby_of_le h.2⟩
#align wcovby_iff_covby_or_le_and_le wcovby_iff_covby_or_le_and_le

theorem AntisymmRel.trans_covby (hab : AntisymmRel (· ≤ ·) a b) (hbc : b ⋖ c) : a ⋖ c :=
  ⟨hab.1.trans_lt hbc.lt, fun _ had hdc => hbc.2 (hab.2.trans_lt had) hdc⟩
#align antisymm_rel.trans_covby AntisymmRel.trans_covby

theorem covby_congr_left (hab : AntisymmRel (· ≤ ·) a b) : a ⋖ c ↔ b ⋖ c :=
  ⟨hab.symm.trans_covby, hab.trans_covby⟩
#align covby_congr_left covby_congr_left

theorem Covby.trans_antisymmRel (hab : a ⋖ b) (hbc : AntisymmRel (· ≤ ·) b c) : a ⋖ c :=
  ⟨hab.lt.trans_le hbc.1, fun _ had hdb => hab.2 had <| hdb.trans_le hbc.2⟩
#align covby.trans_antisymm_rel Covby.trans_antisymmRel

theorem covby_congr_right (hab : AntisymmRel (· ≤ ·) a b) : c ⋖ a ↔ c ⋖ b :=
  ⟨fun h => h.trans_antisymmRel hab, fun h => h.trans_antisymmRel hab.symm⟩
#align covby_congr_right covby_congr_right

instance : IsNonstrictStrictOrder α (· ⩿ ·) (· ⋖ ·) :=
  ⟨fun _ _ =>
    covby_iff_wcovby_and_not_le.trans <| and_congr_right fun h => h.wcovby_iff_le.not.symm⟩

instance Covby.isIrrefl : IsIrrefl α (· ⋖ ·) :=
  ⟨fun _ ha => ha.ne rfl⟩
#align covby.is_irrefl Covby.isIrrefl

theorem Covby.Ioo_eq (h : a ⋖ b) : Ioo a b = ∅ :=
  h.wcovby.Ioo_eq
#align covby.Ioo_eq Covby.Ioo_eq

theorem covby_iff_Ioo_eq : a ⋖ b ↔ a < b ∧ Ioo a b = ∅ :=
  and_congr_right' <| by simp [eq_empty_iff_forall_not_mem]
#align covby_iff_Ioo_eq covby_iff_Ioo_eq

theorem Covby.of_image (f : α ↪o β) (h : f a ⋖ f b) : a ⋖ b :=
  ⟨f.lt_iff_lt.mp h.lt, fun _ hac hcb => h.2 (f.lt_iff_lt.mpr hac) (f.lt_iff_lt.mpr hcb)⟩
#align covby.of_image Covby.of_image

theorem Covby.image (f : α ↪o β) (hab : a ⋖ b) (h : (range f).OrdConnected) : f a ⋖ f b :=
  (hab.wcovby.image f h).covby_of_lt <| f.strictMono hab.lt
#align covby.image Covby.image

theorem Set.OrdConnected.apply_covby_apply_iff (f : α ↪o β) (h : (range f).OrdConnected) :
    f a ⋖ f b ↔ a ⋖ b :=
  ⟨Covby.of_image f, fun hab => hab.image f h⟩
#align set.ord_connected.apply_covby_apply_iff Set.OrdConnected.apply_covby_apply_iff

@[simp]
theorem apply_covby_apply_iff {E : Type _} [OrderIsoClass E α β] (e : E) : e a ⋖ e b ↔ a ⋖ b :=
  (ordConnected_range (e : α ≃o β)).apply_covby_apply_iff ((e : α ≃o β) : α ↪o β)
#align apply_covby_apply_iff apply_covby_apply_iff

theorem covby_of_eq_or_eq (hab : a < b) (h : ∀ c, a ≤ c → c ≤ b → c = a ∨ c = b) : a ⋖ b :=
  ⟨hab, fun c ha hb => (h c ha.le hb.le).elim ha.ne' hb.ne⟩
#align covby_of_eq_or_eq covby_of_eq_or_eq

end Preorder

section PartialOrder

variable [PartialOrder α] {a b c : α}

theorem Wcovby.covby_of_ne (h : a ⩿ b) (h2 : a ≠ b) : a ⋖ b :=
  ⟨h.le.lt_of_ne h2, h.2⟩
#align wcovby.covby_of_ne Wcovby.covby_of_ne

theorem covby_iff_wcovby_and_ne : a ⋖ b ↔ a ⩿ b ∧ a ≠ b :=
  ⟨fun h => ⟨h.wcovby, h.ne⟩, fun h => h.1.covby_of_ne h.2⟩
#align covby_iff_wcovby_and_ne covby_iff_wcovby_and_ne

theorem wcovby_iff_covby_or_eq : a ⩿ b ↔ a ⋖ b ∨ a = b := by
  rw [le_antisymm_iff, wcovby_iff_covby_or_le_and_le]
#align wcovby_iff_covby_or_eq wcovby_iff_covby_or_eq

theorem wcovby_iff_eq_or_covby : a ⩿ b ↔ a = b ∨ a ⋖ b :=
  wcovby_iff_covby_or_eq.trans or_comm
#align wcovby_iff_eq_or_covby wcovby_iff_eq_or_covby

alias wcovby_iff_covby_or_eq ↔ Wcovby.covby_or_eq _
#align wcovby.covby_or_eq Wcovby.covby_or_eq

alias wcovby_iff_eq_or_covby ↔ Wcovby.eq_or_covby _
#align wcovby.eq_or_covby Wcovby.eq_or_covby

theorem Covby.eq_or_eq (h : a ⋖ b) (h2 : a ≤ c) (h3 : c ≤ b) : c = a ∨ c = b :=
  h.wcovby.eq_or_eq h2 h3
#align covby.eq_or_eq Covby.eq_or_eq

/-- An `iff` version of `Covby.eq_or_eq` and `covby_of_eq_or_eq`. -/
theorem covby_iff_lt_and_eq_or_eq : a ⋖ b ↔ a < b ∧ ∀ c, a ≤ c → c ≤ b → c = a ∨ c = b :=
  ⟨fun h => ⟨h.lt, fun _ => h.eq_or_eq⟩, And.rec covby_of_eq_or_eq⟩
#align covby_iff_lt_and_eq_or_eq covby_iff_lt_and_eq_or_eq

theorem Covby.Ico_eq (h : a ⋖ b) : Ico a b = {a} := by
  rw [← Ioo_union_left h.lt, h.Ioo_eq, empty_union]
#align covby.Ico_eq Covby.Ico_eq

theorem Covby.Ioc_eq (h : a ⋖ b) : Ioc a b = {b} := by
  rw [← Ioo_union_right h.lt, h.Ioo_eq, empty_union]
#align covby.Ioc_eq Covby.Ioc_eq

theorem Covby.Icc_eq (h : a ⋖ b) : Icc a b = {a, b} :=
  h.wcovby.Icc_eq
#align covby.Icc_eq Covby.Icc_eq

end PartialOrder

section LinearOrder

variable [LinearOrder α] {a b c : α}

theorem Covby.Ioi_eq (h : a ⋖ b) : Ioi a = Ici b := by
  rw [← Ioo_union_Ici_eq_Ioi h.lt, h.Ioo_eq, empty_union]
#align covby.Ioi_eq Covby.Ioi_eq

theorem Covby.Iio_eq (h : a ⋖ b) : Iio b = Iic a := by
  rw [← Iic_union_Ioo_eq_Iio h.lt, h.Ioo_eq, union_empty]
#align covby.Iio_eq Covby.Iio_eq

theorem Wcovby.le_of_lt (hab : a ⩿ b) (hcb : c < b) : c ≤ a :=
  not_lt.1 fun hac => hab.2 hac hcb
#align wcovby.le_of_lt Wcovby.le_of_lt

theorem Wcovby.ge_of_gt (hab : a ⩿ b) (hac : a < c) : b ≤ c :=
  not_lt.1 <| hab.2 hac
#align wcovby.ge_of_gt Wcovby.ge_of_gt

theorem Covby.le_of_lt (hab : a ⋖ b) : c < b → c ≤ a :=
  hab.wcovby.le_of_lt
#align covby.le_of_lt Covby.le_of_lt

theorem Covby.ge_of_gt (hab : a ⋖ b) : a < c → b ≤ c :=
  hab.wcovby.ge_of_gt
#align covby.ge_of_gt Covby.ge_of_gt

theorem Covby.unique_left (ha : a ⋖ c) (hb : b ⋖ c) : a = b :=
  (hb.le_of_lt ha.lt).antisymm <| ha.le_of_lt hb.lt
#align covby.unique_left Covby.unique_left

theorem Covby.unique_right (hb : a ⋖ b) (hc : a ⋖ c) : b = c :=
  (hb.ge_of_gt hc.lt).antisymm <| hc.ge_of_gt hb.lt
#align covby.unique_right Covby.unique_right

/-- If `a`, `b`, `c` are consecutive and `a < x < c` then `x = b`. -/
theorem Covby.eq_of_between {x : α} (hab : a ⋖ b) (hbc : b ⋖ c) (hax : a < x) (hxc : x < c) :
    x = b :=
  le_antisymm (le_of_not_lt fun h => hbc.2 h hxc) (le_of_not_lt <| hab.2 hax)
#align covby.eq_of_between Covby.eq_of_between

/-- If `a < b` then there exist `a' > a` and `b' < b` such that `Set.Iio a'` is strictly to the left
of `Set.Ioi b'`. -/
lemma LT.lt.exists_disjoint_Iio_Ioi (h : a < b) :
    ∃ a' > a, ∃ b' < b, ∀ x < a', ∀ y > b', x < y := by
  by_cases h' : a ⋖ b
  · exact ⟨b, h, a, h, fun x hx y hy => hx.trans_le <| h'.ge_of_gt hy⟩
  · rcases h.exists_lt_lt h' with ⟨c, ha, hb⟩
    exact ⟨c, ha, c, hb, fun _ h₁ _ => lt_trans h₁⟩

end LinearOrder

namespace Set

theorem wcovby_insert (x : α) (s : Set α) : s ⩿ insert x s := by
  refine' wcovby_of_eq_or_eq (subset_insert x s) fun t hst h2t => _
  by_cases h : x ∈ t
  · exact Or.inr (subset_antisymm h2t <| insert_subset.mpr ⟨h, hst⟩)
  · refine' Or.inl (subset_antisymm _ hst)
    rwa [← diff_singleton_eq_self h, diff_singleton_subset_iff]
#align set.wcovby_insert Set.wcovby_insert

theorem covby_insert {x : α} {s : Set α} (hx : x ∉ s) : s ⋖ insert x s :=
  (wcovby_insert x s).covby_of_lt <| ssubset_insert hx
#align set.covby_insert Set.covby_insert

end Set

namespace Prod

variable [PartialOrder α] [PartialOrder β] {a a₁ a₂ : α} {b b₁ b₂ : β} {x y : α × β}

@[simp]
theorem swap_wcovby_swap : x.swap ⩿ y.swap ↔ x ⩿ y :=
  apply_wcovby_apply_iff (OrderIso.prodComm : α × β ≃o β × α)
#align prod.swap_wcovby_swap Prod.swap_wcovby_swap

@[simp]
theorem swap_covby_swap : x.swap ⋖ y.swap ↔ x ⋖ y :=
  apply_covby_apply_iff (OrderIso.prodComm : α × β ≃o β × α)
#align prod.swap_covby_swap Prod.swap_covby_swap

theorem fst_eq_or_snd_eq_of_wcovby : x ⩿ y → x.1 = y.1 ∨ x.2 = y.2 := by
  refine' fun h => of_not_not fun hab => _
  push_neg  at hab
  exact
    h.2 (mk_lt_mk.2 <| Or.inl ⟨hab.1.lt_of_le h.1.1, le_rfl⟩)
      (mk_lt_mk.2 <| Or.inr ⟨le_rfl, hab.2.lt_of_le h.1.2⟩)
#align prod.fst_eq_or_snd_eq_of_wcovby Prod.fst_eq_or_snd_eq_of_wcovby

theorem _root_.Wcovby.fst (h : x ⩿ y) : x.1 ⩿ y.1 :=
  ⟨h.1.1, fun _ h₁ h₂ => h.2 (mk_lt_mk_iff_left.2 h₁) ⟨⟨h₂.le, h.1.2⟩, fun hc => h₂.not_le hc.1⟩⟩
#align wcovby.fst Wcovby.fst

theorem _root_.Wcovby.snd (h : x ⩿ y) : x.2 ⩿ y.2 :=
  ⟨h.1.2, fun _ h₁ h₂ => h.2 (mk_lt_mk_iff_right.2 h₁) ⟨⟨h.1.1, h₂.le⟩, fun hc => h₂.not_le hc.2⟩⟩
#align wcovby.snd Wcovby.snd

theorem mk_wcovby_mk_iff_left : (a₁, b) ⩿ (a₂, b) ↔ a₁ ⩿ a₂ := by
  refine' ⟨Wcovby.fst, (And.imp mk_le_mk_iff_left.2) fun h c h₁ h₂ => _⟩
  have : c.2 = b := h₂.le.2.antisymm h₁.le.2
  rw [← @Prod.mk.eta _ _ c, this, mk_lt_mk_iff_left] at h₁ h₂
  exact h h₁ h₂
#align prod.mk_wcovby_mk_iff_left Prod.mk_wcovby_mk_iff_left

theorem mk_wcovby_mk_iff_right : (a, b₁) ⩿ (a, b₂) ↔ b₁ ⩿ b₂ :=
  swap_wcovby_swap.trans mk_wcovby_mk_iff_left
#align prod.mk_wcovby_mk_iff_right Prod.mk_wcovby_mk_iff_right

theorem mk_covby_mk_iff_left : (a₁, b) ⋖ (a₂, b) ↔ a₁ ⋖ a₂ := by
  simp_rw [covby_iff_wcovby_and_lt, mk_wcovby_mk_iff_left, mk_lt_mk_iff_left]
#align prod.mk_covby_mk_iff_left Prod.mk_covby_mk_iff_left

theorem mk_covby_mk_iff_right : (a, b₁) ⋖ (a, b₂) ↔ b₁ ⋖ b₂ := by
  simp_rw [covby_iff_wcovby_and_lt, mk_wcovby_mk_iff_right, mk_lt_mk_iff_right]
#align prod.mk_covby_mk_iff_right Prod.mk_covby_mk_iff_right

theorem mk_wcovby_mk_iff : (a₁, b₁) ⩿ (a₂, b₂) ↔ a₁ ⩿ a₂ ∧ b₁ = b₂ ∨ b₁ ⩿ b₂ ∧ a₁ = a₂ := by
  refine' ⟨fun h => _, _⟩
  · obtain rfl | rfl : a₁ = a₂ ∨ b₁ = b₂ := fst_eq_or_snd_eq_of_wcovby h
    · exact Or.inr ⟨mk_wcovby_mk_iff_right.1 h, rfl⟩
    · exact Or.inl ⟨mk_wcovby_mk_iff_left.1 h, rfl⟩
  · rintro (⟨h, rfl⟩ | ⟨h, rfl⟩)
    · exact mk_wcovby_mk_iff_left.2 h
    · exact mk_wcovby_mk_iff_right.2 h
#align prod.mk_wcovby_mk_iff Prod.mk_wcovby_mk_iff

theorem mk_covby_mk_iff : (a₁, b₁) ⋖ (a₂, b₂) ↔ a₁ ⋖ a₂ ∧ b₁ = b₂ ∨ b₁ ⋖ b₂ ∧ a₁ = a₂ := by
  refine' ⟨fun h => _, _⟩
  · obtain rfl | rfl : a₁ = a₂ ∨ b₁ = b₂ := fst_eq_or_snd_eq_of_wcovby h.wcovby
    · exact Or.inr ⟨mk_covby_mk_iff_right.1 h, rfl⟩
    · exact Or.inl ⟨mk_covby_mk_iff_left.1 h, rfl⟩
  · rintro (⟨h, rfl⟩ | ⟨h, rfl⟩)
    · exact mk_covby_mk_iff_left.2 h
    · exact mk_covby_mk_iff_right.2 h
#align prod.mk_covby_mk_iff Prod.mk_covby_mk_iff

theorem wcovby_iff : x ⩿ y ↔ x.1 ⩿ y.1 ∧ x.2 = y.2 ∨ x.2 ⩿ y.2 ∧ x.1 = y.1 := by
  cases x
  cases y
  exact mk_wcovby_mk_iff
#align prod.wcovby_iff Prod.wcovby_iff

theorem covby_iff : x ⋖ y ↔ x.1 ⋖ y.1 ∧ x.2 = y.2 ∨ x.2 ⋖ y.2 ∧ x.1 = y.1 := by
  cases x
  cases y
  exact mk_covby_mk_iff
#align prod.covby_iff Prod.covby_iff

end Prod