/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta

! This file was ported from Lean 3 source module category_theory.limits.shapes.reflexive
! leanprover-community/mathlib commit 97eab48559068f3d6313da387714ef25768fb730
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Limits.Shapes.Equalizers
import Mathbin.CategoryTheory.Limits.Shapes.KernelPair

/-!
# Reflexive coequalizers

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

We define reflexive pairs as a pair of morphisms which have a common section. We say a category has
reflexive coequalizers if it has coequalizers of all reflexive pairs.
Reflexive coequalizers often enjoy nicer properties than general coequalizers, and feature heavily
in some versions of the monadicity theorem.

We also give some examples of reflexive pairs: for an adjunction `F ⊣ G` with counit `ε`, the pair
`(FGε_B, ε_FGB)` is reflexive. If a pair `f,g` is a kernel pair for some morphism, then it is
reflexive.

# TODO
* If `C` has binary coproducts and reflexive coequalizers, then it has all coequalizers.
* If `T` is a monad on cocomplete category `C`, then `algebra T` is cocomplete iff it has reflexive
  coequalizers.
* If `C` is locally cartesian closed and has reflexive coequalizers, then it has images: in fact
  regular epi (and hence strong epi) images.
-/

namespace CategoryTheory

universe v v₂ u u₂

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

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

variable {A B : C} {f g : A ⟶ B}

#print CategoryTheory.IsReflexivePair /-
/- ./././Mathport/Syntax/Translate/Command.lean:388:30: infer kinds are unsupported in Lean 4: #[`common_section] [] -/
/-- The pair `f g : A ⟶ B` is reflexive if there is a morphism `B ⟶ A` which is a section for both.
-/
class IsReflexivePair (f g : A ⟶ B) : Prop where
  common_section : ∃ s : B ⟶ A, s ≫ f = 𝟙 B ∧ s ≫ g = 𝟙 B
#align category_theory.is_reflexive_pair CategoryTheory.IsReflexivePair
-/

#print CategoryTheory.IsCoreflexivePair /-
/- ./././Mathport/Syntax/Translate/Command.lean:388:30: infer kinds are unsupported in Lean 4: #[`common_retraction] [] -/
/--
The pair `f g : A ⟶ B` is coreflexive if there is a morphism `B ⟶ A` which is a retraction for both.
-/
class IsCoreflexivePair (f g : A ⟶ B) : Prop where
  common_retraction : ∃ s : B ⟶ A, f ≫ s = 𝟙 A ∧ g ≫ s = 𝟙 A
#align category_theory.is_coreflexive_pair CategoryTheory.IsCoreflexivePair
-/

#print CategoryTheory.IsReflexivePair.mk' /-
theorem IsReflexivePair.mk' (s : B ⟶ A) (sf : s ≫ f = 𝟙 B) (sg : s ≫ g = 𝟙 B) :
    IsReflexivePair f g :=
  ⟨⟨s, sf, sg⟩⟩
#align category_theory.is_reflexive_pair.mk' CategoryTheory.IsReflexivePair.mk'
-/

#print CategoryTheory.IsCoreflexivePair.mk' /-
theorem IsCoreflexivePair.mk' (s : B ⟶ A) (fs : f ≫ s = 𝟙 A) (gs : g ≫ s = 𝟙 A) :
    IsCoreflexivePair f g :=
  ⟨⟨s, fs, gs⟩⟩
#align category_theory.is_coreflexive_pair.mk' CategoryTheory.IsCoreflexivePair.mk'
-/

#print CategoryTheory.commonSection /-
/-- Get the common section for a reflexive pair. -/
noncomputable def commonSection (f g : A ⟶ B) [IsReflexivePair f g] : B ⟶ A :=
  (IsReflexivePair.common_section f g).some
#align category_theory.common_section CategoryTheory.commonSection
-/

#print CategoryTheory.section_comp_left /-
@[simp, reassoc.1]
theorem section_comp_left (f g : A ⟶ B) [IsReflexivePair f g] : commonSection f g ≫ f = 𝟙 B :=
  (IsReflexivePair.common_section f g).choose_spec.1
#align category_theory.section_comp_left CategoryTheory.section_comp_left
-/

#print CategoryTheory.section_comp_right /-
@[simp, reassoc.1]
theorem section_comp_right (f g : A ⟶ B) [IsReflexivePair f g] : commonSection f g ≫ g = 𝟙 B :=
  (IsReflexivePair.common_section f g).choose_spec.2
#align category_theory.section_comp_right CategoryTheory.section_comp_right
-/

#print CategoryTheory.commonRetraction /-
/-- Get the common retraction for a coreflexive pair. -/
noncomputable def commonRetraction (f g : A ⟶ B) [IsCoreflexivePair f g] : B ⟶ A :=
  (IsCoreflexivePair.common_retraction f g).some
#align category_theory.common_retraction CategoryTheory.commonRetraction
-/

#print CategoryTheory.left_comp_retraction /-
@[simp, reassoc.1]
theorem left_comp_retraction (f g : A ⟶ B) [IsCoreflexivePair f g] :
    f ≫ commonRetraction f g = 𝟙 A :=
  (IsCoreflexivePair.common_retraction f g).choose_spec.1
#align category_theory.left_comp_retraction CategoryTheory.left_comp_retraction
-/

#print CategoryTheory.right_comp_retraction /-
@[simp, reassoc.1]
theorem right_comp_retraction (f g : A ⟶ B) [IsCoreflexivePair f g] :
    g ≫ commonRetraction f g = 𝟙 A :=
  (IsCoreflexivePair.common_retraction f g).choose_spec.2
#align category_theory.right_comp_retraction CategoryTheory.right_comp_retraction
-/

#print CategoryTheory.IsKernelPair.isReflexivePair /-
/-- If `f,g` is a kernel pair for some morphism `q`, then it is reflexive. -/
theorem IsKernelPair.isReflexivePair {R : C} {f g : R ⟶ A} {q : A ⟶ B} (h : IsKernelPair q f g) :
    IsReflexivePair f g :=
  IsReflexivePair.mk' _ (h.lift' _ _ rfl).2.1 (h.lift' _ _ _).2.2
#align category_theory.is_kernel_pair.is_reflexive_pair CategoryTheory.IsKernelPair.isReflexivePair
-/

#print CategoryTheory.IsReflexivePair.swap /-
-- This shouldn't be an instance as it would instantly loop.
/-- If `f,g` is reflexive, then `g,f` is reflexive. -/
theorem IsReflexivePair.swap [IsReflexivePair f g] : IsReflexivePair g f :=
  IsReflexivePair.mk' _ (section_comp_right f g) (section_comp_left f g)
#align category_theory.is_reflexive_pair.swap CategoryTheory.IsReflexivePair.swap
-/

#print CategoryTheory.IsCoreflexivePair.swap /-
-- This shouldn't be an instance as it would instantly loop.
/-- If `f,g` is coreflexive, then `g,f` is coreflexive. -/
theorem IsCoreflexivePair.swap [IsCoreflexivePair f g] : IsCoreflexivePair g f :=
  IsCoreflexivePair.mk' _ (right_comp_retraction f g) (left_comp_retraction f g)
#align category_theory.is_coreflexive_pair.swap CategoryTheory.IsCoreflexivePair.swap
-/

variable {F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G)

/-- For an adjunction `F ⊣ G` with counit `ε`, the pair `(FGε_B, ε_FGB)` is reflexive. -/
instance (B : D) :
    IsReflexivePair (F.map (G.map (adj.counit.app B))) (adj.counit.app (F.obj (G.obj B))) :=
  IsReflexivePair.mk' (F.map (adj.Unit.app (G.obj B)))
    (by
      rw [← F.map_comp, adj.right_triangle_components]
      apply F.map_id)
    adj.left_triangle_components

namespace Limits

variable (C)

#print CategoryTheory.Limits.HasReflexiveCoequalizers /-
/-- `C` has reflexive coequalizers if it has coequalizers for every reflexive pair. -/
class HasReflexiveCoequalizers : Prop where
  has_coeq : ∀ ⦃A B : C⦄ (f g : A ⟶ B) [IsReflexivePair f g], HasCoequalizer f g
#align category_theory.limits.has_reflexive_coequalizers CategoryTheory.Limits.HasReflexiveCoequalizers
-/

#print CategoryTheory.Limits.HasCoreflexiveEqualizers /-
/-- `C` has coreflexive equalizers if it has equalizers for every coreflexive pair. -/
class HasCoreflexiveEqualizers : Prop where
  has_eq : ∀ ⦃A B : C⦄ (f g : A ⟶ B) [IsCoreflexivePair f g], HasEqualizer f g
#align category_theory.limits.has_coreflexive_equalizers CategoryTheory.Limits.HasCoreflexiveEqualizers
-/

attribute [instance] has_reflexive_coequalizers.has_coeq

attribute [instance] has_coreflexive_equalizers.has_eq

#print CategoryTheory.Limits.hasCoequalizer_of_common_section /-
theorem hasCoequalizer_of_common_section [HasReflexiveCoequalizers C] {A B : C} {f g : A ⟶ B}
    (r : B ⟶ A) (rf : r ≫ f = 𝟙 _) (rg : r ≫ g = 𝟙 _) : HasCoequalizer f g :=
  by
  letI := is_reflexive_pair.mk' r rf rg
  infer_instance
#align category_theory.limits.has_coequalizer_of_common_section CategoryTheory.Limits.hasCoequalizer_of_common_section
-/

#print CategoryTheory.Limits.hasEqualizer_of_common_retraction /-
theorem hasEqualizer_of_common_retraction [HasCoreflexiveEqualizers C] {A B : C} {f g : A ⟶ B}
    (r : B ⟶ A) (fr : f ≫ r = 𝟙 _) (gr : g ≫ r = 𝟙 _) : HasEqualizer f g :=
  by
  letI := is_coreflexive_pair.mk' r fr gr
  infer_instance
#align category_theory.limits.has_equalizer_of_common_retraction CategoryTheory.Limits.hasEqualizer_of_common_retraction
-/

#print CategoryTheory.Limits.hasReflexiveCoequalizers_of_hasCoequalizers /-
/-- If `C` has coequalizers, then it has reflexive coequalizers. -/
instance (priority := 100) hasReflexiveCoequalizers_of_hasCoequalizers [HasCoequalizers C] :
    HasReflexiveCoequalizers C where has_coeq A B f g i := by infer_instance
#align category_theory.limits.has_reflexive_coequalizers_of_has_coequalizers CategoryTheory.Limits.hasReflexiveCoequalizers_of_hasCoequalizers
-/

#print CategoryTheory.Limits.hasCoreflexiveEqualizers_of_hasEqualizers /-
/-- If `C` has equalizers, then it has coreflexive equalizers. -/
instance (priority := 100) hasCoreflexiveEqualizers_of_hasEqualizers [HasEqualizers C] :
    HasCoreflexiveEqualizers C where has_eq A B f g i := by infer_instance
#align category_theory.limits.has_coreflexive_equalizers_of_has_equalizers CategoryTheory.Limits.hasCoreflexiveEqualizers_of_hasEqualizers
-/

end Limits

open Limits

end CategoryTheory


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

! This file was ported from Lean 3 source module category_theory.groupoid
! leanprover-community/mathlib commit e97cf15cd1aec9bd5c193b2ffac5a6dc9118912b
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.FullSubcategory
import Mathbin.CategoryTheory.Products.Basic
import Mathbin.CategoryTheory.Pi.Basic
import Mathbin.CategoryTheory.Category.Basic
import Mathbin.Combinatorics.Quiver.ConnectedComponent

/-!
# Groupoids

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

We define `groupoid` as a typeclass extending `category`,
asserting that all morphisms have inverses.

The instance `is_iso.of_groupoid (f : X ⟶ Y) : is_iso f` means that you can then write
`inv f` to access the inverse of any morphism `f`.

`groupoid.iso_equiv_hom : (X ≅ Y) ≃ (X ⟶ Y)` provides the equivalence between
isomorphisms and morphisms in a groupoid.

We provide a (non-instance) constructor `groupoid.of_is_iso` from an existing category
with `is_iso f` for every `f`.

## See also

See also `category_theory.core` for the groupoid of isomorphisms in a category.
-/

namespace CategoryTheory

universe v v₂ u u₂

#print CategoryTheory.Groupoid /-
-- morphism levels before object levels. See note [category_theory universes].
/-- A `groupoid` is a category such that all morphisms are isomorphisms. -/
class Groupoid (obj : Type u) extends Category.{v} obj : Type max u (v + 1) where
  inv : ∀ {X Y : obj}, (X ⟶ Y) → (Y ⟶ X)
  inv_comp' : ∀ {X Y : obj} (f : X ⟶ Y), comp (inv f) f = id Y := by obviously
  comp_inv' : ∀ {X Y : obj} (f : X ⟶ Y), comp f (inv f) = id X := by obviously
#align category_theory.groupoid CategoryTheory.Groupoid
-/

restate_axiom groupoid.inv_comp'

restate_axiom groupoid.comp_inv'

#print CategoryTheory.LargeGroupoid /-
/-- A `large_groupoid` is a groupoid
where the objects live in `Type (u+1)` while the morphisms live in `Type u`.
-/
abbrev LargeGroupoid (C : Type (u + 1)) : Type (u + 1) :=
  Groupoid.{u} C
#align category_theory.large_groupoid CategoryTheory.LargeGroupoid
-/

#print CategoryTheory.SmallGroupoid /-
/-- A `small_groupoid` is a groupoid
where the objects and morphisms live in the same universe.
-/
abbrev SmallGroupoid (C : Type u) : Type (u + 1) :=
  Groupoid.{u} C
#align category_theory.small_groupoid CategoryTheory.SmallGroupoid
-/

section

variable {C : Type u} [Groupoid.{v} C] {X Y : C}

#print CategoryTheory.IsIso.of_groupoid /-
-- see Note [lower instance priority]
instance (priority := 100) IsIso.of_groupoid (f : X ⟶ Y) : IsIso f :=
  ⟨⟨Groupoid.inv f, Groupoid.comp_inv f, Groupoid.inv_comp f⟩⟩
#align category_theory.is_iso.of_groupoid CategoryTheory.IsIso.of_groupoid
-/

#print CategoryTheory.Groupoid.inv_eq_inv /-
@[simp]
theorem Groupoid.inv_eq_inv (f : X ⟶ Y) : Groupoid.inv f = inv f :=
  IsIso.eq_inv_of_hom_inv_id <| Groupoid.comp_inv f
#align category_theory.groupoid.inv_eq_inv CategoryTheory.Groupoid.inv_eq_inv
-/

#print CategoryTheory.Groupoid.invEquiv /-
/-- `groupoid.inv` is involutive. -/
@[simps]
def Groupoid.invEquiv : (X ⟶ Y) ≃ (Y ⟶ X) :=
  ⟨Groupoid.inv, Groupoid.inv, fun f => by simp, fun f => by simp⟩
#align category_theory.groupoid.inv_equiv CategoryTheory.Groupoid.invEquiv
-/

#print CategoryTheory.groupoidHasInvolutiveReverse /-
instance (priority := 100) groupoidHasInvolutiveReverse : Quiver.HasInvolutiveReverse C
    where
  reverse' X Y f := Groupoid.inv f
  inv' X Y f := by
    dsimp [Quiver.reverse]
    simp
#align category_theory.groupoid_has_involutive_reverse CategoryTheory.groupoidHasInvolutiveReverse
-/

#print CategoryTheory.Groupoid.reverse_eq_inv /-
@[simp]
theorem Groupoid.reverse_eq_inv (f : X ⟶ Y) : Quiver.reverse f = Groupoid.inv f :=
  rfl
#align category_theory.groupoid.reverse_eq_inv CategoryTheory.Groupoid.reverse_eq_inv
-/

#print CategoryTheory.functorMapReverse /-
instance functorMapReverse {D : Type _} [Groupoid D] (F : C ⥤ D) : F.toPrefunctor.MapReverse
    where map_reverse' X Y f := by
    simp only [Quiver.reverse, Quiver.HasReverse.reverse', groupoid.inv_eq_inv,
      functor.to_prefunctor_map, functor.map_inv]
#align category_theory.functor_map_reverse CategoryTheory.functorMapReverse
-/

variable (X Y)

#print CategoryTheory.Groupoid.isoEquivHom /-
/-- In a groupoid, isomorphisms are equivalent to morphisms. -/
def Groupoid.isoEquivHom : (X ≅ Y) ≃ (X ⟶ Y)
    where
  toFun := Iso.hom
  invFun f := ⟨f, Groupoid.inv f⟩
  left_inv i := Iso.ext rfl
  right_inv f := rfl
#align category_theory.groupoid.iso_equiv_hom CategoryTheory.Groupoid.isoEquivHom
-/

variable (C)

#print CategoryTheory.Groupoid.invFunctor /-
/-- The functor from a groupoid `C` to its opposite sending every morphism to its inverse. -/
@[simps]
noncomputable def Groupoid.invFunctor : C ⥤ Cᵒᵖ
    where
  obj := Opposite.op
  map {X Y} f := (inv f).op
#align category_theory.groupoid.inv_functor CategoryTheory.Groupoid.invFunctor
-/

end

section

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

#print CategoryTheory.Groupoid.ofIsIso /-
/-- A category where every morphism `is_iso` is a groupoid. -/
noncomputable def Groupoid.ofIsIso (all_is_iso : ∀ {X Y : C} (f : X ⟶ Y), IsIso f) : Groupoid.{v} C
    where inv X Y f := inv f
#align category_theory.groupoid.of_is_iso CategoryTheory.Groupoid.ofIsIso
-/

#print CategoryTheory.Groupoid.ofHomUnique /-
/-- A category with a unique morphism between any two objects is a groupoid -/
def Groupoid.ofHomUnique (all_unique : ∀ {X Y : C}, Unique (X ⟶ Y)) : Groupoid.{v} C
    where inv X Y f := all_unique.default
#align category_theory.groupoid.of_hom_unique CategoryTheory.Groupoid.ofHomUnique
-/

end

#print CategoryTheory.InducedCategory.groupoid /-
instance InducedCategory.groupoid {C : Type u} (D : Type u₂) [Groupoid.{v} D] (F : C → D) :
    Groupoid.{v} (InducedCategory D F) :=
  { InducedCategory.category F with
    inv := fun X Y f => Groupoid.inv f
    inv_comp' := fun X Y f => Groupoid.inv_comp f
    comp_inv' := fun X Y f => Groupoid.comp_inv f }
#align category_theory.induced_category.groupoid CategoryTheory.InducedCategory.groupoid
-/

section

#print CategoryTheory.groupoidPi /-
instance groupoidPi {I : Type u} {J : I → Type u₂} [∀ i, Groupoid.{v} (J i)] :
    Groupoid.{max u v} (∀ i : I, J i)
    where inv (x y : ∀ i, J i) (f : ∀ i, x i ⟶ y i) := fun i : I => Groupoid.inv (f i)
#align category_theory.groupoid_pi CategoryTheory.groupoidPi
-/

#print CategoryTheory.groupoidProd /-
instance groupoidProd {α : Type u} {β : Type v} [Groupoid.{u₂} α] [Groupoid.{v₂} β] :
    Groupoid.{max u₂ v₂} (α × β)
    where inv (x y : α × β) (f : x ⟶ y) := (Groupoid.inv f.1, Groupoid.inv f.2)
#align category_theory.groupoid_prod CategoryTheory.groupoidProd
-/

end

end CategoryTheory


import M4R.Algebra.Ring.Ring
import M4R.Algebra.Ring.RMorphism

open Classical

namespace M4R

  namespace Finsupp

    protected noncomputable instance one (α : Type _) (β : Type _) [Zero α] [Zero β] [One β] :
      One (α →₀ β) where one := single 0 1

    theorem one_def [Zero α] [Zero β] [One β] : (1 : α →₀ β) = single 0 1 := rfl

    theorem all_trivial (α : Type _) (β : Type _) [Zero α] [NCSemiring β] (h10 : (1 : β) = 0)
      (x : α →₀ β) : x = 0 :=
        zero_fun fun a => NCSemiring.all_trivial h10 _

    protected noncomputable instance mul' [Monoid α] [NCSemiring β] : Mul (α →₀ β) where
      mul :=  fun x y => ∑ fun a₁ b₁ => ∑ fun a₂ b₂ => single (a₁ + a₂) (b₁ * b₂) in y in x

    theorem mul_def [Monoid α] [NCSemiring β] {f g : α →₀ β} :
      f * g = ∑ fun a₁ b₁ => ∑ fun a₂ b₂ => single (a₁ + a₂) (b₁ * b₂) in g in f := rfl

    noncomputable instance toNCSemiring [Monoid α] [NCSemiring β] : NCSemiring (α →₀ β) :=
      {
        mul_zero          := fun x => by simp only [mul_def, map_sum.zero_sum, map_sum.sum_zero]
        zero_mul          := fun x => by simp only [mul_def, map_sum.zero_sum]
        mul_one           := fun x => by
          have : (fun (a₁ : α) (b₁ : β) => ∑ fun a₂ b₂ => single (a₁ + a₂) (b₁ * b₂) in single 0 1)
            = fun a₁ b₁ => single a₁ b₁ := by
              apply funext; intro a₁; apply funext; intro b₁
              rw [map_sum.single (0 : α) (1 : β) (fun a₂ b₂ => single (a₁ + a₂) (b₁ * b₂))
                (by simp only [NCSemiring.mul_zero, single.zero]),
                Monoid.add_zero, NCSemiring.mul_one]
          simp only [mul_def, one_def, mul_eq, this, map_sum.sum_single]
        one_mul           := fun x => by
          have : (fun (a₂ : α) (b₂ : β) => single (0 + a₂) (1 * b₂)) = fun a₂ b₂ => single a₂ b₂ := by
            apply funext; intro a₂; apply funext; intro b₂
            rw [Monoid.zero_add, NCSemiring.one_mul]
          simp only [mul_def, one_def, mul_eq]
          rw [map_sum.single 0 1 _ (by simp only [NCSemiring.zero_mul, single.zero, map_sum.sum_zero]),
            this, map_sum.sum_single]
        mul_assoc         := fun x y z => by
          simp only [mul_def]
          have h₁ : ∀ a, (∑ fun a₂ b₂ => single (a + a₂) (0 * b₂) in z) = 0 := by
            intros; simp only [NCSemiring.zero_mul, single.zero, map_sum.sum_zero]
          have h₂ : ∀ (a : α) (b₁ b₂ : β),
            (∑ fun a₂ b₂_1 => single (a + a₂) ((b₁ + b₂) * b₂_1) in z) =
              (∑ fun a₂ b₂ => single (a + a₂) (b₁ * b₂) in z) + ∑ fun a₂ b₂_1 => single (a + a₂) (b₂ * b₂_1) in z := by
                intro a b b'; simp only; rw [←map_sum.sum_add]; apply map_sum.congr
                intros; rw [←single.add, NCSemiring.mul_distrib_right]
          have h₃ : ∀ {a₁} a, single (a₁ + a) (to_fun x a₁ * 0) = 0 := by
            intros; rw [NCSemiring.mul_zero, single.zero]
          have h₄ : ∀ {a₁} (a) (b₁ b₂), single (a₁ + a) (to_fun x a₁ * (b₁ + b₂)) =
              single (a₁ + a) (to_fun x a₁ * b₁) + single (a₁ + a) (to_fun x a₁ * b₂) := by
                intros; rw [←single.add, NCSemiring.mul_distrib_left]
          rw [map_sum.sum_sum h₁ h₂]; apply map_sum.congr; intros
          rw [map_sum.sum_sum h₁ h₂, map_sum.sum_sum h₃ h₄]; apply map_sum.congr; intros
          rw [map_sum.single _ _ _ (by
            conv => rhs; rw [←map_sum.sum_zero z]
            apply map_sum.congr; intros; rw [NCSemiring.zero_mul, single.zero])]
          rw [map_sum.sum_sum h₃ h₄]; apply map_sum.congr; intros
          rw [map_sum.single _ _ _ (by rw [NCSemiring.mul_zero, single.zero]), Monoid.add_assoc, NCSemiring.mul_assoc]
        mul_distrib_left  := fun x y z => by
          simp only [mul_def]
          have : (fun a₁ b₁ => (∑ fun a₂ b₂ => single (a₁ + a₂) (b₁ * b₂) in (y + z))) =
            fun a₁ b₁ => (∑ fun a₂ b₂ => single (a₁ + a₂) (b₁ * b₂) in y) + ∑ fun a₂ b₂ => single (a₁ + a₂) (b₁ * b₂) in z :=
              funext fun _ => funext fun _ =>
                map_sum.add_sum y z _ (fun _ => by rw [NCSemiring.mul_zero, single.zero])
                  (fun _ => by rw [←single.add, add_apply, NCSemiring.mul_distrib_left])
          rw [this]; exact map_sum.sum_add
        mul_distrib_right := fun x y z => by
          simp only [mul_def]
          exact map_sum.add_sum x y _ (fun _ =>
            map_sum.map_eq_zero (by intros; rw [NCSemiring.zero_mul, single.zero]))
              (fun _ => by
                rw [←map_sum.sum_add]; exact map_sum.congr (by
                  intros; rw [←single.add, add_apply, NCSemiring.mul_distrib_right]))
      }

    noncomputable instance toNonTrivialNCSemiring [Monoid α] [NonTrivialNCSemiring β] : NonTrivialNCSemiring (α →₀ β) where
      one_neq_zero := by
        intro h; simp only [one_def] at h
        have := congrArg (fun (x : α →₀ β) => x (0 : α)) h
        simp only [single.eq_same, zero_apply] at this
        exact absurd this NonTrivial.one_neq_zero

    noncomputable instance toSemiring [CommMonoid α] [Semiring β] : Semiring (α →₀ β) where
      mul_comm := fun x y => by
        simp only [mul_def, Finsupp.map_sum, Semiring.mul_comm]
        rw [Finset.map_sum.comm]; simp only [CommMonoid.add_comm]

    noncomputable instance toNCRing [Monoid α] [NCRing β] : NCRing (α →₀ β) where
      toNeg   := Finsupp.neg
      add_neg := toGroup.add_neg

    noncomputable instance toRing [CommMonoid α] [Ring β] : Ring (α →₀ β) where
      toNCRing := toNCRing
      mul_comm := toSemiring.mul_comm

    noncomputable instance UnitFinsuppNCSemiring [NCSemiring α] : (Unit →₀ α) ≅* α where
      toMHomomorphism := UnitFinsuppMonoid.toMHomomorphism
      preserve_mul := fun x y => by
        simp only [mul_def]
        have : (fun a₂ b₂ => single (Unit.unit + a₂) ((0 : α) * b₂)) = fun _ _ => (0 : Unit →₀ α) := by
          apply funext; intro u; cases u; apply funext; intro u
          rw [NCSemiring.zero_mul, single.zero]
        rw [map_sum.unit_sum x (by rw [this, map_sum.sum_zero]), map_sum.unit_sum y
          (by rw [NCSemiring.mul_zero, single.zero])]
        simp only [UnitFinsuppMonoid]; have : Unit.unit + Unit.unit = Unit.unit := rfl
        rw [this, single.eq_same]
      inv := UnitFinsuppMonoid.inv
      left_inv := UnitFinsuppMonoid.left_inv
      right_inv := UnitFinsuppMonoid.right_inv

    noncomputable instance UnitFinsuppNCRing [NCRing α] : (Unit →₀ α) ≅ᵣ α where
      toSMulMap := UnitFinsuppNCSemiring.toSMulMap
      preserve_neg := UnitFinsuppGroup.preserve_neg
      inv := UnitFinsuppMonoid.inv
      left_inv := UnitFinsuppMonoid.left_inv
      right_inv := UnitFinsuppMonoid.right_inv

    @[simp] theorem single_mul_single [Monoid α] [NCSemiring β] {a₁ a₂ : α} {b₁ b₂ : β} :
        single a₁ b₁ * single a₂ b₂ = single (a₁ + a₂) (b₁ * b₂) := by
          simp only [mul_def, map_sum.single, NCSemiring.zero_mul, NCSemiring.mul_zero, single.zero]

  end Finsupp
end M4R


namespace fol_06

variable A : Type
variables P Q : A → Prop

variable h : ¬ ∃ x, P x ∨ Q x
include h

theorem fol_06 : ∀ x, ¬ P x ∧ ¬ Q x :=
assume s,
have h1: ∀ t, ¬ (P t ∨ Q t), from
  (assume t: A,
   classical.by_contradiction
    (assume h2: ¬¬(P t ∨ Q t),
     have h3: P t ∨ Q t, from classical.by_contradiction h2,
     h (exists.intro t h3))),

have h4: ¬ (P s ∨ Q s), from h1 s,

have h5: ¬ P s, from classical.by_contradiction
  (assume h6: ¬¬P s,
   have h7: P s, from classical.by_contradiction h6,
   have h8: P s ∨ Q s, from or.inl h7,
   h4 h8),
have h9: ¬ Q s, from classical.by_contradiction
  (assume h10: ¬¬Q s,
   have h11: Q s, from classical.by_contradiction h10,
   have h12: P s ∨ Q s, from or.inr h11,
   h4 h12),

have h13: ¬ P s ∧ ¬ Q s, from and.intro h5 h9,
show ¬P s ∧ ¬Q s, from h13

end fol_06


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem amc12a_2009_p5
  (x : ℝ)
  (h₀ : x^3 - (x + 1) * (x - 1) * x = 5) :
  x^3 = 125 :=
begin
  nlinarith [pow_two x],
end


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

/-!
# List sections

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

This file proves some stuff about `list.sections` (definition in `data.list.defs`). A section of a
list of lists `[l₁, ..., lₙ]` is a list whose `i`-th element comes from the `i`-th list.
-/

open nat function

namespace list
variables {α β : Type*}

theorem mem_sections {L : list (list α)} {f} : f ∈ sections L ↔ forall₂ (∈) f L :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  { induction L generalizing f, {cases mem_singleton.1 h, exact forall₂.nil},
    simp only [sections, bind_eq_bind, mem_bind, mem_map] at h,
    rcases h with ⟨_, _, _, _, rfl⟩,
    simp only [*, forall₂_cons, true_and] },
  { induction h with a l f L al fL fs, {exact or.inl rfl},
    simp only [sections, bind_eq_bind, mem_bind, mem_map],
    exact ⟨_, fs, _, al, rfl, rfl⟩ }
end

lemma rel_sections {r : α → β → Prop} :
  (forall₂ (forall₂ r) ⇒ forall₂ (forall₂ r)) sections sections
| _ _ forall₂.nil := forall₂.cons forall₂.nil forall₂.nil
| _ _ (forall₂.cons h₀ h₁) :=
  rel_bind (rel_sections h₁) (assume _ _ hl, rel_map (assume _ _ ha, forall₂.cons ha hl) h₀)

end list


/-
Copyright (c) 2018 Sean Leather. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sean Leather, Mario Carneiro

! This file was ported from Lean 3 source module data.finmap
! leanprover-community/mathlib commit cea83e192eae2d368ab2b500a0975667da42c920
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.List.Alist
import Mathbin.Data.Finset.Sigma
import Mathbin.Data.Part

/-!
# Finite maps over `multiset`

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

universe u v w

open List

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

/-! ### multisets of sigma types-/

namespace Multiset

#print Multiset.keys /-
/-- Multiset of keys of an association multiset. -/
def keys (s : Multiset (Sigma β)) : Multiset α :=
  s.map Sigma.fst
#align multiset.keys Multiset.keys
-/

#print Multiset.coe_keys /-
@[simp]
theorem coe_keys {l : List (Sigma β)} : keys (l : Multiset (Sigma β)) = (l.keys : Multiset α) :=
  rfl
#align multiset.coe_keys Multiset.coe_keys
-/

#print Multiset.NodupKeys /-
/-- `nodupkeys s` means that `s` has no duplicate keys. -/
def NodupKeys (s : Multiset (Sigma β)) : Prop :=
  Quot.liftOn s List.NodupKeys fun s t p => propext <| perm_nodupKeys p
#align multiset.nodupkeys Multiset.NodupKeys
-/

#print Multiset.coe_nodupKeys /-
@[simp]
theorem coe_nodupKeys {l : List (Sigma β)} : @NodupKeys α β l ↔ l.NodupKeys :=
  Iff.rfl
#align multiset.coe_nodupkeys Multiset.coe_nodupKeys
-/

#print Multiset.nodup_keys /-
theorem nodup_keys {m : Multiset (Σa, β a)} : m.keys.Nodup ↔ m.NodupKeys :=
  by
  rcases m with ⟨l⟩
  rfl
#align multiset.nodup_keys Multiset.nodup_keys
-/

alias nodup_keys ↔ _ nodupkeys.nodup_keys
#align multiset.nodupkeys.nodup_keys Multiset.NodupKeys.nodup_keys

#print Multiset.NodupKeys.nodup /-
theorem NodupKeys.nodup {m : Multiset (Σa, β a)} (h : m.NodupKeys) : m.Nodup :=
  h.nodup_keys.of_map _
#align multiset.nodupkeys.nodup Multiset.NodupKeys.nodup
-/

end Multiset

/-! ### finmap -/

#print Finmap /-
/-- `finmap β` is the type of finite maps over a multiset. It is effectively
  a quotient of `alist β` by permutation of the underlying list. -/
structure Finmap (β : α → Type v) : Type max u v where
  entries : Multiset (Sigma β)
  NodupKeys : entries.NodupKeys
#align finmap Finmap
-/

#print AList.toFinmap /-
/-- The quotient map from `alist` to `finmap`. -/
def AList.toFinmap (s : AList β) : Finmap β :=
  ⟨s.entries, s.NodupKeys⟩
#align alist.to_finmap AList.toFinmap
-/

-- mathport name: to_finmap
local notation:arg "⟦" a "⟧" => AList.toFinmap a

#print AList.toFinmap_eq /-
theorem AList.toFinmap_eq {s₁ s₂ : AList β} : ⟦s₁⟧ = ⟦s₂⟧ ↔ s₁.entries ~ s₂.entries := by
  cases s₁ <;> cases s₂ <;> simp [AList.toFinmap]
#align alist.to_finmap_eq AList.toFinmap_eq
-/

#print AList.toFinmap_entries /-
@[simp]
theorem AList.toFinmap_entries (s : AList β) : ⟦s⟧.entries = s.entries :=
  rfl
#align alist.to_finmap_entries AList.toFinmap_entries
-/

#print List.toFinmap /-
/-- Given `l : list (sigma β)`, create a term of type `finmap β` by removing
entries with duplicate keys. -/
def List.toFinmap [DecidableEq α] (s : List (Sigma β)) : Finmap β :=
  s.toAList.toFinmap
#align list.to_finmap List.toFinmap
-/

namespace Finmap

open AList

#print Finmap.nodup_entries /-
theorem nodup_entries (f : Finmap β) : f.entries.Nodup :=
  f.NodupKeys.Nodup
#align finmap.nodup_entries Finmap.nodup_entries
-/

/-! ### lifting from alist -/

#print Finmap.liftOn /-
/-- Lift a permutation-respecting function on `alist` to `finmap`. -/
@[elab_as_elim]
def liftOn {γ} (s : Finmap β) (f : AList β → γ)
    (H : ∀ a b : AList β, a.entries ~ b.entries → f a = f b) : γ :=
  by
  refine'
    (Quotient.liftOn s.1 (fun l => (⟨_, fun nd => f ⟨l, nd⟩⟩ : Part γ)) fun l₁ l₂ p =>
            Part.ext' (perm_nodupkeys p) _ :
          Part γ).get
      _
  · exact fun h₁ h₂ => H _ _ p
  · have := s.nodupkeys
    rcases s.entries with ⟨l⟩
    exact id
#align finmap.lift_on Finmap.liftOn
-/

/- warning: finmap.lift_on_to_finmap -> Finmap.liftOn_toFinmap is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : α -> Type.{u2}} {γ : Type.{u3}} (s : AList.{u1, u2} α β) (f : (AList.{u1, u2} α β) -> γ) (H : forall (a : AList.{u1, u2} α β) (b : AList.{u1, u2} α β), (List.Perm.{max u1 u2} (Sigma.{u1, u2} α β) (AList.entries.{u1, u2} α β a) (AList.entries.{u1, u2} α β b)) -> (Eq.{succ u3} γ (f a) (f b))), Eq.{succ u3} γ (Finmap.liftOn.{u1, u2, u3} α β γ (AList.toFinmap.{u1, u2} α β s) f H) (f s)
but is expected to have type
  forall {α : Type.{u2}} {β : α -> Type.{u3}} {γ : Type.{u1}} (s : AList.{u2, u3} α β) (f : (AList.{u2, u3} α β) -> γ) (H : forall (a : AList.{u2, u3} α β) (b : AList.{u2, u3} α β), (List.Perm.{max u2 u3} (Sigma.{u2, u3} α β) (AList.entries.{u2, u3} α β a) (AList.entries.{u2, u3} α β b)) -> (Eq.{succ u1} γ (f a) (f b))), Eq.{succ u1} γ (Finmap.liftOn.{u2, u3, u1} α β γ (AList.toFinmap.{u2, u3} α β s) f H) (f s)
Case conversion may be inaccurate. Consider using '#align finmap.lift_on_to_finmap Finmap.liftOn_toFinmapₓ'. -/
@[simp]
theorem liftOn_toFinmap {γ} (s : AList β) (f : AList β → γ) (H) : liftOn ⟦s⟧ f H = f s := by
  cases s <;> rfl
#align finmap.lift_on_to_finmap Finmap.liftOn_toFinmap

#print Finmap.liftOn₂ /-
/-- Lift a permutation-respecting function on 2 `alist`s to 2 `finmap`s. -/
@[elab_as_elim]
def liftOn₂ {γ} (s₁ s₂ : Finmap β) (f : AList β → AList β → γ)
    (H :
      ∀ a₁ b₁ a₂ b₂ : AList β,
        a₁.entries ~ a₂.entries → b₁.entries ~ b₂.entries → f a₁ b₁ = f a₂ b₂) :
    γ :=
  liftOn s₁ (fun l₁ => liftOn s₂ (f l₁) fun b₁ b₂ p => H _ _ _ _ (Perm.refl _) p) fun a₁ a₂ p =>
    by
    have H' : f a₁ = f a₂ := funext fun _ => H _ _ _ _ p (Perm.refl _)
    simp only [H']
#align finmap.lift_on₂ Finmap.liftOn₂
-/

/- warning: finmap.lift_on₂_to_finmap -> Finmap.liftOn₂_toFinmap is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : α -> Type.{u2}} {γ : Type.{u3}} (s₁ : AList.{u1, u2} α β) (s₂ : AList.{u1, u2} α β) (f : (AList.{u1, u2} α β) -> (AList.{u1, u2} α β) -> γ) (H : forall (a₁ : AList.{u1, u2} α β) (b₁ : AList.{u1, u2} α β) (a₂ : AList.{u1, u2} α β) (b₂ : AList.{u1, u2} α β), (List.Perm.{max u1 u2} (Sigma.{u1, u2} α β) (AList.entries.{u1, u2} α β a₁) (AList.entries.{u1, u2} α β a₂)) -> (List.Perm.{max u1 u2} (Sigma.{u1, u2} α β) (AList.entries.{u1, u2} α β b₁) (AList.entries.{u1, u2} α β b₂)) -> (Eq.{succ u3} γ (f a₁ b₁) (f a₂ b₂))), Eq.{succ u3} γ (Finmap.liftOn₂.{u1, u2, u3} α β γ (AList.toFinmap.{u1, u2} α β s₁) (AList.toFinmap.{u1, u2} α β s₂) f H) (f s₁ s₂)
but is expected to have type
  forall {α : Type.{u2}} {β : α -> Type.{u3}} {γ : Type.{u1}} (s₁ : AList.{u2, u3} α β) (s₂ : AList.{u2, u3} α β) (f : (AList.{u2, u3} α β) -> (AList.{u2, u3} α β) -> γ) (H : forall (a₁ : AList.{u2, u3} α β) (b₁ : AList.{u2, u3} α β) (a₂ : AList.{u2, u3} α β) (b₂ : AList.{u2, u3} α β), (List.Perm.{max u2 u3} (Sigma.{u2, u3} α β) (AList.entries.{u2, u3} α β a₁) (AList.entries.{u2, u3} α β a₂)) -> (List.Perm.{max u2 u3} (Sigma.{u2, u3} α β) (AList.entries.{u2, u3} α β b₁) (AList.entries.{u2, u3} α β b₂)) -> (Eq.{succ u1} γ (f a₁ b₁) (f a₂ b₂))), Eq.{succ u1} γ (Finmap.liftOn₂.{u2, u3, u1} α β γ (AList.toFinmap.{u2, u3} α β s₁) (AList.toFinmap.{u2, u3} α β s₂) f H) (f s₁ s₂)
Case conversion may be inaccurate. Consider using '#align finmap.lift_on₂_to_finmap Finmap.liftOn₂_toFinmapₓ'. -/
@[simp]
theorem liftOn₂_toFinmap {γ} (s₁ s₂ : AList β) (f : AList β → AList β → γ) (H) :
    liftOn₂ ⟦s₁⟧ ⟦s₂⟧ f H = f s₁ s₂ := by cases s₁ <;> cases s₂ <;> rfl
#align finmap.lift_on₂_to_finmap Finmap.liftOn₂_toFinmap

/-! ### induction -/

#print Finmap.induction_on /-
@[elab_as_elim]
theorem induction_on {C : Finmap β → Prop} (s : Finmap β) (H : ∀ a : AList β, C ⟦a⟧) : C s := by
  rcases s with ⟨⟨a⟩, h⟩ <;> exact H ⟨a, h⟩
#align finmap.induction_on Finmap.induction_on
-/

#print Finmap.induction_on₂ /-
@[elab_as_elim]
theorem induction_on₂ {C : Finmap β → Finmap β → Prop} (s₁ s₂ : Finmap β)
    (H : ∀ a₁ a₂ : AList β, C ⟦a₁⟧ ⟦a₂⟧) : C s₁ s₂ :=
  induction_on s₁ fun l₁ => induction_on s₂ fun l₂ => H l₁ l₂
#align finmap.induction_on₂ Finmap.induction_on₂
-/

#print Finmap.induction_on₃ /-
@[elab_as_elim]
theorem induction_on₃ {C : Finmap β → Finmap β → Finmap β → Prop} (s₁ s₂ s₃ : Finmap β)
    (H : ∀ a₁ a₂ a₃ : AList β, C ⟦a₁⟧ ⟦a₂⟧ ⟦a₃⟧) : C s₁ s₂ s₃ :=
  induction_on₂ s₁ s₂ fun l₁ l₂ => induction_on s₃ fun l₃ => H l₁ l₂ l₃
#align finmap.induction_on₃ Finmap.induction_on₃
-/

/-! ### extensionality -/

#print Finmap.ext /-
@[ext]
theorem ext : ∀ {s t : Finmap β}, s.entries = t.entries → s = t
  | ⟨l₁, h₁⟩, ⟨l₂, h₂⟩, H => by congr
#align finmap.ext Finmap.ext
-/

#print Finmap.ext_iff /-
@[simp]
theorem ext_iff {s t : Finmap β} : s.entries = t.entries ↔ s = t :=
  ⟨ext, congr_arg _⟩
#align finmap.ext_iff Finmap.ext_iff
-/

/-! ### mem -/

/-- The predicate `a ∈ s` means that `s` has a value associated to the key `a`. -/
instance : Membership α (Finmap β) :=
  ⟨fun a s => a ∈ s.entries.keys⟩

#print Finmap.mem_def /-
theorem mem_def {a : α} {s : Finmap β} : a ∈ s ↔ a ∈ s.entries.keys :=
  Iff.rfl
#align finmap.mem_def Finmap.mem_def
-/

#print Finmap.mem_toFinmap /-
@[simp]
theorem mem_toFinmap {a : α} {s : AList β} : a ∈ ⟦s⟧ ↔ a ∈ s :=
  Iff.rfl
#align finmap.mem_to_finmap Finmap.mem_toFinmap
-/

/-! ### keys -/

#print Finmap.keys /-
/-- The set of keys of a finite map. -/
def keys (s : Finmap β) : Finset α :=
  ⟨s.entries.keys, s.NodupKeys.nodup_keys⟩
#align finmap.keys Finmap.keys
-/

#print Finmap.keys_val /-
@[simp]
theorem keys_val (s : AList β) : (keys ⟦s⟧).val = s.keys :=
  rfl
#align finmap.keys_val Finmap.keys_val
-/

#print Finmap.keys_ext /-
@[simp]
theorem keys_ext {s₁ s₂ : AList β} : keys ⟦s₁⟧ = keys ⟦s₂⟧ ↔ s₁.keys ~ s₂.keys := by
  simp [keys, AList.keys]
#align finmap.keys_ext Finmap.keys_ext
-/

#print Finmap.mem_keys /-
theorem mem_keys {a : α} {s : Finmap β} : a ∈ s.keys ↔ a ∈ s :=
  induction_on s fun s => AList.mem_keys
#align finmap.mem_keys Finmap.mem_keys
-/

/-! ### empty -/

/-- The empty map. -/
instance : EmptyCollection (Finmap β) :=
  ⟨⟨0, nodupKeys_nil⟩⟩

instance : Inhabited (Finmap β) :=
  ⟨∅⟩

#print Finmap.empty_toFinmap /-
@[simp]
theorem empty_toFinmap : (⟦∅⟧ : Finmap β) = ∅ :=
  rfl
#align finmap.empty_to_finmap Finmap.empty_toFinmap
-/

#print Finmap.toFinmap_nil /-
@[simp]
theorem toFinmap_nil [DecidableEq α] : ([].toFinmap : Finmap β) = ∅ :=
  rfl
#align finmap.to_finmap_nil Finmap.toFinmap_nil
-/

#print Finmap.not_mem_empty /-
theorem not_mem_empty {a : α} : a ∉ (∅ : Finmap β) :=
  Multiset.not_mem_zero a
#align finmap.not_mem_empty Finmap.not_mem_empty
-/

#print Finmap.keys_empty /-
@[simp]
theorem keys_empty : (∅ : Finmap β).keys = ∅ :=
  rfl
#align finmap.keys_empty Finmap.keys_empty
-/

/-! ### singleton -/

#print Finmap.singleton /-
/-- The singleton map. -/
def singleton (a : α) (b : β a) : Finmap β :=
  ⟦AList.singleton a b⟧
#align finmap.singleton Finmap.singleton
-/

#print Finmap.keys_singleton /-
@[simp]
theorem keys_singleton (a : α) (b : β a) : (singleton a b).keys = {a} :=
  rfl
#align finmap.keys_singleton Finmap.keys_singleton
-/

#print Finmap.mem_singleton /-
@[simp]
theorem mem_singleton (x y : α) (b : β y) : x ∈ singleton y b ↔ x = y := by
  simp only [singleton] <;> erw [mem_cons_eq, mem_nil_iff, or_false_iff]
#align finmap.mem_singleton Finmap.mem_singleton
-/

section

variable [DecidableEq α]

#print Finmap.decidableEq /-
instance decidableEq [∀ a, DecidableEq (β a)] : DecidableEq (Finmap β)
  | s₁, s₂ => decidable_of_iff _ ext_iff
#align finmap.has_decidable_eq Finmap.decidableEq
-/

/-! ### lookup -/

#print Finmap.lookup /-
/-- Look up the value associated to a key in a map. -/
def lookup (a : α) (s : Finmap β) : Option (β a) :=
  liftOn s (lookup a) fun s t => perm_lookup
#align finmap.lookup Finmap.lookup
-/

#print Finmap.lookup_toFinmap /-
@[simp]
theorem lookup_toFinmap (a : α) (s : AList β) : lookup a ⟦s⟧ = s.dlookup a :=
  rfl
#align finmap.lookup_to_finmap Finmap.lookup_toFinmap
-/

#print Finmap.dlookup_list_toFinmap /-
@[simp]
theorem dlookup_list_toFinmap (a : α) (s : List (Sigma β)) : lookup a s.toFinmap = s.dlookup a := by
  rw [List.toFinmap, lookup_to_finmap, lookup_to_alist]
#align finmap.lookup_list_to_finmap Finmap.dlookup_list_toFinmap
-/

#print Finmap.lookup_empty /-
@[simp]
theorem lookup_empty (a) : lookup a (∅ : Finmap β) = none :=
  rfl
#align finmap.lookup_empty Finmap.lookup_empty
-/

#print Finmap.lookup_isSome /-
theorem lookup_isSome {a : α} {s : Finmap β} : (s.dlookup a).isSome ↔ a ∈ s :=
  induction_on s fun s => AList.lookup_isSome
#align finmap.lookup_is_some Finmap.lookup_isSome
-/

#print Finmap.lookup_eq_none /-
theorem lookup_eq_none {a} {s : Finmap β} : lookup a s = none ↔ a ∉ s :=
  induction_on s fun s => AList.lookup_eq_none
#align finmap.lookup_eq_none Finmap.lookup_eq_none
-/

#print Finmap.mem_lookup_iff /-
theorem mem_lookup_iff {f : Finmap β} {a : α} {b : β a} :
    b ∈ f.dlookup a ↔ Sigma.mk a b ∈ f.entries :=
  by
  rcases f with ⟨⟨l⟩, hl⟩
  exact List.mem_dlookup_iff hl
#align finmap.mem_lookup_iff Finmap.mem_lookup_iff
-/

#print Finmap.lookup_eq_some_iff /-
/-- A version of `finmap.mem_lookup_iff` with LHS in the simp-normal form. -/
theorem lookup_eq_some_iff {f : Finmap β} {a : α} {b : β a} :
    f.dlookup a = some b ↔ Sigma.mk a b ∈ f.entries :=
  mem_lookup_iff
#align finmap.lookup_eq_some_iff Finmap.lookup_eq_some_iff
-/

#print Finmap.sigma_keys_lookup /-
@[simp]
theorem sigma_keys_lookup (f : Finmap β) :
    (f.keys.Sigma fun i => (f.dlookup i).toFinset) = ⟨f.entries, f.nodup_entries⟩ :=
  by
  ext x
  have : x ∈ f.entries → x.fst ∈ f.keys := Multiset.mem_map_of_mem _
  simpa [lookup_eq_some_iff]
#align finmap.sigma_keys_lookup Finmap.sigma_keys_lookup
-/

#print Finmap.lookup_singleton_eq /-
@[simp]
theorem lookup_singleton_eq {a : α} {b : β a} : (singleton a b).dlookup a = some b := by
  rw [singleton, lookup_to_finmap, AList.singleton, AList.lookup, lookup_cons_eq]
#align finmap.lookup_singleton_eq Finmap.lookup_singleton_eq
-/

instance (a : α) (s : Finmap β) : Decidable (a ∈ s) :=
  decidable_of_iff _ lookup_isSome

#print Finmap.mem_iff /-
theorem mem_iff {a : α} {s : Finmap β} : a ∈ s ↔ ∃ b, s.dlookup a = some b :=
  induction_on s fun s =>
    Iff.trans List.mem_keys <| exists_congr fun b => (List.mem_dlookup_iff s.NodupKeys).symm
#align finmap.mem_iff Finmap.mem_iff
-/

#print Finmap.mem_of_lookup_eq_some /-
theorem mem_of_lookup_eq_some {a : α} {b : β a} {s : Finmap β} (h : s.dlookup a = some b) : a ∈ s :=
  mem_iff.mpr ⟨_, h⟩
#align finmap.mem_of_lookup_eq_some Finmap.mem_of_lookup_eq_some
-/

#print Finmap.ext_lookup /-
theorem ext_lookup {s₁ s₂ : Finmap β} : (∀ x, s₁.dlookup x = s₂.dlookup x) → s₁ = s₂ :=
  induction_on₂ s₁ s₂ fun s₁ s₂ h =>
    by
    simp only [AList.lookup, lookup_to_finmap] at h
    rw [AList.toFinmap_eq]
    apply lookup_ext s₁.nodupkeys s₂.nodupkeys
    intro x y
    rw [h]
#align finmap.ext_lookup Finmap.ext_lookup
-/

#print Finmap.keysLookupEquiv /-
/-- An equivalence between `finmap β` and pairs `(keys : finset α, lookup : Π a, option (β a))` such
that `(lookup a).is_some ↔ a ∈ keys`. -/
@[simps apply_coe_fst apply_coe_snd]
def keysLookupEquiv :
    Finmap β ≃ { f : Finset α × ∀ a, Option (β a) // ∀ i, (f.2 i).isSome ↔ i ∈ f.1 }
    where
  toFun f := ⟨(f.keys, fun i => f.dlookup i), fun i => lookup_isSome⟩
  invFun f :=
    ⟨(f.1.1.Sigma fun i => (f.1.2 i).toFinset).val,
      by
      refine' Multiset.nodup_keys.1 ((Finset.nodup _).map_onₓ _)
      simp only [Finset.mem_val, Finset.mem_sigma, Option.mem_toFinset, Option.mem_def]
      rintro ⟨i, x⟩ ⟨hi, hx⟩ ⟨j, y⟩ ⟨hj, hy⟩ (rfl : i = j)
      obtain rfl : x = y; exact Option.some.inj (hx.symm.trans hy)
      rfl⟩
  left_inv f := ext <| by simp
  right_inv := fun ⟨⟨s, f⟩, hf⟩ => by
    ext : 2 <;> dsimp [keys]
    · ext1 i
      have : i ∈ s → ∃ x, f i = some x := fun hi => ⟨Option.get _, Option.get_mem <| (hf i).2 hi⟩
      simpa [Multiset.keys]
    · ext (i x) : 2
      simp only [Option.mem_def, lookup_eq_some_iff, Finset.mem_val, Finset.mem_sigma,
        Option.mem_toFinset, and_iff_right_iff_imp, ← hf]
      exact fun h => Option.isSome_iff_exists.2 ⟨_, h⟩
#align finmap.keys_lookup_equiv Finmap.keysLookupEquiv
-/

#print Finmap.keysLookupEquiv_symm_apply_keys /-
@[simp]
theorem keysLookupEquiv_symm_apply_keys :
    ∀ f : { f : Finset α × ∀ a, Option (β a) // ∀ i, (f.2 i).isSome ↔ i ∈ f.1 },
      (keysLookupEquiv.symm f).keys = (f : Finset α × ∀ a, Option (β a)).1 :=
  keysLookupEquiv.Surjective.forall.2 fun f => by
    simp only [Equiv.symm_apply_apply, keys_lookup_equiv_apply_coe_fst]
#align finmap.keys_lookup_equiv_symm_apply_keys Finmap.keysLookupEquiv_symm_apply_keys
-/

#print Finmap.keysLookupEquiv_symm_apply_lookup /-
@[simp]
theorem keysLookupEquiv_symm_apply_lookup :
    ∀ (f : { f : Finset α × ∀ a, Option (β a) // ∀ i, (f.2 i).isSome ↔ i ∈ f.1 }) (a),
      (keysLookupEquiv.symm f).dlookup a = (f : Finset α × ∀ a, Option (β a)).2 a :=
  keysLookupEquiv.Surjective.forall.2 fun f a => by
    simp only [Equiv.symm_apply_apply, keys_lookup_equiv_apply_coe_snd]
#align finmap.keys_lookup_equiv_symm_apply_lookup Finmap.keysLookupEquiv_symm_apply_lookup
-/

/-! ### replace -/

#print Finmap.replace /-
/-- Replace a key with a given value in a finite map.
  If the key is not present it does nothing. -/
def replace (a : α) (b : β a) (s : Finmap β) : Finmap β :=
  liftOn s (fun t => ⟦replace a b t⟧) fun s₁ s₂ p => toFinmap_eq.2 <| perm_replace p
#align finmap.replace Finmap.replace
-/

#print Finmap.replace_toFinmap /-
@[simp]
theorem replace_toFinmap (a : α) (b : β a) (s : AList β) : replace a b ⟦s⟧ = ⟦s.replace a b⟧ := by
  simp [replace]
#align finmap.replace_to_finmap Finmap.replace_toFinmap
-/

#print Finmap.keys_replace /-
@[simp]
theorem keys_replace (a : α) (b : β a) (s : Finmap β) : (replace a b s).keys = s.keys :=
  induction_on s fun s => by simp
#align finmap.keys_replace Finmap.keys_replace
-/

#print Finmap.mem_replace /-
@[simp]
theorem mem_replace {a a' : α} {b : β a} {s : Finmap β} : a' ∈ replace a b s ↔ a' ∈ s :=
  induction_on s fun s => by simp
#align finmap.mem_replace Finmap.mem_replace
-/

end

/-! ### foldl -/

#print Finmap.foldl /-
/-- Fold a commutative function over the key-value pairs in the map -/
def foldl {δ : Type w} (f : δ → ∀ a, β a → δ)
    (H : ∀ d a₁ b₁ a₂ b₂, f (f d a₁ b₁) a₂ b₂ = f (f d a₂ b₂) a₁ b₁) (d : δ) (m : Finmap β) : δ :=
  m.entries.foldl (fun d s => f d s.1 s.2) (fun d s t => H _ _ _ _ _) d
#align finmap.foldl Finmap.foldl
-/

#print Finmap.any /-
/-- `any f s` returns `tt` iff there exists a value `v` in `s` such that `f v = tt`. -/
def any (f : ∀ x, β x → Bool) (s : Finmap β) : Bool :=
  s.foldl (fun x y z => x || f y z)
    (by
      intros
      simp_rw [Bool.or_assoc, Bool.or_comm])
    false
#align finmap.any Finmap.any
-/

#print Finmap.all /-
/-- `all f s` returns `tt` iff `f v = tt` for all values `v` in `s`. -/
def all (f : ∀ x, β x → Bool) (s : Finmap β) : Bool :=
  s.foldl (fun x y z => x && f y z)
    (by
      intros
      simp_rw [Bool.and_assoc, Bool.and_comm])
    true
#align finmap.all Finmap.all
-/

/-! ### erase -/

section

variable [DecidableEq α]

#print Finmap.erase /-
/-- Erase a key from the map. If the key is not present it does nothing. -/
def erase (a : α) (s : Finmap β) : Finmap β :=
  liftOn s (fun t => ⟦erase a t⟧) fun s₁ s₂ p => toFinmap_eq.2 <| perm_erase p
#align finmap.erase Finmap.erase
-/

#print Finmap.erase_toFinmap /-
@[simp]
theorem erase_toFinmap (a : α) (s : AList β) : erase a ⟦s⟧ = ⟦s.eraseₓ a⟧ := by simp [erase]
#align finmap.erase_to_finmap Finmap.erase_toFinmap
-/

#print Finmap.keys_erase_toFinset /-
@[simp]
theorem keys_erase_toFinset (a : α) (s : AList β) : keys ⟦s.eraseₓ a⟧ = (keys ⟦s⟧).eraseₓ a := by
  simp [Finset.erase, keys, AList.erase, keys_kerase]
#align finmap.keys_erase_to_finset Finmap.keys_erase_toFinset
-/

#print Finmap.keys_erase /-
@[simp]
theorem keys_erase (a : α) (s : Finmap β) : (erase a s).keys = s.keys.eraseₓ a :=
  induction_on s fun s => by simp
#align finmap.keys_erase Finmap.keys_erase
-/

#print Finmap.mem_erase /-
@[simp]
theorem mem_erase {a a' : α} {s : Finmap β} : a' ∈ erase a s ↔ a' ≠ a ∧ a' ∈ s :=
  induction_on s fun s => by simp
#align finmap.mem_erase Finmap.mem_erase
-/

#print Finmap.not_mem_erase_self /-
theorem not_mem_erase_self {a : α} {s : Finmap β} : ¬a ∈ erase a s := by
  rw [mem_erase, not_and_or, Classical.not_not] <;> left <;> rfl
#align finmap.not_mem_erase_self Finmap.not_mem_erase_self
-/

#print Finmap.lookup_erase /-
@[simp]
theorem lookup_erase (a) (s : Finmap β) : lookup a (erase a s) = none :=
  induction_on s <| lookup_erase a
#align finmap.lookup_erase Finmap.lookup_erase
-/

#print Finmap.lookup_erase_ne /-
@[simp]
theorem lookup_erase_ne {a a'} {s : Finmap β} (h : a ≠ a') : lookup a (erase a' s) = lookup a s :=
  induction_on s fun s => lookup_erase_ne h
#align finmap.lookup_erase_ne Finmap.lookup_erase_ne
-/

#print Finmap.erase_erase /-
theorem erase_erase {a a' : α} {s : Finmap β} : erase a (erase a' s) = erase a' (erase a s) :=
  induction_on s fun s => ext (by simp only [erase_erase, erase_to_finmap])
#align finmap.erase_erase Finmap.erase_erase
-/

/-! ### sdiff -/

#print Finmap.sdiff /-
/-- `sdiff s s'` consists of all key-value pairs from `s` and `s'` where the keys are in `s` or
`s'` but not both. -/
def sdiff (s s' : Finmap β) : Finmap β :=
  s'.foldl (fun s x _ => s.eraseₓ x) (fun a₀ a₁ _ a₂ _ => erase_erase) s
#align finmap.sdiff Finmap.sdiff
-/

instance : SDiff (Finmap β) :=
  ⟨sdiff⟩

/-! ### insert -/

#print Finmap.insert /-
/-- Insert a key-value pair into a finite map, replacing any existing pair with
  the same key. -/
def insert (a : α) (b : β a) (s : Finmap β) : Finmap β :=
  liftOn s (fun t => ⟦insert a b t⟧) fun s₁ s₂ p => toFinmap_eq.2 <| perm_insert p
#align finmap.insert Finmap.insert
-/

#print Finmap.insert_toFinmap /-
@[simp]
theorem insert_toFinmap (a : α) (b : β a) (s : AList β) : insert a b ⟦s⟧ = ⟦s.insert a b⟧ := by
  simp [insert]
#align finmap.insert_to_finmap Finmap.insert_toFinmap
-/

#print Finmap.insert_entries_of_neg /-
theorem insert_entries_of_neg {a : α} {b : β a} {s : Finmap β} :
    a ∉ s → (insert a b s).entries = ⟨a, b⟩ ::ₘ s.entries :=
  induction_on s fun s h => by simp [insert_entries_of_neg (mt mem_to_finmap.1 h)]
#align finmap.insert_entries_of_neg Finmap.insert_entries_of_neg
-/

#print Finmap.mem_insert /-
@[simp]
theorem mem_insert {a a' : α} {b' : β a'} {s : Finmap β} : a ∈ insert a' b' s ↔ a = a' ∨ a ∈ s :=
  induction_on s mem_insert
#align finmap.mem_insert Finmap.mem_insert
-/

#print Finmap.lookup_insert /-
@[simp]
theorem lookup_insert {a} {b : β a} (s : Finmap β) : lookup a (insert a b s) = some b :=
  induction_on s fun s => by simp only [insert_to_finmap, lookup_to_finmap, lookup_insert]
#align finmap.lookup_insert Finmap.lookup_insert
-/

#print Finmap.lookup_insert_of_ne /-
@[simp]
theorem lookup_insert_of_ne {a a'} {b : β a} (s : Finmap β) (h : a' ≠ a) :
    lookup a' (insert a b s) = lookup a' s :=
  induction_on s fun s => by simp only [insert_to_finmap, lookup_to_finmap, lookup_insert_ne h]
#align finmap.lookup_insert_of_ne Finmap.lookup_insert_of_ne
-/

#print Finmap.insert_insert /-
@[simp]
theorem insert_insert {a} {b b' : β a} (s : Finmap β) :
    (s.insert a b).insert a b' = s.insert a b' :=
  induction_on s fun s => by simp only [insert_to_finmap, insert_insert]
#align finmap.insert_insert Finmap.insert_insert
-/

#print Finmap.insert_insert_of_ne /-
theorem insert_insert_of_ne {a a'} {b : β a} {b' : β a'} (s : Finmap β) (h : a ≠ a') :
    (s.insert a b).insert a' b' = (s.insert a' b').insert a b :=
  induction_on s fun s => by
    simp only [insert_to_finmap, AList.toFinmap_eq, insert_insert_of_ne _ h]
#align finmap.insert_insert_of_ne Finmap.insert_insert_of_ne
-/

#print Finmap.toFinmap_cons /-
theorem toFinmap_cons (a : α) (b : β a) (xs : List (Sigma β)) :
    List.toFinmap (⟨a, b⟩ :: xs) = insert a b xs.toFinmap :=
  rfl
#align finmap.to_finmap_cons Finmap.toFinmap_cons
-/

#print Finmap.mem_list_toFinmap /-
theorem mem_list_toFinmap (a : α) (xs : List (Sigma β)) :
    a ∈ xs.toFinmap ↔ ∃ b : β a, Sigma.mk a b ∈ xs :=
  by
  induction' xs with x xs <;> [skip, cases x] <;>
      simp only [to_finmap_cons, *, not_mem_empty, exists_or, not_mem_nil, to_finmap_nil,
        exists_false, mem_cons_iff, mem_insert, exists_and_left] <;>
    apply or_congr _ Iff.rfl
  conv =>
    lhs
    rw [← and_true_iff (a = x_fst)]
  apply and_congr_right
  rintro ⟨⟩
  simp only [exists_eq, heq_iff_eq]
#align finmap.mem_list_to_finmap Finmap.mem_list_toFinmap
-/

#print Finmap.insert_singleton_eq /-
@[simp]
theorem insert_singleton_eq {a : α} {b b' : β a} : insert a b (singleton a b') = singleton a b := by
  simp only [singleton, Finmap.insert_toFinmap, AList.insert_singleton_eq]
#align finmap.insert_singleton_eq Finmap.insert_singleton_eq
-/

/-! ### extract -/

#print Finmap.extract /-
/-- Erase a key from the map, and return the corresponding value, if found. -/
def extract (a : α) (s : Finmap β) : Option (β a) × Finmap β :=
  liftOn s (fun t => Prod.map id toFinmap (extract a t)) fun s₁ s₂ p => by
    simp [perm_lookup p, to_finmap_eq, perm_erase p]
#align finmap.extract Finmap.extract
-/

#print Finmap.extract_eq_lookup_erase /-
@[simp]
theorem extract_eq_lookup_erase (a : α) (s : Finmap β) : extract a s = (lookup a s, erase a s) :=
  induction_on s fun s => by simp [extract]
#align finmap.extract_eq_lookup_erase Finmap.extract_eq_lookup_erase
-/

/-! ### union -/

#print Finmap.union /-
/-- `s₁ ∪ s₂` is the key-based union of two finite maps. It is left-biased: if
there exists an `a ∈ s₁`, `lookup a (s₁ ∪ s₂) = lookup a s₁`. -/
def union (s₁ s₂ : Finmap β) : Finmap β :=
  liftOn₂ s₁ s₂ (fun s₁ s₂ => ⟦s₁ ∪ s₂⟧) fun s₁ s₂ s₃ s₄ p₁₃ p₂₄ =>
    toFinmap_eq.mpr <| perm_union p₁₃ p₂₄
#align finmap.union Finmap.union
-/

instance : Union (Finmap β) :=
  ⟨union⟩

#print Finmap.mem_union /-
@[simp]
theorem mem_union {a} {s₁ s₂ : Finmap β} : a ∈ s₁ ∪ s₂ ↔ a ∈ s₁ ∨ a ∈ s₂ :=
  induction_on₂ s₁ s₂ fun _ _ => mem_union
#align finmap.mem_union Finmap.mem_union
-/

#print Finmap.union_toFinmap /-
@[simp]
theorem union_toFinmap (s₁ s₂ : AList β) : ⟦s₁⟧ ∪ ⟦s₂⟧ = ⟦s₁ ∪ s₂⟧ := by simp [(· ∪ ·), union]
#align finmap.union_to_finmap Finmap.union_toFinmap
-/

#print Finmap.keys_union /-
theorem keys_union {s₁ s₂ : Finmap β} : (s₁ ∪ s₂).keys = s₁.keys ∪ s₂.keys :=
  induction_on₂ s₁ s₂ fun s₁ s₂ => Finset.ext <| by simp [keys]
#align finmap.keys_union Finmap.keys_union
-/

#print Finmap.lookup_union_left /-
@[simp]
theorem lookup_union_left {a} {s₁ s₂ : Finmap β} : a ∈ s₁ → lookup a (s₁ ∪ s₂) = lookup a s₁ :=
  induction_on₂ s₁ s₂ fun s₁ s₂ => lookup_union_left
#align finmap.lookup_union_left Finmap.lookup_union_left
-/

#print Finmap.lookup_union_right /-
@[simp]
theorem lookup_union_right {a} {s₁ s₂ : Finmap β} : a ∉ s₁ → lookup a (s₁ ∪ s₂) = lookup a s₂ :=
  induction_on₂ s₁ s₂ fun s₁ s₂ => lookup_union_right
#align finmap.lookup_union_right Finmap.lookup_union_right
-/

#print Finmap.lookup_union_left_of_not_in /-
theorem lookup_union_left_of_not_in {a} {s₁ s₂ : Finmap β} (h : a ∉ s₂) :
    lookup a (s₁ ∪ s₂) = lookup a s₁ :=
  by
  by_cases h' : a ∈ s₁
  · rw [lookup_union_left h']
  · rw [lookup_union_right h', lookup_eq_none.mpr h, lookup_eq_none.mpr h']
#align finmap.lookup_union_left_of_not_in Finmap.lookup_union_left_of_not_in
-/

#print Finmap.mem_lookup_union /-
@[simp]
theorem mem_lookup_union {a} {b : β a} {s₁ s₂ : Finmap β} :
    b ∈ lookup a (s₁ ∪ s₂) ↔ b ∈ lookup a s₁ ∨ a ∉ s₁ ∧ b ∈ lookup a s₂ :=
  induction_on₂ s₁ s₂ fun s₁ s₂ => mem_lookup_union
#align finmap.mem_lookup_union Finmap.mem_lookup_union
-/

#print Finmap.mem_lookup_union_middle /-
theorem mem_lookup_union_middle {a} {b : β a} {s₁ s₂ s₃ : Finmap β} :
    b ∈ lookup a (s₁ ∪ s₃) → a ∉ s₂ → b ∈ lookup a (s₁ ∪ s₂ ∪ s₃) :=
  induction_on₃ s₁ s₂ s₃ fun s₁ s₂ s₃ => mem_lookup_union_middle
#align finmap.mem_lookup_union_middle Finmap.mem_lookup_union_middle
-/

#print Finmap.insert_union /-
theorem insert_union {a} {b : β a} {s₁ s₂ : Finmap β} : insert a b (s₁ ∪ s₂) = insert a b s₁ ∪ s₂ :=
  induction_on₂ s₁ s₂ fun a₁ a₂ => by simp [insert_union]
#align finmap.insert_union Finmap.insert_union
-/

#print Finmap.union_assoc /-
theorem union_assoc {s₁ s₂ s₃ : Finmap β} : s₁ ∪ s₂ ∪ s₃ = s₁ ∪ (s₂ ∪ s₃) :=
  induction_on₃ s₁ s₂ s₃ fun s₁ s₂ s₃ => by
    simp only [AList.toFinmap_eq, union_to_finmap, AList.union_assoc]
#align finmap.union_assoc Finmap.union_assoc
-/

#print Finmap.empty_union /-
@[simp]
theorem empty_union {s₁ : Finmap β} : ∅ ∪ s₁ = s₁ :=
  induction_on s₁ fun s₁ => by
    rw [← empty_to_finmap] <;>
      simp [-empty_to_finmap, AList.toFinmap_eq, union_to_finmap, AList.union_assoc]
#align finmap.empty_union Finmap.empty_union
-/

#print Finmap.union_empty /-
@[simp]
theorem union_empty {s₁ : Finmap β} : s₁ ∪ ∅ = s₁ :=
  induction_on s₁ fun s₁ => by
    rw [← empty_to_finmap] <;>
      simp [-empty_to_finmap, AList.toFinmap_eq, union_to_finmap, AList.union_assoc]
#align finmap.union_empty Finmap.union_empty
-/

#print Finmap.erase_union_singleton /-
theorem erase_union_singleton (a : α) (b : β a) (s : Finmap β) (h : s.dlookup a = some b) :
    s.eraseₓ a ∪ singleton a b = s :=
  ext_lookup fun x => by
    by_cases h' : x = a
    · subst a
      rw [lookup_union_right not_mem_erase_self, lookup_singleton_eq, h]
    · have : x ∉ singleton a b := by rwa [mem_singleton]
      rw [lookup_union_left_of_not_in this, lookup_erase_ne h']
#align finmap.erase_union_singleton Finmap.erase_union_singleton
-/

end

/-! ### disjoint -/

#print Finmap.Disjoint /-
/-- `disjoint s₁ s₂` holds if `s₁` and `s₂` have no keys in common. -/
def Disjoint (s₁ s₂ : Finmap β) : Prop :=
  ∀ x ∈ s₁, ¬x ∈ s₂
#align finmap.disjoint Finmap.Disjoint
-/

#print Finmap.disjoint_empty /-
theorem disjoint_empty (x : Finmap β) : Disjoint ∅ x :=
  fun.
#align finmap.disjoint_empty Finmap.disjoint_empty
-/

#print Finmap.Disjoint.symm /-
@[symm]
theorem Disjoint.symm (x y : Finmap β) (h : Disjoint x y) : Disjoint y x := fun p hy hx => h p hx hy
#align finmap.disjoint.symm Finmap.Disjoint.symm
-/

#print Finmap.Disjoint.symm_iff /-
theorem Disjoint.symm_iff (x y : Finmap β) : Disjoint x y ↔ Disjoint y x :=
  ⟨Disjoint.symm x y, Disjoint.symm y x⟩
#align finmap.disjoint.symm_iff Finmap.Disjoint.symm_iff
-/

section

variable [DecidableEq α]

instance : DecidableRel (@Disjoint α β) := fun x y => by dsimp only [Disjoint] <;> infer_instance

#print Finmap.disjoint_union_left /-
theorem disjoint_union_left (x y z : Finmap β) : Disjoint (x ∪ y) z ↔ Disjoint x z ∧ Disjoint y z :=
  by simp [Disjoint, Finmap.mem_union, or_imp, forall_and]
#align finmap.disjoint_union_left Finmap.disjoint_union_left
-/

#print Finmap.disjoint_union_right /-
theorem disjoint_union_right (x y z : Finmap β) :
    Disjoint x (y ∪ z) ↔ Disjoint x y ∧ Disjoint x z := by
  rw [disjoint.symm_iff, disjoint_union_left, disjoint.symm_iff _ x, disjoint.symm_iff _ x]
#align finmap.disjoint_union_right Finmap.disjoint_union_right
-/

#print Finmap.union_comm_of_disjoint /-
theorem union_comm_of_disjoint {s₁ s₂ : Finmap β} : Disjoint s₁ s₂ → s₁ ∪ s₂ = s₂ ∪ s₁ :=
  induction_on₂ s₁ s₂ fun s₁ s₂ => by
    intro h
    simp only [AList.toFinmap_eq, union_to_finmap, AList.union_comm_of_disjoint h]
#align finmap.union_comm_of_disjoint Finmap.union_comm_of_disjoint
-/

#print Finmap.union_cancel /-
theorem union_cancel {s₁ s₂ s₃ : Finmap β} (h : Disjoint s₁ s₃) (h' : Disjoint s₂ s₃) :
    s₁ ∪ s₃ = s₂ ∪ s₃ ↔ s₁ = s₂ :=
  ⟨fun h'' => by
    apply ext_lookup
    intro x
    have : (s₁ ∪ s₃).dlookup x = (s₂ ∪ s₃).dlookup x := h'' ▸ rfl
    by_cases hs₁ : x ∈ s₁
    · rwa [lookup_union_left hs₁, lookup_union_left_of_not_in (h _ hs₁)] at this
    · by_cases hs₂ : x ∈ s₂
      · rwa [lookup_union_left_of_not_in (h' _ hs₂), lookup_union_left hs₂] at this
      · rw [lookup_eq_none.mpr hs₁, lookup_eq_none.mpr hs₂], fun h => h ▸ rfl⟩
#align finmap.union_cancel Finmap.union_cancel
-/

end

end Finmap


/-
Copyright (c) 2020 Frédéric Dupuis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Frédéric Dupuis
-/
import analysis.inner_product_space.projection
import analysis.normed_space.dual

/-!
# The Fréchet-Riesz representation theorem

We consider an inner product space `E` over `𝕜`, which is either `ℝ` or `ℂ`. We define
`to_dual_map`, a conjugate-linear isometric embedding of `E` into its dual, which maps an element
`x` of the space to `λ y, ⟪x, y⟫`.

Under the hypothesis of completeness (i.e., for Hilbert spaces), we upgrade this to `to_dual`, a
conjugate-linear isometric *equivalence* of `E` onto its dual; that is, we establish the
surjectivity of `to_dual_map`.  This is the Fréchet-Riesz representation theorem: every element of
the dual of a Hilbert space `E` has the form `λ u, ⟪x, u⟫` for some `x : E`.

## References

* [M. Einsiedler and T. Ward, *Functional Analysis, Spectral Theory, and Applications*]
  [EinsiedlerWard2017]

## Tags

dual, Fréchet-Riesz
-/

noncomputable theory
open_locale classical
universes u v

namespace inner_product_space
open is_R_or_C continuous_linear_map

variables (𝕜 : Type*)
variables (E : Type*) [is_R_or_C 𝕜] [inner_product_space 𝕜 E]
local notation `⟪`x`, `y`⟫` := @inner 𝕜 E _ x y
local postfix `†`:90 := star_ring_aut

/--
An element `x` of an inner product space `E` induces an element of the dual space `dual 𝕜 E`,
the map `λ y, ⟪x, y⟫`; moreover this operation is a conjugate-linear isometric embedding of `E`
into `dual 𝕜 E`.
If `E` is complete, this operation is surjective, hence a conjugate-linear isometric equivalence;
see `to_dual`.
-/
def to_dual_map : E →ₗᵢ⋆[𝕜] normed_space.dual 𝕜 E :=
{ to_fun := λ x, linear_map.mk_continuous
    { to_fun := λ y, ⟪x, y⟫,
      map_add' := λ _ _, inner_add_right,
      map_smul' := λ _ _, inner_smul_right }
    ∥x∥
    (λ y, by { rw [is_R_or_C.norm_eq_abs], exact abs_inner_le_norm _ _ }),
  map_add' := λ x y, by { ext z, simp [inner_add_left] },
  map_smul' := λ c y, by { ext z, simp [inner_smul_left] },
  norm_map' := λ x, begin
    refine le_antisymm _ _,
    { exact linear_map.mk_continuous_norm_le _ (norm_nonneg _) _ },
    { cases eq_or_lt_of_le (norm_nonneg x) with h h,
      { have : x = 0 := norm_eq_zero.mp (eq.symm h),
        simp [this] },
      { refine (mul_le_mul_right h).mp _,
        calc ∥x∥ * ∥x∥ = ∥x∥ ^ 2 : by ring
        ... = re ⟪x, x⟫ : norm_sq_eq_inner _
        ... ≤ abs ⟪x, x⟫ : re_le_abs _
        ... = ∥linear_map.mk_continuous _ _ _ x∥ : by simp [norm_eq_abs]
        ... ≤ ∥linear_map.mk_continuous _ _ _∥ * ∥x∥ : le_op_norm _ x } }
  end }

variables {E}

@[simp] lemma to_dual_map_apply {x y : E} : to_dual_map 𝕜 E x y = ⟪x, y⟫ := rfl

variables (E) [complete_space E]

/--
Fréchet-Riesz representation: any `ℓ` in the dual of a Hilbert space `E` is of the form
`λ u, ⟪y, u⟫` for some `y : E`, i.e. `to_dual_map` is surjective.
-/
def to_dual : E ≃ₗᵢ⋆[𝕜] normed_space.dual 𝕜 E :=
linear_isometry_equiv.of_surjective (to_dual_map 𝕜 E)
begin
  intros ℓ,
  set Y := ker ℓ with hY,
  by_cases htriv : Y = ⊤,
  { have hℓ : ℓ = 0,
    { have h' := linear_map.ker_eq_top.mp htriv,
      rw [←coe_zero] at h',
      apply coe_injective,
      exact h' },
    exact ⟨0, by simp [hℓ]⟩ },
  { rw [← submodule.orthogonal_eq_bot_iff] at htriv,
    change Yᗮ ≠ ⊥ at htriv,
    rw [submodule.ne_bot_iff] at htriv,
    obtain ⟨z : E, hz : z ∈ Yᗮ, z_ne_0 : z ≠ 0⟩ := htriv,
    refine ⟨((ℓ z)† / ⟪z, z⟫) • z, _⟩,
    ext x,
    have h₁ : (ℓ z) • x - (ℓ x) • z ∈ Y,
    { rw [mem_ker, map_sub, map_smul, map_smul, algebra.id.smul_eq_mul, algebra.id.smul_eq_mul,
          mul_comm],
      exact sub_self (ℓ x * ℓ z) },
    have h₂ : (ℓ z) * ⟪z, x⟫ = (ℓ x) * ⟪z, z⟫,
    { have h₃ := calc
        0    = ⟪z, (ℓ z) • x - (ℓ x) • z⟫       : by { rw [(Y.mem_orthogonal' z).mp hz], exact h₁ }
         ... = ⟪z, (ℓ z) • x⟫ - ⟪z, (ℓ x) • z⟫  : by rw [inner_sub_right]
         ... = (ℓ z) * ⟪z, x⟫ - (ℓ x) * ⟪z, z⟫  : by simp [inner_smul_right],
      exact sub_eq_zero.mp (eq.symm h₃) },
    have h₄ := calc
      ⟪((ℓ z)† / ⟪z, z⟫) • z, x⟫ = (ℓ z) / ⟪z, z⟫ * ⟪z, x⟫
            : by simp [inner_smul_left, ring_equiv.map_div, conj_conj]
                            ... = (ℓ z) * ⟪z, x⟫ / ⟪z, z⟫
            : by rw [←div_mul_eq_mul_div]
                            ... = (ℓ x) * ⟪z, z⟫ / ⟪z, z⟫
            : by rw [h₂]
                            ... = ℓ x
            : begin
                have : ⟪z, z⟫ ≠ 0,
                { change z = 0 → false at z_ne_0,
                  rwa ←inner_self_eq_zero at z_ne_0 },
                field_simp [this]
              end,
    exact h₄ }
end

variables {E}

@[simp] lemma to_dual_apply {x y : E} : to_dual 𝕜 E x y = ⟪x, y⟫ := rfl

@[simp] lemma to_dual_symm_apply {x : E} {y : normed_space.dual 𝕜 E} :
  ⟪(to_dual 𝕜 E).symm y, x⟫ = y x :=
begin
  rw ← to_dual_apply,
  simp only [linear_isometry_equiv.apply_symm_apply],
end

end inner_product_space


/-
Copyright (c) 2021 Paula Neeley. All rights reserved.
Author: Paula Neeley
Following the textbook "Dynamic Epistemic Logic" by
Hans van Ditmarsch, Wiebe van der Hoek, and Barteld Kooi
-/

import del.semantics.translationlemmas
import del.semantics.completenessDEL del.syntax.syntaxlemmasPADEL
import tactic.linarith

variables {agents : Type}
open prfPA
open PAlemma

---------------------- Completeness by Translation ----------------------

theorem equiv_translation_aux' {Γ : ctxPA agents} (n : nat) (φ : formPA agents) (h : complexity φ ≤ n) :
  prfPA Γ (φ ↔ to_PA (translate φ)) :=
begin
  simp at *,
  induction n with n ih generalizing φ,
  { have h1 : complexity φ > 0, from comp_gt_zero, linarith},
  cases φ,
  case formPA.bot
    { exact mp (mp pl4 iden) iden },
  case formPA.var : m
    { exact mp (mp pl4 iden) iden },
  case formPA.and : φ ψ
    { rw translate,
      exact iff_iff_and_iff (ih φ (compand1 h)) (ih ψ (compand2 h))
    },
  case formPA.impl : φ ψ
    { rw translate,
      repeat {rw to_PA},
      exact iff_iff_imp_iff (ih φ (compimp1 h)) (ih ψ (compimp2 h))
    },
  case formPA.box : a φ
    { simp at *,
      have h1 : complexity φ ≤ n, from nat.lt_succ_iff.mp (nat.one_add_le_iff.mp h),
      exact iff_k_dist (ih φ h1),
    },
  case formPA.update : φ ψ
    { cases ψ,
      case formPA.bot
        { repeat {rw translate},
          repeat {rw complexity at h},
          have h1 : complexity φ ≤ n,
            {have : complexity φ + 1 ≤ nat.succ n, linarith,
             exact nat.lt_succ_iff.mp this},
          have h2 := atomicbot,
          exact update_iff1 (ih φ h1) h2
        },
      case formPA.var : m
        { repeat {rw translate},
          repeat {rw complexity at h},
          have h1 : complexity φ ≤ n,
            {have : complexity φ + 1 ≤ nat.succ n, linarith,
             exact nat.lt_succ_iff.mp this},
          have h2 := atomicperm,
          exact update_iff1 (ih φ h1) h2
        },
      case formPA.and : ψ χ
        { repeat {rw translate},
          exact update_iff2 (ih (U φ ψ) (updatecompand1 h)) (ih (U φ χ) (updatecompand2 h)) announceconj,
        },
      case formPA.impl : ψ χ
        { repeat {rw translate},
          exact update_iff3 (ih (U φ ψ) (updatecompimp1 h)) (ih (U φ χ) (updatecompimp2 h)) announceimp,
        },
      case formPA.box : a ψ
        { repeat {rw translate},
          exact update_iff4 announceknow (ih (φ ⊃ K a (U φ ψ)) (updatecompknow2 h))
        },
      case formPA.update : ψ χ
        { rw translate,
          exact update_iff5 announcecomp (ih (U (φ & (U φ ψ)) χ) (updatecompupdate h))
        }
    }
end

theorem equiv_translation (Γ : ctxPA agents) : ∀ φ : formPA agents, prfPA Γ (φ ↔ to_PA (translate φ)) :=
begin
intro φ,
have h : complexity φ ≤ complexity φ + 1, linarith,
simp,
exact equiv_translation_aux' (complexity φ + 1) φ h
end

lemma forces_ctxPA_iff_forces_ctx (f : frame agents)
  (v : nat → f.states → Prop) :
  forces_ctxPA f v ∅ ↔ forces_ctx f v ∅ :=
begin
split,
repeat {intros h1 φ x h2,
exact false.elim h2},
end

lemma global_sem_csqPA_iff_global_sem_csq (F : set (frame agents)) (φ : form agents) :
  global_sem_csqPA ∅ F (to_PA φ) ↔ global_sem_csq ∅ F φ :=
begin
split,
intros h1 f h2 v h3 x,
have h4 := (forces_ctxPA_iff_forces_ctx f v).mpr h3,
exact (forcesPA_iff_forces φ f v x).mp (h1 f h2 v h4 x),
intros h1 f h2 v h3 x,
have h4 := (forces_ctxPA_iff_forces_ctx f v).mp h3,
exact (forcesPA_iff_forces φ f v x).mpr (h1 f h2 v h4 x)
end

theorem completenessPA {φ : formPA agents} (Γ : ctxPA agents) :
  global_sem_csqPA ∅ equiv_class φ → prfPA ∅ φ :=
begin
intros h1,
have h2 := mp pl5 (equiv_translation ∅ φ),
have h3 := soundnessPA,
have h4 : global_sem_csqPA ∅ equiv_class (to_PA (translate φ)),
{intros f h4 v h5 x,
exact h3 h2 f h4 v h5 x (h1 f h4 v h5 x)},
have h5 := (global_sem_csqPA_iff_global_sem_csq equiv_class (translate φ) ).mp h4,
have h6 := canonical.completeness sem_consS5 (translate φ),
have h7 := to_prfPA (h6 h5),
simp at *,
exact mp (mp pl6 (equiv_translation ∅ φ)) h7
end


namespace Hidden

inductive Eq {α : Sort u} (a : α) : α → Prop where
  | intro : Eq a a

inductive Nonempty (α : Sort u) : Prop where
  | intro : α → Nonempty α

theorem elim_from_prop_is_bad
(choice : ∀{α}, Nonempty α → α) :
¬({α : Type u} → {x : α} → choice ⟨x⟩ = x) := by
  intro h
  let true' : ULift Bool := ⟨true⟩
  let false' : ULift Bool := ⟨false⟩
  have t_eq_f : true' = false' := h.symm.trans h
  have : true = false := congrArg ULift.down t_eq_f
  contradiction

def Or.by_cases [Decidable p] [Decidable q] {α : Sort u}
(h : p ∨ q) (fp : p → α) (fq : q → α) : α :=
  if hp : p then fp hp else
  if hq : q then fq hq else
  False.elim (Or.elim h hp hq)

def Nat.strong_rec {p : Nat → Sort u}
(h : (n : Nat) → ((m : Nat) → m < n → p m) → p n)
(n : Nat) : p n :=
  h n (aux n)
where
  aux : (n m : Nat) → m < n → p m
    | 0, m, h₁ => absurd h₁ (Nat.not_lt_zero m)
    | n+1, m, h₁ => Or.by_cases (Nat.eq_or_lt_of_le (Nat.le_of_lt_succ h₁))
      (λ h₂ => h₂ ▸ h n (aux n))
      (λ h₂ => (aux n) m h₂)

end Hidden


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Tim Baumann, Stephen Morgan, Scott Morrison, Floris van Doorn
-/
import category_theory.functor.fully_faithful
import category_theory.full_subcategory
import category_theory.whiskering
import category_theory.essential_image
import tactic.slice

/-!
# Equivalence of categories

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

An equivalence of categories `C` and `D` is a pair of functors `F : C ⥤ D` and `G : D ⥤ C` such
that `η : 𝟭 C ≅ F ⋙ G` and `ε : G ⋙ F ≅ 𝟭 D`. In many situations, equivalences are a better
notion of "sameness" of categories than the stricter isomorphims of categories.

Recall that one way to express that two functors `F : C ⥤ D` and `G : D ⥤ C` are adjoint is using
two natural transformations `η : 𝟭 C ⟶ F ⋙ G` and `ε : G ⋙ F ⟶ 𝟭 D`, called the unit and the
counit, such that the compositions `F ⟶ FGF ⟶ F` and `G ⟶ GFG ⟶ G` are the identity. Unfortunately,
it is not the case that the natural isomorphisms `η` and `ε` in the definition of an equivalence
automatically give an adjunction. However, it is true that
* if one of the two compositions is the identity, then so is the other, and
* given an equivalence of categories, it is always possible to refine `η` in such a way that the
  identities are satisfied.

For this reason, in mathlib we define an equivalence to be a "half-adjoint equivalence", which is
a tuple `(F, G, η, ε)` as in the first paragraph such that the composite `F ⟶ FGF ⟶ F` is the
identity. By the remark above, this already implies that the tuple is an "adjoint equivalence",
i.e., that the composite `G ⟶ GFG ⟶ G` is also the identity.

We also define essentially surjective functors and show that a functor is an equivalence if and only
if it is full, faithful and essentially surjective.

## Main definitions

* `equivalence`: bundled (half-)adjoint equivalences of categories
* `is_equivalence`: type class on a functor `F` containing the data of the inverse `G` as well as
  the natural isomorphisms `η` and `ε`.
* `ess_surj`: type class on a functor `F` containing the data of the preimages and the isomorphisms
  `F.obj (preimage d) ≅ d`.

## Main results

* `equivalence.mk`: upgrade an equivalence to a (half-)adjoint equivalence
* `is_equivalence.equiv_of_iso`: when `F` and `G` are isomorphic functors, `F` is an equivalence
iff `G` is.
* `equivalence.of_fully_faithfully_ess_surj`: a fully faithful essentially surjective functor is an
  equivalence.

## Notations

We write `C ≌ D` (`\backcong`, not to be confused with `≅`/`\cong`) for a bundled equivalence.

-/

namespace category_theory
open category_theory.functor nat_iso category
-- declare the `v`'s first; see `category_theory.category` for an explanation
universes v₁ v₂ v₃ u₁ u₂ u₃

/-- We define an equivalence as a (half)-adjoint equivalence, a pair of functors with
  a unit and counit which are natural isomorphisms and the triangle law `Fη ≫ εF = 1`, or in other
  words the composite `F ⟶ FGF ⟶ F` is the identity.

  In `unit_inverse_comp`, we show that this is actually an adjoint equivalence, i.e., that the
  composite `G ⟶ GFG ⟶ G` is also the identity.

  The triangle equation is written as a family of equalities between morphisms, it is more
  complicated if we write it as an equality of natural transformations, because then we would have
  to insert natural transformations like `F ⟶ F1`.

See <https://stacks.math.columbia.edu/tag/001J>
-/
structure equivalence (C : Type u₁) [category.{v₁} C] (D : Type u₂) [category.{v₂} D] :=
mk' ::
(functor : C ⥤ D)
(inverse : D ⥤ C)
(unit_iso   : 𝟭 C ≅ functor ⋙ inverse)
(counit_iso : inverse ⋙ functor ≅ 𝟭 D)
(functor_unit_iso_comp' : ∀(X : C), functor.map ((unit_iso.hom : 𝟭 C ⟶ functor ⋙ inverse).app X) ≫
  counit_iso.hom.app (functor.obj X) = 𝟙 (functor.obj X) . obviously)

restate_axiom equivalence.functor_unit_iso_comp'

infixr ` ≌ `:10  := equivalence

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

namespace equivalence

/-- The unit of an equivalence of categories. -/
abbreviation unit (e : C ≌ D) : 𝟭 C ⟶ e.functor ⋙ e.inverse := e.unit_iso.hom
/-- The counit of an equivalence of categories. -/
abbreviation counit (e : C ≌ D) : e.inverse ⋙ e.functor ⟶ 𝟭 D := e.counit_iso.hom
/-- The inverse of the unit of an equivalence of categories. -/
abbreviation unit_inv (e : C ≌ D) : e.functor ⋙ e.inverse ⟶ 𝟭 C := e.unit_iso.inv
/-- The inverse of the counit of an equivalence of categories. -/
abbreviation counit_inv (e : C ≌ D) : 𝟭 D ⟶ e.inverse ⋙ e.functor := e.counit_iso.inv

/- While these abbreviations are convenient, they also cause some trouble,
preventing structure projections from unfolding. -/
@[simp] lemma equivalence_mk'_unit (functor inverse unit_iso counit_iso f) :
  (⟨functor, inverse, unit_iso, counit_iso, f⟩ : C ≌ D).unit = unit_iso.hom := rfl
@[simp] lemma equivalence_mk'_counit (functor inverse unit_iso counit_iso f) :
  (⟨functor, inverse, unit_iso, counit_iso, f⟩ : C ≌ D).counit = counit_iso.hom := rfl
@[simp] lemma equivalence_mk'_unit_inv (functor inverse unit_iso counit_iso f) :
  (⟨functor, inverse, unit_iso, counit_iso, f⟩ : C ≌ D).unit_inv = unit_iso.inv := rfl
@[simp] lemma equivalence_mk'_counit_inv (functor inverse unit_iso counit_iso f) :
  (⟨functor, inverse, unit_iso, counit_iso, f⟩ : C ≌ D).counit_inv = counit_iso.inv := rfl

@[simp] lemma functor_unit_comp (e : C ≌ D) (X : C) :
  e.functor.map (e.unit.app X) ≫ e.counit.app (e.functor.obj X) = 𝟙 (e.functor.obj X) :=
e.functor_unit_iso_comp X

@[simp] lemma counit_inv_functor_comp (e : C ≌ D) (X : C) :
  e.counit_inv.app (e.functor.obj X) ≫ e.functor.map (e.unit_inv.app X) = 𝟙 (e.functor.obj X) :=
begin
  erw [iso.inv_eq_inv
    (e.functor.map_iso (e.unit_iso.app X) ≪≫ e.counit_iso.app (e.functor.obj X)) (iso.refl _)],
  exact e.functor_unit_comp X
end

lemma counit_inv_app_functor (e : C ≌ D) (X : C) :
  e.counit_inv.app (e.functor.obj X) = e.functor.map (e.unit.app X) :=
by { symmetry, erw [←iso.comp_hom_eq_id (e.counit_iso.app _), functor_unit_comp], refl }

lemma counit_app_functor (e : C ≌ D) (X : C) :
  e.counit.app (e.functor.obj X) = e.functor.map (e.unit_inv.app X) :=
by { erw [←iso.hom_comp_eq_id (e.functor.map_iso (e.unit_iso.app X)), functor_unit_comp], refl }

/-- The other triangle equality. The proof follows the following proof in Globular:
  http://globular.science/1905.001 -/
@[simp] lemma unit_inverse_comp (e : C ≌ D) (Y : D) :
  e.unit.app (e.inverse.obj Y) ≫ e.inverse.map (e.counit.app Y) = 𝟙 (e.inverse.obj Y) :=
begin
  rw [←id_comp (e.inverse.map _), ←map_id e.inverse, ←counit_inv_functor_comp, map_comp],
  dsimp,
  rw [←iso.hom_inv_id_assoc (e.unit_iso.app _) (e.inverse.map (e.functor.map _)),
      app_hom, app_inv],
  slice_lhs 2 3 { erw [e.unit.naturality] },
  slice_lhs 1 2 { erw [e.unit.naturality] },
  slice_lhs 4 4
  { rw [←iso.hom_inv_id_assoc (e.inverse.map_iso (e.counit_iso.app _)) (e.unit_inv.app _)] },
  slice_lhs 3 4 { erw [←map_comp e.inverse, e.counit.naturality],
    erw [(e.counit_iso.app _).hom_inv_id, map_id] }, erw [id_comp],
  slice_lhs 2 3 { erw [←map_comp e.inverse, e.counit_iso.inv.naturality, map_comp] },
  slice_lhs 3 4 { erw [e.unit_inv.naturality] },
  slice_lhs 4 5 { erw [←map_comp (e.functor ⋙ e.inverse), (e.unit_iso.app _).hom_inv_id, map_id] },
  erw [id_comp],
  slice_lhs 3 4 { erw [←e.unit_inv.naturality] },
  slice_lhs 2 3 { erw [←map_comp e.inverse, ←e.counit_iso.inv.naturality,
    (e.counit_iso.app _).hom_inv_id, map_id] }, erw [id_comp, (e.unit_iso.app _).hom_inv_id], refl
end

@[simp] lemma inverse_counit_inv_comp (e : C ≌ D) (Y : D) :
  e.inverse.map (e.counit_inv.app Y) ≫ e.unit_inv.app (e.inverse.obj Y) = 𝟙 (e.inverse.obj Y) :=
begin
  erw [iso.inv_eq_inv
    (e.unit_iso.app (e.inverse.obj Y) ≪≫ e.inverse.map_iso (e.counit_iso.app Y)) (iso.refl _)],
  exact e.unit_inverse_comp Y
end

lemma unit_app_inverse (e : C ≌ D) (Y : D) :
  e.unit.app (e.inverse.obj Y) = e.inverse.map (e.counit_inv.app Y) :=
by { erw [←iso.comp_hom_eq_id (e.inverse.map_iso (e.counit_iso.app Y)), unit_inverse_comp], refl }

lemma unit_inv_app_inverse (e : C ≌ D) (Y : D) :
  e.unit_inv.app (e.inverse.obj Y) = e.inverse.map (e.counit.app Y) :=
by { symmetry, erw [←iso.hom_comp_eq_id (e.unit_iso.app _), unit_inverse_comp], refl }

@[simp] lemma fun_inv_map (e : C ≌ D) (X Y : D) (f : X ⟶ Y) :
  e.functor.map (e.inverse.map f) = e.counit.app X ≫ f ≫ e.counit_inv.app Y :=
(nat_iso.naturality_2 (e.counit_iso) f).symm

@[simp] lemma inv_fun_map (e : C ≌ D) (X Y : C) (f : X ⟶ Y) :
  e.inverse.map (e.functor.map f) = e.unit_inv.app X ≫ f ≫ e.unit.app Y :=
(nat_iso.naturality_1 (e.unit_iso) f).symm

section
-- In this section we convert an arbitrary equivalence to a half-adjoint equivalence.
variables {F : C ⥤ D} {G : D ⥤ C} (η : 𝟭 C ≅ F ⋙ G) (ε : G ⋙ F ≅ 𝟭 D)

/-- If `η : 𝟭 C ≅ F ⋙ G` is part of a (not necessarily half-adjoint) equivalence, we can upgrade it
to a refined natural isomorphism `adjointify_η η : 𝟭 C ≅ F ⋙ G` which exhibits the properties
required for a half-adjoint equivalence. See `equivalence.mk`. -/
def adjointify_η : 𝟭 C ≅ F ⋙ G :=
calc
  𝟭 C ≅ F ⋙ G               : η
  ... ≅ F ⋙ (𝟭 D ⋙ G)      : iso_whisker_left F (left_unitor G).symm
  ... ≅ F ⋙ ((G ⋙ F) ⋙ G) : iso_whisker_left F (iso_whisker_right ε.symm G)
  ... ≅ F ⋙ (G ⋙ (F ⋙ G)) : iso_whisker_left F (associator G F G)
  ... ≅ (F ⋙ G) ⋙ (F ⋙ G) : (associator F G (F ⋙ G)).symm
  ... ≅ 𝟭 C ⋙ (F ⋙ G)      : iso_whisker_right η.symm (F ⋙ G)
  ... ≅ F ⋙ G               : left_unitor (F ⋙ G)

lemma adjointify_η_ε (X : C) :
  F.map ((adjointify_η η ε).hom.app X) ≫ ε.hom.app (F.obj X) = 𝟙 (F.obj X) :=
begin
  dsimp [adjointify_η], simp,
  have := ε.hom.naturality (F.map (η.inv.app X)), dsimp at this, rw [this], clear this,
  rw [←assoc _ _ (F.map _)],
  have := ε.hom.naturality (ε.inv.app $ F.obj X), dsimp at this, rw [this], clear this,
  have := (ε.app $ F.obj X).hom_inv_id, dsimp at this, rw [this], clear this,
  rw [id_comp], have := (F.map_iso $ η.app X).hom_inv_id, dsimp at this, rw [this]
end

end

/-- Every equivalence of categories consisting of functors `F` and `G` such that `F ⋙ G` and
    `G ⋙ F` are naturally isomorphic to identity functors can be transformed into a half-adjoint
    equivalence without changing `F` or `G`. -/
protected definition mk (F : C ⥤ D) (G : D ⥤ C)
  (η : 𝟭 C ≅ F ⋙ G) (ε : G ⋙ F ≅ 𝟭 D) : C ≌ D :=
⟨F, G, adjointify_η η ε, ε, adjointify_η_ε η ε⟩

/-- Equivalence of categories is reflexive. -/
@[refl, simps] def refl : C ≌ C :=
⟨𝟭 C, 𝟭 C, iso.refl _, iso.refl _, λ X, category.id_comp _⟩

instance : inhabited (C ≌ C) :=
⟨refl⟩

/-- Equivalence of categories is symmetric. -/
@[symm, simps] def symm (e : C ≌ D) : D ≌ C :=
⟨e.inverse, e.functor, e.counit_iso.symm, e.unit_iso.symm, e.inverse_counit_inv_comp⟩

variables {E : Type u₃} [category.{v₃} E]

/-- Equivalence of categories is transitive. -/
@[trans, simps] def trans (e : C ≌ D) (f : D ≌ E) : C ≌ E :=
{ functor := e.functor ⋙ f.functor,
  inverse := f.inverse ⋙ e.inverse,
  unit_iso :=
  begin
    refine iso.trans e.unit_iso _,
    exact iso_whisker_left e.functor (iso_whisker_right f.unit_iso e.inverse) ,
  end,
  counit_iso :=
  begin
    refine iso.trans _ f.counit_iso,
    exact iso_whisker_left f.inverse (iso_whisker_right e.counit_iso f.functor)
  end,
  -- We wouldn't have needed to give this proof if we'd used `equivalence.mk`,
  -- but we choose to avoid using that here, for the sake of good structure projection `simp`
  -- lemmas.
  functor_unit_iso_comp' := λ X,
  begin
    dsimp,
    rw [← f.functor.map_comp_assoc, e.functor.map_comp, ←counit_inv_app_functor, fun_inv_map,
        iso.inv_hom_id_app_assoc, assoc, iso.inv_hom_id_app, counit_app_functor,
        ← functor.map_comp],
    erw [comp_id, iso.hom_inv_id_app, functor.map_id],
  end }

/-- Composing a functor with both functors of an equivalence yields a naturally isomorphic
functor. -/
def fun_inv_id_assoc (e : C ≌ D) (F : C ⥤ E) : e.functor ⋙ e.inverse ⋙ F ≅ F :=
(functor.associator _ _ _).symm ≪≫ iso_whisker_right e.unit_iso.symm F ≪≫ F.left_unitor

@[simp] lemma fun_inv_id_assoc_hom_app (e : C ≌ D) (F : C ⥤ E) (X : C) :
  (fun_inv_id_assoc e F).hom.app X = F.map (e.unit_inv.app X) :=
by { dsimp [fun_inv_id_assoc], tidy }

@[simp] lemma fun_inv_id_assoc_inv_app (e : C ≌ D) (F : C ⥤ E) (X : C) :
  (fun_inv_id_assoc e F).inv.app X = F.map (e.unit.app X) :=
by { dsimp [fun_inv_id_assoc], tidy }

/-- Composing a functor with both functors of an equivalence yields a naturally isomorphic
functor. -/
def inv_fun_id_assoc (e : C ≌ D) (F : D ⥤ E) : e.inverse ⋙ e.functor ⋙ F ≅ F :=
(functor.associator _ _ _).symm ≪≫ iso_whisker_right e.counit_iso F ≪≫ F.left_unitor

@[simp] lemma inv_fun_id_assoc_hom_app (e : C ≌ D) (F : D ⥤ E) (X : D) :
  (inv_fun_id_assoc e F).hom.app X = F.map (e.counit.app X) :=
by { dsimp [inv_fun_id_assoc], tidy }

@[simp] lemma inv_fun_id_assoc_inv_app (e : C ≌ D) (F : D ⥤ E) (X : D) :
  (inv_fun_id_assoc e F).inv.app X = F.map (e.counit_inv.app X) :=
by { dsimp [inv_fun_id_assoc], tidy }

/-- If `C` is equivalent to `D`, then `C ⥤ E` is equivalent to `D ⥤ E`. -/
@[simps functor inverse unit_iso counit_iso]
def congr_left (e : C ≌ D) : (C ⥤ E) ≌ (D ⥤ E) :=
equivalence.mk
  ((whiskering_left _ _ _).obj e.inverse)
  ((whiskering_left _ _ _).obj e.functor)
  (nat_iso.of_components (λ F, (e.fun_inv_id_assoc F).symm) (by tidy))
  (nat_iso.of_components (λ F, e.inv_fun_id_assoc F) (by tidy))

/-- If `C` is equivalent to `D`, then `E ⥤ C` is equivalent to `E ⥤ D`. -/
@[simps functor inverse unit_iso counit_iso]
def congr_right (e : C ≌ D) : (E ⥤ C) ≌ (E ⥤ D) :=
equivalence.mk
  ((whiskering_right _ _ _).obj e.functor)
  ((whiskering_right _ _ _).obj e.inverse)
  (nat_iso.of_components
    (λ F, F.right_unitor.symm ≪≫ iso_whisker_left F e.unit_iso ≪≫ functor.associator _ _ _)
    (by tidy))
  (nat_iso.of_components
    (λ F, functor.associator _ _ _ ≪≫ iso_whisker_left F e.counit_iso ≪≫ F.right_unitor)
    (by tidy))

section cancellation_lemmas
variables (e : C ≌ D)

/- We need special forms of `cancel_nat_iso_hom_right(_assoc)` and
`cancel_nat_iso_inv_right(_assoc)` for units and counits, because neither `simp` or `rw` will apply
those lemmas in this setting without providing `e.unit_iso` (or similar) as an explicit argument.
We also provide the lemmas for length four compositions, since they're occasionally useful.
(e.g. in proving that equivalences take monos to monos) -/

@[simp] lemma cancel_unit_right {X Y : C}
  (f f' : X ⟶ Y) :
  f ≫ e.unit.app Y = f' ≫ e.unit.app Y ↔ f = f' :=
by simp only [cancel_mono]

@[simp] lemma cancel_unit_inv_right {X Y : C}
  (f f' : X ⟶ e.inverse.obj (e.functor.obj Y))   :
  f ≫ e.unit_inv.app Y = f' ≫ e.unit_inv.app Y ↔ f = f' :=
by simp only [cancel_mono]

@[simp] lemma cancel_counit_right {X Y : D}
  (f f' : X ⟶ e.functor.obj (e.inverse.obj Y))   :
  f ≫ e.counit.app Y = f' ≫ e.counit.app Y ↔ f = f' :=
by simp only [cancel_mono]

@[simp] lemma cancel_counit_inv_right {X Y : D}
  (f f' : X ⟶ Y) :
  f ≫ e.counit_inv.app Y = f' ≫ e.counit_inv.app Y ↔ f = f' :=
by simp only [cancel_mono]

@[simp] lemma cancel_unit_right_assoc {W X X' Y : C}
  (f : W ⟶ X) (g : X ⟶ Y) (f' : W ⟶ X') (g' : X' ⟶ Y) :
  f ≫ g ≫ e.unit.app Y = f' ≫ g' ≫ e.unit.app Y ↔ f ≫ g = f' ≫ g' :=
by simp only [←category.assoc, cancel_mono]

@[simp] lemma cancel_counit_inv_right_assoc {W X X' Y : D}
  (f : W ⟶ X) (g : X ⟶ Y) (f' : W ⟶ X') (g' : X' ⟶ Y) :
  f ≫ g ≫ e.counit_inv.app Y = f' ≫ g' ≫ e.counit_inv.app Y ↔ f ≫ g = f' ≫ g' :=
by simp only [←category.assoc, cancel_mono]

@[simp] lemma cancel_unit_right_assoc' {W X X' Y Y' Z : C}
  (f : W ⟶ X) (g : X ⟶ Y) (h : Y ⟶ Z) (f' : W ⟶ X') (g' : X' ⟶ Y') (h' : Y' ⟶ Z) :
  f ≫ g ≫ h ≫ e.unit.app Z = f' ≫ g' ≫ h' ≫ e.unit.app Z ↔ f ≫ g ≫ h = f' ≫ g' ≫ h' :=
by simp only [←category.assoc, cancel_mono]

@[simp]

end cancellation_lemmas

section

-- There's of course a monoid structure on `C ≌ C`,
-- but let's not encourage using it.
-- The power structure is nevertheless useful.

/-- Natural number powers of an auto-equivalence.  Use `(^)` instead. -/
def pow_nat (e : C ≌ C) : ℕ → (C ≌ C)
| 0 := equivalence.refl
| 1 := e
| (n+2) := e.trans (pow_nat (n+1))

/-- Powers of an auto-equivalence.  Use `(^)` instead. -/
def pow (e : C ≌ C) : ℤ → (C ≌ C)
| (int.of_nat n) := e.pow_nat n
| (int.neg_succ_of_nat n) := e.symm.pow_nat (n+1)

instance : has_pow (C ≌ C) ℤ := ⟨pow⟩

@[simp] lemma pow_zero (e : C ≌ C) : e^(0 : ℤ) = equivalence.refl := rfl
@[simp] lemma pow_one (e : C ≌ C) : e^(1 : ℤ) = e := rfl
@[simp] lemma pow_neg_one (e : C ≌ C) : e^(-1 : ℤ) = e.symm := rfl

-- TODO as necessary, add the natural isomorphisms `(e^a).trans e^b ≅ e^(a+b)`.
-- At this point, we haven't even defined the category of equivalences.

end

end equivalence

/-- A functor that is part of a (half) adjoint equivalence -/
class is_equivalence (F : C ⥤ D) :=
mk' ::
(inverse    : D ⥤ C)
(unit_iso   : 𝟭 C ≅ F ⋙ inverse)
(counit_iso : inverse ⋙ F ≅ 𝟭 D)
(functor_unit_iso_comp' : ∀ (X : C), F.map ((unit_iso.hom : 𝟭 C ⟶ F ⋙ inverse).app X) ≫
  counit_iso.hom.app (F.obj X) = 𝟙 (F.obj X) . obviously)

restate_axiom is_equivalence.functor_unit_iso_comp'

attribute [simp, reassoc] is_equivalence.functor_unit_iso_comp

namespace is_equivalence

instance of_equivalence (F : C ≌ D) : is_equivalence F.functor :=
{ ..F }

instance of_equivalence_inverse (F : C ≌ D) : is_equivalence F.inverse :=
is_equivalence.of_equivalence F.symm

open equivalence
/-- To see that a functor is an equivalence, it suffices to provide an inverse functor `G` such that
    `F ⋙ G` and `G ⋙ F` are naturally isomorphic to identity functors. -/
protected definition mk {F : C ⥤ D} (G : D ⥤ C)
  (η : 𝟭 C ≅ F ⋙ G) (ε : G ⋙ F ≅ 𝟭 D) : is_equivalence F :=
⟨G, adjointify_η η ε, ε, adjointify_η_ε η ε⟩

end is_equivalence

namespace functor

/-- Interpret a functor that is an equivalence as an equivalence. -/
def as_equivalence (F : C ⥤ D) [is_equivalence F] : C ≌ D :=
⟨F, is_equivalence.inverse F, is_equivalence.unit_iso, is_equivalence.counit_iso,
  is_equivalence.functor_unit_iso_comp⟩

instance is_equivalence_refl : is_equivalence (𝟭 C) :=
is_equivalence.of_equivalence equivalence.refl

/-- The inverse functor of a functor that is an equivalence. -/
def inv (F : C ⥤ D) [is_equivalence F] : D ⥤ C :=
is_equivalence.inverse F

instance is_equivalence_inv (F : C ⥤ D) [is_equivalence F] : is_equivalence F.inv :=
is_equivalence.of_equivalence F.as_equivalence.symm

@[simp] lemma as_equivalence_functor (F : C ⥤ D) [is_equivalence F] :
  F.as_equivalence.functor = F := rfl

@[simp] lemma as_equivalence_inverse (F : C ⥤ D) [is_equivalence F] :
  F.as_equivalence.inverse = inv F := rfl

@[simp] lemma as_equivalence_unit {F : C ⥤ D} [h : is_equivalence F] :
  F.as_equivalence.unit_iso = @@is_equivalence.unit_iso _ _ h := rfl

@[simp] lemma as_equivalence_counit {F : C ⥤ D} [is_equivalence F] :
  F.as_equivalence.counit_iso = is_equivalence.counit_iso := rfl

@[simp] lemma inv_inv (F : C ⥤ D) [is_equivalence F] :
  inv (inv F) = F := rfl

variables {E : Type u₃} [category.{v₃} E]

instance is_equivalence_trans (F : C ⥤ D) (G : D ⥤ E) [is_equivalence F] [is_equivalence G] :
  is_equivalence (F ⋙ G) :=
is_equivalence.of_equivalence (equivalence.trans (as_equivalence F) (as_equivalence G))

end functor

namespace equivalence

@[simp]
lemma functor_inv (E : C ≌ D) : E.functor.inv = E.inverse := rfl

@[simp]
lemma inverse_inv (E : C ≌ D) : E.inverse.inv = E.functor := rfl

@[simp]
lemma functor_as_equivalence (E : C ≌ D) : E.functor.as_equivalence = E :=
by { cases E, congr, }

@[simp]
lemma inverse_as_equivalence (E : C ≌ D) : E.inverse.as_equivalence = E.symm :=
by { cases E, congr, }

end equivalence

namespace is_equivalence

@[simp] lemma fun_inv_map (F : C ⥤ D) [is_equivalence F] (X Y : D) (f : X ⟶ Y) :
  F.map (F.inv.map f) = F.as_equivalence.counit.app X ≫ f ≫ F.as_equivalence.counit_inv.app Y :=
begin
  erw [nat_iso.naturality_2],
  refl
end
@[simp] lemma inv_fun_map (F : C ⥤ D) [is_equivalence F] (X Y : C) (f : X ⟶ Y) :
  F.inv.map (F.map f) = F.as_equivalence.unit_inv.app X ≫ f ≫ F.as_equivalence.unit.app Y :=
begin
  erw [nat_iso.naturality_1],
  refl
end

/-- When a functor `F` is an equivalence of categories, and `G` is isomorphic to `F`, then
`G` is also an equivalence of categories. -/
@[simps]
def of_iso {F G : C ⥤ D} (e : F ≅ G) (hF : is_equivalence F) : is_equivalence G :=
{ inverse := hF.inverse,
  unit_iso := hF.unit_iso ≪≫ nat_iso.hcomp e (iso.refl hF.inverse),
  counit_iso := nat_iso.hcomp (iso.refl hF.inverse) e.symm ≪≫ hF.counit_iso,
  functor_unit_iso_comp' := λ X, begin
    dsimp [nat_iso.hcomp],
    erw [id_comp, F.map_id, comp_id],
    apply (cancel_epi (e.hom.app X)).mp,
    slice_lhs 1 2 { rw ← e.hom.naturality, },
    slice_lhs 2 3 { rw [← nat_trans.vcomp_app', e.hom_inv_id], },
    simp only [nat_trans.id_app, id_comp, comp_id, F.map_comp, assoc],
    erw hF.counit_iso.hom.naturality,
    slice_lhs 1 2 { rw functor_unit_iso_comp, },
    simp only [functor.id_map, id_comp],
  end }

/-- Compatibility of `of_iso` with the composition of isomorphisms of functors -/
lemma of_iso_trans {F G H : C ⥤ D} (e : F ≅ G) (e' : G ≅ H) (hF : is_equivalence F) :
  (of_iso e' (of_iso e hF)) = of_iso (e ≪≫ e') hF :=
begin
  dsimp [of_iso],
  congr' 1; ext X; dsimp [nat_iso.hcomp],
  { simp only [id_comp, assoc, functor.map_comp], },
  { simp only [functor.map_id, comp_id, id_comp, assoc], },
end

/-- Compatibility of `of_iso` with identity isomorphisms of functors -/
lemma of_iso_refl (F : C ⥤ D) (hF : is_equivalence F) : of_iso (iso.refl F) hF = hF :=
begin
  unfreezingI { rcases hF with ⟨Finv, Funit, Fcounit, Fcomp⟩, },
  dsimp [of_iso],
  congr' 1; ext X; dsimp [nat_iso.hcomp],
  { simp only [comp_id, map_id], },
  { simp only [id_comp, map_id], },
end

/-- When `F` and `G` are two isomorphic functors, then `F` is an equivalence iff `G` is. -/
@[simps]
def equiv_of_iso {F G : C ⥤ D} (e : F ≅ G) : is_equivalence F ≃ is_equivalence G :=
{ to_fun := of_iso e,
  inv_fun := of_iso e.symm,
  left_inv := λ hF, by rw [of_iso_trans, iso.self_symm_id, of_iso_refl],
  right_inv := λ hF, by rw [of_iso_trans, iso.symm_self_id, of_iso_refl], }

/-- If `G` and `F ⋙ G` are equivalence of categories, then `F` is also an equivalence. -/
@[simp]
def cancel_comp_right {E : Type*} [category E]
  (F : C ⥤ D) (G : D ⥤ E) (hG : is_equivalence G) (hGF : is_equivalence (F ⋙ G)) :
  is_equivalence F :=
of_iso ((functor.associator F G G.inv) ≪≫ nat_iso.hcomp (iso.refl F) hG.unit_iso.symm ≪≫
  right_unitor F) (functor.is_equivalence_trans (F ⋙ G) (G.inv))

/-- If `F` and `F ⋙ G` are equivalence of categories, then `G` is also an equivalence. -/
@[simp]
def cancel_comp_left {E : Type*} [category E]
  (F : C ⥤ D) (G : D ⥤ E) (hF : is_equivalence F) (hGF : is_equivalence (F ⋙ G)) :
  is_equivalence G :=
of_iso ((functor.associator F.inv F G).symm ≪≫ nat_iso.hcomp hF.counit_iso (iso.refl G) ≪≫
  left_unitor G) (functor.is_equivalence_trans F.inv (F ⋙ G))

end is_equivalence

namespace equivalence

/--
An equivalence is essentially surjective.

See <https://stacks.math.columbia.edu/tag/02C3>.
-/
lemma ess_surj_of_equivalence (F : C ⥤ D) [is_equivalence F] : ess_surj F :=
⟨λ Y, ⟨F.inv.obj Y, ⟨F.as_equivalence.counit_iso.app Y⟩⟩⟩

/--
An equivalence is faithful.

See <https://stacks.math.columbia.edu/tag/02C3>.
-/
@[priority 100] -- see Note [lower instance priority]
instance faithful_of_equivalence (F : C ⥤ D) [is_equivalence F] : faithful F :=
{ map_injective' := λ X Y f g w,
  begin
    have p := congr_arg (@category_theory.functor.map _ _ _ _ F.inv _ _) w,
    simpa only [cancel_epi, cancel_mono, is_equivalence.inv_fun_map] using p
  end }.

/--
An equivalence is full.

See <https://stacks.math.columbia.edu/tag/02C3>.
-/
@[priority 100] -- see Note [lower instance priority]
instance full_of_equivalence (F : C ⥤ D) [is_equivalence F] : full F :=
{ preimage := λ X Y f, F.as_equivalence.unit.app X ≫ F.inv.map f ≫ F.as_equivalence.unit_inv.app Y,
  witness' := λ X Y f, F.inv.map_injective $
  by simpa only [is_equivalence.inv_fun_map, assoc, iso.inv_hom_id_app_assoc, iso.inv_hom_id_app]
    using comp_id _ }

@[simps] private noncomputable def equivalence_inverse (F : C ⥤ D) [full F] [faithful F]
  [ess_surj F] : D ⥤ C :=
{ obj  := λ X, F.obj_preimage X,
  map := λ X Y f, F.preimage ((F.obj_obj_preimage_iso X).hom ≫ f ≫ (F.obj_obj_preimage_iso Y).inv),
  map_id' := λ X, begin apply F.map_injective, tidy end,
  map_comp' := λ X Y Z f g, by apply F.map_injective; simp }

/--
A functor which is full, faithful, and essentially surjective is an equivalence.

See <https://stacks.math.columbia.edu/tag/02C3>.
-/
noncomputable def of_fully_faithfully_ess_surj
  (F : C ⥤ D) [full F] [faithful F] [ess_surj F] : is_equivalence F :=
is_equivalence.mk (equivalence_inverse F)
  (nat_iso.of_components
    (λ X, (F.preimage_iso $ F.obj_obj_preimage_iso $ F.obj X).symm)
    (λ X Y f, by { apply F.map_injective, obviously }))
  (nat_iso.of_components F.obj_obj_preimage_iso (by tidy))

@[simp] lemma functor_map_inj_iff (e : C ≌ D) {X Y : C} (f g : X ⟶ Y) :
  e.functor.map f = e.functor.map g ↔ f = g :=
⟨λ h, e.functor.map_injective h, λ h, h ▸ rfl⟩

@[simp] lemma inverse_map_inj_iff (e : C ≌ D) {X Y : D} (f g : X ⟶ Y) :
  e.inverse.map f = e.inverse.map g ↔ f = g :=
functor_map_inj_iff e.symm f g

instance ess_surj_induced_functor {C' : Type*} (e : C' ≃ D) : ess_surj (induced_functor e) :=
{ mem_ess_image := λ Y, ⟨e.symm Y, by simp⟩, }

noncomputable
instance induced_functor_of_equiv {C' : Type*} (e : C' ≃ D) : is_equivalence (induced_functor e) :=
equivalence.of_fully_faithfully_ess_surj _

noncomputable
instance fully_faithful_to_ess_image (F : C ⥤ D) [full F] [faithful F] :
  is_equivalence F.to_ess_image :=
of_fully_faithfully_ess_surj F.to_ess_image

end equivalence

end category_theory


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import init.data.bool.basic init.meta

attribute [simp] cond bor band bnot bxor

@[simp] lemma {u} cond_a_a {α : Type u} (b : bool) (a : α) : cond b a a = a :=
by cases b; simp

@[simp] lemma band_self (b : bool) : b && b = b :=
by cases b; simp

@[simp] lemma band_tt (b : bool) : b && tt = b :=
by cases b; simp

@[simp] lemma band_ff (b : bool) : b && ff = ff :=
by cases b; simp

@[simp] lemma tt_band (b : bool) : tt && b = b :=
by cases b; simp

@[simp] lemma ff_band (b : bool) : ff && b = ff :=
by cases b; simp

@[simp] lemma bor_self (b : bool) : b || b = b :=
by cases b; simp

@[simp] lemma bor_tt (b : bool) : b || tt = tt :=
by cases b; simp

@[simp] lemma bor_ff (b : bool) : b || ff = b :=
by cases b; simp

@[simp] lemma tt_bor (b : bool) : tt || b = tt :=
by cases b; simp

@[simp] lemma ff_bor (b : bool) : ff || b = b :=
by cases b; simp

@[simp] lemma bxor_self (b : bool) : bxor b b = ff :=
by cases b; simp

@[simp] lemma bxor_tt (b : bool) : bxor b tt = bnot b :=
by cases b; simp

lemma bxor_ff (b : bool) : bxor b ff = b :=
by cases b; simp

@[simp] lemma tt_bxor (b : bool) : bxor tt b = bnot b :=
by cases b; simp

lemma ff_bxor (b : bool) : bxor ff b = b :=
by cases b; simp

@[simp] lemma bnot_bnot (b : bool) : bnot (bnot b) = b :=
by cases b; simp

lemma tt_eq_ff_eq_false : ¬(tt = ff) :=
by contradiction

lemma ff_eq_tt_eq_false : ¬(ff = tt) :=
by contradiction

@[simp] lemma eq_ff_eq_not_eq_tt (b : bool) : (¬(b = tt)) = (b = ff) :=
by cases b; simp

@[simp] lemma eq_tt_eq_not_eq_ff (b : bool) : (¬(b = ff)) = (b = tt) :=
by cases b; simp

lemma eq_ff_of_not_eq_tt {b : bool} : (¬(b = tt)) → (b = ff) :=
eq.mp (eq_ff_eq_not_eq_tt b)

lemma eq_tt_of_not_eq_ff {b : bool} : (¬(b = ff)) → (b = tt) :=
eq.mp (eq_tt_eq_not_eq_ff b)

@[simp] lemma band_eq_true_eq_eq_tt_and_eq_tt (a b : bool) : (a && b = tt) = (a = tt ∧ b = tt) :=
by cases a; cases b; simp

@[simp] lemma bor_eq_true_eq_eq_tt_or_eq_tt (a b : bool) : (a || b = tt) = (a = tt ∨ b = tt) :=
by cases a; cases b; simp

@[simp] lemma bnot_eq_true_eq_eq_ff (a : bool) : (bnot a = tt) = (a = ff) :=
by cases a; simp

@[simp] lemma band_eq_false_eq_eq_ff_or_eq_ff (a b : bool) : (a && b = ff) = (a = ff ∨ b = ff) :=
by cases a; cases b; simp

@[simp] lemma bor_eq_false_eq_eq_ff_and_eq_ff (a b : bool) : (a || b = ff) = (a = ff ∧ b = ff) :=
by cases a; cases b; simp

@[simp] lemma bnot_eq_ff_eq_eq_tt (a : bool) : (bnot a = ff) = (a = tt) :=
by cases a; simp

@[simp] lemma coe_ff : ↑ff = false :=
show (ff = tt) = false, by simp

@[simp] lemma coe_tt : ↑tt = true :=
show (tt = tt) = true, by simp

@[simp] lemma coe_sort_ff : ↥ff = false :=
show (ff = tt) = false, by simp

@[simp] lemma coe_sort_tt : ↥tt = true :=
show (tt = tt) = true, by simp

@[simp] theorem to_bool_iff (p : Prop) [d : decidable p] : (to_bool p = tt) ↔ p :=
match d with
| is_true hp := ⟨λh, hp, λ_, rfl⟩
| is_false hnp := ⟨λh, bool.no_confusion h, λhp, absurd hp hnp⟩
end

theorem to_bool_true {p : Prop} [decidable p] : p → to_bool p := (to_bool_iff p).2

theorem to_bool_tt {p : Prop} [decidable p] : p → to_bool p = tt := to_bool_true

theorem of_to_bool_true {p : Prop} [decidable p] : to_bool p → p := (to_bool_iff p).1

theorem bool_iff_false {b : bool} : ¬ b ↔ b = ff := by cases b; exact dec_trivial

theorem bool_eq_false {b : bool} : ¬ b → b = ff := bool_iff_false.1

@[simp] theorem to_bool_ff_iff (p : Prop) [decidable p] : to_bool p = ff ↔ ¬p :=
bool_iff_false.symm.trans (not_congr (to_bool_iff _))

theorem to_bool_ff {p : Prop} [decidable p] : ¬p → to_bool p = ff := (to_bool_ff_iff p).2

theorem of_to_bool_ff {p : Prop} [decidable p] : to_bool p = ff → ¬p := (to_bool_ff_iff p).1

theorem to_bool_congr {p q : Prop} [decidable p] [decidable q] (h : p ↔ q) : to_bool p = to_bool q :=
begin
  induction h' : to_bool q,
  exact to_bool_ff (mt h.1 $ of_to_bool_ff h'),
  exact to_bool_true (h.2 $ of_to_bool_true h')
end

@[simp] theorem bor_coe_iff (a b : bool) : a || b ↔ a ∨ b :=
by cases a; cases b; exact dec_trivial

@[simp] theorem band_coe_iff (a b : bool) : a && b ↔ a ∧ b :=
by cases a; cases b; exact dec_trivial

@[simp] theorem bxor_coe_iff (a b : bool) : bxor a b ↔ xor a b :=
by cases a; cases b; exact dec_trivial

@[simp] theorem ite_eq_tt_distrib (c : Prop) [decidable c] (a b : bool) : ((if c then a else b) = tt) = (if c then a = tt else b = tt) :=
by by_cases c; simp [*]

@[simp] theorem ite_eq_ff_distrib (c : Prop) [decidable c] (a b : bool) : ((if c then a else b) = ff) = (if c then a = ff else b = ff) :=
by by_cases c; simp [*]