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

! This file was ported from Lean 3 source module data.pequiv
! leanprover-community/mathlib commit 7c3269ca3fa4c0c19e4d127cd7151edbdbf99ed4
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Set.Basic

/-!

# Partial Equivalences

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

In this file, we define partial equivalences `pequiv`, which are a bijection between a subset of `α`
and a subset of `β`. Notationally, a `pequiv` is denoted by "`≃.`" (note that the full stop is part
of the notation). The way we store these internally is with two functions `f : α → option β` and
the reverse function `g : β → option α`, with the condition that if `f a` is `option.some b`,
then `g b` is `option.some a`.

## Main results

- `pequiv.of_set`: creates a `pequiv` from a set `s`,
  which sends an element to itself if it is in `s`.
- `pequiv.single`: given two elements `a : α` and `b : β`, create a `pequiv` that sends them to
  each other, and ignores all other elements.
- `pequiv.injective_of_forall_ne_is_some`/`injective_of_forall_is_some`: If the domain of a `pequiv`
  is all of `α` (except possibly one point), its `to_fun` is injective.

## Canonical order

`pequiv` is canonically ordered by inclusion; that is, if a function `f` defined on a subset `s`
is equal to `g` on that subset, but `g` is also defined on a larger set, then `f ≤ g`. We also have
a definition of `⊥`, which is the empty `pequiv` (sends all to `none`), which in the end gives us a
`semilattice_inf` with an `order_bot` instance.

## Tags

pequiv, partial equivalence

-/

universe u v w x

#print PEquiv /-
/-- A `pequiv` is a partial equivalence, a representation of a bijection between a subset
  of `α` and a subset of `β`. See also `local_equiv` for a version that requires `to_fun` and
`inv_fun` to be globally defined functions and has `source` and `target` sets as extra fields. -/
structure PEquiv (α : Type u) (β : Type v) where
  toFun : α → Option β
  invFun : β → Option α
  inv : ∀ (a : α) (b : β), a ∈ inv_fun b ↔ b ∈ to_fun a
#align pequiv PEquiv
-/

-- mathport name: «expr ≃. »
infixr:25 " ≃. " => PEquiv

namespace PEquiv

variable {α : Type u} {β : Type v} {γ : Type w} {δ : Type x}

open Function Option

instance funLike : FunLike (α ≃. β) α fun _ => Option β
    where
  coe := toFun
  coe_injective' := by
    rintro ⟨f₁, f₂, hf⟩ ⟨g₁, g₂, hg⟩ (rfl : f₁ = g₁)
    congr with (y x)
    simp only [hf, hg]
#align pequiv.fun_like PEquiv.funLike

#print PEquiv.coe_mk_apply /-
@[simp]
theorem coe_mk_apply (f₁ : α → Option β) (f₂ : β → Option α) (h) (x : α) :
    (PEquiv.mk f₁ f₂ h : α → Option β) x = f₁ x :=
  rfl
#align pequiv.coe_mk_apply PEquiv.coe_mk_apply
-/

#print PEquiv.ext /-
@[ext]
theorem ext {f g : α ≃. β} (h : ∀ x, f x = g x) : f = g :=
  FunLike.ext f g h
#align pequiv.ext PEquiv.ext
-/

#print PEquiv.ext_iff /-
theorem ext_iff {f g : α ≃. β} : f = g ↔ ∀ x, f x = g x :=
  FunLike.ext_iff
#align pequiv.ext_iff PEquiv.ext_iff
-/

#print PEquiv.refl /-
/-- The identity map as a partial equivalence. -/
@[refl]
protected def refl (α : Type _) : α ≃. α
    where
  toFun := some
  invFun := some
  inv _ _ := eq_comm
#align pequiv.refl PEquiv.refl
-/

#print PEquiv.symm /-
/-- The inverse partial equivalence. -/
@[symm]
protected def symm (f : α ≃. β) : β ≃. α
    where
  toFun := f.2
  invFun := f.1
  inv _ _ := (f.inv _ _).symm
#align pequiv.symm PEquiv.symm
-/

#print PEquiv.mem_iff_mem /-
theorem mem_iff_mem (f : α ≃. β) : ∀ {a : α} {b : β}, a ∈ f.symm b ↔ b ∈ f a :=
  f.3
#align pequiv.mem_iff_mem PEquiv.mem_iff_mem
-/

#print PEquiv.eq_some_iff /-
theorem eq_some_iff (f : α ≃. β) : ∀ {a : α} {b : β}, f.symm b = some a ↔ f a = some b :=
  f.3
#align pequiv.eq_some_iff PEquiv.eq_some_iff
-/

#print PEquiv.trans /-
/-- Composition of partial equivalences `f : α ≃. β` and `g : β ≃. γ`. -/
@[trans]
protected def trans (f : α ≃. β) (g : β ≃. γ) : α ≃. γ
    where
  toFun a := (f a).bind g
  invFun a := (g.symm a).bind f.symm
  inv a b := by simp_all [and_comm, eq_some_iff f, eq_some_iff g]
#align pequiv.trans PEquiv.trans
-/

#print PEquiv.refl_apply /-
@[simp]
theorem refl_apply (a : α) : PEquiv.refl α a = some a :=
  rfl
#align pequiv.refl_apply PEquiv.refl_apply
-/

#print PEquiv.symm_refl /-
@[simp]
theorem symm_refl : (PEquiv.refl α).symm = PEquiv.refl α :=
  rfl
#align pequiv.symm_refl PEquiv.symm_refl
-/

#print PEquiv.symm_symm /-
@[simp]
theorem symm_symm (f : α ≃. β) : f.symm.symm = f := by cases f <;> rfl
#align pequiv.symm_symm PEquiv.symm_symm
-/

#print PEquiv.symm_injective /-
theorem symm_injective : Function.Injective (@PEquiv.symm α β) :=
  LeftInverse.injective symm_symm
#align pequiv.symm_injective PEquiv.symm_injective
-/

#print PEquiv.trans_assoc /-
theorem trans_assoc (f : α ≃. β) (g : β ≃. γ) (h : γ ≃. δ) :
    (f.trans g).trans h = f.trans (g.trans h) :=
  ext fun _ => Option.bind_assoc _ _ _
#align pequiv.trans_assoc PEquiv.trans_assoc
-/

#print PEquiv.mem_trans /-
theorem mem_trans (f : α ≃. β) (g : β ≃. γ) (a : α) (c : γ) :
    c ∈ f.trans g a ↔ ∃ b, b ∈ f a ∧ c ∈ g b :=
  Option.bind_eq_some'
#align pequiv.mem_trans PEquiv.mem_trans
-/

#print PEquiv.trans_eq_some /-
theorem trans_eq_some (f : α ≃. β) (g : β ≃. γ) (a : α) (c : γ) :
    f.trans g a = some c ↔ ∃ b, f a = some b ∧ g b = some c :=
  Option.bind_eq_some'
#align pequiv.trans_eq_some PEquiv.trans_eq_some
-/

#print PEquiv.trans_eq_none /-
theorem trans_eq_none (f : α ≃. β) (g : β ≃. γ) (a : α) :
    f.trans g a = none ↔ ∀ b c, b ∉ f a ∨ c ∉ g b :=
  by
  simp only [eq_none_iff_forall_not_mem, mem_trans, imp_iff_not_or.symm]
  push_neg; tauto
#align pequiv.trans_eq_none PEquiv.trans_eq_none
-/

#print PEquiv.refl_trans /-
@[simp]
theorem refl_trans (f : α ≃. β) : (PEquiv.refl α).trans f = f := by
  ext <;> dsimp [PEquiv.trans] <;> rfl
#align pequiv.refl_trans PEquiv.refl_trans
-/

#print PEquiv.trans_refl /-
@[simp]
theorem trans_refl (f : α ≃. β) : f.trans (PEquiv.refl β) = f := by
  ext <;> dsimp [PEquiv.trans] <;> simp
#align pequiv.trans_refl PEquiv.trans_refl
-/

#print PEquiv.inj /-
protected theorem inj (f : α ≃. β) {a₁ a₂ : α} {b : β} (h₁ : b ∈ f a₁) (h₂ : b ∈ f a₂) : a₁ = a₂ :=
  by rw [← mem_iff_mem] at * <;> cases h : f.symm b <;> simp_all
#align pequiv.inj PEquiv.inj
-/

#print PEquiv.injective_of_forall_ne_isSome /-
/-- If the domain of a `pequiv` is `α` except a point, its forward direction is injective. -/
theorem injective_of_forall_ne_isSome (f : α ≃. β) (a₂ : α)
    (h : ∀ a₁ : α, a₁ ≠ a₂ → isSome (f a₁)) : Injective f :=
  HasLeftInverse.injective
    ⟨fun b => Option.recOn b a₂ fun b' => Option.recOn (f.symm b') a₂ id, fun x => by
      classical
        cases hfx : f x
        · have : x = a₂ := not_imp_comm.1 (h x) (hfx.symm ▸ by simp)
          simp [this]
        · dsimp only
          rw [(eq_some_iff f).2 hfx]
          rfl⟩
#align pequiv.injective_of_forall_ne_is_some PEquiv.injective_of_forall_ne_isSome
-/

#print PEquiv.injective_of_forall_isSome /-
/-- If the domain of a `pequiv` is all of `α`, its forward direction is injective. -/
theorem injective_of_forall_isSome {f : α ≃. β} (h : ∀ a : α, isSome (f a)) : Injective f :=
  (Classical.em (Nonempty α)).elim
    (fun hn => injective_of_forall_ne_isSome f (Classical.choice hn) fun a _ => h a) fun hn x =>
    (hn ⟨x⟩).elim
#align pequiv.injective_of_forall_is_some PEquiv.injective_of_forall_isSome
-/

section OfSet

variable (s : Set α) [DecidablePred (· ∈ s)]

#print PEquiv.ofSet /-
/-- Creates a `pequiv` that is the identity on `s`, and `none` outside of it. -/
def ofSet (s : Set α) [DecidablePred (· ∈ s)] : α ≃. α
    where
  toFun a := if a ∈ s then some a else none
  invFun a := if a ∈ s then some a else none
  inv a b := by
    split_ifs with hb ha ha
    · simp [eq_comm]
    · simp [ne_of_mem_of_not_mem hb ha]
    · simp [ne_of_mem_of_not_mem ha hb]
    · simp
#align pequiv.of_set PEquiv.ofSet
-/

#print PEquiv.mem_ofSet_self_iff /-
theorem mem_ofSet_self_iff {s : Set α} [DecidablePred (· ∈ s)] {a : α} : a ∈ ofSet s a ↔ a ∈ s := by
  dsimp [of_set] <;> split_ifs <;> simp [*]
#align pequiv.mem_of_set_self_iff PEquiv.mem_ofSet_self_iff
-/

#print PEquiv.mem_ofSet_iff /-
theorem mem_ofSet_iff {s : Set α} [DecidablePred (· ∈ s)] {a b : α} :
    a ∈ ofSet s b ↔ a = b ∧ a ∈ s := by
  dsimp [of_set]
  split_ifs
  · simp only [iff_self_and, eq_comm]
    rintro rfl
    exact h
  · simp only [false_iff_iff, not_and]
    rintro rfl
    exact h
#align pequiv.mem_of_set_iff PEquiv.mem_ofSet_iff
-/

#print PEquiv.ofSet_eq_some_iff /-
@[simp]
theorem ofSet_eq_some_iff {s : Set α} {h : DecidablePred (· ∈ s)} {a b : α} :
    ofSet s b = some a ↔ a = b ∧ a ∈ s :=
  mem_ofSet_iff
#align pequiv.of_set_eq_some_iff PEquiv.ofSet_eq_some_iff
-/

#print PEquiv.ofSet_eq_some_self_iff /-
@[simp]
theorem ofSet_eq_some_self_iff {s : Set α} {h : DecidablePred (· ∈ s)} {a : α} :
    ofSet s a = some a ↔ a ∈ s :=
  mem_ofSet_self_iff
#align pequiv.of_set_eq_some_self_iff PEquiv.ofSet_eq_some_self_iff
-/

#print PEquiv.ofSet_symm /-
@[simp]
theorem ofSet_symm : (ofSet s).symm = ofSet s :=
  rfl
#align pequiv.of_set_symm PEquiv.ofSet_symm
-/

#print PEquiv.ofSet_univ /-
@[simp]
theorem ofSet_univ : ofSet Set.univ = PEquiv.refl α :=
  rfl
#align pequiv.of_set_univ PEquiv.ofSet_univ
-/

#print PEquiv.ofSet_eq_refl /-
@[simp]
theorem ofSet_eq_refl {s : Set α} [DecidablePred (· ∈ s)] :
    ofSet s = PEquiv.refl α ↔ s = Set.univ :=
  ⟨fun h => by
    rw [Set.eq_univ_iff_forall]
    intro
    rw [← mem_of_set_self_iff, h]
    exact rfl, fun h => by simp only [← of_set_univ, h]⟩
#align pequiv.of_set_eq_refl PEquiv.ofSet_eq_refl
-/

end OfSet

#print PEquiv.symm_trans_rev /-
theorem symm_trans_rev (f : α ≃. β) (g : β ≃. γ) : (f.trans g).symm = g.symm.trans f.symm :=
  rfl
#align pequiv.symm_trans_rev PEquiv.symm_trans_rev
-/

#print PEquiv.self_trans_symm /-
theorem self_trans_symm (f : α ≃. β) : f.trans f.symm = ofSet { a | (f a).isSome } :=
  by
  ext
  dsimp [PEquiv.trans]
  simp only [eq_some_iff f, Option.isSome_iff_exists, Option.mem_def, bind_eq_some',
    of_set_eq_some_iff]
  constructor
  · rintro ⟨b, hb₁, hb₂⟩
    exact ⟨PEquiv.inj _ hb₂ hb₁, b, hb₂⟩
  · simp (config := { contextual := true })
#align pequiv.self_trans_symm PEquiv.self_trans_symm
-/

#print PEquiv.symm_trans_self /-
theorem symm_trans_self (f : α ≃. β) : f.symm.trans f = ofSet { b | (f.symm b).isSome } :=
  symm_injective <| by simp [symm_trans_rev, self_trans_symm, -symm_symm]
#align pequiv.symm_trans_self PEquiv.symm_trans_self
-/

#print PEquiv.trans_symm_eq_iff_forall_isSome /-
theorem trans_symm_eq_iff_forall_isSome {f : α ≃. β} :
    f.trans f.symm = PEquiv.refl α ↔ ∀ a, isSome (f a) := by
  rw [self_trans_symm, of_set_eq_refl, Set.eq_univ_iff_forall] <;> rfl
#align pequiv.trans_symm_eq_iff_forall_is_some PEquiv.trans_symm_eq_iff_forall_isSome
-/

instance : Bot (α ≃. β) :=
  ⟨{  toFun := fun _ => none
      invFun := fun _ => none
      inv := by simp }⟩

instance : Inhabited (α ≃. β) :=
  ⟨⊥⟩

#print PEquiv.bot_apply /-
@[simp]
theorem bot_apply (a : α) : (⊥ : α ≃. β) a = none :=
  rfl
#align pequiv.bot_apply PEquiv.bot_apply
-/

#print PEquiv.symm_bot /-
@[simp]
theorem symm_bot : (⊥ : α ≃. β).symm = ⊥ :=
  rfl
#align pequiv.symm_bot PEquiv.symm_bot
-/

#print PEquiv.trans_bot /-
@[simp]
theorem trans_bot (f : α ≃. β) : f.trans (⊥ : β ≃. γ) = ⊥ := by
  ext <;> dsimp [PEquiv.trans] <;> simp
#align pequiv.trans_bot PEquiv.trans_bot
-/

#print PEquiv.bot_trans /-
@[simp]
theorem bot_trans (f : β ≃. γ) : (⊥ : α ≃. β).trans f = ⊥ := by
  ext <;> dsimp [PEquiv.trans] <;> simp
#align pequiv.bot_trans PEquiv.bot_trans
-/

#print PEquiv.isSome_symm_get /-
theorem isSome_symm_get (f : α ≃. β) {a : α} (h : isSome (f a)) : isSome (f.symm (Option.get h)) :=
  isSome_iff_exists.2 ⟨a, by rw [f.eq_some_iff, some_get]⟩
#align pequiv.is_some_symm_get PEquiv.isSome_symm_get
-/

section Single

variable [DecidableEq α] [DecidableEq β] [DecidableEq γ]

#print PEquiv.single /-
/-- Create a `pequiv` which sends `a` to `b` and `b` to `a`, but is otherwise `none`. -/
def single (a : α) (b : β) : α ≃. β
    where
  toFun x := if x = a then some b else none
  invFun x := if x = b then some a else none
  inv _ _ := by simp <;> split_ifs <;> cc
#align pequiv.single PEquiv.single
-/

#print PEquiv.mem_single /-
theorem mem_single (a : α) (b : β) : b ∈ single a b a :=
  if_pos rfl
#align pequiv.mem_single PEquiv.mem_single
-/

#print PEquiv.mem_single_iff /-
theorem mem_single_iff (a₁ a₂ : α) (b₁ b₂ : β) : b₁ ∈ single a₂ b₂ a₁ ↔ a₁ = a₂ ∧ b₁ = b₂ := by
  dsimp [single] <;> split_ifs <;> simp [*, eq_comm]
#align pequiv.mem_single_iff PEquiv.mem_single_iff
-/

#print PEquiv.symm_single /-
@[simp]
theorem symm_single (a : α) (b : β) : (single a b).symm = single b a :=
  rfl
#align pequiv.symm_single PEquiv.symm_single
-/

#print PEquiv.single_apply /-
@[simp]
theorem single_apply (a : α) (b : β) : single a b a = some b :=
  if_pos rfl
#align pequiv.single_apply PEquiv.single_apply
-/

#print PEquiv.single_apply_of_ne /-
theorem single_apply_of_ne {a₁ a₂ : α} (h : a₁ ≠ a₂) (b : β) : single a₁ b a₂ = none :=
  if_neg h.symm
#align pequiv.single_apply_of_ne PEquiv.single_apply_of_ne
-/

#print PEquiv.single_trans_of_mem /-
theorem single_trans_of_mem (a : α) {b : β} {c : γ} {f : β ≃. γ} (h : c ∈ f b) :
    (single a b).trans f = single a c := by
  ext
  dsimp [single, PEquiv.trans]
  split_ifs <;> simp_all
#align pequiv.single_trans_of_mem PEquiv.single_trans_of_mem
-/

#print PEquiv.trans_single_of_mem /-
theorem trans_single_of_mem {a : α} {b : β} (c : γ) {f : α ≃. β} (h : b ∈ f a) :
    f.trans (single b c) = single a c :=
  symm_injective <| single_trans_of_mem _ ((mem_iff_mem f).2 h)
#align pequiv.trans_single_of_mem PEquiv.trans_single_of_mem
-/

#print PEquiv.single_trans_single /-
@[simp]
theorem single_trans_single (a : α) (b : β) (c : γ) :
    (single a b).trans (single b c) = single a c :=
  single_trans_of_mem _ (mem_single _ _)
#align pequiv.single_trans_single PEquiv.single_trans_single
-/

#print PEquiv.single_subsingleton_eq_refl /-
@[simp]
theorem single_subsingleton_eq_refl [Subsingleton α] (a b : α) : single a b = PEquiv.refl α :=
  by
  ext (i j)
  dsimp [single]
  rw [if_pos (Subsingleton.elim i a), Subsingleton.elim i j, Subsingleton.elim b j]
#align pequiv.single_subsingleton_eq_refl PEquiv.single_subsingleton_eq_refl
-/

#print PEquiv.trans_single_of_eq_none /-
theorem trans_single_of_eq_none {b : β} (c : γ) {f : δ ≃. β} (h : f.symm b = none) :
    f.trans (single b c) = ⊥ := by
  ext
  simp only [eq_none_iff_forall_not_mem, Option.mem_def, f.eq_some_iff] at h
  dsimp [PEquiv.trans, single]
  simp
  intros
  split_ifs <;> simp_all
#align pequiv.trans_single_of_eq_none PEquiv.trans_single_of_eq_none
-/

#print PEquiv.single_trans_of_eq_none /-
theorem single_trans_of_eq_none (a : α) {b : β} {f : β ≃. δ} (h : f b = none) :
    (single a b).trans f = ⊥ :=
  symm_injective <| trans_single_of_eq_none _ h
#align pequiv.single_trans_of_eq_none PEquiv.single_trans_of_eq_none
-/

#print PEquiv.single_trans_single_of_ne /-
theorem single_trans_single_of_ne {b₁ b₂ : β} (h : b₁ ≠ b₂) (a : α) (c : γ) :
    (single a b₁).trans (single b₂ c) = ⊥ :=
  single_trans_of_eq_none _ (single_apply_of_ne h.symm _)
#align pequiv.single_trans_single_of_ne PEquiv.single_trans_single_of_ne
-/

end Single

section Order

instance : PartialOrder (α ≃. β)
    where
  le f g := ∀ (a : α) (b : β), b ∈ f a → b ∈ g a
  le_refl _ _ _ := id
  le_trans f g h fg gh a b := gh a b ∘ fg a b
  le_antisymm f g fg gf :=
    ext
      (by
        intro a
        cases' h : g a with b
        · exact eq_none_iff_forall_not_mem.2 fun b hb => Option.not_mem_none b <| h ▸ fg a b hb
        · exact gf _ _ h)

/- warning: pequiv.le_def -> PEquiv.le_def is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {f : PEquiv.{u1, u2} α β} {g : PEquiv.{u1, u2} α β}, Iff (LE.le.{max u1 u2} (PEquiv.{u1, u2} α β) (Preorder.toLE.{max u1 u2} (PEquiv.{u1, u2} α β) (PartialOrder.toPreorder.{max u1 u2} (PEquiv.{u1, u2} α β) (PEquiv.partialOrder.{u1, u2} α β))) f g) (forall (a : α) (b : β), (Membership.Mem.{u2, u2} β (Option.{u2} β) (Option.hasMem.{u2} β) b (coeFn.{max (succ u1) (succ u2), max (succ u1) (succ u2)} (PEquiv.{u1, u2} α β) (fun (_x : PEquiv.{u1, u2} α β) => α -> (Option.{u2} β)) (FunLike.hasCoeToFun.{max (succ u1) (succ u2), succ u1, succ u2} (PEquiv.{u1, u2} α β) α (fun (_x : α) => Option.{u2} β) (PEquiv.funLike.{u1, u2} α β)) f a)) -> (Membership.Mem.{u2, u2} β (Option.{u2} β) (Option.hasMem.{u2} β) b (coeFn.{max (succ u1) (succ u2), max (succ u1) (succ u2)} (PEquiv.{u1, u2} α β) (fun (_x : PEquiv.{u1, u2} α β) => α -> (Option.{u2} β)) (FunLike.hasCoeToFun.{max (succ u1) (succ u2), succ u1, succ u2} (PEquiv.{u1, u2} α β) α (fun (_x : α) => Option.{u2} β) (PEquiv.funLike.{u1, u2} α β)) g a)))
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} {f : PEquiv.{u1, u2} α β} {g : PEquiv.{u1, u2} α β}, Iff (LE.le.{max u1 u2} (PEquiv.{u1, u2} α β) (Preorder.toLE.{max u1 u2} (PEquiv.{u1, u2} α β) (PartialOrder.toPreorder.{max u1 u2} (PEquiv.{u1, u2} α β) (PEquiv.instPartialOrderPEquiv.{u1, u2} α β))) f g) (forall (a : α) (b : β), (Membership.mem.{u2, u2} β ((fun (x._@.Mathlib.Data.PEquiv._hyg.659 : α) => Option.{u2} β) a) (Option.instMembershipOption.{u2} β) b (FunLike.coe.{max (succ u1) (succ u2), succ u1, succ u2} (PEquiv.{u1, u2} α β) α (fun (_x : α) => (fun (x._@.Mathlib.Data.PEquiv._hyg.659 : α) => Option.{u2} β) _x) (PEquiv.instFunLikePEquivOption.{u1, u2} α β) f a)) -> (Membership.mem.{u2, u2} β ((fun (x._@.Mathlib.Data.PEquiv._hyg.659 : α) => Option.{u2} β) a) (Option.instMembershipOption.{u2} β) b (FunLike.coe.{max (succ u1) (succ u2), succ u1, succ u2} (PEquiv.{u1, u2} α β) α (fun (_x : α) => (fun (x._@.Mathlib.Data.PEquiv._hyg.659 : α) => Option.{u2} β) _x) (PEquiv.instFunLikePEquivOption.{u1, u2} α β) g a)))
Case conversion may be inaccurate. Consider using '#align pequiv.le_def PEquiv.le_defₓ'. -/
theorem le_def {f g : α ≃. β} : f ≤ g ↔ ∀ (a : α) (b : β), b ∈ f a → b ∈ g a :=
  Iff.rfl
#align pequiv.le_def PEquiv.le_def

instance : OrderBot (α ≃. β) :=
  { PEquiv.hasBot with bot_le := fun _ _ _ h => (not_mem_none _ h).elim }

instance [DecidableEq α] [DecidableEq β] : SemilatticeInf (α ≃. β) :=
  {-- `split_ifs; finish` closes this goal from here
    PEquiv.partialOrder with
    inf := fun f g =>
      { toFun := fun a => if f a = g a then f a else none
        invFun := fun b => if f.symm b = g.symm b then f.symm b else none
        inv := fun a b => by
          have hf := @mem_iff_mem _ _ f a b
          have hg := @mem_iff_mem _ _ g a b
          split_ifs with h1 h2 h2 <;> try simp [hf]
          · contrapose! h2
            rw [h2]
            rw [← h1, hf, h2] at hg
            simp only [mem_def, true_iff_iff, eq_self_iff_true] at hg
            rw [hg]
          · contrapose! h1
            rw [h1] at *
            rw [← h2] at hg
            simp only [mem_def, eq_self_iff_true, iff_true_iff] at hf hg
            rw [hf, hg] }
    inf_le_left := fun _ _ _ _ => by simp <;> split_ifs <;> cc
    inf_le_right := fun _ _ _ _ => by simp <;> split_ifs <;> cc
    le_inf := fun f g h fg gh a b => by
      intro H
      have hf := fg a b H
      have hg := gh a b H
      simp only [Option.mem_def, PEquiv.coe_mk_apply]
      split_ifs with h1; · exact hf; · exact h1 (hf.trans hg.symm) }

end Order

end PEquiv

namespace Equiv

variable {α : Type _} {β : Type _} {γ : Type _}

#print Equiv.toPEquiv /-
/-- Turns an `equiv` into a `pequiv` of the whole type. -/
def toPEquiv (f : α ≃ β) : α ≃. β where
  toFun := some ∘ f
  invFun := some ∘ f.symm
  inv := by simp [Equiv.eq_symm_apply, eq_comm]
#align equiv.to_pequiv Equiv.toPEquiv
-/

#print Equiv.toPEquiv_refl /-
@[simp]
theorem toPEquiv_refl : (Equiv.refl α).toPEquiv = PEquiv.refl α :=
  rfl
#align equiv.to_pequiv_refl Equiv.toPEquiv_refl
-/

/- warning: equiv.to_pequiv_trans -> Equiv.toPEquiv_trans is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {γ : Type.{u3}} (f : Equiv.{succ u1, succ u2} α β) (g : Equiv.{succ u2, succ u3} β γ), Eq.{max (succ u1) (succ u3)} (PEquiv.{u1, u3} α γ) (Equiv.toPEquiv.{u1, u3} α γ (Equiv.trans.{succ u1, succ u2, succ u3} α β γ f g)) (PEquiv.trans.{u1, u2, u3} α β γ (Equiv.toPEquiv.{u1, u2} α β f) (Equiv.toPEquiv.{u2, u3} β γ g))
but is expected to have type
  forall {α : Type.{u3}} {β : Type.{u2}} {γ : Type.{u1}} (f : Equiv.{succ u3, succ u2} α β) (g : Equiv.{succ u2, succ u1} β γ), Eq.{max (succ u3) (succ u1)} (PEquiv.{u3, u1} α γ) (Equiv.toPEquiv.{u3, u1} α γ (Equiv.trans.{succ u3, succ u2, succ u1} α β γ f g)) (PEquiv.trans.{u3, u2, u1} α β γ (Equiv.toPEquiv.{u3, u2} α β f) (Equiv.toPEquiv.{u2, u1} β γ g))
Case conversion may be inaccurate. Consider using '#align equiv.to_pequiv_trans Equiv.toPEquiv_transₓ'. -/
theorem toPEquiv_trans (f : α ≃ β) (g : β ≃ γ) :
    (f.trans g).toPEquiv = f.toPEquiv.trans g.toPEquiv :=
  rfl
#align equiv.to_pequiv_trans Equiv.toPEquiv_trans

/- warning: equiv.to_pequiv_symm -> Equiv.toPEquiv_symm is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (f : Equiv.{succ u1, succ u2} α β), Eq.{max (succ u2) (succ u1)} (PEquiv.{u2, u1} β α) (Equiv.toPEquiv.{u2, u1} β α (Equiv.symm.{succ u1, succ u2} α β f)) (PEquiv.symm.{u1, u2} α β (Equiv.toPEquiv.{u1, u2} α β f))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (f : Equiv.{succ u2, succ u1} α β), Eq.{max (succ u2) (succ u1)} (PEquiv.{u1, u2} β α) (Equiv.toPEquiv.{u1, u2} β α (Equiv.symm.{succ u2, succ u1} α β f)) (PEquiv.symm.{u2, u1} α β (Equiv.toPEquiv.{u2, u1} α β f))
Case conversion may be inaccurate. Consider using '#align equiv.to_pequiv_symm Equiv.toPEquiv_symmₓ'. -/
theorem toPEquiv_symm (f : α ≃ β) : f.symm.toPEquiv = f.toPEquiv.symm :=
  rfl
#align equiv.to_pequiv_symm Equiv.toPEquiv_symm

/- warning: equiv.to_pequiv_apply -> Equiv.toPEquiv_apply is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (f : Equiv.{succ u1, succ u2} α β) (x : α), Eq.{succ u2} (Option.{u2} β) (coeFn.{max (succ u1) (succ u2), max (succ u1) (succ u2)} (PEquiv.{u1, u2} α β) (fun (_x : PEquiv.{u1, u2} α β) => α -> (Option.{u2} β)) (FunLike.hasCoeToFun.{max (succ u1) (succ u2), succ u1, succ u2} (PEquiv.{u1, u2} α β) α (fun (_x : α) => Option.{u2} β) (PEquiv.funLike.{u1, u2} α β)) (Equiv.toPEquiv.{u1, u2} α β f) x) (Option.some.{u2} β (coeFn.{max 1 (max (succ u1) (succ u2)) (succ u2) (succ u1), max (succ u1) (succ u2)} (Equiv.{succ u1, succ u2} α β) (fun (_x : Equiv.{succ u1, succ u2} α β) => α -> β) (Equiv.hasCoeToFun.{succ u1, succ u2} α β) f x))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (f : Equiv.{succ u2, succ u1} α β) (x : α), Eq.{succ u1} ((fun (x._@.Mathlib.Data.PEquiv._hyg.659 : α) => Option.{u1} β) x) (FunLike.coe.{max (succ u2) (succ u1), succ u2, succ u1} (PEquiv.{u2, u1} α β) α (fun (_x : α) => (fun (x._@.Mathlib.Data.PEquiv._hyg.659 : α) => Option.{u1} β) _x) (PEquiv.instFunLikePEquivOption.{u2, u1} α β) (Equiv.toPEquiv.{u2, u1} α β f) x) (Option.some.{u1} ((fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : α) => β) x) (FunLike.coe.{max (succ u2) (succ u1), succ u2, succ u1} (Equiv.{succ u2, succ u1} α β) α (fun (_x : α) => (fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : α) => β) _x) (Equiv.instFunLikeEquiv.{succ u2, succ u1} α β) f x))
Case conversion may be inaccurate. Consider using '#align equiv.to_pequiv_apply Equiv.toPEquiv_applyₓ'. -/
theorem toPEquiv_apply (f : α ≃ β) (x : α) : f.toPEquiv x = some (f x) :=
  rfl
#align equiv.to_pequiv_apply Equiv.toPEquiv_apply

end Equiv


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

import for_mathlib.idempotents.basic
import category_theory.preadditive.additive_functor
import category_theory.equivalence

/-!
# The Karoubi envelope of a category

In this file, we define the Karoubi envelope `karoubi C` of a category `C`.

## Main constructions and definitions

- `karoubi C` is the Karoubi envelope of a category `C`: it is an idempotent
complete category. It is also preadditive when `C` is preadditive.
- `to_karoubi C : C ⥤ karoubi C` is a fully faithful functor, which is an equivalence
(`to_karoubi_is_equivalence`) when `C` is idempotent complete.

-/

noncomputable theory

open category_theory.category
open category_theory.preadditive
open category_theory.limits
open_locale big_operators

namespace category_theory

variables (C : Type*) [category C]

namespace idempotents

/-- In a preadditive category `C`, when an object `X` decomposes as `X ≅ P ⨿ Q`, one may
consider `P` as a direct factor of `X` and up to unique isomorphism, it is determined by the
obvious idempotent `X ⟶ P ⟶ X` which is the projection onto `P` with kernel `Q`. More generally,
one may define a formal direct factor of an object `X : C` : it consists of an idempotent
`p : X ⟶ X` which is thought as the "formal image" of `p`. The type `karoubi C` shall be the
type of the objects of the karoubi enveloppe of `C`. It makes sense for any category `C`. -/
@[nolint has_inhabited_instance]
structure karoubi := (X : C) (p : X ⟶ X) (idem : p ≫ p = p)

namespace karoubi

variables {C}

@[ext]
lemma ext {P Q : karoubi C} (h_X : P.X = Q.X)
  (h_p : P.p ≫ eq_to_hom h_X = eq_to_hom h_X ≫ Q.p) : P = Q :=
begin
  cases P,
  cases Q,
  dsimp at h_X h_p,
  subst h_X,
  simpa only [true_and, eq_self_iff_true, id_comp, eq_to_hom_refl,
    heq_iff_eq, comp_id] using h_p,
end

/-- A morphism `P ⟶ Q` in the category `karoubi C` is a morphism in the underlying category
`C` which satisfies a relation, which in the preadditive case, expresses that it induces a
map between the corresponding "formal direct factors" and that it vanishes on the complement
formal direct factor. -/
@[ext]
structure hom (P Q : karoubi C) := (f : P.X ⟶ Q.X) (comm : f = P.p ≫ f ≫ Q.p)

instance [preadditive C] (P Q : karoubi C) : inhabited (hom P Q) :=
⟨⟨0, by rw [zero_comp, comp_zero]⟩⟩

@[simp]
lemma hom_ext {P Q : karoubi C} {f g : hom P Q} : f = g ↔ f.f = g.f :=
begin
  split,
  { intro h, rw h, },
  { ext, }
end

@[simp, reassoc]
lemma p_comp {P Q : karoubi C} (f : hom P Q) : P.p ≫ f.f = f.f :=
by rw [f.comm, ← assoc, P.idem]

@[simp, reassoc]
lemma comp_p {P Q : karoubi C} (f : hom P Q) : f.f ≫ Q.p = f.f :=
by rw [f.comm, assoc, assoc, Q.idem]

@[reassoc]
lemma p_comm {P Q : karoubi C} (f : hom P Q) : P.p ≫ f.f = f.f ≫ Q.p :=
by rw [p_comp, comp_p]

lemma comp_proof {P Q R : karoubi C} (g : hom Q R) (f : hom P Q) :
  f.f ≫ g.f = P.p ≫ (f.f ≫ g.f) ≫ R.p :=
by rw [assoc, comp_p, ← assoc, p_comp]

/-- The category structure on the karoubi envelope of a category. -/
instance : category (karoubi C) :=
{ hom      := karoubi.hom,
  id       := λ P, ⟨P.p, by { repeat { rw P.idem, }, }⟩,
  comp     := λ P Q R f g, ⟨f.f ≫ g.f, karoubi.comp_proof g f⟩, }

@[simp]
lemma comp {P Q R : karoubi C} (f : P ⟶ Q) (g : Q ⟶ R) :
  f ≫ g = ⟨f.f ≫ g.f, comp_proof g f⟩ := by refl

@[simp]
lemma id_eq {P : karoubi C} : 𝟙 P = ⟨P.p, by repeat { rw P.idem, }⟩ := by refl

/-- It is possible to coerce an object of `C` into an object of `karoubi C`.
See also the functor `to_karoubi`. -/
instance coe : has_coe_t C (karoubi C) := ⟨λ X, ⟨X, 𝟙 X, by rw comp_id⟩⟩

@[simp]
lemma coe_X (X : C) : (X : karoubi C).X = X := by refl

@[simp]
lemma coe_p (X : C) : (X : karoubi C).p = 𝟙 X := by refl

@[simp]
lemma eq_to_hom_f {P Q : karoubi C} (h : P = Q) :
  karoubi.hom.f (eq_to_hom h) = P.p ≫ eq_to_hom (congr_arg karoubi.X h) :=
by { subst h, simp only [eq_to_hom_refl, karoubi.id_eq, comp_id], }

end karoubi

/-- The obvious fully faithful functor `to_karoubi` sends an object `X : C` to the obvious
formal direct factor of `X` given by `𝟙 X`. -/
@[simps]
def to_karoubi : C ⥤ karoubi C :=
{ obj := λ X, ⟨X, 𝟙 X, by rw comp_id⟩,
  map := λ X Y f, ⟨f, by simp only [comp_id, id_comp]⟩ }

instance : full (to_karoubi C) :=
{ preimage := λ X Y f, f.f, }

instance : faithful (to_karoubi C) := { }

variables {C}

@[simps]
instance [preadditive C] {P Q : karoubi C} : add_comm_group (P ⟶ Q) :=
{ add := λ f g, ⟨f.f+g.f, begin
    rw [add_comp, comp_add],
    congr',
    exacts [f.comm, g.comm],
  end⟩,
  zero := ⟨0, by simp only [comp_zero, zero_comp]⟩,
  zero_add := λ f, by { ext, simp only [zero_add], },
  add_zero := λ f, by { ext, simp only [add_zero], },
  add_assoc := λ f g h', by simp only [add_assoc],
  add_comm := λ f g, by { ext, apply_rules [add_comm], },
  neg := λ f, ⟨-f.f, by simpa only [neg_comp, comp_neg, neg_inj] using f.comm⟩,
  add_left_neg := λ f, by { ext, apply_rules [add_left_neg], }, }

namespace karoubi

lemma hom_eq_zero_iff [preadditive C] {P Q : karoubi C} {f : hom P Q} : f = 0 ↔ f.f = 0 := hom_ext

/-- The map sending `f : P ⟶ Q` to `f.f : P.X ⟶ Q.X` is additive. -/
@[simps]
def inclusion_hom [preadditive C] (P Q : karoubi C) : add_monoid_hom (P ⟶ Q) (P.X ⟶ Q.X) :=
{ to_fun    := λ f, f.f,
  map_zero' := rfl,
  map_add'  := λ f g, rfl }

@[simp]
lemma sum_hom [preadditive C] {P Q : karoubi C} {α : Type*} (s : finset α) (f : α → (P ⟶ Q)) :
  (∑ x in s, f x).f = ∑ x in s, (f x).f :=
add_monoid_hom.map_sum (inclusion_hom P Q) f s

@[simp]
lemma zsmul_hom [preadditive C] {P Q : karoubi C} (f : P ⟶ Q) (n : ℤ) :
  (n • f).f = n • f.f :=
map_zsmul (inclusion_hom P Q) n f

end karoubi

/-- The category `karoubi C` is preadditive if `C` is. -/
instance [preadditive C] : preadditive (karoubi C) :=
{ hom_group := λ P Q, by apply_instance,
  add_comp' := λ P Q R f g h,
    by { ext, simp only [add_comp, quiver.hom.add_comm_group_add_f, karoubi.comp], },
  comp_add' := λ P Q R f g h,
    by { ext, simp only [comp_add, quiver.hom.add_comm_group_add_f, karoubi.comp], }, }

instance [preadditive C] : functor.additive (to_karoubi C) := { }

open karoubi

variables (C)

instance : is_idempotent_complete (karoubi C) :=
begin
  refine ⟨_⟩,
  intros P p hp,
  have hp' := hom_ext.mp hp,
  simp only [comp] at hp',
  use ⟨P.X, p.f, hp'⟩,
  use ⟨p.f, by rw [comp_p p, hp']⟩,
  use ⟨p.f, by rw [hp', p_comp p]⟩,
  split; simpa only [hom_ext] using hp',
end

instance [is_idempotent_complete C] : ess_surj (to_karoubi C) := ⟨λ P, begin
  have h : is_idempotent_complete C := infer_instance,
  rcases is_idempotent_complete.idempotents_split P.X P.p P.idem
    with ⟨Y,i,e,⟨h₁,h₂⟩⟩,
  use Y,
  exact nonempty.intro
    { hom := ⟨i, by erw [id_comp, ← h₂, ← assoc, h₁, id_comp]⟩,
      inv := ⟨e, by erw [comp_id, ← h₂, assoc, h₁, comp_id]⟩, },
end⟩

/-- If `C` is idempotent complete, the functor `to_karoubi : C ⥤ karoubi C` is an equivalence. -/
def to_karoubi_is_equivalence [is_idempotent_complete C] :
  is_equivalence (to_karoubi C) :=
equivalence.of_fully_faithfully_ess_surj (to_karoubi C)

def to_karoubi_equivalence [is_idempotent_complete C] : C ≌ karoubi C :=
begin
  haveI := to_karoubi_is_equivalence C,
  exact functor.as_equivalence (to_karoubi C),
end

namespace karoubi

variables {C}

/-- The split mono which appears in the factorisation `decomp_id P`. -/
@[simps]
def decomp_id_i (P : karoubi C) : P ⟶ P.X := ⟨P.p, by erw [coe_p, comp_id, P.idem]⟩

/-- The split epi which appears in the factorisation `decomp_id P`. -/
@[simps]
def decomp_id_p (P : karoubi C) : (P.X : karoubi C) ⟶ P :=
⟨P.p, by erw [coe_p, id_comp, P.idem]⟩

/-- The formal direct factor of `P.X` given by the idempotent `P.p` in the category `C`
is actually a direct factor in the category `karoubi C`. -/
lemma decomp_id (P : karoubi C) :
  𝟙 P = (decomp_id_i P) ≫ (decomp_id_p P) :=
by { ext, simp only [comp, id_eq, P.idem, decomp_id_i, decomp_id_p], }

lemma decomp_p (P : karoubi C) :
  (to_karoubi C).map P.p = (decomp_id_p P) ≫ (decomp_id_i P) :=
by { ext, simp only [comp, decomp_id_p_f, decomp_id_i_f, P.idem, to_karoubi_map_f], }

lemma decomp_id_i_to_karoubi (X : C) : decomp_id_i ((to_karoubi C).obj X) = 𝟙 _ :=
by { ext, refl, }

lemma decomp_id_p_to_karoubi (X : C) : decomp_id_p ((to_karoubi C).obj X) = 𝟙 _ :=
by { ext, refl, }

lemma decomp_id_i_naturality {P Q : karoubi C} (f : P ⟶ Q) : f ≫ decomp_id_i _ =
  decomp_id_i _ ≫ ⟨f.f, by erw [comp_id, id_comp]⟩ :=
by { ext, simp only [comp, decomp_id_i_f, karoubi.comp_p, karoubi.p_comp], }

lemma decomp_id_p_naturality {P Q : karoubi C} (f : P ⟶ Q) : decomp_id_p P ≫ f =
  (⟨f.f, by erw [comp_id, id_comp]⟩ : (P.X : karoubi C) ⟶ Q.X) ≫ decomp_id_p Q :=
by { ext, simp only [comp, decomp_id_p_f, karoubi.comp_p, karoubi.p_comp], }

end karoubi

end idempotents

end category_theory


/-
Copyright (c) 2021 Alex Kontorovich, Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alex Kontorovich, Heather Macbeth
-/
import topology.algebra.constructions
import topology.homeomorph
import group_theory.group_action.basic
import topology.bases
import topology.support

/-!
# Monoid actions continuous in the second variable

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

In this file we define class `has_continuous_const_smul`. We say `has_continuous_const_smul Γ T` if
`Γ` acts on `T` and for each `γ`, the map `x ↦ γ • x` is continuous. (This differs from
`has_continuous_smul`, which requires simultaneous continuity in both variables.)

## Main definitions

* `has_continuous_const_smul Γ T` : typeclass saying that the map `x ↦ γ • x` is continuous on `T`;
* `properly_discontinuous_smul`: says that the scalar multiplication `(•) : Γ → T → T`
  is properly discontinuous, that is, for any pair of compact sets `K, L` in `T`, only finitely
  many `γ:Γ` move `K` to have nontrivial intersection with `L`.
* `homeomorph.smul`: scalar multiplication by an element of a group `Γ` acting on `T`
  is a homeomorphism of `T`.

## Main results

* `is_open_map_quotient_mk_mul` : The quotient map by a group action is open.
* `t2_space_of_properly_discontinuous_smul_of_t2_space` : The quotient by a discontinuous group
  action of a locally compact t2 space is t2.

## Tags

Hausdorff, discrete group, properly discontinuous, quotient space

-/

open_locale topology pointwise

open filter set topological_space

local attribute [instance] mul_action.orbit_rel

/-- Class `has_continuous_const_smul Γ T` says that the scalar multiplication `(•) : Γ → T → T`
is continuous in the second argument. We use the same class for all kinds of multiplicative
actions, including (semi)modules and algebras.

Note that both `has_continuous_const_smul α α` and `has_continuous_const_smul αᵐᵒᵖ α` are
weaker versions of `has_continuous_mul α`. -/
class has_continuous_const_smul (Γ : Type*) (T : Type*) [topological_space T] [has_smul Γ T]
 : Prop :=
(continuous_const_smul : ∀ γ : Γ, continuous (λ x : T, γ • x))

/-- Class `has_continuous_const_vadd Γ T` says that the additive action `(+ᵥ) : Γ → T → T`
is continuous in the second argument. We use the same class for all kinds of additive actions,
including (semi)modules and algebras.

Note that both `has_continuous_const_vadd α α` and `has_continuous_const_vadd αᵐᵒᵖ α` are
weaker versions of `has_continuous_add α`. -/
class has_continuous_const_vadd (Γ : Type*) (T : Type*) [topological_space T]
  [has_vadd Γ T] : Prop :=
(continuous_const_vadd : ∀ γ : Γ, continuous (λ x : T, γ +ᵥ x))

attribute [to_additive] has_continuous_const_smul

export has_continuous_const_smul (continuous_const_smul)

export has_continuous_const_vadd (continuous_const_vadd)

variables {M α β : Type*}

section has_smul
variables [topological_space α] [has_smul M α] [has_continuous_const_smul M α]

@[to_additive]
lemma filter.tendsto.const_smul {f : β → α} {l : filter β} {a : α} (hf : tendsto f l (𝓝 a))
  (c : M) :
  tendsto (λ x, c • f x) l (𝓝 (c • a)) :=
((continuous_const_smul _).tendsto _).comp hf

variables [topological_space β] {f : β → M} {g : β → α} {b : β} {s : set β}

@[to_additive]
lemma continuous_within_at.const_smul (hg : continuous_within_at g s b) (c : M) :
  continuous_within_at (λ x, c • g x) s b :=
hg.const_smul c

@[to_additive]
lemma continuous_at.const_smul (hg : continuous_at g b) (c : M) :
  continuous_at (λ x, c • g x) b :=
hg.const_smul c

@[to_additive]
lemma continuous_on.const_smul (hg : continuous_on g s) (c : M) :
  continuous_on (λ x, c • g x) s :=
λ x hx, (hg x hx).const_smul c

@[continuity, to_additive]
lemma continuous.const_smul (hg : continuous g) (c : M) :
  continuous (λ x, c • g x) :=
(continuous_const_smul _).comp hg

/-- If a scalar is central, then its right action is continuous when its left action is. -/
@[to_additive "If an additive action is central, then its right action is continuous when its left
action is."]
instance has_continuous_const_smul.op [has_smul Mᵐᵒᵖ α] [is_central_scalar M α] :
  has_continuous_const_smul Mᵐᵒᵖ α :=
⟨ mul_opposite.rec $ λ c, by simpa only [op_smul_eq_smul] using continuous_const_smul c ⟩

@[to_additive] instance mul_opposite.has_continuous_const_smul :
  has_continuous_const_smul M αᵐᵒᵖ :=
⟨λ c, mul_opposite.continuous_op.comp $ mul_opposite.continuous_unop.const_smul c⟩

@[to_additive] instance : has_continuous_const_smul M αᵒᵈ := ‹has_continuous_const_smul M α›

@[to_additive] instance order_dual.has_continuous_const_smul' : has_continuous_const_smul Mᵒᵈ α :=
‹has_continuous_const_smul M α›

@[to_additive]
instance [has_smul M β] [has_continuous_const_smul M β] :
  has_continuous_const_smul M (α × β) :=
⟨λ _, (continuous_fst.const_smul _).prod_mk (continuous_snd.const_smul _)⟩

@[to_additive]
instance {ι : Type*} {γ : ι → Type*} [∀ i, topological_space (γ i)] [Π i, has_smul M (γ i)]
  [∀ i, has_continuous_const_smul M (γ i)] : has_continuous_const_smul M (Π i, γ i) :=
⟨λ _, continuous_pi $ λ i, (continuous_apply i).const_smul _⟩

@[to_additive]
lemma is_compact.smul {α β} [has_smul α β] [topological_space β]
  [has_continuous_const_smul α β] (a : α) {s : set β}
  (hs : is_compact s) : is_compact (a • s) := hs.image (continuous_id'.const_smul a)

end has_smul

section monoid

variables [topological_space α]
variables [monoid M] [mul_action M α] [has_continuous_const_smul M α]

@[to_additive] instance units.has_continuous_const_smul : has_continuous_const_smul Mˣ α :=
{ continuous_const_smul := λ m, (continuous_const_smul (m : M) : _) }

@[to_additive]
lemma smul_closure_subset (c : M) (s : set α) : c • closure s ⊆ closure (c • s) :=
((set.maps_to_image _ _).closure $ continuous_id.const_smul c).image_subset

@[to_additive]
lemma smul_closure_orbit_subset (c : M) (x : α) :
  c • closure (mul_action.orbit M x) ⊆ closure (mul_action.orbit M x) :=
(smul_closure_subset c _).trans $ closure_mono $ mul_action.smul_orbit_subset _ _

end monoid

section group

variables {G : Type*} [topological_space α] [group G] [mul_action G α]
  [has_continuous_const_smul G α]

@[to_additive]
lemma tendsto_const_smul_iff {f : β → α} {l : filter β} {a : α} (c : G) :
  tendsto (λ x, c • f x) l (𝓝 $ c • a) ↔ tendsto f l (𝓝 a) :=
⟨λ h, by simpa only [inv_smul_smul] using h.const_smul c⁻¹,
  λ h, h.const_smul _⟩

variables [topological_space β] {f : β → α} {b : β}  {s : set β}

@[to_additive]
lemma continuous_within_at_const_smul_iff (c : G) :
  continuous_within_at (λ x, c • f x) s b ↔ continuous_within_at f s b :=
tendsto_const_smul_iff c

@[to_additive]
lemma continuous_on_const_smul_iff (c : G) : continuous_on (λ x, c • f x) s ↔ continuous_on f s :=
forall₂_congr $ λ b hb, continuous_within_at_const_smul_iff c

@[to_additive]
lemma continuous_at_const_smul_iff (c : G) :
  continuous_at (λ x, c • f x) b ↔ continuous_at f b :=
tendsto_const_smul_iff c

@[to_additive]
lemma continuous_const_smul_iff (c : G) :
  continuous (λ x, c • f x) ↔ continuous f :=
by simp only [continuous_iff_continuous_at, continuous_at_const_smul_iff]

/-- The homeomorphism given by scalar multiplication by a given element of a group `Γ` acting on
  `T` is a homeomorphism from `T` to itself. -/
@[to_additive] def homeomorph.smul (γ : G) : α ≃ₜ α :=
{ to_equiv := mul_action.to_perm γ,
  continuous_to_fun  := continuous_const_smul γ,
  continuous_inv_fun := continuous_const_smul γ⁻¹ }

/-- The homeomorphism given by affine-addition by an element of an additive group `Γ` acting on
  `T` is a homeomorphism from `T` to itself. -/
add_decl_doc homeomorph.vadd

@[to_additive]
lemma is_open_map_smul (c : G) : is_open_map (λ x : α, c • x) :=
(homeomorph.smul c).is_open_map

@[to_additive] lemma is_open.smul {s : set α} (hs : is_open s) (c : G) : is_open (c • s) :=
is_open_map_smul c s hs

@[to_additive]
lemma is_closed_map_smul (c : G) : is_closed_map (λ x : α, c • x) :=
(homeomorph.smul c).is_closed_map

@[to_additive] lemma is_closed.smul {s : set α} (hs : is_closed s) (c : G) : is_closed (c • s) :=
is_closed_map_smul c s hs

@[to_additive] lemma closure_smul (c : G) (s : set α) : closure (c • s) = c • closure s :=
((homeomorph.smul c).image_closure s).symm

@[to_additive] lemma dense.smul (c : G) {s : set α} (hs : dense s) : dense (c • s) :=
by rw [dense_iff_closure_eq] at ⊢ hs; rw [closure_smul, hs, smul_set_univ]

@[to_additive] lemma interior_smul (c : G) (s : set α) : interior (c • s) = c • interior s :=
((homeomorph.smul c).image_interior s).symm

end group

section group_with_zero

variables {G₀ : Type*} [topological_space α] [group_with_zero G₀] [mul_action G₀ α]
  [has_continuous_const_smul G₀ α]

lemma tendsto_const_smul_iff₀ {f : β → α} {l : filter β} {a : α} {c : G₀} (hc : c ≠ 0) :
  tendsto (λ x, c • f x) l (𝓝 $ c • a) ↔ tendsto f l (𝓝 a) :=
tendsto_const_smul_iff (units.mk0 c hc)

variables [topological_space β] {f : β → α} {b : β} {c : G₀} {s : set β}

lemma continuous_within_at_const_smul_iff₀ (hc : c ≠ 0) :
  continuous_within_at (λ x, c • f x) s b ↔ continuous_within_at f s b :=
tendsto_const_smul_iff (units.mk0 c hc)

lemma continuous_on_const_smul_iff₀ (hc : c ≠ 0) :
  continuous_on (λ x, c • f x) s ↔ continuous_on f s :=
continuous_on_const_smul_iff (units.mk0 c hc)

lemma continuous_at_const_smul_iff₀ (hc : c ≠ 0) :
  continuous_at (λ x, c • f x) b ↔ continuous_at f b :=
continuous_at_const_smul_iff (units.mk0 c hc)

lemma continuous_const_smul_iff₀ (hc : c ≠ 0) :
  continuous (λ x, c • f x) ↔ continuous f :=
continuous_const_smul_iff (units.mk0 c hc)

/-- Scalar multiplication by a non-zero element of a group with zero acting on `α` is a
homeomorphism from `α` onto itself. -/
protected def homeomorph.smul_of_ne_zero (c : G₀) (hc : c ≠ 0) : α ≃ₜ α :=
homeomorph.smul (units.mk0 c hc)

lemma is_open_map_smul₀ {c : G₀} (hc : c ≠ 0) : is_open_map (λ x : α, c • x) :=
(homeomorph.smul_of_ne_zero c hc).is_open_map

lemma is_open.smul₀ {c : G₀} {s : set α} (hs : is_open s) (hc : c ≠ 0) : is_open (c • s) :=
is_open_map_smul₀ hc s hs

lemma interior_smul₀ {c : G₀} (hc : c ≠ 0) (s : set α) : interior (c • s) = c • interior s :=
((homeomorph.smul_of_ne_zero c hc).image_interior s).symm

lemma closure_smul₀ {E} [has_zero E] [mul_action_with_zero G₀ E] [topological_space E]
  [t1_space E] [has_continuous_const_smul G₀ E] (c : G₀) (s : set E) :
  closure (c • s) = c • closure s :=
begin
  rcases eq_or_ne c 0 with rfl|hc,
  { rcases eq_empty_or_nonempty s with rfl|hs,
    { simp },
    { rw [zero_smul_set hs, zero_smul_set hs.closure], exact closure_singleton } },
  { exact ((homeomorph.smul_of_ne_zero c hc).image_closure s).symm }
end

/-- `smul` is a closed map in the second argument.

The lemma that `smul` is a closed map in the first argument (for a normed space over a complete
normed field) is `is_closed_map_smul_left` in `analysis.normed_space.finite_dimension`. -/
lemma is_closed_map_smul_of_ne_zero {c : G₀} (hc : c ≠ 0) : is_closed_map (λ x : α, c • x) :=
(homeomorph.smul_of_ne_zero c hc).is_closed_map

lemma is_closed.smul_of_ne_zero {c : G₀} {s : set α} (hs : is_closed s) (hc : c ≠ 0) :
  is_closed (c • s) :=
is_closed_map_smul_of_ne_zero hc s hs

/-- `smul` is a closed map in the second argument.

The lemma that `smul` is a closed map in the first argument (for a normed space over a complete
normed field) is `is_closed_map_smul_left` in `analysis.normed_space.finite_dimension`. -/
lemma is_closed_map_smul₀ {𝕜 M : Type*} [division_ring 𝕜] [add_comm_monoid M] [topological_space M]
  [t1_space M] [module 𝕜 M] [has_continuous_const_smul 𝕜 M] (c : 𝕜) :
  is_closed_map (λ x : M, c • x) :=
begin
  rcases eq_or_ne c 0 with (rfl|hne),
  { simp only [zero_smul], exact is_closed_map_const },
  { exact (homeomorph.smul_of_ne_zero c hne).is_closed_map },
end

lemma is_closed.smul₀ {𝕜 M : Type*} [division_ring 𝕜] [add_comm_monoid M] [topological_space M]
  [t1_space M] [module 𝕜 M] [has_continuous_const_smul 𝕜 M] (c : 𝕜) {s : set M} (hs : is_closed s) :
  is_closed (c • s) :=
is_closed_map_smul₀ c s hs

lemma has_compact_mul_support.comp_smul {β : Type*} [has_one β] {f : α → β}
  (h : has_compact_mul_support f) {c : G₀} (hc : c ≠ 0) :
  has_compact_mul_support (λ x, f (c • x)) :=
h.comp_homeomorph (homeomorph.smul_of_ne_zero c hc)

lemma has_compact_support.comp_smul {β : Type*} [has_zero β] {f : α → β}
  (h : has_compact_support f) {c : G₀} (hc : c ≠ 0) :
  has_compact_support (λ x, f (c • x)) :=
h.comp_homeomorph (homeomorph.smul_of_ne_zero c hc)

attribute [to_additive has_compact_support.comp_smul] has_compact_mul_support.comp_smul

end group_with_zero

namespace is_unit

variables [monoid M] [topological_space α] [mul_action M α] [has_continuous_const_smul M α]

lemma tendsto_const_smul_iff {f : β → α} {l : filter β} {a : α} {c : M} (hc : is_unit c) :
  tendsto (λ x, c • f x) l (𝓝 $ c • a) ↔ tendsto f l (𝓝 a) :=
let ⟨u, hu⟩ := hc in hu ▸ tendsto_const_smul_iff u

variables [topological_space β] {f : β → α} {b : β} {c : M} {s : set β}

lemma continuous_within_at_const_smul_iff (hc : is_unit c) :
  continuous_within_at (λ x, c • f x) s b ↔ continuous_within_at f s b :=
let ⟨u, hu⟩ := hc in hu ▸ continuous_within_at_const_smul_iff u

lemma continuous_on_const_smul_iff (hc : is_unit c) :
  continuous_on (λ x, c • f x) s ↔ continuous_on f s :=
let ⟨u, hu⟩ := hc in hu ▸ continuous_on_const_smul_iff u

lemma continuous_at_const_smul_iff (hc : is_unit c) :
  continuous_at (λ x, c • f x) b ↔ continuous_at f b :=
let ⟨u, hu⟩ := hc in hu ▸ continuous_at_const_smul_iff u

lemma continuous_const_smul_iff (hc : is_unit c) :
  continuous (λ x, c • f x) ↔ continuous f :=
let ⟨u, hu⟩ := hc in hu ▸ continuous_const_smul_iff u

lemma is_open_map_smul (hc : is_unit c) : is_open_map (λ x : α, c • x) :=
let ⟨u, hu⟩ := hc in hu ▸ is_open_map_smul u

lemma is_closed_map_smul (hc : is_unit c) : is_closed_map (λ x : α, c • x) :=
let ⟨u, hu⟩ := hc in hu ▸ is_closed_map_smul u

end is_unit

/-- Class `properly_discontinuous_smul Γ T` says that the scalar multiplication `(•) : Γ → T → T`
is properly discontinuous, that is, for any pair of compact sets `K, L` in `T`, only finitely many
`γ:Γ` move `K` to have nontrivial intersection with `L`.
-/
class properly_discontinuous_smul (Γ : Type*) (T : Type*) [topological_space T]
  [has_smul Γ T] : Prop :=
(finite_disjoint_inter_image : ∀ {K L : set T}, is_compact K → is_compact L →
  set.finite {γ : Γ | (((•) γ) '' K) ∩ L ≠ ∅ })

/-- Class `properly_discontinuous_vadd Γ T` says that the additive action `(+ᵥ) : Γ → T → T`
is properly discontinuous, that is, for any pair of compact sets `K, L` in `T`, only finitely many
`γ:Γ` move `K` to have nontrivial intersection with `L`.
-/
class properly_discontinuous_vadd (Γ : Type*) (T : Type*) [topological_space T]
  [has_vadd Γ T] : Prop :=
(finite_disjoint_inter_image : ∀ {K L : set T}, is_compact K → is_compact L →
  set.finite {γ : Γ | (((+ᵥ) γ) '' K) ∩ L ≠ ∅ })

attribute [to_additive] properly_discontinuous_smul

variables {Γ : Type*} [group Γ] {T : Type*} [topological_space T] [mul_action Γ T]

/-- A finite group action is always properly discontinuous. -/
@[priority 100, to_additive "A finite group action is always properly discontinuous."]
instance finite.to_properly_discontinuous_smul [finite Γ] : properly_discontinuous_smul Γ T :=
{ finite_disjoint_inter_image := λ _ _ _ _, set.to_finite _}

export properly_discontinuous_smul (finite_disjoint_inter_image)

export properly_discontinuous_vadd (finite_disjoint_inter_image)

/-- The quotient map by a group action is open, i.e. the quotient by a group action is an open
  quotient. -/
@[to_additive "The quotient map by a group action is open, i.e. the quotient by a group
action is an open quotient. "]
lemma is_open_map_quotient_mk_mul [has_continuous_const_smul Γ T] :
  is_open_map (quotient.mk : T → quotient (mul_action.orbit_rel Γ T)) :=
begin
  intros U hU,
  rw [is_open_coinduced, mul_action.quotient_preimage_image_eq_union_mul U],
  exact is_open_Union (λ γ, (homeomorph.smul γ).is_open_map U hU)
end

/-- The quotient by a discontinuous group action of a locally compact t2 space is t2. -/
@[priority 100, to_additive "The quotient by a discontinuous group action of a locally compact t2
space is t2."]
instance t2_space_of_properly_discontinuous_smul_of_t2_space [t2_space T] [locally_compact_space T]
  [has_continuous_const_smul Γ T] [properly_discontinuous_smul Γ T] :
  t2_space (quotient (mul_action.orbit_rel Γ T)) :=
begin
  set Q := quotient (mul_action.orbit_rel Γ T),
  rw t2_space_iff_nhds,
  let f : T → Q := quotient.mk,
  have f_op : is_open_map f := is_open_map_quotient_mk_mul,
  rintros ⟨x₀⟩ ⟨y₀⟩ (hxy : f x₀ ≠ f y₀),
  show ∃ (U ∈ 𝓝 (f x₀)) (V ∈ 𝓝 (f y₀)), _,
  have hx₀y₀ : x₀ ≠ y₀ := ne_of_apply_ne _ hxy,
  have hγx₀y₀ : ∀ γ : Γ, γ • x₀ ≠ y₀ := not_exists.mp (mt quotient.sound hxy.symm : _),
  obtain ⟨K₀, L₀, K₀_in, L₀_in, hK₀, hL₀, hK₀L₀⟩ := t2_separation_compact_nhds hx₀y₀,
  let bad_Γ_set := {γ : Γ | (((•) γ) '' K₀) ∩ L₀ ≠ ∅ },
  have bad_Γ_finite : bad_Γ_set.finite := finite_disjoint_inter_image hK₀ hL₀,
  choose u v hu hv u_v_disjoint using λ γ, t2_separation_nhds (hγx₀y₀ γ),
  let U₀₀ := ⋂ γ ∈ bad_Γ_set, ((•) γ) ⁻¹' (u γ),
  let U₀ := U₀₀ ∩ K₀,
  let V₀₀ := ⋂ γ ∈ bad_Γ_set, v γ,
  let V₀ := V₀₀ ∩ L₀,
  have U_nhds : f '' U₀ ∈ 𝓝 (f x₀),
  { apply f_op.image_mem_nhds (inter_mem ((bInter_mem bad_Γ_finite).mpr $ λ γ hγ, _) K₀_in),
    exact (continuous_const_smul _).continuous_at (hu γ) },
  have V_nhds : f '' V₀ ∈ 𝓝 (f y₀),
    from f_op.image_mem_nhds (inter_mem ((bInter_mem bad_Γ_finite).mpr $ λ γ hγ, hv γ) L₀_in),
  refine ⟨f '' U₀, U_nhds, f '' V₀, V_nhds, mul_action.disjoint_image_image_iff.2 _⟩,
  rintros x ⟨x_in_U₀₀, x_in_K₀⟩ γ,
  by_cases H : γ ∈ bad_Γ_set,
  { exact λ h, (u_v_disjoint γ).le_bot ⟨mem_Inter₂.mp x_in_U₀₀ γ H, mem_Inter₂.mp h.1 γ H⟩ },
  { rintros ⟨-, h'⟩,
    simp only [image_smul, not_not, mem_set_of_eq, ne.def] at H,
    exact eq_empty_iff_forall_not_mem.mp H (γ • x) ⟨mem_image_of_mem _ x_in_K₀, h'⟩ },
end

/-- The quotient of a second countable space by a group action is second countable. -/
@[to_additive "The quotient of a second countable space by an additive group action is second
countable."]
theorem has_continuous_const_smul.second_countable_topology [second_countable_topology T]
  [has_continuous_const_smul Γ T] :
  second_countable_topology (quotient (mul_action.orbit_rel Γ T)) :=
topological_space.quotient.second_countable_topology is_open_map_quotient_mk_mul

section nhds

section mul_action

variables {G₀ : Type*} [group_with_zero G₀] [mul_action G₀ α]
  [topological_space α] [has_continuous_const_smul G₀ α]

/-- Scalar multiplication preserves neighborhoods. -/
lemma set_smul_mem_nhds_smul {c : G₀} {s : set α} {x : α} (hs : s ∈ 𝓝 x) (hc : c ≠ 0) :
  c • s ∈ 𝓝 (c • x : α) :=
begin
  rw mem_nhds_iff at hs ⊢,
  obtain ⟨U, hs', hU, hU'⟩ := hs,
  exact ⟨c • U, set.smul_set_mono hs', hU.smul₀ hc, set.smul_mem_smul_set hU'⟩,
end

lemma set_smul_mem_nhds_smul_iff {c : G₀} {s : set α} {x : α} (hc : c ≠ 0) :
  c • s ∈ 𝓝 (c • x : α) ↔ s ∈ 𝓝 x :=
begin
  refine ⟨λ h, _, λ h, set_smul_mem_nhds_smul h hc⟩,
  rw [←inv_smul_smul₀ hc x, ←inv_smul_smul₀ hc s],
  exact set_smul_mem_nhds_smul h (inv_ne_zero hc),
end

end mul_action

section distrib_mul_action

variables {G₀ : Type*} [group_with_zero G₀] [add_monoid α] [distrib_mul_action G₀ α]
  [topological_space α] [has_continuous_const_smul G₀ α]

lemma set_smul_mem_nhds_zero_iff {s : set α} {c : G₀} (hc : c ≠ 0) :
  c • s ∈ 𝓝 (0 : α) ↔ s ∈ 𝓝 (0 : α) :=
begin
  refine iff.trans _ (set_smul_mem_nhds_smul_iff hc),
  rw smul_zero,
end

end distrib_mul_action

end nhds


import Mathlib.Tactic.Inhabit

-- Most basic test (prop)
noncomputable example {p : Prop} [Nonempty p] : Inhabited p := by
  inhabit p
  assumption

-- Most basic test (nonprop)
noncomputable example {α : Type} [Nonempty α] : Inhabited α := by
  inhabit α
  assumption

-- Confirms inhabit can handle higher type universes
noncomputable example {α : Type 3} [Nonempty α] : Inhabited α := by
  inhabit α
  assumption

-- Confirms that inhabit can find Nonempty instances even if they're in the local context
noncomputable example {α : Type} : Nonempty α → Inhabited α := by
  intro nonempty_α
  inhabit α
  assumption

-- Confirms that inhabit assigns to the correct name when given one
noncomputable example {p : Prop} [Nonempty p] : Inhabited p := by
  inhabit p_inhabited : p
  exact p_inhabited

-- Test for the issue that required generalizing `nonempty_to_inhabited` to `Sort`.
section Unique

structure Unique (α : Sort u) extends Inhabited α where
  uniq : ∀ a : α, a = default

/-- Construct `unique` from `inhabited` and `subsingleton`. Making this an instance would create
a loop in the class inheritance graph. -/
@[reducible]
def Unique.mk' (α : Sort u) [h₁ : Inhabited α] [Subsingleton α] : Unique α :=
  { h₁ with uniq := fun _ => Subsingleton.elim _ _ }

noncomputable example {α : Sort u} [Subsingleton α] [Nonempty α] : Unique α := by
  inhabit α
  exact Unique.mk' α

end Unique

axiom α : Type
axiom a : α
instance : Nonempty α := Nonempty.intro a

-- Confirms that inhabit can find Nonempty instances that aren't in the local context
noncomputable example : Inhabited α := by
  inhabit α
  assumption


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

! This file was ported from Lean 3 source module data.list.pairwise
! leanprover-community/mathlib commit f694c7dead66f5d4c80f446c796a5aad14707f0e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.List.Count
import Mathbin.Data.List.Lex
import Mathbin.Logic.Pairwise
import Mathbin.Logic.Relation

/-!
# Pairwise relations on a list

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

This file provides basic results about `list.pairwise` and `list.pw_filter` (definitions are in
`data.list.defs`).
`pairwise r [a 0, ..., a (n - 1)]` means `∀ i j, i < j → r (a i) (a j)`. For example,
`pairwise (≠) l` means that all elements of `l` are distinct, and `pairwise (<) l` means that `l`
is strictly increasing.
`pw_filter r l` is the list obtained by iteratively adding each element of `l` that doesn't break
the pairwiseness of the list we have so far. It thus yields `l'` a maximal sublist of `l` such that
`pairwise r l'`.

## Tags

sorted, nodup
-/

open Nat Function

namespace List

variable {α β : Type _} {R S T : α → α → Prop} {a : α} {l : List α}

mk_iff_of_inductive_prop List.Pairwise List.pairwise_iff

/-! ### Pairwise -/

#print List.rel_of_pairwise_cons /-
theorem rel_of_pairwise_cons (p : (a :: l).Pairwise R) : ∀ {a'}, a' ∈ l → R a a' :=
  (pairwise_cons.1 p).1
#align list.rel_of_pairwise_cons List.rel_of_pairwise_cons
-/

#print List.Pairwise.of_cons /-
theorem Pairwise.of_cons (p : (a :: l).Pairwise R) : Pairwise R l :=
  (pairwise_cons.1 p).2
#align list.pairwise.of_cons List.Pairwise.of_cons
-/

#print List.Pairwise.tail /-
theorem Pairwise.tail : ∀ {l : List α} (p : Pairwise R l), Pairwise R l.tail
  | [], h => h
  | a :: l, h => h.of_cons
#align list.pairwise.tail List.Pairwise.tail
-/

#print List.Pairwise.drop /-
theorem Pairwise.drop : ∀ {l : List α} {n : ℕ}, List.Pairwise R l → List.Pairwise R (l.drop n)
  | _, 0, h => h
  | [], n + 1, h => List.Pairwise.nil
  | a :: l, n + 1, h => pairwise.drop (pairwise_cons.mp h).right
#align list.pairwise.drop List.Pairwise.drop
-/

#print List.Pairwise.imp_of_mem /-
theorem Pairwise.imp_of_mem {S : α → α → Prop} {l : List α}
    (H : ∀ {a b}, a ∈ l → b ∈ l → R a b → S a b) (p : Pairwise R l) : Pairwise S l :=
  by
  induction' p with a l r p IH generalizing H <;> constructor
  · exact BAll.imp_right (fun x h => H (mem_cons_self _ _) (mem_cons_of_mem _ h)) r
  · exact IH fun a b m m' => H (mem_cons_of_mem _ m) (mem_cons_of_mem _ m')
#align list.pairwise.imp_of_mem List.Pairwise.imp_of_mem
-/

theorem Pairwise.imp (H : ∀ a b, R a b → S a b) : Pairwise R l → Pairwise S l :=
  Pairwise.imp_of_mem fun a b _ _ => H a b
#align list.pairwise.imp List.Pairwise.impₓ

#print List.pairwise_and_iff /-
theorem pairwise_and_iff : (l.Pairwise fun a b => R a b ∧ S a b) ↔ l.Pairwise R ∧ l.Pairwise S :=
  ⟨fun h => ⟨h.imp fun a b h => h.1, h.imp fun a b h => h.2⟩, fun ⟨hR, hS⟩ =>
    by
    clear_; induction' hR with a l R1 R2 IH <;> simp only [pairwise.nil, pairwise_cons] at *
    exact ⟨fun b bl => ⟨R1 b bl, hS.1 b bl⟩, IH hS.2⟩⟩
#align list.pairwise_and_iff List.pairwise_and_iff
-/

#print List.Pairwise.and /-
theorem Pairwise.and (hR : l.Pairwise R) (hS : l.Pairwise S) :
    l.Pairwise fun a b => R a b ∧ S a b :=
  pairwise_and_iff.2 ⟨hR, hS⟩
#align list.pairwise.and List.Pairwise.and
-/

#print List.Pairwise.imp₂ /-
theorem Pairwise.imp₂ (H : ∀ a b, R a b → S a b → T a b) (hR : l.Pairwise R) (hS : l.Pairwise S) :
    l.Pairwise T :=
  (hR.And hS).imp fun a b => And.ndrec (H a b)
#align list.pairwise.imp₂ List.Pairwise.imp₂
-/

#print List.Pairwise.iff_of_mem /-
theorem Pairwise.iff_of_mem {S : α → α → Prop} {l : List α}
    (H : ∀ {a b}, a ∈ l → b ∈ l → (R a b ↔ S a b)) : Pairwise R l ↔ Pairwise S l :=
  ⟨Pairwise.imp_of_mem fun a b m m' => (H m m').1, Pairwise.imp_of_mem fun a b m m' => (H m m').2⟩
#align list.pairwise.iff_of_mem List.Pairwise.iff_of_mem
-/

#print List.Pairwise.iff /-
theorem Pairwise.iff {S : α → α → Prop} (H : ∀ a b, R a b ↔ S a b) {l : List α} :
    Pairwise R l ↔ Pairwise S l :=
  Pairwise.iff_of_mem fun a b _ _ => H a b
#align list.pairwise.iff List.Pairwise.iff
-/

#print List.pairwise_of_forall /-
theorem pairwise_of_forall {l : List α} (H : ∀ x y, R x y) : Pairwise R l := by
  induction l <;> [exact pairwise.nil, simp only [*, pairwise_cons, forall₂_true_iff, and_true_iff]]
#align list.pairwise_of_forall List.pairwise_of_forall
-/

#print List.Pairwise.and_mem /-
theorem Pairwise.and_mem {l : List α} :
    Pairwise R l ↔ Pairwise (fun x y => x ∈ l ∧ y ∈ l ∧ R x y) l :=
  Pairwise.iff_of_mem
    (by simp (config := { contextual := true }) only [true_and_iff, iff_self_iff, forall₂_true_iff])
#align list.pairwise.and_mem List.Pairwise.and_mem
-/

#print List.Pairwise.imp_mem /-
theorem Pairwise.imp_mem {l : List α} :
    Pairwise R l ↔ Pairwise (fun x y => x ∈ l → y ∈ l → R x y) l :=
  Pairwise.iff_of_mem
    (by
      simp (config := { contextual := true }) only [forall_prop_of_true, iff_self_iff,
        forall₂_true_iff])
#align list.pairwise.imp_mem List.Pairwise.imp_mem
-/

protected theorem Pairwise.sublist : ∀ {l₁ l₂ : List α}, l₁ <+ l₂ → Pairwise R l₂ → Pairwise R l₁
  | _, _, sublist.slnil, h => h
  | _, _, sublist.cons l₁ l₂ a s, pairwise.cons i h => h.Sublist s
  | _, _, sublist.cons2 l₁ l₂ a s, pairwise.cons i h =>
    (h.Sublist s).cons (BAll.imp_left s.Subset i)
#align list.pairwise.sublist List.Pairwise.sublistₓ

#print List.Pairwise.forall_of_forall_of_flip /-
theorem Pairwise.forall_of_forall_of_flip (h₁ : ∀ x ∈ l, R x x) (h₂ : l.Pairwise R)
    (h₃ : l.Pairwise (flip R)) : ∀ ⦃x⦄, x ∈ l → ∀ ⦃y⦄, y ∈ l → R x y :=
  by
  induction' l with a l ih
  · exact forall_mem_nil _
  rw [pairwise_cons] at h₂ h₃
  rintro x (rfl | hx) y (rfl | hy)
  · exact h₁ _ (l.mem_cons_self _)
  · exact h₂.1 _ hy
  · exact h₃.1 _ hx
  · exact ih (fun x hx => h₁ _ <| mem_cons_of_mem _ hx) h₂.2 h₃.2 hx hy
#align list.pairwise.forall_of_forall_of_flip List.Pairwise.forall_of_forall_of_flip
-/

#print List.Pairwise.forall_of_forall /-
theorem Pairwise.forall_of_forall (H : Symmetric R) (H₁ : ∀ x ∈ l, R x x) (H₂ : l.Pairwise R) :
    ∀ ⦃x⦄, x ∈ l → ∀ ⦃y⦄, y ∈ l → R x y :=
  H₂.forall_of_forall_of_flip H₁ <| by rwa [H.flip_eq]
#align list.pairwise.forall_of_forall List.Pairwise.forall_of_forall
-/

#print List.Pairwise.forall /-
theorem Pairwise.forall (hR : Symmetric R) (hl : l.Pairwise R) :
    ∀ ⦃a⦄, a ∈ l → ∀ ⦃b⦄, b ∈ l → a ≠ b → R a b :=
  Pairwise.forall_of_forall (fun a b h hne => hR (h hne.symm)) (fun _ _ h => (h rfl).elim)
    (hl.imp fun _ _ h _ => h)
#align list.pairwise.forall List.Pairwise.forall
-/

#print List.Pairwise.set_pairwise /-
theorem Pairwise.set_pairwise (hl : Pairwise R l) (hr : Symmetric R) : { x | x ∈ l }.Pairwise R :=
  hl.forall hr
#align list.pairwise.set_pairwise List.Pairwise.set_pairwise
-/

#print List.pairwise_singleton /-
theorem pairwise_singleton (R) (a : α) : Pairwise R [a] := by
  simp only [pairwise_cons, mem_singleton, forall_prop_of_false (not_mem_nil _), forall_true_iff,
    pairwise.nil, and_true_iff]
#align list.pairwise_singleton List.pairwise_singleton
-/

#print List.pairwise_pair /-
theorem pairwise_pair {a b : α} : Pairwise R [a, b] ↔ R a b := by
  simp only [pairwise_cons, mem_singleton, forall_eq, forall_prop_of_false (not_mem_nil _),
    forall_true_iff, pairwise.nil, and_true_iff]
#align list.pairwise_pair List.pairwise_pair
-/

#print List.pairwise_append /-
theorem pairwise_append {l₁ l₂ : List α} :
    Pairwise R (l₁ ++ l₂) ↔ Pairwise R l₁ ∧ Pairwise R l₂ ∧ ∀ x ∈ l₁, ∀ y ∈ l₂, R x y := by
  induction' l₁ with x l₁ IH <;>
    [simp only [List.Pairwise.nil, forall_prop_of_false (not_mem_nil _), forall_true_iff,
      and_true_iff, true_and_iff, nil_append],
    simp only [cons_append, pairwise_cons, forall_mem_append, IH, forall_mem_cons, forall_and,
      and_assoc', and_left_comm]]
#align list.pairwise_append List.pairwise_append
-/

#print List.pairwise_append_comm /-
theorem pairwise_append_comm (s : Symmetric R) {l₁ l₂ : List α} :
    Pairwise R (l₁ ++ l₂) ↔ Pairwise R (l₂ ++ l₁) :=
  by
  have :
    ∀ l₁ l₂ : List α,
      (∀ x : α, x ∈ l₁ → ∀ y : α, y ∈ l₂ → R x y) → ∀ x : α, x ∈ l₂ → ∀ y : α, y ∈ l₁ → R x y :=
    fun l₁ l₂ a x xm y ym => s (a y ym x xm)
  simp only [pairwise_append, and_left_comm] <;> rw [Iff.intro (this l₁ l₂) (this l₂ l₁)]
#align list.pairwise_append_comm List.pairwise_append_comm
-/

#print List.pairwise_middle /-
theorem pairwise_middle (s : Symmetric R) {a : α} {l₁ l₂ : List α} :
    Pairwise R (l₁ ++ a :: l₂) ↔ Pairwise R (a :: (l₁ ++ l₂)) :=
  show Pairwise R (l₁ ++ ([a] ++ l₂)) ↔ Pairwise R ([a] ++ l₁ ++ l₂) by
    rw [← append_assoc, pairwise_append, @pairwise_append _ _ ([a] ++ l₁),
        pairwise_append_comm s] <;>
      simp only [mem_append, or_comm']
#align list.pairwise_middle List.pairwise_middle
-/

#print List.pairwise_map' /-
theorem pairwise_map' (f : β → α) :
    ∀ {l : List β}, Pairwise R (map f l) ↔ Pairwise (fun a b : β => R (f a) (f b)) l
  | [] => by simp only [map, pairwise.nil]
  | b :: l =>
    by
    have : (∀ a b', b' ∈ l → f b' = a → R (f b) a) ↔ ∀ b' : β, b' ∈ l → R (f b) (f b') :=
      forall_swap.trans <| forall_congr' fun a => forall_swap.trans <| by simp only [forall_eq']
    simp only [map, pairwise_cons, mem_map, exists_imp, and_imp, this, pairwise_map]
#align list.pairwise_map List.pairwise_map'
-/

#print List.Pairwise.of_map /-
theorem Pairwise.of_map {S : β → β → Prop} (f : α → β) (H : ∀ a b : α, S (f a) (f b) → R a b)
    (p : Pairwise S (map f l)) : Pairwise R l :=
  ((pairwise_map' f).1 p).imp H
#align list.pairwise.of_map List.Pairwise.of_map
-/

/- warning: list.pairwise.map -> List.Pairwise.map is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {R : α -> α -> Prop} {l : List.{u1} α} {S : β -> β -> Prop} (f : α -> β), (forall (a : α) (b : α), (R a b) -> (S (f a) (f b))) -> (List.Pairwise.{u1} α R l) -> (List.Pairwise.{u2} β S (List.map.{u1, u2} α β f l))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {R : α -> α -> Prop} {l : List.{u2} α} {S : β -> β -> Prop} (f : α -> β), (forall (a : α) (b : α), (R a b) -> (S (f a) (f b))) -> (List.Pairwise.{u2} α R l) -> (List.Pairwise.{u1} β S (List.map.{u2, u1} α β f l))
Case conversion may be inaccurate. Consider using '#align list.pairwise.map List.Pairwise.mapₓ'. -/
theorem Pairwise.map {S : β → β → Prop} (f : α → β) (H : ∀ a b : α, R a b → S (f a) (f b))
    (p : Pairwise R l) : Pairwise S (map f l) :=
  (pairwise_map' f).2 <| p.imp H
#align list.pairwise.map List.Pairwise.map

/- warning: list.pairwise_filter_map -> List.pairwise_filterMap is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {R : α -> α -> Prop} (f : β -> (Option.{u1} α)) {l : List.{u2} β}, Iff (List.Pairwise.{u1} α R (List.filterMap.{u2, u1} β α f l)) (List.Pairwise.{u2} β (fun (a : β) (a' : β) => forall (b : α), (Membership.Mem.{u1, u1} α (Option.{u1} α) (Option.hasMem.{u1} α) b (f a)) -> (forall (b' : α), (Membership.Mem.{u1, u1} α (Option.{u1} α) (Option.hasMem.{u1} α) b' (f a')) -> (R b b'))) l)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {R : α -> α -> Prop} (f : β -> (Option.{u2} α)) {l : List.{u1} β}, Iff (List.Pairwise.{u2} α R (List.filterMap.{u1, u2} β α f l)) (List.Pairwise.{u1} β (fun (a : β) (a' : β) => forall (b : α), (Membership.mem.{u2, u2} α (Option.{u2} α) (Option.instMembershipOption.{u2} α) b (f a)) -> (forall (b' : α), (Membership.mem.{u2, u2} α (Option.{u2} α) (Option.instMembershipOption.{u2} α) b' (f a')) -> (R b b'))) l)
Case conversion may be inaccurate. Consider using '#align list.pairwise_filter_map List.pairwise_filterMapₓ'. -/
theorem pairwise_filterMap (f : β → Option α) {l : List β} :
    Pairwise R (filterMap f l) ↔ Pairwise (fun a a' : β => ∀ b ∈ f a, ∀ b' ∈ f a', R b b') l :=
  by
  let S (a a' : β) := ∀ b ∈ f a, ∀ b' ∈ f a', R b b'
  simp only [Option.mem_def]; induction' l with a l IH
  · simp only [filter_map, pairwise.nil]
  cases' e : f a with b
  · rw [filter_map_cons_none _ _ e, IH, pairwise_cons]
    simp only [e, forall_prop_of_false not_false, forall₃_true_iff, true_and_iff]
  rw [filter_map_cons_some _ _ _ e]
  simp only [pairwise_cons, mem_filter_map, exists_imp, and_imp, IH, e, forall_eq']
  show
    (∀ (a' : α) (x : β), x ∈ l → f x = some a' → R b a') ∧ Pairwise S l ↔
      (∀ a' : β, a' ∈ l → ∀ b' : α, f a' = some b' → R b b') ∧ Pairwise S l
  exact and_congr ⟨fun h b mb a ma => h a b mb ma, fun h a b mb ma => h b mb a ma⟩ Iff.rfl
#align list.pairwise_filter_map List.pairwise_filterMap

#print List.Pairwise.filter_map /-
theorem Pairwise.filter_map {S : β → β → Prop} (f : α → Option β)
    (H : ∀ a a' : α, R a a' → ∀ b ∈ f a, ∀ b' ∈ f a', S b b') {l : List α} (p : Pairwise R l) :
    Pairwise S (filterMap f l) :=
  (pairwise_filterMap _).2 <| p.imp H
#align list.pairwise.filter_map List.Pairwise.filter_map
-/

/- warning: list.pairwise_filter -> List.pairwise_filter is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {R : α -> α -> Prop} (p : α -> Prop) [_inst_1 : DecidablePred.{succ u1} α p] {l : List.{u1} α}, Iff (List.Pairwise.{u1} α R (List.filterₓ.{u1} α p (fun (a : α) => _inst_1 a) l)) (List.Pairwise.{u1} α (fun (x : α) (y : α) => (p x) -> (p y) -> (R x y)) l)
but is expected to have type
  forall {α : Type.{u1}} {R : α -> α -> Prop} (p : α -> Prop) [_inst_1 : DecidablePred.{succ u1} α p] {l : List.{u1} α}, Iff (List.Pairwise.{u1} α R (List.filter.{u1} α (fun (a : α) => Decidable.decide (p a) ((fun (a : α) => _inst_1 a) a)) l)) (List.Pairwise.{u1} α (fun (x : α) (y : α) => (p x) -> (p y) -> (R x y)) l)
Case conversion may be inaccurate. Consider using '#align list.pairwise_filter List.pairwise_filterₓ'. -/
theorem pairwise_filter (p : α → Prop) [DecidablePred p] {l : List α} :
    Pairwise R (filter p l) ↔ Pairwise (fun x y => p x → p y → R x y) l :=
  by
  rw [← filter_map_eq_filter, pairwise_filter_map]
  apply pairwise.iff; intros ; simp only [Option.mem_def, Option.guard_eq_some, and_imp, forall_eq']
#align list.pairwise_filter List.pairwise_filter

theorem Pairwise.filter (p : α → Prop) [DecidablePred p] : Pairwise R l → Pairwise R (filter p l) :=
  Pairwise.sublist (filter_sublist _)
#align list.pairwise.filter List.Pairwise.filterₓ

#print List.pairwise_pmap /-
theorem pairwise_pmap {p : β → Prop} {f : ∀ b, p b → α} {l : List β} (h : ∀ x ∈ l, p x) :
    Pairwise R (l.pmap f h) ↔
      Pairwise (fun b₁ b₂ => ∀ (h₁ : p b₁) (h₂ : p b₂), R (f b₁ h₁) (f b₂ h₂)) l :=
  by
  induction' l with a l ihl
  · simp
  obtain ⟨ha, hl⟩ : p a ∧ ∀ b, b ∈ l → p b := by simpa using h
  simp only [ihl hl, pairwise_cons, bex_imp, pmap, and_congr_left_iff, mem_pmap]
  refine' fun _ => ⟨fun H b hb hpa hpb => H _ _ hb rfl, _⟩
  rintro H _ b hb rfl
  exact H b hb _ _
#align list.pairwise_pmap List.pairwise_pmap
-/

/- warning: list.pairwise.pmap -> List.Pairwise.pmap is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {R : α -> α -> Prop} {l : List.{u1} α}, (List.Pairwise.{u1} α R l) -> (forall {p : α -> Prop} {f : forall (a : α), (p a) -> β} (h : forall (x : α), (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) x l) -> (p x)) {S : β -> β -> Prop}, (forall {{x : α}} (hx : p x) {{y : α}} (hy : p y), (R x y) -> (S (f x hx) (f y hy))) -> (List.Pairwise.{u2} β S (List.pmap.{u1, u2} α β (fun (a : α) => p a) f l h)))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {R : α -> α -> Prop} {l : List.{u2} α}, (List.Pairwise.{u2} α R l) -> (forall {p : α -> Prop} {f : forall (a : α), (p a) -> β} (h : forall (x : α), (Membership.mem.{u2, u2} α (List.{u2} α) (List.instMembershipList.{u2} α) x l) -> (p x)) {S : β -> β -> Prop}, (forall {{x : α}} (hx : p x) {{y : α}} (hy : p y), (R x y) -> (S (f x hx) (f y hy))) -> (List.Pairwise.{u1} β S (List.pmap.{u2, u1} α β (fun (a : α) => p a) f l h)))
Case conversion may be inaccurate. Consider using '#align list.pairwise.pmap List.Pairwise.pmapₓ'. -/
theorem Pairwise.pmap {l : List α} (hl : Pairwise R l) {p : α → Prop} {f : ∀ a, p a → β}
    (h : ∀ x ∈ l, p x) {S : β → β → Prop}
    (hS : ∀ ⦃x⦄ (hx : p x) ⦃y⦄ (hy : p y), R x y → S (f x hx) (f y hy)) : Pairwise S (l.pmap f h) :=
  by
  refine' (pairwise_pmap h).2 (pairwise.imp_of_mem _ hl)
  intros ; apply hS; assumption
#align list.pairwise.pmap List.Pairwise.pmap

#print List.pairwise_join /-
theorem pairwise_join {L : List (List α)} :
    Pairwise R (join L) ↔
      (∀ l ∈ L, Pairwise R l) ∧ Pairwise (fun l₁ l₂ => ∀ x ∈ l₁, ∀ y ∈ l₂, R x y) L :=
  by
  induction' L with l L IH
  · simp only [join, pairwise.nil, forall_prop_of_false (not_mem_nil _), forall_const, and_self_iff]
  have :
    (∀ x : α, x ∈ l → ∀ (y : α) (x_1 : List α), x_1 ∈ L → y ∈ x_1 → R x y) ↔
      ∀ a' : List α, a' ∈ L → ∀ x : α, x ∈ l → ∀ y : α, y ∈ a' → R x y :=
    ⟨fun h a b c d e => h c d e a b, fun h c d e a b => h a b c d e⟩
  simp only [join, pairwise_append, IH, mem_join, exists_imp, and_imp, this, forall_mem_cons,
    pairwise_cons]
  simp only [and_assoc', and_comm', and_left_comm]
#align list.pairwise_join List.pairwise_join
-/

/- warning: list.pairwise_bind -> List.pairwise_bind is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {R : β -> β -> Prop} {l : List.{u1} α} {f : α -> (List.{u2} β)}, Iff (List.Pairwise.{u2} β R (List.bind.{u1, u2} α β l f)) (And (forall (a : α), (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) a l) -> (List.Pairwise.{u2} β R (f a))) (List.Pairwise.{u1} α (fun (a₁ : α) (a₂ : α) => forall (x : β), (Membership.Mem.{u2, u2} β (List.{u2} β) (List.hasMem.{u2} β) x (f a₁)) -> (forall (y : β), (Membership.Mem.{u2, u2} β (List.{u2} β) (List.hasMem.{u2} β) y (f a₂)) -> (R x y))) l))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {R : β -> β -> Prop} {l : List.{u2} α} {f : α -> (List.{u1} β)}, Iff (List.Pairwise.{u1} β R (List.bind.{u2, u1} α β l f)) (And (forall (a : α), (Membership.mem.{u2, u2} α (List.{u2} α) (List.instMembershipList.{u2} α) a l) -> (List.Pairwise.{u1} β R (f a))) (List.Pairwise.{u2} α (fun (a₁ : α) (a₂ : α) => forall (x : β), (Membership.mem.{u1, u1} β (List.{u1} β) (List.instMembershipList.{u1} β) x (f a₁)) -> (forall (y : β), (Membership.mem.{u1, u1} β (List.{u1} β) (List.instMembershipList.{u1} β) y (f a₂)) -> (R x y))) l))
Case conversion may be inaccurate. Consider using '#align list.pairwise_bind List.pairwise_bindₓ'. -/
theorem pairwise_bind {R : β → β → Prop} {l : List α} {f : α → List β} :
    List.Pairwise R (l.bind f) ↔
      (∀ a ∈ l, Pairwise R (f a)) ∧ Pairwise (fun a₁ a₂ => ∀ x ∈ f a₁, ∀ y ∈ f a₂, R x y) l :=
  by simp [List.bind, List.pairwise_join, List.mem_map, List.pairwise_map']
#align list.pairwise_bind List.pairwise_bind

#print List.pairwise_reverse /-
@[simp]
theorem pairwise_reverse :
    ∀ {R} {l : List α}, Pairwise R (reverse l) ↔ Pairwise (fun x y => R y x) l :=
  suffices ∀ {R l}, @Pairwise α R l → Pairwise (fun x y => R y x) (reverse l) from fun R l =>
    ⟨fun p => reverse_reverse l ▸ this p, this⟩
  fun R l p => by
  induction' p with a l h p IH <;> [apply pairwise.nil,
    simpa only [reverse_cons, pairwise_append, IH, pairwise_cons,
      forall_prop_of_false (not_mem_nil _), forall_true_iff, pairwise.nil, mem_reverse,
      mem_singleton, forall_eq, true_and_iff] using h]
#align list.pairwise_reverse List.pairwise_reverse
-/

#print List.pairwise_of_reflexive_on_dupl_of_forall_ne /-
theorem pairwise_of_reflexive_on_dupl_of_forall_ne [DecidableEq α] {l : List α} {r : α → α → Prop}
    (hr : ∀ a, 1 < count a l → r a a) (h : ∀ a ∈ l, ∀ b ∈ l, a ≠ b → r a b) : l.Pairwise r :=
  by
  induction' l with hd tl IH
  · simp
  · rw [List.pairwise_cons]
    constructor
    · intro x hx
      by_cases H : hd = x
      · rw [H]
        refine' hr _ _
        simpa [count_cons, H, Nat.succ_lt_succ_iff, count_pos] using hx
      · exact h hd (mem_cons_self _ _) x (mem_cons_of_mem _ hx) H
    · refine' IH _ _
      · intro x hx
        refine' hr _ _
        rw [count_cons]
        split_ifs
        · exact hx.trans (Nat.lt_succ_self _)
        · exact hx
      · intro x hx y hy
        exact h x (mem_cons_of_mem _ hx) y (mem_cons_of_mem _ hy)
#align list.pairwise_of_reflexive_on_dupl_of_forall_ne List.pairwise_of_reflexive_on_dupl_of_forall_ne
-/

#print List.pairwise_of_forall_mem_list /-
theorem pairwise_of_forall_mem_list {l : List α} {r : α → α → Prop} (h : ∀ a ∈ l, ∀ b ∈ l, r a b) :
    l.Pairwise r := by
  classical
    refine'
      pairwise_of_reflexive_on_dupl_of_forall_ne (fun a ha' => _) fun a ha b hb _ => h a ha b hb
    have ha := List.one_le_count_iff_mem.1 ha'.le
    exact h a ha a ha
#align list.pairwise_of_forall_mem_list List.pairwise_of_forall_mem_list
-/

#print List.pairwise_of_reflexive_of_forall_ne /-
theorem pairwise_of_reflexive_of_forall_ne {l : List α} {r : α → α → Prop} (hr : Reflexive r)
    (h : ∀ a ∈ l, ∀ b ∈ l, a ≠ b → r a b) : l.Pairwise r := by
  classical exact pairwise_of_reflexive_on_dupl_of_forall_ne (fun _ _ => hr _) h
#align list.pairwise_of_reflexive_of_forall_ne List.pairwise_of_reflexive_of_forall_ne
-/

#print List.pairwise_iff_nthLe /-
theorem pairwise_iff_nthLe {R} :
    ∀ {l : List α},
      Pairwise R l ↔
        ∀ (i j) (h₁ : j < length l) (h₂ : i < j), R (nthLe l i (lt_trans h₂ h₁)) (nthLe l j h₁)
  | [] => by
    simp only [pairwise.nil, true_iff_iff] <;> exact fun i j h => (Nat.not_lt_zero j).elim h
  | a :: l => by
    rw [pairwise_cons, pairwise_iff_nth_le]
    refine'
      ⟨fun H i j h₁ h₂ => _, fun H =>
        ⟨fun a' m => _, fun i j h₁ h₂ => H _ _ (succ_lt_succ h₁) (succ_lt_succ h₂)⟩⟩
    · cases' j with j
      · exact (Nat.not_lt_zero _).elim h₂
      cases' i with i
      · exact H.1 _ (nth_le_mem l _ _)
      · exact H.2 _ _ (lt_of_succ_lt_succ h₁) (lt_of_succ_lt_succ h₂)
    · rcases nth_le_of_mem m with ⟨n, h, rfl⟩
      exact H _ _ (succ_lt_succ h) (succ_pos _)
#align list.pairwise_iff_nth_le List.pairwise_iff_nthLe
-/

#print List.pairwise_replicate /-
theorem pairwise_replicate {α : Type _} {r : α → α → Prop} {x : α} (hx : r x x) :
    ∀ n : ℕ, Pairwise r (replicate n x)
  | 0 => by simp
  | n + 1 => by simp [hx, mem_replicate, pairwise_replicate n]
#align list.pairwise_replicate List.pairwise_replicate
-/

/-! ### Pairwise filtering -/

variable [DecidableRel R]

#print List.pwFilter_nil /-
@[simp]
theorem pwFilter_nil : pwFilter R [] = [] :=
  rfl
#align list.pw_filter_nil List.pwFilter_nil
-/

#print List.pwFilter_cons_of_pos /-
@[simp]
theorem pwFilter_cons_of_pos {a : α} {l : List α} (h : ∀ b ∈ pwFilter R l, R a b) :
    pwFilter R (a :: l) = a :: pwFilter R l :=
  if_pos h
#align list.pw_filter_cons_of_pos List.pwFilter_cons_of_pos
-/

#print List.pwFilter_cons_of_neg /-
@[simp]
theorem pwFilter_cons_of_neg {a : α} {l : List α} (h : ¬∀ b ∈ pwFilter R l, R a b) :
    pwFilter R (a :: l) = pwFilter R l :=
  if_neg h
#align list.pw_filter_cons_of_neg List.pwFilter_cons_of_neg
-/

#print List.pwFilter_map /-
theorem pwFilter_map (f : β → α) :
    ∀ l : List β, pwFilter R (map f l) = map f (pwFilter (fun x y => R (f x) (f y)) l)
  | [] => rfl
  | x :: xs =>
    if h : ∀ b ∈ pwFilter R (map f xs), R (f x) b then
      by
      have h' : ∀ b : β, b ∈ pwFilter (fun x y : β => R (f x) (f y)) xs → R (f x) (f b) :=
        fun b hb => h _ (by rw [pw_filter_map] <;> apply mem_map_of_mem _ hb)
      rw [map, pw_filter_cons_of_pos h, pw_filter_cons_of_pos h', pw_filter_map, map]
    else
      by
      have h' : ¬∀ b : β, b ∈ pwFilter (fun x y : β => R (f x) (f y)) xs → R (f x) (f b) :=
        fun hh =>
        h fun a ha => by
          rw [pw_filter_map, mem_map] at ha
          rcases ha with ⟨b, hb₀, hb₁⟩
          subst a
          exact hh _ hb₀
      rw [map, pw_filter_cons_of_neg h, pw_filter_cons_of_neg h', pw_filter_map]
#align list.pw_filter_map List.pwFilter_map
-/

#print List.pwFilter_sublist /-
theorem pwFilter_sublist : ∀ l : List α, pwFilter R l <+ l
  | [] => nil_sublist _
  | x :: l => by
    by_cases ∀ y ∈ pw_filter R l, R x y
    · rw [pw_filter_cons_of_pos h]
      exact (pw_filter_sublist l).cons_cons _
    · rw [pw_filter_cons_of_neg h]
      exact sublist_cons_of_sublist _ (pw_filter_sublist l)
#align list.pw_filter_sublist List.pwFilter_sublist
-/

#print List.pwFilter_subset /-
theorem pwFilter_subset (l : List α) : pwFilter R l ⊆ l :=
  (pwFilter_sublist _).Subset
#align list.pw_filter_subset List.pwFilter_subset
-/

#print List.pairwise_pwFilter /-
theorem pairwise_pwFilter : ∀ l : List α, Pairwise R (pwFilter R l)
  | [] => Pairwise.nil
  | x :: l => by
    by_cases ∀ y ∈ pw_filter R l, R x y
    · rw [pw_filter_cons_of_pos h]
      exact pairwise_cons.2 ⟨h, pairwise_pw_filter l⟩
    · rw [pw_filter_cons_of_neg h]
      exact pairwise_pw_filter l
#align list.pairwise_pw_filter List.pairwise_pwFilter
-/

#print List.pwFilter_eq_self /-
theorem pwFilter_eq_self {l : List α} : pwFilter R l = l ↔ Pairwise R l :=
  ⟨fun e => e ▸ pairwise_pwFilter l, fun p =>
    by
    induction' l with x l IH; · rfl
    cases' pairwise_cons.1 p with al p
    rw [pw_filter_cons_of_pos (BAll.imp_left (pw_filter_subset l) al), IH p]⟩
#align list.pw_filter_eq_self List.pwFilter_eq_self
-/

alias pw_filter_eq_self ↔ _ pairwise.pw_filter
#align list.pairwise.pw_filter List.Pairwise.pwFilter

attribute [protected] pairwise.pw_filter

#print List.pwFilter_idempotent /-
@[simp]
theorem pwFilter_idempotent : pwFilter R (pwFilter R l) = pwFilter R l :=
  (pairwise_pwFilter l).pwFilter
#align list.pw_filter_idempotent List.pwFilter_idempotent
-/

#print List.forall_mem_pwFilter /-
theorem forall_mem_pwFilter (neg_trans : ∀ {x y z}, R x z → R x y ∨ R y z) (a : α) (l : List α) :
    (∀ b ∈ pwFilter R l, R a b) ↔ ∀ b ∈ l, R a b :=
  ⟨by
    induction' l with x l IH; · exact fun _ _ => False.elim
    simp only [forall_mem_cons]
    by_cases ∀ y ∈ pw_filter R l, R x y <;> dsimp at h
    · simp only [pw_filter_cons_of_pos h, forall_mem_cons, and_imp]
      exact fun r H => ⟨r, IH H⟩
    · rw [pw_filter_cons_of_neg h]
      refine' fun H => ⟨_, IH H⟩
      cases' e : find (fun y => ¬R x y) (pw_filter R l) with k
      · refine' h.elim (BAll.imp_right _ (find_eq_none.1 e))
        exact fun y _ => Classical.not_not.1
      · have := find_some e
        exact (neg_trans (H k (find_mem e))).resolve_right this, BAll.imp_left (pwFilter_subset l)⟩
#align list.forall_mem_pw_filter List.forall_mem_pwFilter
-/

end List


import tactic
import data.nat.basic
import data.nat.prime

noncomputable theory
open_locale classical

open nat

theorem sqrt2_irrational' :
  ¬ ∃ (m n : ℕ),
  2 * m^2 = n^2 ∧
  m.coprime n
:=
begin
  sorry,
end

-- Assume that everything above this line is true.

--BEGIN--

/-
pow_pos : ∀ {a : ℕ}, 0 < a → ∀ (n : ℕ), 0 < a ^ n
-/
lemma ge_zero_sq_ge_zero {n : ℕ} (hne : 0 < n) : (0 < n^2)
:=
begin
  sorry,
end

/-
nat.mul_left_inj : ∀ {a b c : ℕ}, 0 < a → (b * a = c * a ↔ b = c)
-/
lemma cancellation_lemma {k m n : ℕ}
(hk_pos : 0 < k^2)
(hmn : 2 * (m * k) ^ 2 = (n * k) ^ 2)
: 2 * m ^ 2 = n ^ 2
:=
begin
  sorry,
end

--END--


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.hom_functor
import Mathlib.PostPort

universes u₁ v₁ l

namespace Mathlib

/-!
# The Yoneda embedding

The Yoneda embedding as a functor `yoneda : C ⥤ (Cᵒᵖ ⥤ Type v₁)`,
along with an instance that it is `fully_faithful`.

Also the Yoneda lemma, `yoneda_lemma : (yoneda_pairing C) ≅ (yoneda_evaluation C)`.

## References
* [Stacks: Opposite Categories and the Yoneda Lemma](https://stacks.math.columbia.edu/tag/001L)
-/

namespace category_theory

/--
The Yoneda embedding, as a functor from `C` into presheaves on `C`.

See https://stacks.math.columbia.edu/tag/001O.
-/
def yoneda {C : Type u₁} [category C] : C ⥤ Cᵒᵖ ⥤ Type v₁ :=
  functor.mk
    (fun (X : C) =>
      functor.mk (fun (Y : Cᵒᵖ) => opposite.unop Y ⟶ X)
        fun (Y Y' : Cᵒᵖ) (f : Y ⟶ Y') (g : opposite.unop Y ⟶ X) => has_hom.hom.unop f ≫ g)
    fun (X X' : C) (f : X ⟶ X') =>
      nat_trans.mk
        fun (Y : Cᵒᵖ)
          (g :
          functor.obj
            (functor.mk (fun (Y : Cᵒᵖ) => opposite.unop Y ⟶ X)
              fun (Y Y' : Cᵒᵖ) (f : Y ⟶ Y') (g : opposite.unop Y ⟶ X) => has_hom.hom.unop f ≫ g)
            Y) =>
          g ≫ f

/--
The co-Yoneda embedding, as a functor from `Cᵒᵖ` into co-presheaves on `C`.
-/
@[simp] theorem coyoneda_obj_map {C : Type u₁} [category C] (X : Cᵒᵖ) (Y : C) (Y' : C) (f : Y ⟶ Y')
    (g : opposite.unop X ⟶ Y) : functor.map (functor.obj coyoneda X) f g = g ≫ f :=
  Eq.refl (functor.map (functor.obj coyoneda X) f g)

namespace yoneda

theorem obj_map_id {C : Type u₁} [category C] {X : C} {Y : C} (f : opposite.op X ⟶ opposite.op Y) :
    functor.map (functor.obj yoneda X) f 𝟙 =
        nat_trans.app (functor.map yoneda (has_hom.hom.unop f)) (opposite.op Y) 𝟙 :=
  sorry

@[simp] theorem naturality {C : Type u₁} [category C] {X : C} {Y : C}
    (α : functor.obj yoneda X ⟶ functor.obj yoneda Y) {Z : C} {Z' : C} (f : Z ⟶ Z') (h : Z' ⟶ X) :
    f ≫ nat_trans.app α (opposite.op Z') h = nat_trans.app α (opposite.op Z) (f ≫ h) :=
  Eq.symm
    (functor_to_types.naturality (functor.obj yoneda X) (functor.obj yoneda Y) α (has_hom.hom.op f)
      h)

/--
The Yoneda embedding is full.

See https://stacks.math.columbia.edu/tag/001P.
-/
protected instance yoneda_full {C : Type u₁} [category C] : full yoneda :=
  full.mk
    fun (X Y : C) (f : functor.obj yoneda X ⟶ functor.obj yoneda Y) =>
      nat_trans.app f (opposite.op X) 𝟙

/--
The Yoneda embedding is faithful.

See https://stacks.math.columbia.edu/tag/001P.
-/
protected instance yoneda_faithful {C : Type u₁} [category C] : faithful yoneda := faithful.mk

/-- Extensionality via Yoneda. The typical usage would be
```
-- Goal is `X ≅ Y`

-- Goal is `X ≅ Y`
apply yoneda.ext,
-- Goals are now functions `(Z ⟶ X) → (Z ⟶ Y)`, `(Z ⟶ Y) → (Z ⟶ X)`, and the fact that these

-- Goals are now functions `(Z ⟶ X) → (Z ⟶ Y)`, `(Z ⟶ Y) → (Z ⟶ X)`, and the fact that these
functions are inverses and natural in `Z`.
```
-/
def ext {C : Type u₁} [category C] (X : C) (Y : C) (p : {Z : C} → (Z ⟶ X) → (Z ⟶ Y))
    (q : {Z : C} → (Z ⟶ Y) → (Z ⟶ X)) (h₁ : ∀ {Z : C} (f : Z ⟶ X), q (p f) = f)
    (h₂ : ∀ {Z : C} (f : Z ⟶ Y), p (q f) = f)
    (n : ∀ {Z Z' : C} (f : Z' ⟶ Z) (g : Z ⟶ X), p (f ≫ g) = f ≫ p g) : X ≅ Y :=
  preimage_iso (nat_iso.of_components (fun (Z : Cᵒᵖ) => iso.mk p q) sorry)

/--
If `yoneda.map f` is an isomorphism, so was `f`.
-/
def is_iso {C : Type u₁} [category C] {X : C} {Y : C} (f : X ⟶ Y) [is_iso (functor.map yoneda f)] :
    is_iso f :=
  is_iso_of_fully_faithful yoneda f

end yoneda

namespace coyoneda

@[simp] theorem naturality {C : Type u₁} [category C] {X : Cᵒᵖ} {Y : Cᵒᵖ}
    (α : functor.obj coyoneda X ⟶ functor.obj coyoneda Y) {Z : C} {Z' : C} (f : Z' ⟶ Z)
    (h : opposite.unop X ⟶ Z') : nat_trans.app α Z' h ≫ f = nat_trans.app α Z (h ≫ f) :=
  sorry

protected instance coyoneda_full {C : Type u₁} [category C] : full coyoneda :=
  full.mk
    fun (X Y : Cᵒᵖ) (f : functor.obj coyoneda X ⟶ functor.obj coyoneda Y) =>
      has_hom.hom.op (nat_trans.app f (opposite.unop X) 𝟙)

protected instance coyoneda_faithful {C : Type u₁} [category C] : faithful coyoneda := faithful.mk

/--
If `coyoneda.map f` is an isomorphism, so was `f`.
-/
def is_iso {C : Type u₁} [category C] {X : Cᵒᵖ} {Y : Cᵒᵖ} (f : X ⟶ Y)
    [is_iso (functor.map coyoneda f)] : is_iso f :=
  is_iso_of_fully_faithful coyoneda f

-- No need to use Cᵒᵖ here, works with any category

/-- A Type-valued presheaf `P` is isomorphic to the composition of `P` with the
  coyoneda functor coming from `punit`. -/
@[simp] theorem iso_comp_punit_inv_app {C : Type u₁} [category C] (P : C ⥤ Type v₁) (X : C)
    (a : functor.obj P X) (_x : opposite.unop (opposite.op PUnit)) :
    nat_trans.app (iso.inv (iso_comp_punit P)) X a _x = a :=
  Eq.refl (nat_trans.app (iso.inv (iso_comp_punit P)) X a _x)

end coyoneda

/--
A presheaf `F` is representable if there is object `X` so `F ≅ yoneda.obj X`.

See https://stacks.math.columbia.edu/tag/001Q.
-/
-- TODO should we make this a Prop, merely asserting existence of such an object?

class representable {C : Type u₁} [category C] (F : Cᵒᵖ ⥤ Type v₁) where
  X : C
  w : functor.obj yoneda X ≅ F

end category_theory

namespace category_theory

-- For the rest of the file, we are using product categories,

-- so need to restrict to the case morphisms are in 'Type', not 'Sort'.

-- We need to help typeclass inference with some awkward universe levels here.

protected instance prod_category_instance_1 (C : Type u₁) [category C] :
    category ((Cᵒᵖ ⥤ Type v₁) × (Cᵒᵖ)) :=
  category_theory.prod (Cᵒᵖ ⥤ Type v₁) (Cᵒᵖ)

protected instance prod_category_instance_2 (C : Type u₁) [category C] :
    category (Cᵒᵖ × (Cᵒᵖ ⥤ Type v₁)) :=
  category_theory.prod (Cᵒᵖ) (Cᵒᵖ ⥤ Type v₁)

/--
The "Yoneda evaluation" functor, which sends `X : Cᵒᵖ` and `F : Cᵒᵖ ⥤ Type`
to `F.obj X`, functorially in both `X` and `F`.
-/
def yoneda_evaluation (C : Type u₁) [category C] : Cᵒᵖ × (Cᵒᵖ ⥤ Type v₁) ⥤ Type (max u₁ v₁) :=
  evaluation_uncurried (Cᵒᵖ) (Type v₁) ⋙ ulift_functor

@[simp] theorem yoneda_evaluation_map_down (C : Type u₁) [category C] (P : Cᵒᵖ × (Cᵒᵖ ⥤ Type v₁))
    (Q : Cᵒᵖ × (Cᵒᵖ ⥤ Type v₁)) (α : P ⟶ Q) (x : functor.obj (yoneda_evaluation C) P) :
    ulift.down (functor.map (yoneda_evaluation C) α x) =
        nat_trans.app (prod.snd α) (prod.fst Q)
          (functor.map (prod.snd P) (prod.fst α) (ulift.down x)) :=
  rfl

/--
The "Yoneda pairing" functor, which sends `X : Cᵒᵖ` and `F : Cᵒᵖ ⥤ Type`
to `yoneda.op.obj X ⟶ F`, functorially in both `X` and `F`.
-/
def yoneda_pairing (C : Type u₁) [category C] : Cᵒᵖ × (Cᵒᵖ ⥤ Type v₁) ⥤ Type (max u₁ v₁) :=
  functor.prod (functor.op yoneda) 𝟭 ⋙ functor.hom (Cᵒᵖ ⥤ Type v₁)

@[simp] theorem yoneda_pairing_map (C : Type u₁) [category C] (P : Cᵒᵖ × (Cᵒᵖ ⥤ Type v₁))
    (Q : Cᵒᵖ × (Cᵒᵖ ⥤ Type v₁)) (α : P ⟶ Q) (β : functor.obj (yoneda_pairing C) P) :
    functor.map (yoneda_pairing C) α β =
        functor.map yoneda (has_hom.hom.unop (prod.fst α)) ≫ β ≫ prod.snd α :=
  rfl

/--
The Yoneda lemma asserts that that the Yoneda pairing
`(X : Cᵒᵖ, F : Cᵒᵖ ⥤ Type) ↦ (yoneda.obj (unop X) ⟶ F)`
is naturally isomorphic to the evaluation `(X, F) ↦ F.obj X`.

See https://stacks.math.columbia.edu/tag/001P.
-/
def yoneda_lemma (C : Type u₁) [category C] : yoneda_pairing C ≅ yoneda_evaluation C :=
  iso.mk
    (nat_trans.mk
      fun (F : Cᵒᵖ × (Cᵒᵖ ⥤ Type v₁)) (x : functor.obj (yoneda_pairing C) F) =>
        ulift.up (nat_trans.app x (prod.fst F) 𝟙))
    (nat_trans.mk
      fun (F : Cᵒᵖ × (Cᵒᵖ ⥤ Type v₁)) (x : functor.obj (yoneda_evaluation C) F) =>
        nat_trans.mk
          fun (X : Cᵒᵖ)
            (a :
            functor.obj
              (opposite.unop (prod.fst (functor.obj (functor.prod (functor.op yoneda) 𝟭) F))) X) =>
            functor.map (prod.snd F) (has_hom.hom.op a) (ulift.down x))

/--
The isomorphism between `yoneda.obj X ⟶ F` and `F.obj (op X)`
(we need to insert a `ulift` to get the universes right!)
given by the Yoneda lemma.
-/
@[simp] def yoneda_sections {C : Type u₁} [category C] (X : C) (F : Cᵒᵖ ⥤ Type v₁) :
    (functor.obj yoneda X ⟶ F) ≅ ulift (functor.obj F (opposite.op X)) :=
  iso.app (yoneda_lemma C) (opposite.op X, F)

/--
We have a type-level equivalence between natural transformations from the yoneda embedding
and elements of `F.obj X`, without any universe switching.
-/
def yoneda_equiv {C : Type u₁} [category C] {X : C} {F : Cᵒᵖ ⥤ Type v₁} :
    (functor.obj yoneda X ⟶ F) ≃ functor.obj F (opposite.op X) :=
  equiv.trans (iso.to_equiv (yoneda_sections X F)) equiv.ulift

theorem yoneda_equiv_naturality {C : Type u₁} [category C] {X : C} {Y : C} {F : Cᵒᵖ ⥤ Type v₁}
    (f : functor.obj yoneda X ⟶ F) (g : Y ⟶ X) :
    functor.map F (has_hom.hom.op g) (coe_fn yoneda_equiv f) =
        coe_fn yoneda_equiv (functor.map yoneda g ≫ f) :=
  sorry

@[simp] theorem yoneda_equiv_apply {C : Type u₁} [category C] {X : C} {F : Cᵒᵖ ⥤ Type v₁}
    (f : functor.obj yoneda X ⟶ F) : coe_fn yoneda_equiv f = nat_trans.app f (opposite.op X) 𝟙 :=
  rfl

@[simp] theorem yoneda_equiv_symm_app_apply {C : Type u₁} [category C] {X : C} {F : Cᵒᵖ ⥤ Type v₁}
    (x : functor.obj F (opposite.op X)) (Y : Cᵒᵖ) (f : opposite.unop Y ⟶ X) :
    nat_trans.app (coe_fn (equiv.symm yoneda_equiv) x) Y f = functor.map F (has_hom.hom.op f) x :=
  rfl

/--
When `C` is a small category, we can restate the isomorphism from `yoneda_sections`
without having to change universes.
-/
def yoneda_sections_small {C : Type u₁} [small_category C] (X : C) (F : Cᵒᵖ ⥤ Type u₁) :
    (functor.obj yoneda X ⟶ F) ≅ functor.obj F (opposite.op X) :=
  yoneda_sections X F ≪≫ ulift_trivial (functor.obj F (opposite.op X))

@[simp] theorem yoneda_sections_small_hom {C : Type u₁} [small_category C] (X : C)
    (F : Cᵒᵖ ⥤ Type u₁) (f : functor.obj yoneda X ⟶ F) :
    iso.hom (yoneda_sections_small X F) f = nat_trans.app f (opposite.op X) 𝟙 :=
  rfl

@[simp] theorem yoneda_sections_small_inv_app_apply {C : Type u₁} [small_category C] (X : C)
    (F : Cᵒᵖ ⥤ Type u₁) (t : functor.obj F (opposite.op X)) (Y : Cᵒᵖ) (f : opposite.unop Y ⟶ X) :
    nat_trans.app (iso.inv (yoneda_sections_small X F) t) Y f =
        functor.map F (has_hom.hom.op f) t :=
  rfl

end Mathlib


/-
Copyright (c) 2021 Jakob von Raumer. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jakob von Raumer
-/
import category_theory.monoidal.rigid
import linear_algebra.tensor_product_basis
import linear_algebra.coevaluation
import algebra.category.Module.monoidal

/-!
# The category of finite dimensional vector spaces

This introduces `FinVect K`, the category of finite dimensional vector spaces on a field `K`.
It is implemented as a full subcategory on a subtype of  `Module K`.
We first create the instance as a category, then as a monoidal category and then as a rigid monoidal
category.

## Future work

* Show that `FinVect K` is a symmetric monoidal category.

-/
noncomputable theory

open category_theory Module.monoidal_category
open_locale classical big_operators

universes u

variables (K : Type u) [field K]

/-- Define `FinVect` as the subtype of `Module.{u} K` of finite dimensional vector spaces. -/
@[derive [category, λ α, has_coe_to_sort α (Sort*)]]
def FinVect := { V : Module.{u} K // finite_dimensional K V }

namespace FinVect

instance finite_dimensional (V : FinVect K): finite_dimensional K V := V.prop

instance : inhabited (FinVect K) := ⟨⟨Module.of K K, finite_dimensional.finite_dimensional_self K⟩⟩

instance : has_coe (FinVect.{u} K) (Module.{u} K) := { coe := λ V, V.1, }

protected lemma coe_comp {U V W : FinVect K} (f : U ⟶ V) (g : V ⟶ W) :
  ((f ≫ g) : U → W) = (g : V → W) ∘ (f : U → V) := rfl

instance monoidal_category : monoidal_category (FinVect K) :=
monoidal_category.full_monoidal_subcategory
  (λ V, finite_dimensional K V)
  (finite_dimensional.finite_dimensional_self K)
  (λ X Y hX hY, by exactI finite_dimensional_tensor_product X Y)

variables (V : FinVect K)

/-- The dual module is the dual in the rigid monoidal category `FinVect K`. -/
def FinVect_dual : FinVect K :=
⟨Module.of K (module.dual K V), subspace.module.dual.finite_dimensional⟩

instance : has_coe_to_fun (FinVect_dual K V) (λ _, V → K) :=
{ coe := λ v, by { change V →ₗ[K] K at v, exact v, } }

open category_theory.monoidal_category

/-- The coevaluation map is defined in `linear_algebra.coevaluation`. -/
def FinVect_coevaluation : 𝟙_ (FinVect K) ⟶ V ⊗ (FinVect_dual K V) :=
by apply coevaluation K V

lemma FinVect_coevaluation_apply_one : FinVect_coevaluation K V (1 : K) =
   ∑ (i : basis.of_vector_space_index K V),
    (basis.of_vector_space K V) i ⊗ₜ[K] (basis.of_vector_space K V).coord i :=
by apply coevaluation_apply_one K V

/-- The evaluation morphism is given by the contraction map. -/
def FinVect_evaluation : (FinVect_dual K V) ⊗ V ⟶ 𝟙_ (FinVect K) :=
by apply contract_left K V

@[simp]
lemma FinVect_evaluation_apply (f : (FinVect_dual K V)) (x : V) :
  (FinVect_evaluation K V) (f ⊗ₜ x) = f x :=
by apply contract_left_apply f x

private theorem coevaluation_evaluation :
  let V' : FinVect K := FinVect_dual K V in
  (𝟙 V' ⊗ (FinVect_coevaluation K V)) ≫ (α_ V' V V').inv ≫ (FinVect_evaluation K V ⊗ 𝟙 V')
  = (ρ_ V').hom ≫ (λ_ V').inv :=
by apply contract_left_assoc_coevaluation K V

private theorem evaluation_coevaluation :
  (FinVect_coevaluation K V ⊗ 𝟙 V)
  ≫ (α_ V (FinVect_dual K V) V).hom ≫ (𝟙 V ⊗ FinVect_evaluation K V)
  = (λ_ V).hom ≫ (ρ_ V).inv :=
by apply contract_left_assoc_coevaluation' K V

instance exact_pairing : exact_pairing V (FinVect_dual K V) :=
{ coevaluation := FinVect_coevaluation K V,
  evaluation := FinVect_evaluation K V,
  coevaluation_evaluation' := coevaluation_evaluation K V,
  evaluation_coevaluation' := evaluation_coevaluation K V }

instance right_dual : has_right_dual V := ⟨FinVect_dual K V⟩

instance right_rigid_category : right_rigid_category (FinVect K) := { }

end FinVect