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

/-!
# Alternate definition of `vector` in terms of `fin2`

This file provides a locale `vector3` which overrides the `[a, b, c]` notation to create a `vector3`
instead of a `list`.

The `::` notation is also overloaded by this file to mean `vector3.cons`.
-/

open fin2 nat

universes u
variables {α : Type*} {m n : ℕ}

/-- Alternate definition of `vector` based on `fin2`. -/
def vector3 (α : Type u) (n : ℕ) : Type u := fin2 n → α

instance [inhabited α] : inhabited (vector3 α n) := pi.inhabited _

namespace vector3

/-- The empty vector -/
@[pattern] def nil : vector3 α 0.

/-- The vector cons operation -/
@[pattern] def cons (a : α) (v : vector3 α n) : vector3 α (succ n) :=
λ i, by { refine i.cases' _ _, exact a, exact v }

/- We do not want to make the following notation global, because then these expressions will be
overloaded, and only the expected type will be able to disambiguate the meaning. Worse: Lean will
try to insert a coercion from `vector3 α _` to `list α`, if a list is expected. -/
localized "notation `[` l:(foldr `, ` (h t, vector3.cons h t) vector3.nil `]`) := l" in vector3
notation a :: b := cons a b

@[simp] lemma cons_fz (a : α) (v : vector3 α n) : (a :: v) fz = a := rfl
@[simp] lemma cons_fs (a : α) (v : vector3 α n) (i) : (a :: v) (fs i) = v i := rfl

/-- Get the `i`th element of a vector -/
@[reducible] def nth (i : fin2 n) (v : vector3 α n) : α := v i

/-- Construct a vector from a function on `fin2`. -/
@[reducible] def of_fn (f : fin2 n → α) : vector3 α n := f

/-- Get the head of a nonempty vector. -/
def head (v : vector3 α (succ n)) : α := v fz

/-- Get the tail of a nonempty vector. -/
def tail (v : vector3 α (succ n)) : vector3 α n := λ i, v (fs i)

lemma eq_nil (v : vector3 α 0) : v = [] := funext $ λ i, match i with end

lemma cons_head_tail (v : vector3 α (succ n)) : head v :: tail v = v :=
funext $ λ i, fin2.cases' rfl (λ _, rfl) i

/-- Eliminator for an empty vector. -/
def nil_elim {C : vector3 α 0 → Sort u} (H : C []) (v : vector3 α 0) : C v :=
by rw eq_nil v; apply H

/-- Recursion principle for a nonempty vector. -/
def cons_elim {C : vector3 α (succ n) → Sort u} (H : Π (a : α) (t : vector3 α n), C (a :: t))
  (v : vector3 α (succ n)) : C v :=
by rw ← (cons_head_tail v); apply H

@[simp] lemma cons_elim_cons {C H a t} : @cons_elim α n C H (a :: t) = H a t := rfl

/-- Recursion principle with the vector as first argument. -/
@[elab_as_eliminator]
protected def rec_on {C : Π {n}, vector3 α n → Sort u} {n} (v : vector3 α n)
  (H0 : C [])
  (Hs : Π {n} (a) (w : vector3 α n), C w → C (a :: w)) : C v :=
nat.rec_on n
  (λ v, v.nil_elim H0)
  (λ n IH v, v.cons_elim (λ a t, Hs _ _ (IH _))) v

@[simp] lemma rec_on_nil {C H0 Hs} : @vector3.rec_on α @C 0 [] H0 @Hs = H0 := rfl

@[simp] lemma rec_on_cons {C H0 Hs n a v} :
  @vector3.rec_on α @C (succ n) (a :: v) H0 @Hs = Hs a v (@vector3.rec_on α @C n v H0 @Hs) :=
rfl

/-- Append two vectors -/
def append (v : vector3 α m) (w : vector3 α n) : vector3 α (n+m) :=
nat.rec_on m (λ _, w) (λ m IH v, v.cons_elim $ λ a t, @fin2.cases' (n+m) (λ _, α) a (IH t)) v

local infix ` +-+ `:65 := vector3.append

@[simp] lemma append_nil (w : vector3 α n) : [] +-+ w = w := rfl

@[simp] lemma append_cons (a : α) (v : vector3 α m) (w : vector3 α n) :
  (a :: v) +-+ w = a :: (v +-+ w) := rfl

@[simp] lemma append_left : ∀ {m} (i : fin2 m) (v : vector3 α m) {n} (w : vector3 α n),
  (v +-+ w) (left n i) = v i
| ._ (@fz m)   v n w := v.cons_elim (λ a t, by simp [*, left])
| ._ (@fs m i) v n w := v.cons_elim (λ a t, by simp [*, left])

@[simp] lemma append_add : ∀ {m} (v : vector3 α m) {n} (w : vector3 α n) (i : fin2 n),
  (v +-+ w) (add i m) = w i
| 0        v n w i := rfl
| (succ m) v n w i := v.cons_elim (λ a t, by simp [*, add])

/-- Insert `a` into `v` at index `i`. -/
def insert (a : α) (v : vector3 α n) (i : fin2 (succ n)) : vector3 α (succ n) :=
λ j, (a :: v) (insert_perm i j)

@[simp] lemma insert_fz (a : α) (v : vector3 α n) : insert a v fz = a :: v :=
by refine funext (λ j, j.cases' _ _); intros; refl

@[simp] lemma insert_fs (a : α) (b : α) (v : vector3 α n) (i : fin2 (succ n)) :
  insert a (b :: v) (fs i) = b :: insert a v i :=
funext $ λ j, by
{ refine j.cases' _ (λ j, _); simp [insert, insert_perm],
  refine fin2.cases' _ _ (insert_perm i j); simp [insert_perm] }

lemma append_insert (a : α) (t : vector3 α m) (v : vector3 α n) (i : fin2 (succ n))
  (e : succ n + m = succ (n + m)) :
  insert a (t +-+ v) (eq.rec_on e (i.add m)) = eq.rec_on e (t +-+ insert a v i) :=
begin
  refine vector3.rec_on t (λ e, _) (λ k b t IH e, _) e, refl,
  have e' := succ_add n k,
  change insert a (b :: (t +-+ v)) (eq.rec_on (congr_arg succ e') (fs (add i k)))
    = eq.rec_on (congr_arg succ e') (b :: (t +-+ insert a v i)),
  rw ← (eq.drec_on e' rfl : fs (eq.rec_on e' (i.add k) : fin2 (succ (n + k))) = eq.rec_on
    (congr_arg succ e') (fs (i.add k))),
  simp, rw IH, exact eq.drec_on e' rfl
end

end vector3

section vector3
open vector3
open_locale vector3

/-- "Curried" exists, i.e. `∃ x₁ ... xₙ, f [x₁, ..., xₙ]`. -/
def vector_ex : Π k, (vector3 α k → Prop) → Prop
| 0        f := f []
| (succ k) f := ∃x : α, vector_ex k (λ v, f (x :: v))

/-- "Curried" forall, i.e. `∀ x₁ ... xₙ, f [x₁, ..., xₙ]`. -/
def vector_all : Π k, (vector3 α k → Prop) → Prop
| 0        f := f []
| (succ k) f := ∀ x : α, vector_all k (λ v, f (x :: v))

lemma exists_vector_zero (f : vector3 α 0 → Prop) : Exists f ↔ f [] :=
⟨λ ⟨v, fv⟩, by rw ← (eq_nil v); exact fv, λ f0, ⟨[], f0⟩⟩

lemma exists_vector_succ (f : vector3 α (succ n) → Prop) : Exists f ↔ ∃x v, f (x :: v) :=
⟨λ ⟨v, fv⟩, ⟨_, _, by rw cons_head_tail v; exact fv⟩, λ ⟨x, v, fxv⟩, ⟨_, fxv⟩⟩

lemma vector_ex_iff_exists : ∀ {n} (f : vector3 α n → Prop), vector_ex n f ↔ Exists f
| 0        f := (exists_vector_zero f).symm
| (succ n) f := iff.trans (exists_congr (λ x, vector_ex_iff_exists _)) (exists_vector_succ f).symm

lemma vector_all_iff_forall : ∀ {n} (f : vector3 α n → Prop), vector_all n f ↔ ∀ v, f v
| 0        f := ⟨λ f0 v, v.nil_elim f0, λ al, al []⟩
| (succ n) f := (forall_congr (λ x, vector_all_iff_forall (λ v, f (x :: v)))).trans
  ⟨λ al v, v.cons_elim al, λ al x v, al (x :: v)⟩

/-- `vector_allp p v` is equivalent to `∀ i, p (v i)`, but unfolds directly to a conjunction,
  i.e. `vector_allp p [0, 1, 2] = p 0 ∧ p 1 ∧ p 2`. -/
def vector_allp (p : α → Prop) (v : vector3 α n) : Prop :=
vector3.rec_on v true (λ n a v IH, @vector3.rec_on _ (λ n v, Prop) _ v (p a) (λ n b v' _, p a ∧ IH))

@[simp] lemma vector_allp_nil (p : α → Prop) : vector_allp p [] = true := rfl
@[simp] lemma vector_allp_singleton (p : α → Prop) (x : α) : vector_allp p [x] = p x := rfl
@[simp] lemma vector_allp_cons (p : α → Prop) (x : α) (v : vector3 α n) :
  vector_allp p (x :: v) ↔ p x ∧ vector_allp p v :=
vector3.rec_on v (and_true _).symm (λ n a v IH, iff.rfl)

lemma vector_allp_iff_forall (p : α → Prop) (v : vector3 α n) : vector_allp p v ↔ ∀ i, p (v i) :=
begin
  refine v.rec_on _ _,
  { exact ⟨λ _, fin2.elim0, λ _, trivial⟩ },
  { simp, refine λ n a v IH, (and_congr_right (λ _, IH)).trans
      ⟨λ ⟨pa, h⟩ i, by {refine i.cases' _ _, exacts [pa, h]}, λ h, ⟨_, λ i, _⟩⟩,
    { have h0 := h fz, simp at h0, exact h0 },
    { have hs := h (fs i), simp at hs, exact hs } }
end

lemma vector_allp.imp {p q : α → Prop} (h : ∀ x, p x → q x) {v : vector3 α n}
  (al : vector_allp p v) : vector_allp q v :=
(vector_allp_iff_forall _ _).2 (λ i, h _ $ (vector_allp_iff_forall _ _).1 al _)

end vector3


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

! This file was ported from Lean 3 source module control.fix
! leanprover-community/mathlib commit 207cfac9fcd06138865b5d04f7091e46d9320432
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Part
import Mathlib.Data.Nat.Upto
import Mathlib.Data.Stream.Defs

/-!
# Fixed point

This module defines a generic `fix` operator for defining recursive
computations that are not necessarily well-founded or productive.
An instance is defined for `Part`.

## Main definition

 * class `Fix`
 * `Part.fix`
-/

universe u v

open Classical

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

/-- `Fix α` provides a `fix` operator to define recursive computatiation
via the fixed point of function of type `α → α`. -/
class Fix (α : Type _) where
  /-- `fix f` represents the computation of a fixed point for `f`.-/
  fix : (α → α) → α
#align has_fix Fix

namespace Part

open Part Nat Nat.Upto

section Basic

variable (f : (∀ a, Part (β a)) → (∀ a, Part (β a)))

/-- A series of successive, finite approximation of the fixed point of `f`, defined by
`approx f n = f^[n] ⊥`. The limit of this chain is the fixed point of `f`. -/
def Fix.approx : Stream' (∀ a, Part (β a))
  | 0 => ⊥
  | Nat.succ i => f (Fix.approx i)
#align part.fix.approx Part.Fix.approx

/-- loop body for finding the fixed point of `f` -/
def fixAux {p : ℕ → Prop} (i : Nat.Upto p) (g : ∀ j : Nat.Upto p, i < j → ∀ a, Part (β a)) :
    ∀ a, Part (β a) :=
  f fun x : α => (assert ¬p i.val) fun h : ¬p i.val => g (i.succ h) (Nat.lt_succ_self _) x
#align part.fix_aux Part.fixAux

/-- The least fixed point of `f`.

If `f` is a continuous function (according to complete partial orders),
it satisfies the equations:

  1. `fix f = f (fix f)`          (is a fixed point)
  2. `∀ X, f X ≤ X → fix f ≤ X`   (least fixed point)
-/
-- porting note: added noncomputable, because WellFounded.fix is noncomputable (for now?)
protected noncomputable def fix (x : α) : Part (β x) :=
  (Part.assert (∃ i, (Fix.approx f i x).Dom)) fun h =>
    WellFounded.fix.{1} (Nat.Upto.wf h) (fixAux f) Nat.Upto.zero x
#align part.fix Part.fix

protected theorem fix_def {x : α} (h' : ∃ i, (Fix.approx f i x).Dom) :
    Part.fix f x = Fix.approx f (Nat.succ (Nat.find h')) x := by
  let p := fun i : ℕ => (Fix.approx f i x).Dom
  have : p (Nat.find h') := Nat.find_spec h'
  generalize hk : Nat.find h' = k
  replace hk : Nat.find h' = k + (@Upto.zero p).val := hk
  rw [hk] at this
  revert hk
  dsimp [Part.fix]; rw [assert_pos h']; revert this
  generalize Upto.zero = z; intro _this hk
  suffices : ∀ x',
    WellFounded.fix (Part.fix.proof_1 f x h') (fixAux f) z x' = Fix.approx f (succ k) x'
  exact this _
  induction k generalizing z with
  | zero =>
    intro x'
    rw [Fix.approx, WellFounded.fix_eq, fixAux]
    congr
    ext x: 1
    rw [assert_neg]
    rfl
    rw [Nat.zero_add] at _this
    simpa only [not_not, Coe]
  | succ n n_ih =>
    intro x'
    rw [Fix.approx, WellFounded.fix_eq, fixAux]
    congr
    ext : 1
    have hh : ¬(Fix.approx f z.val x).Dom := by
      apply Nat.find_min h'
      rw [hk, Nat.succ_add, ← Nat.add_succ]
      apply Nat.lt_of_succ_le
      apply Nat.le_add_left
    rw [succ_add_eq_succ_add] at _this hk
    rw [assert_pos hh, n_ih (Upto.succ z hh) _this hk]
#align part.fix_def Part.fix_def

theorem fix_def' {x : α} (h' : ¬∃ i, (Fix.approx f i x).Dom) : Part.fix f x = none := by
  dsimp [Part.fix]
  rw [assert_neg h']
#align part.fix_def' Part.fix_def'

end Basic

end Part

namespace Part

-- porting note: added noncomputable, because WellFounded.fix is noncomputable (for now?)
noncomputable instance : Fix (Part α) :=
  ⟨fun f => Part.fix (fun x u => f (x u)) ()⟩

end Part

open Sigma

namespace Pi

-- porting note: added noncomputable, because WellFounded.fix is noncomputable (for now?)
noncomputable instance Part.hasFix {β} : Fix (α → Part β) :=
  ⟨Part.fix⟩
#align pi.part.has_fix Pi.Part.hasFix

end Pi


example (x : Nat × Nat) : x.1 + x.2 ≥ 0 :=
  let (a, b) := x
  _

example (x : Nat × Nat) : x.1 + x.2 ≥ 0 :=
  have (a, b) := x
  _

example (x : Nat × Nat) : x.1 + x.2 ≥ 0 := by
  let (a, b) := x
  done

example (x : Nat × Nat) : x.1 + x.2 ≥ 0 := by
  have (a, b) := x
  done

def f : Nat × Nat → Nat
  | (a, b) => a + b + 1

example (x : Nat × Nat) : f x > 0 := by
  let (a, b) := x
  done


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

Functors with two arguments
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.logic.function.basic
import Mathlib.control.functor
import Mathlib.tactic.core
import Mathlib.PostPort

universes u₀ u₁ u₂ l l_3 l_2 l_1 u_1 u_2

namespace Mathlib

class bifunctor (F : Type u₀ → Type u₁ → Type u₂)
where
  bimap : {α α' : Type u₀} → {β β' : Type u₁} → (α → α') → (β → β') → F α β → F α' β'

class is_lawful_bifunctor (F : Type u₀ → Type u₁ → Type u₂) [bifunctor F]
where
  id_bimap : ∀ {α : Type u₀} {β : Type u₁} (x : F α β), bimap id id x = x
  bimap_bimap : ∀ {α₀ α₁ α₂ : Type u₀} {β₀ β₁ β₂ : Type u₁} (f : α₀ → α₁) (f' : α₁ → α₂) (g : β₀ → β₁) (g' : β₁ → β₂) (x : F α₀ β₀),
  bimap f' g' (bimap f g x) = bimap (f' ∘ f) (g' ∘ g) x

theorem is_lawful_bifunctor.bimap_id_id {F : Type l_3 → Type l_2 → Type l_1} [bifunctor F] [c : is_lawful_bifunctor F] {α : Type l_3} {β : Type l_2} : bimap id id = id :=
  funext fun (x : F α β) => id_bimap x

theorem is_lawful_bifunctor.bimap_comp_bimap {F : Type l_3 → Type l_2 → Type l_1} [bifunctor F] [c : is_lawful_bifunctor F] {α₀ : Type l_3} {α₁ : Type l_3} {α₂ : Type l_3} {β₀ : Type l_2} {β₁ : Type l_2} {β₂ : Type l_2} (f : α₀ → α₁) (f' : α₁ → α₂) (g : β₀ → β₁) (g' : β₁ → β₂) : bimap f' g' ∘ bimap f g = bimap (f' ∘ f) (g' ∘ g) :=
  funext fun (x : F α₀ β₀) => bimap_bimap f f' g g' x

namespace bifunctor

def fst {F : Type u₀ → Type u₁ → Type u₂} [bifunctor F] {α : Type u₀} {α' : Type u₀} {β : Type u₁} (f : α → α') : F α β → F α' β :=
  bimap f id

def snd {F : Type u₀ → Type u₁ → Type u₂} [bifunctor F] {α : Type u₀} {β : Type u₁} {β' : Type u₁} (f : β → β') : F α β → F α β' :=
  bimap id f

theorem id_fst {F : Type u₀ → Type u₁ → Type u₂} [bifunctor F] [is_lawful_bifunctor F] {α : Type u₀} {β : Type u₁} (x : F α β) : fst id x = x :=
  id_bimap

theorem snd_id {F : Type l_3 → Type l_2 → Type l_1} [bifunctor F] [is_lawful_bifunctor F] {α : Type l_3} {β : Type l_2} : snd id = id :=
  funext fun (x : F α β) => id_snd x

theorem comp_fst {F : Type u₀ → Type u₁ → Type u₂} [bifunctor F] [is_lawful_bifunctor F] {α₀ : Type u₀} {α₁ : Type u₀} {α₂ : Type u₀} {β : Type u₁} (f : α₀ → α₁) (f' : α₁ → α₂) (x : F α₀ β) : fst f' (fst f x) = fst (f' ∘ f) x := sorry

theorem fst_snd {F : Type u₀ → Type u₁ → Type u₂} [bifunctor F] [is_lawful_bifunctor F] {α₀ : Type u₀} {α₁ : Type u₀} {β₀ : Type u₁} {β₁ : Type u₁} (f : α₀ → α₁) (f' : β₀ → β₁) (x : F α₀ β₀) : fst f (snd f' x) = bimap f f' x := sorry

theorem snd_comp_fst {F : Type l_3 → Type l_2 → Type l_1} [bifunctor F] [is_lawful_bifunctor F] {α₀ : Type l_3} {α₁ : Type l_3} {β₀ : Type l_2} {β₁ : Type l_2} (f : α₀ → α₁) (f' : β₀ → β₁) : snd f' ∘ fst f = bimap f f' :=
  funext fun (x : F α₀ β₀) => snd_fst f f' x

theorem comp_snd {F : Type u₀ → Type u₁ → Type u₂} [bifunctor F] [is_lawful_bifunctor F] {α : Type u₀} {β₀ : Type u₁} {β₁ : Type u₁} {β₂ : Type u₁} (g : β₀ → β₁) (g' : β₁ → β₂) (x : F α β₀) : snd g' (snd g x) = snd (g' ∘ g) x := sorry

end bifunctor

protected instance prod.bifunctor : bifunctor Prod :=
  bifunctor.mk prod.map

protected instance prod.is_lawful_bifunctor : is_lawful_bifunctor Prod :=
  is_lawful_bifunctor.mk sorry sorry

protected instance bifunctor.const : bifunctor functor.const :=
  bifunctor.mk fun (α α' : Type u_1) (β β_1 : Type u_2) (f : α → α') (_x : β → β_1) => f

protected instance is_lawful_bifunctor.const : is_lawful_bifunctor functor.const :=
  is_lawful_bifunctor.mk sorry sorry

protected instance bifunctor.flip {F : Type u₀ → Type u₁ → Type u₂} [bifunctor F] : bifunctor (flip F) :=
  bifunctor.mk fun (α α' : Type u₁) (β β' : Type u₀) (f : α → α') (f' : β → β') (x : flip F α β) => bimap f' f x

protected instance is_lawful_bifunctor.flip {F : Type u₀ → Type u₁ → Type u₂} [bifunctor F] [is_lawful_bifunctor F] : is_lawful_bifunctor (flip F) :=
  is_lawful_bifunctor.mk sorry sorry

protected instance sum.bifunctor : bifunctor sum :=
  bifunctor.mk sum.map

protected instance sum.is_lawful_bifunctor : is_lawful_bifunctor sum :=
  is_lawful_bifunctor.mk sorry sorry

protected instance bifunctor.functor {F : Type u₀ → Type u₁ → Type u₂} [bifunctor F] {α : Type u₀} : Functor (F α) :=
  { map := fun (_x _x_1 : Type u₁) => bifunctor.snd,
    mapConst := fun (α_1 β : Type u₁) => bifunctor.snd ∘ function.const β }

protected instance bifunctor.is_lawful_functor {F : Type u₀ → Type u₁ → Type u₂} [bifunctor F] [is_lawful_bifunctor F] {α : Type u₀} : is_lawful_functor (F α) :=
  is_lawful_functor.mk
    (fun (α_1 : Type u₁) (x : F α α_1) =>
      eq.mpr
        (id
          (Eq.trans
            ((fun (a a_1 : F α α_1) (e_1 : a = a_1) (ᾰ ᾰ_1 : F α α_1) (e_2 : ᾰ = ᾰ_1) => congr (congr_arg Eq e_1) e_2)
              (id <$> x) x (Eq.trans (congr_fun bifunctor.snd_id x) (id.def x)) x x (Eq.refl x))
            (propext (eq_self_iff_true x))))
        trivial)
    fun (α_1 β γ : Type u₁) (g : α_1 → β) (h : β → γ) (x : F α α_1) =>
      eq.mpr
        (id
          (Eq.trans
            ((fun (a a_1 : F α γ) (e_1 : a = a_1) (ᾰ ᾰ_1 : F α γ) (e_2 : ᾰ = ᾰ_1) => congr (congr_arg Eq e_1) e_2)
              ((h ∘ g) <$> x) (bifunctor.snd (h ∘ g) x) (Eq.refl (bifunctor.snd (h ∘ g) x)) (h <$> g <$> x)
              (bifunctor.snd (h ∘ g) x) (bifunctor.comp_snd g h x))
            (propext (eq_self_iff_true (bifunctor.snd (h ∘ g) x)))))
        trivial

protected instance function.bicompl.bifunctor {F : Type u₀ → Type u₁ → Type u₂} [bifunctor F] (G : Type u_1 → Type u₀) (H : Type u_2 → Type u₁) [Functor G] [Functor H] : bifunctor (function.bicompl F G H) :=
  bifunctor.mk
    fun (α α' : Type u_1) (β β' : Type u_2) (f : α → α') (f' : β → β') (x : function.bicompl F G H α β) =>
      bimap (Functor.map f) (Functor.map f') x

protected instance function.bicompl.is_lawful_bifunctor {F : Type u₀ → Type u₁ → Type u₂} [bifunctor F] (G : Type u_1 → Type u₀) (H : Type u_2 → Type u₁) [Functor G] [Functor H] [is_lawful_functor G] [is_lawful_functor H] [is_lawful_bifunctor F] : is_lawful_bifunctor (function.bicompl F G H) :=
  is_lawful_bifunctor.mk sorry sorry

protected instance function.bicompr.bifunctor {F : Type u₀ → Type u₁ → Type u₂} [bifunctor F] (G : Type u₂ → Type u_1) [Functor G] : bifunctor (function.bicompr G F) :=
  bifunctor.mk
    fun (α α' : Type u₀) (β β' : Type u₁) (f : α → α') (f' : β → β') (x : function.bicompr G F α β) => bimap f f' <$> x

protected instance function.bicompr.is_lawful_bifunctor {F : Type u₀ → Type u₁ → Type u₂} [bifunctor F] (G : Type u₂ → Type u_1) [Functor G] [is_lawful_functor G] [is_lawful_bifunctor F] : is_lawful_bifunctor (function.bicompr G F) :=
  is_lawful_bifunctor.mk sorry sorry


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

import algebra.geom_sum
import linear_algebra.smodeq
import ring_theory.jacobson_ideal

/-!
# Completion of a module with respect to an ideal.

In this file we define the notions of Hausdorff, precomplete, and complete for an `R`-module `M`
with respect to an ideal `I`:

## Main definitions

- `is_Hausdorff I M`: this says that the intersection of `I^n M` is `0`.
- `is_precomplete I M`: this says that every Cauchy sequence converges.
- `is_adic_complete I M`: this says that `M` is Hausdorff and precomplete.
- `Hausdorffification I M`: this is the universal Hausdorff module with a map from `M`.
- `completion I M`: if `I` is finitely generated, then this is the universal complete module (TODO)
  with a map from `M`. This map is injective iff `M` is Hausdorff and surjective iff `M` is
  precomplete.

-/

open submodule

variables {R : Type*} [comm_ring R] (I : ideal R)
variables (M : Type*) [add_comm_group M] [module R M]
variables {N : Type*} [add_comm_group N] [module R N]

/-- A module `M` is Hausdorff with respect to an ideal `I` if `⋂ I^n M = 0`. -/
class is_Hausdorff : Prop :=
(haus' : ∀ x : M, (∀ n : ℕ, x ≡ 0 [SMOD (I ^ n • ⊤ : submodule R M)]) → x = 0)

/-- A module `M` is precomplete with respect to an ideal `I` if every Cauchy sequence converges. -/
class is_precomplete : Prop :=
(prec' : ∀ f : ℕ → M,
  (∀ {m n}, m ≤ n → f m ≡ f n [SMOD (I ^ m • ⊤ : submodule R M)]) →
  ∃ L : M, ∀ n, f n ≡ L [SMOD (I ^ n • ⊤ : submodule R M)])

/-- A module `M` is `I`-adically complete if it is Hausdorff and precomplete. -/
class is_adic_complete extends is_Hausdorff I M, is_precomplete I M : Prop

variables {I M}

theorem is_Hausdorff.haus (h : is_Hausdorff I M) :
  ∀ x : M, (∀ n : ℕ, x ≡ 0 [SMOD (I ^ n • ⊤ : submodule R M)]) → x = 0 := is_Hausdorff.haus'

theorem is_Hausdorff_iff : is_Hausdorff I M ↔
  ∀ x : M, (∀ n : ℕ, x ≡ 0 [SMOD (I ^ n • ⊤ : submodule R M)]) → x = 0 :=
⟨is_Hausdorff.haus, λ h, ⟨h⟩⟩

theorem is_precomplete.prec (h : is_precomplete I M) {f : ℕ → M} :
  (∀ {m n}, m ≤ n → f m ≡ f n [SMOD (I ^ m • ⊤ : submodule R M)]) →
  ∃ L : M, ∀ n, f n ≡ L [SMOD (I ^ n • ⊤ : submodule R M)] := is_precomplete.prec' _

theorem is_precomplete_iff : is_precomplete I M ↔ ∀ f : ℕ → M,
  (∀ {m n}, m ≤ n → f m ≡ f n [SMOD (I ^ m • ⊤ : submodule R M)]) →
  ∃ L : M, ∀ n, f n ≡ L [SMOD (I ^ n • ⊤ : submodule R M)] :=
⟨λ h, h.1, λ h, ⟨h⟩⟩

variables (I M)

/-- The Hausdorffification of a module with respect to an ideal. -/
@[reducible] def Hausdorffification : Type* :=
M ⧸ (⨅ n : ℕ, I ^ n • ⊤ : submodule R M)

/-- The completion of a module with respect to an ideal. This is not necessarily Hausdorff.
In fact, this is only complete if the ideal is finitely generated. -/
def adic_completion : submodule R (Π n : ℕ, (M ⧸ (I ^ n • ⊤ : submodule R M))) :=
{ carrier := { f | ∀ {m n} (h : m ≤ n), liftq _ (mkq _)
    (by { rw ker_mkq, exact smul_mono (ideal.pow_le_pow h) le_rfl }) (f n) = f m },
  zero_mem' := λ m n hmn, by rw [pi.zero_apply, pi.zero_apply, linear_map.map_zero],
  add_mem' := λ f g hf hg m n hmn, by rw [pi.add_apply, pi.add_apply,
    linear_map.map_add, hf hmn, hg hmn],
  smul_mem' := λ c f hf m n hmn, by rw [pi.smul_apply, pi.smul_apply, linear_map.map_smul, hf hmn] }

namespace is_Hausdorff

instance bot : is_Hausdorff (⊥ : ideal R) M :=
⟨λ x hx, by simpa only [pow_one ⊥, bot_smul, smodeq.bot] using hx 1⟩

variables {M}
protected theorem subsingleton (h : is_Hausdorff (⊤ : ideal R) M) : subsingleton M :=
⟨λ x y, eq_of_sub_eq_zero $ h.haus (x - y) $ λ n,
  by { rw [ideal.top_pow, top_smul], exact smodeq.top }⟩
variables (M)

@[priority 100] instance of_subsingleton [subsingleton M] : is_Hausdorff I M :=
⟨λ x _, subsingleton.elim _ _⟩

variables {I M}
theorem infi_pow_smul (h : is_Hausdorff I M) :
  (⨅ n : ℕ, I ^ n • ⊤ : submodule R M) = ⊥ :=
eq_bot_iff.2 $ λ x hx, (mem_bot _).2 $ h.haus x $ λ n, smodeq.zero.2 $
(mem_infi $ λ n : ℕ, I ^ n • ⊤).1 hx n

end is_Hausdorff

namespace Hausdorffification

/-- The canonical linear map to the Hausdorffification. -/
def of : M →ₗ[R] Hausdorffification I M := mkq _

variables {I M}
@[elab_as_eliminator]
lemma induction_on {C : Hausdorffification I M → Prop} (x : Hausdorffification I M)
  (ih : ∀ x, C (of I M x)) : C x :=
quotient.induction_on' x ih
variables (I M)

instance : is_Hausdorff I (Hausdorffification I M) :=
⟨λ x, quotient.induction_on' x $ λ x hx, (quotient.mk_eq_zero _).2 $ (mem_infi _).2 $ λ n, begin
  have := comap_map_mkq (⨅ n : ℕ, I ^ n • ⊤ : submodule R M) (I ^ n • ⊤),
  simp only [sup_of_le_right (infi_le (λ n, (I ^ n • ⊤ : submodule R M)) n)] at this,
  rw [← this, map_smul'', mem_comap, submodule.map_top, range_mkq, ← smodeq.zero], exact hx n
end⟩

variables {M} [h : is_Hausdorff I N]
include h

/-- universal property of Hausdorffification: any linear map to a Hausdorff module extends to a
unique map from the Hausdorffification. -/
def lift (f : M →ₗ[R] N) : Hausdorffification I M →ₗ[R] N :=
liftq _ f $ map_le_iff_le_comap.1 $ h.infi_pow_smul ▸ le_infi (λ n,
le_trans (map_mono $ infi_le _ n) $ by { rw map_smul'', exact smul_mono le_rfl le_top })

theorem lift_of (f : M →ₗ[R] N) (x : M) : lift I f (of I M x) = f x := rfl

theorem lift_comp_of (f : M →ₗ[R] N) : (lift I f).comp (of I M) = f :=
linear_map.ext $ λ _, rfl

/-- Uniqueness of lift. -/
theorem lift_eq (f : M →ₗ[R] N) (g : Hausdorffification I M →ₗ[R] N) (hg : g.comp (of I M) = f) :
  g = lift I f :=
linear_map.ext $ λ x, induction_on x $ λ x, by rw [lift_of, ← hg, linear_map.comp_apply]

end Hausdorffification

namespace is_precomplete

instance bot : is_precomplete (⊥ : ideal R) M :=
begin
  refine ⟨λ f hf, ⟨f 1, λ n, _⟩⟩, cases n,
  { rw [pow_zero, ideal.one_eq_top, top_smul], exact smodeq.top },
  specialize hf (nat.le_add_left 1 n),
  rw [pow_one, bot_smul, smodeq.bot] at hf, rw hf
end

instance top : is_precomplete (⊤ : ideal R) M :=
⟨λ f hf, ⟨0, λ n, by { rw [ideal.top_pow, top_smul], exact smodeq.top }⟩⟩

@[priority 100] instance of_subsingleton [subsingleton M] : is_precomplete I M :=
⟨λ f hf, ⟨0, λ n, by rw subsingleton.elim (f n) 0⟩⟩

end is_precomplete

namespace adic_completion

/-- The canonical linear map to the completion. -/
def of : M →ₗ[R] adic_completion I M :=
{ to_fun    := λ x, ⟨λ n, mkq _ x, λ m n hmn, rfl⟩,
  map_add'  := λ x y, rfl,
  map_smul' := λ c x, rfl }

@[simp] lemma of_apply (x : M) (n : ℕ) : (of I M x).1 n = mkq _ x := rfl

/-- Linearly evaluating a sequence in the completion at a given input. -/
def eval (n : ℕ) : adic_completion I M →ₗ[R] (M ⧸ (I ^ n • ⊤ : submodule R M)) :=
{ to_fun    := λ f, f.1 n,
  map_add'  := λ f g, rfl,
  map_smul' := λ c f, rfl }

@[simp] lemma coe_eval (n : ℕ) :
  (eval I M n : adic_completion I M → (M ⧸ (I ^ n • ⊤ : submodule R M))) = λ f, f.1 n := rfl

lemma eval_apply (n : ℕ) (f : adic_completion I M) : eval I M n f = f.1 n := rfl

lemma eval_of (n : ℕ) (x : M) : eval I M n (of I M x) = mkq _ x := rfl

@[simp] lemma eval_comp_of (n : ℕ) : (eval I M n).comp (of I M) = mkq _ := rfl

@[simp] lemma range_eval (n : ℕ) : (eval I M n).range = ⊤ :=
linear_map.range_eq_top.2 $ λ x, quotient.induction_on' x $ λ x, ⟨of I M x, rfl⟩

variables {I M}
@[ext] lemma ext {x y : adic_completion I M} (h : ∀ n, eval I M n x = eval I M n y) : x = y :=
subtype.eq $ funext h
variables (I M)

instance : is_Hausdorff I (adic_completion I M) :=
⟨λ x hx, ext $ λ n, smul_induction_on (smodeq.zero.1 $ hx n)
  (λ r hr x _, ((eval I M n).map_smul r x).symm ▸ quotient.induction_on' (eval I M n x)
    (λ x, smodeq.zero.2 $ smul_mem_smul hr mem_top))
  (λ _ _ ih1 ih2, by rw [linear_map.map_add, ih1, ih2, linear_map.map_zero, add_zero])⟩

end adic_completion

namespace is_adic_complete

instance bot : is_adic_complete (⊥ : ideal R) M := {}

protected theorem subsingleton (h : is_adic_complete (⊤ : ideal R) M) : subsingleton M :=
h.1.subsingleton

@[priority 100] instance of_subsingleton [subsingleton M] : is_adic_complete I M := {}

open_locale big_operators
open finset

lemma le_jacobson_bot [is_adic_complete I R] : I ≤ (⊥ : ideal R).jacobson :=
begin
  intros x hx,
  rw [← ideal.neg_mem_iff, ideal.mem_jacobson_bot],
  intros y,
  rw add_comm,
  let f : ℕ → R := λ n, ∑ i in range n, (x * y) ^ i,
  have hf : ∀ m n, m ≤ n → f m ≡ f n [SMOD I ^ m • (⊤ : submodule R R)],
  { intros m n h,
    simp only [f, algebra.id.smul_eq_mul, ideal.mul_top, smodeq.sub_mem],
    rw [← add_tsub_cancel_of_le h, finset.sum_range_add, ← sub_sub, sub_self, zero_sub,
      neg_mem_iff],
    apply submodule.sum_mem,
    intros n hn,
    rw [mul_pow, pow_add, mul_assoc],
    exact ideal.mul_mem_right _ (I ^ m) (ideal.pow_mem_pow hx m) },
  obtain ⟨L, hL⟩ := is_precomplete.prec to_is_precomplete hf,
  { rw is_unit_iff_exists_inv,
    use L,
    rw [← sub_eq_zero, neg_mul],
    apply is_Hausdorff.haus (to_is_Hausdorff : is_Hausdorff I R),
    intros n,
    specialize hL n,
    rw [smodeq.sub_mem, algebra.id.smul_eq_mul, ideal.mul_top] at ⊢ hL,
    rw sub_zero,
    suffices : (1 - x * y) * (f n) - 1 ∈ I ^ n,
    { convert (ideal.sub_mem _ this (ideal.mul_mem_left _ (1 + - (x * y)) hL)) using 1,
      ring },
    cases n,
    { simp only [ideal.one_eq_top, pow_zero] },
    { dsimp [f],
      rw [← neg_sub _ (1:R), neg_mul, mul_geom_sum, neg_sub,
        sub_sub, add_comm, ← sub_sub, sub_self, zero_sub, neg_mem_iff, mul_pow],
      exact ideal.mul_mem_right _ (I ^ _) (ideal.pow_mem_pow hx _), } },
end

end is_adic_complete


/-
Copyright (c) 2020 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel, Scott Morrison, Jakob von Raumer

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

/-!
# Abelian categories with enough projectives have projective resolutions

When `C` is abelian `projective.d f` and `f` are exact.
Hence, starting from an epimorphism `P ⟶ X`, where `P` is projective,
we can apply `projective.d` repeatedly to obtain a projective resolution of `X`.
-/

noncomputable section

open CategoryTheory

open CategoryTheory.Limits

open Opposite

universe v u v' u'

namespace CategoryTheory

open CategoryTheory.Projective

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

/-- When `C` is abelian, `projective.d f` and `f` are exact.
-/
theorem exact_d_f [EnoughProjectives C] {X Y : C} (f : X ⟶ Y) : Exact (d f) f :=
  (Abelian.exact_iff _ _).2 <|
    ⟨by simp, zero_of_epi_comp (π _) <| by rw [← category.assoc, cokernel.condition]⟩
#align category_theory.exact_d_f CategoryTheory.exact_d_f

/-- The preadditive Co-Yoneda functor on `P` preserves colimits if `P` is projective. -/
def preservesFiniteColimitsPreadditiveCoyonedaObjOfProjective (P : C) [hP : Projective P] :
    PreservesFiniteColimits (preadditiveCoyonedaObj (op P)) :=
  by
  letI := (projective_iff_preserves_epimorphisms_preadditive_coyoneda_obj' P).mp hP
  apply functor.preserves_finite_colimits_of_preserves_epis_and_kernels
#align category_theory.preserves_finite_colimits_preadditive_coyoneda_obj_of_projective CategoryTheory.preservesFiniteColimitsPreadditiveCoyonedaObjOfProjective

/-- An object is projective if its preadditive Co-Yoneda functor preserves finite colimits. -/
theorem projective_of_preservesFiniteColimits_preadditiveCoyonedaObj (P : C)
    [hP : PreservesFiniteColimits (preadditiveCoyonedaObj (op P))] : Projective P :=
  by
  rw [projective_iff_preserves_epimorphisms_preadditive_coyoneda_obj']
  infer_instance
#align category_theory.projective_of_preserves_finite_colimits_preadditive_coyoneda_obj CategoryTheory.projective_of_preservesFiniteColimits_preadditiveCoyonedaObj

namespace ProjectiveResolution

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

variable [EnoughProjectives C]

/-- Auxiliary definition for `ProjectiveResolution.of`. -/
@[simps]
def ofComplex (Z : C) : ChainComplex C ℕ :=
  ChainComplex.mk' (Projective.over Z) (Projective.syzygies (Projective.π Z))
    (Projective.d (Projective.π Z)) fun ⟨X, Y, f⟩ =>
    ⟨Projective.syzygies f, Projective.d f, (exact_d_f f).w⟩
#align category_theory.ProjectiveResolution.of_complex CategoryTheory.ProjectiveResolution.ofComplex

/-- In any abelian category with enough projectives,
`ProjectiveResolution.of Z` constructs a projective resolution of the object `Z`.
-/
irreducible_def of (Z : C) : ProjectiveResolution Z :=
  { complex := ofComplex Z
    π :=
      ChainComplex.mkHom _ _ (Projective.π Z) 0
        (by
          simp
          exact (exact_d_f (projective.π Z)).w.symm)
        fun n _ => ⟨0, by ext⟩
    Projective := by rintro (_ | _ | _ | n) <;> apply projective.projective_over
    exact₀ := by simpa using exact_d_f (projective.π Z)
    exact := by
      rintro (_ | n) <;>
        · simp
          apply exact_d_f
    Epi := Projective.π_epi Z }
#align category_theory.ProjectiveResolution.of CategoryTheory.ProjectiveResolution.of

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

instance (priority := 100) : HasProjectiveResolutions C where out Z := by infer_instance

end ProjectiveResolution

end CategoryTheory

namespace HomologicalComplex.Hom

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

/-- If `X` is a chain complex of projective objects and we have a quasi-isomorphism `f : X ⟶ Y[0]`,
then `X` is a projective resolution of `Y.` -/
def toSingle₀ProjectiveResolution {X : ChainComplex C ℕ} {Y : C}
    (f : X ⟶ (ChainComplex.single₀ C).obj Y) [QuasiIso f] (H : ∀ n, Projective (X.pt n)) :
    ProjectiveResolution Y where
  complex := X
  π := f
  Projective := H
  exact₀ := f.to_single₀_exact_d_f_at_zero
  exact := f.to_single₀_exact_at_succ
  Epi := f.to_single₀_epi_at_zero
#align homological_complex.hom.to_single₀_ProjectiveResolution HomologicalComplex.Hom.toSingle₀ProjectiveResolution

end HomologicalComplex.Hom


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel, Floris van Doorn, Mario Carneiro
-/
import data.list.big_operators

/-!
# Join of a list of lists

This file proves basic properties of `list.join`, which concatenates a list of lists. It is defined
in [`data.list.defs`](./data/list/defs).
-/

variables {α β : Type*}

namespace list

attribute [simp] join

@[simp] lemma join_nil : [([] : list α)].join = [] := rfl

@[simp] lemma join_eq_nil : ∀ {L : list (list α)}, join L = [] ↔ ∀ l ∈ L, l = []
| []       := iff_of_true rfl (forall_mem_nil _)
| (l :: L) := by simp only [join, append_eq_nil, join_eq_nil, forall_mem_cons]

@[simp] lemma join_append (L₁ L₂ : list (list α)) : join (L₁ ++ L₂) = join L₁ ++ join L₂ :=
by induction L₁; [refl, simp only [*, join, cons_append, append_assoc]]

@[simp] lemma join_filter_empty_eq_ff [decidable_pred (λ l : list α, l.empty = ff)] :
  ∀ {L : list (list α)}, join (L.filter (λ l, l.empty = ff)) = L.join
| []              := rfl
| ([] :: L)       := by simp [@join_filter_empty_eq_ff L]
| ((a :: l) :: L) := by simp [@join_filter_empty_eq_ff L]

@[simp] lemma join_filter_ne_nil [decidable_pred (λ l : list α, l ≠ [])] {L : list (list α)} :
  join (L.filter (λ l, l ≠ [])) = L.join :=
by simp [join_filter_empty_eq_ff, ← empty_iff_eq_nil]

lemma join_join (l : list (list (list α))) : l.join.join = (l.map join).join :=
by { induction l, simp, simp [l_ih] }

@[simp] lemma length_join (L : list (list α)) : length (join L) = sum (map length L) :=
by induction L; [refl, simp only [*, join, map, sum_cons, length_append]]

@[simp] lemma length_bind (l : list α) (f : α → list β) :
  length (list.bind l f) = sum (map (length ∘ f) l) :=
by rw [list.bind, length_join, map_map]

@[simp] lemma bind_eq_nil {l : list α} {f : α → list β} :
  list.bind l f = [] ↔ ∀ x ∈ l, f x = [] :=
join_eq_nil.trans $ by simp only [mem_map, forall_exists_index, and_imp, forall_apply_eq_imp_iff₂]

/-- In a join, taking the first elements up to an index which is the sum of the lengths of the
first `i` sublists, is the same as taking the join of the first `i` sublists. -/
lemma take_sum_join (L : list (list α)) (i : ℕ) :
  L.join.take ((L.map length).take i).sum = (L.take i).join :=
begin
  induction L generalizing i, { simp },
  cases i, { simp },
  simp [take_append, L_ih]
end

/-- In a join, dropping all the elements up to an index which is the sum of the lengths of the
first `i` sublists, is the same as taking the join after dropping the first `i` sublists. -/
lemma drop_sum_join (L : list (list α)) (i : ℕ) :
  L.join.drop ((L.map length).take i).sum = (L.drop i).join :=
begin
  induction L generalizing i, { simp },
  cases i, { simp },
  simp [drop_append, L_ih],
end

/-- Taking only the first `i+1` elements in a list, and then dropping the first `i` ones, one is
left with a list of length `1` made of the `i`-th element of the original list. -/
lemma drop_take_succ_eq_cons_nth_le (L : list α) {i : ℕ} (hi : i < L.length) :
  (L.take (i+1)).drop i = [nth_le L i hi] :=
begin
  induction L generalizing i,
  { simp only [length] at hi, exact (nat.not_succ_le_zero i hi).elim },
  cases i, { simp },
  have : i < L_tl.length,
  { simp at hi,
    exact nat.lt_of_succ_lt_succ hi },
  simp [L_ih this],
  refl
end

/-- In a join of sublists, taking the slice between the indices `A` and `B - 1` gives back the
original sublist of index `i` if `A` is the sum of the lenghts of sublists of index `< i`, and
`B` is the sum of the lengths of sublists of index `≤ i`. -/
lemma drop_take_succ_join_eq_nth_le (L : list (list α)) {i : ℕ} (hi : i < L.length) :
  (L.join.take ((L.map length).take (i+1)).sum).drop ((L.map length).take i).sum = nth_le L i hi :=
begin
  have : (L.map length).take i = ((L.take (i+1)).map length).take i, by simp [map_take, take_take],
  simp [take_sum_join, this, drop_sum_join, drop_take_succ_eq_cons_nth_le _ hi]
end

/-- Auxiliary lemma to control elements in a join. -/
lemma sum_take_map_length_lt1 (L : list (list α)) {i j : ℕ}
  (hi : i < L.length) (hj : j < (nth_le L i hi).length) :
  ((L.map length).take i).sum + j < ((L.map length).take (i+1)).sum :=
by simp [hi, sum_take_succ, hj]

/-- Auxiliary lemma to control elements in a join. -/
lemma sum_take_map_length_lt2 (L : list (list α)) {i j : ℕ}
  (hi : i < L.length) (hj : j < (nth_le L i hi).length) :
  ((L.map length).take i).sum + j < L.join.length :=
begin
  convert lt_of_lt_of_le (sum_take_map_length_lt1 L hi hj) (monotone_sum_take _ hi),
  have : L.length = (L.map length).length, by simp,
  simp [this, -length_map]
end

/-- The `n`-th element in a join of sublists is the `j`-th element of the `i`th sublist,
where `n` can be obtained in terms of `i` and `j` by adding the lengths of all the sublists
of index `< i`, and adding `j`. -/
lemma nth_le_join (L : list (list α)) {i j : ℕ}
  (hi : i < L.length) (hj : j < (nth_le L i hi).length) :
  nth_le L.join (((L.map length).take i).sum + j) (sum_take_map_length_lt2 L hi hj) =
  nth_le (nth_le L i hi) j hj :=
by rw [nth_le_take L.join (sum_take_map_length_lt2 L hi hj) (sum_take_map_length_lt1 L hi hj),
  nth_le_drop, nth_le_of_eq (drop_take_succ_join_eq_nth_le L hi)]

/-- Two lists of sublists are equal iff their joins coincide, as well as the lengths of the
sublists. -/
theorem eq_iff_join_eq (L L' : list (list α)) :
  L = L' ↔ L.join = L'.join ∧ map length L = map length L' :=
begin
  refine ⟨λ H, by simp [H], _⟩,
  rintros ⟨join_eq, length_eq⟩,
  apply ext_le,
  { have : length (map length L) = length (map length L'), by rw length_eq,
    simpa using this },
  { assume n h₁ h₂,
    rw [← drop_take_succ_join_eq_nth_le, ← drop_take_succ_join_eq_nth_le, join_eq, length_eq] }
end

end list


/-
Copyright (c) 2021 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import category_theory.arrow
import category_theory.limits.constructions.epi_mono
import category_theory.limits.creates
import category_theory.limits.unit
import category_theory.structured_arrow

/-!
# Limits and colimits in comma categories

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

We build limits in the comma category `comma L R` provided that the two source categories have
limits and `R` preserves them.
This is used to construct limits in the arrow category, structured arrow category and under
category, and show that the appropriate forgetful functors create limits.

The duals of all the above are also given.
-/

namespace category_theory
open category limits

universes w' w v u₁ u₂ u₃

variables {J : Type w} [category.{w'} J]
variables {A : Type u₁} [category.{v} A]
variables {B : Type u₂} [category.{v} B]
variables {T : Type u₃} [category.{v} T]

namespace comma

variables {L : A ⥤ T} {R : B ⥤ T}

variables (F : J ⥤ comma L R)

/-- (Implementation). An auxiliary cone which is useful in order to construct limits
in the comma category. -/
@[simps]
def limit_auxiliary_cone (c₁ : cone (F ⋙ fst L R)) :
  cone ((F ⋙ snd L R) ⋙ R) :=
(cones.postcompose (whisker_left F (comma.nat_trans L R) : _)).obj (L.map_cone c₁)

/--
If `R` preserves the appropriate limit, then given a cone for `F ⋙ fst L R : J ⥤ L` and a
limit cone for `F ⋙ snd L R : J ⥤ R` we can build a cone for `F` which will turn out to be a limit
cone.
-/
@[simps]
def cone_of_preserves [preserves_limit (F ⋙ snd L R) R]
  (c₁ : cone (F ⋙ fst L R)) {c₂ : cone (F ⋙ snd L R)} (t₂ : is_limit c₂) :
  cone F :=
{ X :=
  { left := c₁.X,
    right := c₂.X,
    hom := (is_limit_of_preserves R t₂).lift (limit_auxiliary_cone _ c₁) },
  π :=
  { app := λ j,
    { left := c₁.π.app j,
      right := c₂.π.app j,
      w' := ((is_limit_of_preserves R t₂).fac (limit_auxiliary_cone F c₁) j).symm },
    naturality' := λ j₁ j₂ t, by ext; dsimp; simp [←c₁.w t, ←c₂.w t] } }

/-- Provided that `R` preserves the appropriate limit, then the cone in `cone_of_preserves` is a
limit. -/
def cone_of_preserves_is_limit [preserves_limit (F ⋙ snd L R) R]
  {c₁ : cone (F ⋙ fst L R)} (t₁ : is_limit c₁)
  {c₂ : cone (F ⋙ snd L R)} (t₂ : is_limit c₂) :
  is_limit (cone_of_preserves F c₁ t₂) :=
{ lift := λ s,
  { left := t₁.lift ((fst L R).map_cone s),
    right := t₂.lift ((snd L R).map_cone s),
    w' := (is_limit_of_preserves R t₂).hom_ext $ λ j,
    begin
      rw [cone_of_preserves_X_hom, assoc, assoc, (is_limit_of_preserves R t₂).fac,
        limit_auxiliary_cone_π_app, ←L.map_comp_assoc, t₁.fac, R.map_cone_π_app, ←R.map_comp,
        t₂.fac],
      exact (s.π.app j).w,
    end },
  uniq' := λ s m w, comma_morphism.ext _ _
      (t₁.uniq ((fst L R).map_cone s) _ (λ j, by simp [←w]))
      (t₂.uniq ((snd L R).map_cone s) _ (λ j, by simp [←w])) }

/-- (Implementation). An auxiliary cocone which is useful in order to construct colimits
in the comma category. -/
@[simps]
def colimit_auxiliary_cocone (c₂ : cocone (F ⋙ snd L R)) :
  cocone ((F ⋙ fst L R) ⋙ L) :=
(cocones.precompose (whisker_left F (comma.nat_trans L R) : _)).obj (R.map_cocone c₂)

/--
If `L` preserves the appropriate colimit, then given a colimit cocone for `F ⋙ fst L R : J ⥤ L` and
a cocone for `F ⋙ snd L R : J ⥤ R` we can build a cocone for `F` which will turn out to be a
colimit cocone.
-/
@[simps]
def cocone_of_preserves [preserves_colimit (F ⋙ fst L R) L]
  {c₁ : cocone (F ⋙ fst L R)} (t₁ : is_colimit c₁) (c₂ : cocone (F ⋙ snd L R))  :
  cocone F :=
{ X :=
  { left := c₁.X,
    right := c₂.X,
    hom := (is_colimit_of_preserves L t₁).desc (colimit_auxiliary_cocone _ c₂) },
  ι :=
  { app := λ j,
    { left := c₁.ι.app j,
      right := c₂.ι.app j,
      w' := ((is_colimit_of_preserves L t₁).fac (colimit_auxiliary_cocone _ c₂) j) },
    naturality' := λ j₁ j₂ t, by ext; dsimp; simp [←c₁.w t, ←c₂.w t] } }

/-- Provided that `L` preserves the appropriate colimit, then the cocone in `cocone_of_preserves` is
a colimit. -/
def cocone_of_preserves_is_colimit [preserves_colimit (F ⋙ fst L R) L]
  {c₁ : cocone (F ⋙ fst L R)} (t₁ : is_colimit c₁)
  {c₂ : cocone (F ⋙ snd L R)} (t₂ : is_colimit c₂) :
  is_colimit (cocone_of_preserves F t₁ c₂) :=
{ desc := λ s,
  { left := t₁.desc ((fst L R).map_cocone s),
    right := t₂.desc ((snd L R).map_cocone s),
    w' := (is_colimit_of_preserves L t₁).hom_ext $ λ j,
    begin
      rw [cocone_of_preserves_X_hom, (is_colimit_of_preserves L t₁).fac_assoc,
        colimit_auxiliary_cocone_ι_app, assoc, ←R.map_comp, t₂.fac, L.map_cocone_ι_app,
        ←L.map_comp_assoc, t₁.fac],
      exact (s.ι.app j).w,
    end },
  uniq' := λ s m w, comma_morphism.ext _ _
      (t₁.uniq ((fst L R).map_cocone s) _ (by simp [←w]))
      (t₂.uniq ((snd L R).map_cocone s) _ (by simp [←w])) }

instance has_limit (F : J ⥤ comma L R)
  [has_limit (F ⋙ fst L R)] [has_limit (F ⋙ snd L R)]
  [preserves_limit (F ⋙ snd L R) R] :
  has_limit F :=
has_limit.mk ⟨_, cone_of_preserves_is_limit _ (limit.is_limit _) (limit.is_limit _)⟩

instance has_limits_of_shape
  [has_limits_of_shape J A] [has_limits_of_shape J B] [preserves_limits_of_shape J R] :
  has_limits_of_shape J (comma L R) := {}

instance has_limits [has_limits A] [has_limits B] [preserves_limits R] :
  has_limits (comma L R) := ⟨infer_instance⟩

instance has_colimit (F : J ⥤ comma L R)
  [has_colimit (F ⋙ fst L R)] [has_colimit (F ⋙ snd L R)]
  [preserves_colimit (F ⋙ fst L R) L] :
  has_colimit F :=
has_colimit.mk ⟨_, cocone_of_preserves_is_colimit _ (colimit.is_colimit _) (colimit.is_colimit _)⟩

instance has_colimits_of_shape
  [has_colimits_of_shape J A] [has_colimits_of_shape J B] [preserves_colimits_of_shape J L] :
  has_colimits_of_shape J (comma L R) := {}

instance has_colimits [has_colimits A] [has_colimits B] [preserves_colimits L] :
  has_colimits (comma L R) := ⟨infer_instance⟩

end comma

namespace arrow

instance has_limit (F : J ⥤ arrow T)
  [i₁ : has_limit (F ⋙ left_func)] [i₂ : has_limit (F ⋙ right_func)] :
  has_limit F :=
@@comma.has_limit _ _ _ _ _ i₁ i₂ _

instance has_limits_of_shape [has_limits_of_shape J T] : has_limits_of_shape J (arrow T) := {}
instance has_limits [has_limits T] : has_limits (arrow T) := ⟨infer_instance⟩

instance has_colimit (F : J ⥤ arrow T)
  [i₁ : has_colimit (F ⋙ left_func)] [i₂ : has_colimit (F ⋙ right_func)] :
  has_colimit F :=
@@comma.has_colimit _ _ _ _ _ i₁ i₂ _

instance has_colimits_of_shape [has_colimits_of_shape J T] : has_colimits_of_shape J (arrow T) := {}
instance has_colimits [has_colimits T] : has_colimits (arrow T) := ⟨infer_instance⟩

end arrow

namespace structured_arrow

variables {X : T} {G : A ⥤ T} (F : J ⥤ structured_arrow X G)

instance has_limit [i₁ : has_limit (F ⋙ proj X G)] [i₂ : preserves_limit (F ⋙ proj X G) G] :
  has_limit F :=
@@comma.has_limit _ _ _ _ _ _ i₁ i₂

instance has_limits_of_shape [has_limits_of_shape J A] [preserves_limits_of_shape J G] :
  has_limits_of_shape J (structured_arrow X G) := {}

instance has_limits [has_limits A] [preserves_limits G] :
  has_limits (structured_arrow X G) := ⟨infer_instance⟩

noncomputable instance creates_limit [i : preserves_limit (F ⋙ proj X G) G] :
  creates_limit F (proj X G) :=
creates_limit_of_reflects_iso $ λ c t,
{ lifted_cone := @@comma.cone_of_preserves _ _ _ _ _ i punit_cone t,
  makes_limit := comma.cone_of_preserves_is_limit _ punit_cone_is_limit _,
  valid_lift := cones.ext (iso.refl _) $ λ j, (id_comp _).symm }

noncomputable instance creates_limits_of_shape [preserves_limits_of_shape J G] :
  creates_limits_of_shape J (proj X G) := {}

noncomputable instance creates_limits [preserves_limits G] :
  creates_limits (proj X G : _) := ⟨⟩

instance mono_right_of_mono [has_pullbacks A] [preserves_limits_of_shape walking_cospan G]
  {Y Z : structured_arrow X G} (f : Y ⟶ Z) [mono f] : mono f.right :=
show mono ((proj X G).map f), from infer_instance

lemma mono_iff_mono_right [has_pullbacks A] [preserves_limits_of_shape walking_cospan G]
  {Y Z : structured_arrow X G} (f : Y ⟶ Z) : mono f ↔ mono f.right :=
⟨λ h, by exactI infer_instance, λ h, by exactI mono_of_mono_right f⟩

end structured_arrow

namespace costructured_arrow

variables {G : A ⥤ T} {X : T} (F : J ⥤ costructured_arrow G X)

instance has_colimit [i₁ : has_colimit (F ⋙ proj G X)] [i₂ : preserves_colimit (F ⋙ proj G X) G] :
  has_colimit F :=
@@comma.has_colimit _ _ _ _ _ i₁ _ i₂

instance has_colimits_of_shape [has_colimits_of_shape J A] [preserves_colimits_of_shape J G] :
  has_colimits_of_shape J (costructured_arrow G X) := {}

instance has_colimits [has_colimits A] [preserves_colimits G] :
  has_colimits (costructured_arrow G X) := ⟨infer_instance⟩

noncomputable instance creates_colimit [i : preserves_colimit (F ⋙ proj G X) G] :
  creates_colimit F (proj G X) :=
creates_colimit_of_reflects_iso $ λ c t,
{ lifted_cocone := @@comma.cocone_of_preserves _ _ _ _ _ i t punit_cocone,
  makes_colimit := comma.cocone_of_preserves_is_colimit _ _ punit_cocone_is_colimit,
  valid_lift := cocones.ext (iso.refl _) $ λ j, comp_id _ }

noncomputable instance creates_colimits_of_shape [preserves_colimits_of_shape J G] :
  creates_colimits_of_shape J (proj G X) := {}

noncomputable instance creates_colimits [preserves_colimits G] :
  creates_colimits (proj G X : _) := ⟨⟩

instance epi_left_of_epi [has_pushouts A] [preserves_colimits_of_shape walking_span G]
  {Y Z : costructured_arrow G X} (f : Y ⟶ Z) [epi f] : epi f.left :=
show epi ((proj G X).map f), from infer_instance

lemma epi_iff_epi_left [has_pushouts A] [preserves_colimits_of_shape walking_span G]
  {Y Z : costructured_arrow G X} (f : Y ⟶ Z) : epi f ↔ epi f.left :=
⟨λ h, by exactI infer_instance, λ h, by exactI epi_of_epi_left f⟩

end costructured_arrow

end category_theory


/-
Copyright (c) 2016 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro

! This file was ported from Lean 3 source module logic.function.basic
! leanprover-community/mathlib commit d6aae1bcbd04b8de2022b9b83a5b5b10e10c777d
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Logic.Nonempty
import Mathlib.Init.Data.Nat.Lemmas
import Mathlib.Init.Set
import Mathlib.Util.WhatsNew

/-!
# Miscellaneous function constructions and lemmas
-/

open Function

universe u v w

namespace Function

section

variable {α β γ : Sort _} {f : α → β}

/-- Evaluate a function at an argument. Useful if you want to talk about the partially applied
  `Function.eval x : (∀ x, β x) → β x`. -/
@[reducible, simp] def eval {β : α → Sort _} (x : α) (f : ∀ x, β x) : β x := f x
#align function.eval Function.eval

theorem eval_apply {β : α → Sort _} (x : α) (f : ∀ x, β x) : eval x f = f x :=
  rfl
#align function.eval_apply Function.eval_apply

theorem const_def {y : β} : (fun _ : α ↦ y) = const α y :=
  rfl
#align function.const_def Function.const_def

@[simp]
theorem const_comp {f : α → β} {c : γ} : const β c ∘ f = const α c :=
  rfl
#align function.const_comp Function.const_comp

@[simp]
theorem comp_const {f : β → γ} {b : β} : f ∘ const α b = const α (f b) :=
  rfl
#align function.comp_const Function.comp_const

theorem const_injective [Nonempty α] : Injective (const α : β → α → β) := fun y₁ y₂ h ↦
  let ⟨x⟩ := ‹Nonempty α›
  congr_fun h x
#align function.const_injective Function.const_injective

@[simp]
theorem const_inj [Nonempty α] {y₁ y₂ : β} : const α y₁ = const α y₂ ↔ y₁ = y₂ :=
  ⟨fun h ↦ const_injective h, fun h ↦ h ▸ rfl⟩
#align function.const_inj Function.const_inj

theorem id_def : @id α = fun x ↦ x :=
  rfl
#align function.id_def Function.id_def

lemma hfunext {α α': Sort u} {β : α → Sort v} {β' : α' → Sort v} {f : ∀a, β a} {f' : ∀a, β' a}
  (hα : α = α') (h : ∀a a', HEq a a' → HEq (f a) (f' a')) : HEq f f' := by
  subst hα
  have : ∀a, HEq (f a) (f' a) := λ a => h a a (HEq.refl a)
  have : β = β' := by funext a
                      exact type_eq_of_heq (this a)
  subst this
  apply heq_of_eq
  funext a
  exact eq_of_heq (this a)
#align function.hfunext Function.hfunext

theorem funext_iff {β : α → Sort _} {f₁ f₂ : ∀ x : α, β x} : f₁ = f₂ ↔ ∀ a, f₁ a = f₂ a :=
  Iff.intro (fun h _ ↦ h ▸ rfl) funext
#align function.funext_iff Function.funext_iff

theorem ne_iff {β : α → Sort _} {f₁ f₂ : ∀ a, β a} : f₁ ≠ f₂ ↔ ∃ a, f₁ a ≠ f₂ a :=
  funext_iff.not.trans not_forall
#align function.ne_iff Function.ne_iff

protected theorem Bijective.injective {f : α → β} (hf : Bijective f) : Injective f := hf.1
#align function.bijective.injective Function.Bijective.injective
protected theorem Bijective.surjective {f : α → β} (hf : Bijective f) : Surjective f := hf.2
#align function.bijective.surjective Function.Bijective.surjective

theorem Injective.eq_iff (I : Injective f) {a b : α} : f a = f b ↔ a = b :=
  ⟨@I _ _, congr_arg f⟩
#align function.injective.eq_iff Function.Injective.eq_iff

theorem Injective.beq_eq [BEq α] [LawfulBEq α] [BEq β] [LawfulBEq β]
    (I : Injective f) {a b : α} : (f a == f b) = (a == b) := by
  by_cases h : a == b <;> simp [h] <;> simpa [I.eq_iff] using h

theorem Injective.eq_iff' (I : Injective f) {a b : α} {c : β} (h : f b = c) : f a = c ↔ a = b :=
  h ▸ I.eq_iff
#align function.injective.eq_iff' Function.Injective.eq_iff'

theorem Injective.ne (hf : Injective f) {a₁ a₂ : α} : a₁ ≠ a₂ → f a₁ ≠ f a₂ :=
  mt fun h ↦ hf h
#align function.injective.ne Function.Injective.ne

theorem Injective.ne_iff (hf : Injective f) {x y : α} : f x ≠ f y ↔ x ≠ y :=
  ⟨mt <| congr_arg f, hf.ne⟩
#align function.injective.ne_iff Function.Injective.ne_iff

theorem Injective.ne_iff' (hf : Injective f) {x y : α} {z : β} (h : f y = z) : f x ≠ z ↔ x ≠ y :=
  h ▸ hf.ne_iff
#align function.injective.ne_iff' Function.Injective.ne_iff'

/-- If the co-domain `β` of an injective function `f : α → β` has decidable equality, then
the domain `α` also has decidable equality. -/
protected def Injective.decidableEq [DecidableEq β] (I : Injective f) : DecidableEq α :=
  fun _ _ ↦ decidable_of_iff _ I.eq_iff
#align function.injective.decidable_eq Function.Injective.decidableEq

theorem Injective.of_comp {g : γ → α} (I : Injective (f ∘ g)) : Injective g := fun x y h ↦
  I <| show f (g x) = f (g y) from congr_arg f h
#align function.injective.of_comp Function.Injective.of_comp

theorem Injective.of_comp_iff {f : α → β} (hf : Injective f) (g : γ → α) :
    Injective (f ∘ g) ↔ Injective g :=
  ⟨Injective.of_comp, hf.comp⟩
#align function.injective.of_comp_iff Function.Injective.of_comp_iff

theorem Injective.of_comp_iff' (f : α → β) {g : γ → α} (hg : Bijective g) :
    Injective (f ∘ g) ↔ Injective f :=
⟨ λ h x y => let ⟨_, hx⟩ := hg.surjective x
             let ⟨_, hy⟩ := hg.surjective y
             hx ▸ hy ▸ λ hf => h hf ▸ rfl,
  λ h => h.comp hg.injective⟩
#align function.injective.of_comp_iff' Function.Injective.of_comp_iff'

/-- Composition by an injective function on the left is itself injective. -/
theorem Injective.comp_left {g : β → γ} (hg : Function.Injective g) :
    Function.Injective ((· ∘ ·) g : (α → β) → α → γ) :=
  fun _ _ hgf ↦ funext fun i ↦ hg <| (congr_fun hgf i : _)
#align function.injective.comp_left Function.Injective.comp_left

theorem injective_of_subsingleton [Subsingleton α] (f : α → β) : Injective f :=
  fun _ _ _ ↦ Subsingleton.elim _ _
#align function.injective_of_subsingleton Function.injective_of_subsingleton

lemma Injective.dite (p : α → Prop) [DecidablePred p]
  {f : {a : α // p a} → β} {f' : {a : α // ¬ p a} → β}
  (hf : Injective f) (hf' : Injective f')
  (im_disj : ∀ {x x' : α} {hx : p x} {hx' : ¬ p x'}, f ⟨x, hx⟩ ≠ f' ⟨x', hx'⟩) :
  Function.Injective (λ x => if h : p x then f ⟨x, h⟩ else f' ⟨x, h⟩) :=
by intros x₁ x₂ h
   dsimp only at h
   by_cases h₁ : p x₁ <;> by_cases h₂ : p x₂
   · rw [dif_pos h₁, dif_pos h₂] at h; injection (hf h)
   · rw [dif_pos h₁, dif_neg h₂] at h; exact (im_disj h).elim
   · rw [dif_neg h₁, dif_pos h₂] at h; exact (im_disj h.symm).elim
   · rw [dif_neg h₁, dif_neg h₂] at h; injection (hf' h)
#align function.injective.dite Function.Injective.dite

theorem Surjective.of_comp {g : γ → α} (S : Surjective (f ∘ g)) : Surjective f := fun y ↦
  let ⟨x, h⟩ := S y
  ⟨g x, h⟩
#align function.surjective.of_comp Function.Surjective.of_comp

theorem Surjective.of_comp_iff (f : α → β) {g : γ → α} (hg : Surjective g) :
    Surjective (f ∘ g) ↔ Surjective f :=
  ⟨Surjective.of_comp, fun h ↦ h.comp hg⟩
#align function.surjective.of_comp_iff Function.Surjective.of_comp_iff

theorem Surjective.of_comp_iff' (hf : Bijective f) (g : γ → α) :
    Surjective (f ∘ g) ↔ Surjective g :=
  ⟨fun h x ↦
    let ⟨x', hx'⟩ := h (f x)
    ⟨x', hf.injective hx'⟩,
    hf.surjective.comp⟩
#align function.surjective.of_comp_iff' Function.Surjective.of_comp_iff'

instance decidableEqPfun (p : Prop) [Decidable p] (α : p → Type _) [∀ hp, DecidableEq (α hp)] :
    DecidableEq (∀ hp, α hp)
  | f, g => decidable_of_iff (∀ hp, f hp = g hp) funext_iff.symm

protected theorem Surjective.forall (hf : Surjective f) {p : β → Prop} :
    (∀ y, p y) ↔ ∀ x, p (f x) :=
  ⟨fun h x ↦ h (f x), fun h y ↦
    let ⟨x, hx⟩ := hf y
    hx ▸ h x⟩
#align function.surjective.forall Function.Surjective.forall

protected theorem Surjective.forall₂ (hf : Surjective f) {p : β → β → Prop} :
    (∀ y₁ y₂, p y₁ y₂) ↔ ∀ x₁ x₂, p (f x₁) (f x₂) :=
  hf.forall.trans $ forall_congr' fun _ ↦ hf.forall
#align function.surjective.forall₂ Function.Surjective.forall₂

protected theorem Surjective.forall₃ (hf : Surjective f) {p : β → β → β → Prop} :
    (∀ y₁ y₂ y₃, p y₁ y₂ y₃) ↔ ∀ x₁ x₂ x₃, p (f x₁) (f x₂) (f x₃) :=
  hf.forall.trans $ forall_congr' fun _ ↦ hf.forall₂
#align function.surjective.forall₃ Function.Surjective.forall₃

protected theorem Surjective.exists (hf : Surjective f) {p : β → Prop} :
    (∃ y, p y) ↔ ∃ x, p (f x) :=
  ⟨fun ⟨y, hy⟩ ↦
    let ⟨x, hx⟩ := hf y
    ⟨x, hx.symm ▸ hy⟩,
    fun ⟨x, hx⟩ ↦ ⟨f x, hx⟩⟩
#align function.surjective.exists Function.Surjective.exists

protected theorem Surjective.exists₂ (hf : Surjective f) {p : β → β → Prop} :
    (∃ y₁ y₂, p y₁ y₂) ↔ ∃ x₁ x₂, p (f x₁) (f x₂) :=
  hf.exists.trans <| exists_congr fun _ ↦ hf.exists
#align function.surjective.exists₂ Function.Surjective.exists₂

protected theorem Surjective.exists₃ (hf : Surjective f) {p : β → β → β → Prop} :
    (∃ y₁ y₂ y₃, p y₁ y₂ y₃) ↔ ∃ x₁ x₂ x₃, p (f x₁) (f x₂) (f x₃) :=
  hf.exists.trans <| exists_congr fun _ ↦ hf.exists₂
#align function.surjective.exists₃ Function.Surjective.exists₃

theorem Surjective.injective_comp_right (hf : Surjective f) : Injective fun g : β → γ ↦ g ∘ f :=
  fun _ _ h ↦ funext <| hf.forall.2 <| congr_fun h
#align function.surjective.injective_comp_right Function.Surjective.injective_comp_right

protected theorem Surjective.right_cancellable (hf : Surjective f) {g₁ g₂ : β → γ} :
    g₁ ∘ f = g₂ ∘ f ↔ g₁ = g₂ :=
  hf.injective_comp_right.eq_iff
#align function.surjective.right_cancellable Function.Surjective.right_cancellable

theorem surjective_of_right_cancellable_Prop (h : ∀ g₁ g₂ : β → Prop, g₁ ∘ f = g₂ ∘ f → g₁ = g₂) :
    Surjective f := by
  specialize h (fun y ↦ ∃ x, f x = y) (fun _ ↦ True) (funext fun x ↦ eq_true ⟨_, rfl⟩)
  intro y; rw [congr_fun h y]; trivial
#align function.surjective_of_right_cancellable_Prop Function.surjective_of_right_cancellable_Prop

theorem bijective_iff_existsUnique (f : α → β) : Bijective f ↔ ∀ b : β, ∃! a : α, f a = b :=
  ⟨fun hf b ↦
      let ⟨a, ha⟩ := hf.surjective b
      ⟨a, ha, fun _ ha' ↦ hf.injective (ha'.trans ha.symm)⟩,
    fun he ↦ ⟨fun {_a a'} h ↦ (he (f a')).unique h rfl, fun b ↦ (he b).exists⟩⟩
#align function.bijective_iff_exists_unique Function.bijective_iff_existsUnique

/-- Shorthand for using projection notation with `Function.bijective_iff_existsUnique`. -/
protected theorem Bijective.existsUnique {f : α → β} (hf : Bijective f) (b : β) :
    ∃! a : α, f a = b :=
  (bijective_iff_existsUnique f).mp hf b
#align function.bijective.exists_unique Function.Bijective.existsUnique

theorem Bijective.existsUnique_iff {f : α → β} (hf : Bijective f) {p : β → Prop} :
    (∃! y, p y) ↔ ∃! x, p (f x) :=
  ⟨fun ⟨y, hpy, hy⟩ ↦
    let ⟨x, hx⟩ := hf.surjective y
    ⟨x, by simpa [hx], fun z (hz : p (f z)) ↦ hf.injective <| hx.symm ▸ hy _ hz⟩,
    fun ⟨x, hpx, hx⟩ ↦
    ⟨f x, hpx, fun y hy ↦
      let ⟨z, hz⟩ := hf.surjective y
      hz ▸ congr_arg f (hx _ (by simpa [hz]))⟩⟩
#align function.bijective.exists_unique_iff Function.Bijective.existsUnique_iff

theorem Bijective.of_comp_iff (f : α → β) {g : γ → α} (hg : Bijective g) :
    Bijective (f ∘ g) ↔ Bijective f :=
  and_congr (Injective.of_comp_iff' _ hg) (Surjective.of_comp_iff _ hg.surjective)
#align function.bijective.of_comp_iff Function.Bijective.of_comp_iff

theorem Bijective.of_comp_iff' {f : α → β} (hf : Bijective f) (g : γ → α) :
    Function.Bijective (f ∘ g) ↔ Function.Bijective g :=
  and_congr (Injective.of_comp_iff hf.injective _) (Surjective.of_comp_iff' hf _)
#align function.bijective.of_comp_iff' Function.Bijective.of_comp_iff'

/-- **Cantor's diagonal argument** implies that there are no surjective functions from `α`
to `Set α`. -/
theorem cantor_surjective {α} (f : α → Set α) : ¬Surjective f
  | h => let ⟨D, e⟩ := h (λ a => ¬ f a a)
        (@iff_not_self (f D D)) $ iff_of_eq (congr_fun e D)
#align function.cantor_surjective Function.cantor_surjective

/-- **Cantor's diagonal argument** implies that there are no injective functions from `Set α`
to `α`. -/
theorem cantor_injective {α : Type _} (f : Set α → α) : ¬Injective f
| i => cantor_surjective (λ a b => ∀ U, a = f U → U b) $
       RightInverse.surjective
         (λ U => funext $ λ _a => propext ⟨λ h => h U rfl, λ h' _U e => i e ▸ h'⟩)
#align function.cantor_injective Function.cantor_injective

/-- There is no surjection from `α : Type u` into `Type u`. This theorem
  demonstrates why `Type : Type` would be inconsistent in Lean. -/
theorem not_surjective_Type {α : Type u} (f : α → Type max u v) : ¬Surjective f := by
  intro hf
  let T : Type max u v := Sigma f
  cases' hf (Set T) with U hU
  let g : Set T → T := fun s ↦ ⟨U, cast hU.symm s⟩
  have hg : Injective g := by
    intro s t h
    suffices cast hU (g s).2 = cast hU (g t).2 by
      simp only [cast_cast, cast_eq] at this
      assumption
    · congr
  exact cantor_injective g hg
#align function.not_surjective_Type Function.not_surjective_Type

/-- `g` is a partial inverse to `f` (an injective but not necessarily
  surjective function) if `g y = some x` implies `f x = y`, and `g y = none`
  implies that `y` is not in the range of `f`. -/
def IsPartialInv {α β} (f : α → β) (g : β → Option α) : Prop :=
  ∀ x y, g y = some x ↔ f x = y
#align function.is_partial_inv Function.IsPartialInv

theorem isPartialInv_left {α β} {f : α → β} {g} (H : IsPartialInv f g) (x) : g (f x) = some x :=
  (H _ _).2 rfl
#align function.is_partial_inv_left Function.isPartialInv_left

theorem injective_of_isPartialInv {α β} {f : α → β} {g} (H : IsPartialInv f g) :
    Injective f := fun _ _ h ↦
  Option.some.inj <| ((H _ _).2 h).symm.trans ((H _ _).2 rfl)
#align function.injective_of_partial_inv Function.injective_of_isPartialInv

theorem injective_of_isPartialInv_right {α β} {f : α → β} {g} (H : IsPartialInv f g) (x y b)
    (h₁ : b ∈ g x) (h₂ : b ∈ g y) : x = y :=
  ((H _ _).1 h₁).symm.trans ((H _ _).1 h₂)
#align function.injective_of_partial_inv_right Function.injective_of_isPartialInv_right

theorem LeftInverse.comp_eq_id {f : α → β} {g : β → α} (h : LeftInverse f g) : f ∘ g = id :=
  funext h
#align function.left_inverse.comp_eq_id Function.LeftInverse.comp_eq_id

theorem leftInverse_iff_comp {f : α → β} {g : β → α} : LeftInverse f g ↔ f ∘ g = id :=
  ⟨LeftInverse.comp_eq_id, congr_fun⟩
#align function.left_inverse_iff_comp Function.leftInverse_iff_comp

theorem RightInverse.comp_eq_id {f : α → β} {g : β → α} (h : RightInverse f g) : g ∘ f = id :=
  funext h
#align function.right_inverse.comp_eq_id Function.RightInverse.comp_eq_id

theorem rightInverse_iff_comp {f : α → β} {g : β → α} : RightInverse f g ↔ g ∘ f = id :=
  ⟨RightInverse.comp_eq_id, congr_fun⟩
#align function.right_inverse_iff_comp Function.rightInverse_iff_comp

theorem LeftInverse.comp {f : α → β} {g : β → α} {h : β → γ} {i : γ → β} (hf : LeftInverse f g)
    (hh : LeftInverse h i) : LeftInverse (h ∘ f) (g ∘ i) :=
  fun a ↦ show h (f (g (i a))) = a by rw [hf (i a), hh a]
#align function.left_inverse.comp Function.LeftInverse.comp

theorem RightInverse.comp {f : α → β} {g : β → α} {h : β → γ} {i : γ → β} (hf : RightInverse f g)
    (hh : RightInverse h i) : RightInverse (h ∘ f) (g ∘ i) :=
  LeftInverse.comp hh hf
#align function.right_inverse.comp Function.RightInverse.comp

theorem LeftInverse.rightInverse {f : α → β} {g : β → α} (h : LeftInverse g f) : RightInverse f g :=
  h

#align function.left_inverse.right_inverse Function.LeftInverse.rightInverse

theorem RightInverse.leftInverse {f : α → β} {g : β → α} (h : RightInverse g f) : LeftInverse f g :=
  h

#align function.right_inverse.left_inverse Function.RightInverse.leftInverse

theorem LeftInverse.surjective {f : α → β} {g : β → α} (h : LeftInverse f g) : Surjective f :=
  h.rightInverse.surjective
#align function.left_inverse.surjective Function.LeftInverse.surjective

theorem RightInverse.injective {f : α → β} {g : β → α} (h : RightInverse f g) : Injective f :=
  h.leftInverse.injective
#align function.right_inverse.injective Function.RightInverse.injective

theorem LeftInverse.rightInverse_of_injective {f : α → β} {g : β → α} (h : LeftInverse f g)
    (hf : Injective f) : RightInverse f g :=
  fun x ↦ hf <| h (f x)
#align function.left_inverse.right_inverse_of_injective Function.LeftInverse.rightInverse_of_injective

theorem LeftInverse.rightInverse_of_surjective {f : α → β} {g : β → α} (h : LeftInverse f g)
    (hg : Surjective g) : RightInverse f g :=
  fun x ↦ let ⟨y, hy⟩ := hg x; hy ▸ congr_arg g (h y)
#align function.left_inverse.right_inverse_of_surjective Function.LeftInverse.rightInverse_of_surjective

theorem RightInverse.leftInverse_of_surjective {f : α → β} {g : β → α} :
    RightInverse f g → Surjective f → LeftInverse f g :=
  LeftInverse.rightInverse_of_surjective
#align function.right_inverse.left_inverse_of_surjective Function.RightInverse.leftInverse_of_surjective

theorem RightInverse.leftInverse_of_injective {f : α → β} {g : β → α} :
    RightInverse f g → Injective g → LeftInverse f g :=
  LeftInverse.rightInverse_of_injective
#align function.right_inverse.left_inverse_of_injective Function.RightInverse.leftInverse_of_injective

theorem LeftInverse.eq_rightInverse {f : α → β} {g₁ g₂ : β → α} (h₁ : LeftInverse g₁ f)
    (h₂ : RightInverse g₂ f) : g₁ = g₂ :=
  calc
    g₁ = g₁ ∘ f ∘ g₂ := by rw [h₂.comp_eq_id, comp.right_id]
     _ = g₂ := by rw [← comp.assoc, h₁.comp_eq_id, comp.left_id]
#align function.left_inverse.eq_right_inverse Function.LeftInverse.eq_rightInverse

attribute [local instance] Classical.propDecidable

/-- We can use choice to construct explicitly a partial inverse for
  a given injective function `f`. -/
noncomputable def partialInv {α β} (f : α → β) (b : β) : Option α :=
  if h : ∃ a, f a = b then some (Classical.choose h) else none
#align function.partial_inv Function.partialInv

theorem partialInv_of_injective {α β} {f : α → β} (I : Injective f) : IsPartialInv f (partialInv f)
| a, b =>
⟨λ h => have hpi : partialInv f b = if h : ∃ a, f a = b then some (Classical.choose h) else none :=
          rfl
        if h' : ∃ a, f a = b
        then by rw [hpi, dif_pos h'] at h
                injection h with h
                subst h
                apply Classical.choose_spec h'
        else by rw [hpi, dif_neg h'] at h; contradiction,
 λ e => e ▸ have h : ∃ a', f a' = f a := ⟨_, rfl⟩
            (dif_pos h).trans (congr_arg _ (I $ Classical.choose_spec h))⟩
#align function.partial_inv_of_injective Function.partialInv_of_injective

theorem partialInv_left {α β} {f : α → β} (I : Injective f) : ∀ x, partialInv f (f x) = some x :=
  isPartialInv_left (partialInv_of_injective I)
#align function.partial_inv_left Function.partialInv_left

end

section InvFun

variable {α β : Sort _} [Nonempty α] {f : α → β} {a : α} {b : β}

attribute [local instance] Classical.propDecidable

/-- The inverse of a function (which is a left inverse if `f` is injective
  and a right inverse if `f` is surjective). -/
-- Explicit Sort so that `α` isn't inferred to be Prop via `exists_prop_decidable`
noncomputable def invFun {α : Sort u} {β} [Nonempty α] (f : α → β) : β → α :=
  fun y ↦ if h : (∃ x, f x = y) then h.choose else Classical.arbitrary α
#align function.inv_fun Function.invFun

theorem invFun_eq (h : ∃ a, f a = b) : f (invFun f b) = b :=
  by simp only [invFun, dif_pos h, h.choose_spec]
#align function.inv_fun_eq Function.invFun_eq

theorem invFun_neg (h : ¬∃ a, f a = b) : invFun f b = Classical.choice ‹_› :=
  dif_neg h
#align function.inv_fun_neg Function.invFun_neg

theorem invFun_eq_of_injective_of_rightInverse {g : β → α} (hf : Injective f)
    (hg : RightInverse g f) : invFun f = g :=
  funext fun b ↦
    hf
      (by
        rw [hg b]
        exact invFun_eq ⟨g b, hg b⟩)
#align function.inv_fun_eq_of_injective_of_right_inverse Function.invFun_eq_of_injective_of_rightInverse

theorem rightInverse_invFun (hf : Surjective f) : RightInverse (invFun f) f :=
  fun b ↦ invFun_eq <| hf b
#align function.right_inverse_inv_fun Function.rightInverse_invFun

theorem leftInverse_invFun (hf : Injective f) : LeftInverse (invFun f) f :=
  fun b ↦ hf <| invFun_eq ⟨b, rfl⟩
#align function.left_inverse_inv_fun Function.leftInverse_invFun

theorem invFun_surjective (hf : Injective f) : Surjective (invFun f) :=
  (leftInverse_invFun hf).surjective
#align function.inv_fun_surjective Function.invFun_surjective

theorem invFun_comp (hf : Injective f) : invFun f ∘ f = id :=
  funext <| leftInverse_invFun hf
#align function.inv_fun_comp Function.invFun_comp

theorem Injective.hasLeftInverse (hf : Injective f) : HasLeftInverse f :=
  ⟨invFun f, leftInverse_invFun hf⟩
#align function.injective.has_left_inverse Function.Injective.hasLeftInverse

theorem injective_iff_hasLeftInverse : Injective f ↔ HasLeftInverse f :=
  ⟨Injective.hasLeftInverse, HasLeftInverse.injective⟩
#align function.injective_iff_has_left_inverse Function.injective_iff_hasLeftInverse

end InvFun

section SurjInv

variable {α : Sort u} {β : Sort v} {γ : Sort w} {f : α → β}

/-- The inverse of a surjective function. (Unlike `invFun`, this does not require
  `α` to be inhabited.) -/
noncomputable def surjInv {f : α → β} (h : Surjective f) (b : β) : α :=
  Classical.choose (h b)
#align function.surj_inv Function.surjInv

theorem surjInv_eq (h : Surjective f) (b) : f (surjInv h b) = b :=
  Classical.choose_spec (h b)
#align function.surj_inv_eq Function.surjInv_eq

theorem rightInverse_surjInv (hf : Surjective f) : RightInverse (surjInv hf) f :=
  surjInv_eq hf
#align function.right_inverse_surj_inv Function.rightInverse_surjInv

theorem leftInverse_surjInv (hf : Bijective f) : LeftInverse (surjInv hf.2) f :=
  rightInverse_of_injective_of_leftInverse hf.1 (rightInverse_surjInv hf.2)
#align function.left_inverse_surj_inv Function.leftInverse_surjInv

theorem surjective_iff_hasRightInverse : Surjective f ↔ HasRightInverse f :=
  ⟨Surjective.hasRightInverse, HasRightInverse.surjective⟩
#align function.surjective_iff_has_right_inverse Function.surjective_iff_hasRightInverse

theorem bijective_iff_has_inverse : Bijective f ↔ ∃ g, LeftInverse g f ∧ RightInverse g f :=
  ⟨fun hf ↦ ⟨_, leftInverse_surjInv hf, rightInverse_surjInv hf.2⟩, fun ⟨_, gl, gr⟩ ↦
    ⟨gl.injective, gr.surjective⟩⟩
#align function.bijective_iff_has_inverse Function.bijective_iff_has_inverse

theorem injective_surjInv (h : Surjective f) : Injective (surjInv h) :=
  (rightInverse_surjInv h).injective
#align function.injective_surj_inv Function.injective_surjInv

theorem surjective_to_subsingleton [na : Nonempty α] [Subsingleton β] (f : α → β) :
    Surjective f :=
  fun _ ↦ let ⟨a⟩ := na; ⟨a, Subsingleton.elim _ _⟩
#align function.surjective_to_subsingleton Function.surjective_to_subsingleton

/-- Composition by an surjective function on the left is itself surjective. -/
theorem Surjective.comp_left {g : β → γ} (hg : Surjective g) :
    Surjective ((· ∘ ·) g : (α → β) → α → γ) := fun f ↦
  ⟨surjInv hg ∘ f, funext fun _ ↦ rightInverse_surjInv _ _⟩
#align function.surjective.comp_left Function.Surjective.comp_left

/-- Composition by an bijective function on the left is itself bijective. -/
theorem Bijective.comp_left {g : β → γ} (hg : Bijective g) :
    Bijective ((· ∘ ·) g : (α → β) → α → γ) :=
  ⟨hg.injective.comp_left, hg.surjective.comp_left⟩
#align function.bijective.comp_left Function.Bijective.comp_left

end SurjInv

section Update

variable {α : Sort u} {β : α → Sort v} {α' : Sort w} [DecidableEq α] [DecidableEq α']
  {f g : (a : α) → β a} {a : α} {b : β a}

/-- Replacing the value of a function at a given point by a given value. -/
def update (f : ∀ a, β a) (a' : α) (v : β a') (a : α) : β a :=
  if h : a = a' then Eq.ndrec v h.symm else f a
#align function.update Function.update

/-- On non-dependent functions, `Function.update` can be expressed as an `ite` -/
theorem update_apply {β : Sort _} (f : α → β) (a' : α) (b : β) (a : α) :
    update f a' b a = if a = a' then b else f a :=
by have h2 : (h : a = a') → Eq.rec (motive := λ _ _ => β) b h.symm = b :=
     by intro h
        rw [eq_rec_constant]
   have h3 : (λ h : a = a' => Eq.rec (motive := λ _ _ => β) b h.symm) =
             (λ _ : a = a' =>  b) := funext h2
   let f := λ x => dite (a = a') x (λ (_: ¬ a = a') => (f a))
   exact congrArg f h3
#align function.update_apply Function.update_apply

@[simp]
theorem update_same (a : α) (v : β a) (f : ∀ a, β a) : update f a v a = v :=
  dif_pos rfl
#align function.update_same Function.update_same

theorem surjective_eval {α : Sort u} {β : α → Sort v} [h : ∀ a, Nonempty (β a)] (a : α) :
    Surjective (eval a : (∀ a, β a) → β a) := fun b ↦
  ⟨@update _ _ (Classical.decEq α) (fun a ↦ (h a).some) a b,
   @update_same _ _ (Classical.decEq α) _ _ _⟩
#align function.surjective_eval Function.surjective_eval

theorem update_injective (f : ∀ a, β a) (a' : α) : Injective (update f a') := fun v v' h ↦ by
  have := congr_fun h a'
  rwa [update_same, update_same] at this
#align function.update_injective Function.update_injective

@[simp]
theorem update_noteq {a a' : α} (h : a ≠ a') (v : β a') (f : ∀ a, β a) : update f a' v a = f a :=
  dif_neg h
#align function.update_noteq Function.update_noteq

lemma forall_update_iff (f : ∀a, β a) {a : α} {b : β a} (p : ∀a, β a → Prop) :
  (∀ x, p x (update f a b x)) ↔ p a b ∧ ∀ x, x ≠ a → p x (f x) := by
  rw [← and_forall_ne a, update_same]
  simp (config := { contextual := true })
#align function.forall_update_iff Function.forall_update_iff

theorem exists_update_iff (f : ∀ a, β a) {a : α} {b : β a} (p : ∀ a, β a → Prop) :
    (∃ x, p x (update f a b x)) ↔ p a b ∨ ∃ (x : _)(_ : x ≠ a), p x (f x) := by
  rw [← not_forall_not, forall_update_iff f fun a b ↦ ¬p a b]
  simp [-not_and, not_and_or]
#align function.exists_update_iff Function.exists_update_iff

theorem update_eq_iff {a : α} {b : β a} {f g : ∀ a, β a} :
    update f a b = g ↔ b = g a ∧ ∀ (x) (_ : x ≠ a), f x = g x :=
  funext_iff.trans <| forall_update_iff _ fun x y ↦ y = g x
#align function.update_eq_iff Function.update_eq_iff

theorem eq_update_iff {a : α} {b : β a} {f g : ∀ a, β a} :
    g = update f a b ↔ g a = b ∧ ∀ (x) (_ : x ≠ a), g x = f x :=
  funext_iff.trans <| forall_update_iff _ fun x y ↦ g x = y
#align function.eq_update_iff Function.eq_update_iff

@[simp] lemma update_eq_self_iff : update f a b = f ↔ b = f a := by simp [update_eq_iff]
@[simp] lemma eq_update_self_iff : f = update f a b ↔ f a = b := by simp [eq_update_iff]
#align function.eq_update_self_iff Function.eq_update_self_iff
#align function.update_eq_self_iff Function.update_eq_self_iff

lemma ne_update_self_iff : f ≠ update f a b ↔ f a ≠ b := eq_update_self_iff.not
lemma update_ne_self_iff : update f a b ≠ f ↔ b ≠ f a := update_eq_self_iff.not
#align function.update_ne_self_iff Function.update_ne_self_iff
#align function.ne_update_self_iff Function.ne_update_self_iff

@[simp]
theorem update_eq_self (a : α) (f : ∀ a, β a) : update f a (f a) = f :=
  update_eq_iff.2 ⟨rfl, fun _ _ ↦ rfl⟩
#align function.update_eq_self Function.update_eq_self

theorem update_comp_eq_of_forall_ne' {α'} (g : ∀ a, β a) {f : α' → α} {i : α} (a : β i)
    (h : ∀ x, f x ≠ i) : (fun j ↦ (update g i a) (f j)) = fun j ↦ g (f j) :=
  funext fun _ ↦ update_noteq (h _) _ _
#align function.update_comp_eq_of_forall_ne' Function.update_comp_eq_of_forall_ne'

/-- Non-dependent version of `Function.update_comp_eq_of_forall_ne'` -/
theorem update_comp_eq_of_forall_ne {α β : Sort _} (g : α' → β) {f : α → α'} {i : α'} (a : β)
    (h : ∀ x, f x ≠ i) : update g i a ∘ f = g ∘ f :=
  update_comp_eq_of_forall_ne' g a h
#align function.update_comp_eq_of_forall_ne Function.update_comp_eq_of_forall_ne

theorem update_comp_eq_of_injective' (g : ∀ a, β a) {f : α' → α} (hf : Function.Injective f)
    (i : α') (a : β (f i)) : (fun j ↦ update g (f i) a (f j)) = update (fun i ↦ g (f i)) i a :=
  eq_update_iff.2 ⟨update_same _ _ _, fun _ hj ↦ update_noteq (hf.ne hj) _ _⟩
#align function.update_comp_eq_of_injective' Function.update_comp_eq_of_injective'

/-- Non-dependent version of `Function.update_comp_eq_of_injective'` -/
theorem update_comp_eq_of_injective {β : Sort _} (g : α' → β) {f : α → α'}
    (hf : Function.Injective f) (i : α) (a : β) :
    Function.update g (f i) a ∘ f = Function.update (g ∘ f) i a :=
  update_comp_eq_of_injective' g hf i a
#align function.update_comp_eq_of_injective Function.update_comp_eq_of_injective

theorem apply_update {ι : Sort _} [DecidableEq ι] {α β : ι → Sort _} (f : ∀ i, α i → β i)
    (g : ∀ i, α i) (i : ι) (v : α i) (j : ι) :
    f j (update g i v j) = update (fun k ↦ f k (g k)) i (f i v) j := by
  by_cases h:j = i
  · subst j
    simp
  · simp [h]
#align function.apply_update Function.apply_update

theorem apply_update₂ {ι : Sort _} [DecidableEq ι] {α β γ : ι → Sort _} (f : ∀ i, α i → β i → γ i)
    (g : ∀ i, α i) (h : ∀ i, β i) (i : ι) (v : α i) (w : β i) (j : ι) :
    f j (update g i v j) (update h i w j) = update (fun k ↦ f k (g k) (h k)) i (f i v w) j := by
  by_cases h:j = i
  · subst j
    simp
  · simp [h]
#align function.apply_update₂ Function.apply_update₂

theorem comp_update {α' : Sort _} {β : Sort _} (f : α' → β) (g : α → α') (i : α) (v : α') :
    f ∘ update g i v = update (f ∘ g) i (f v) :=
  funext <| apply_update _ _ _ _
#align function.comp_update Function.comp_update

theorem update_comm {α} [DecidableEq α] {β : α → Sort _} {a b : α} (h : a ≠ b) (v : β a) (w : β b)
    (f : ∀ a, β a) : update (update f a v) b w = update (update f b w) a v := by
  funext c
  simp only [update]
  by_cases h₁ : c = b <;> by_cases h₂ : c = a
  · rw [dif_pos h₁, dif_pos h₂]
    cases h (h₂.symm.trans h₁)
  · rw [dif_pos h₁, dif_pos h₁, dif_neg h₂]
  · rw [dif_neg h₁, dif_neg h₁, dif_pos h₂]
  · rw [dif_neg h₁, dif_neg h₁, dif_neg h₂]
#align function.update_comm Function.update_comm

@[simp]
theorem update_idem {α} [DecidableEq α] {β : α → Sort _} {a : α} (v w : β a) (f : ∀ a, β a) :
    update (update f a v) a w = update f a w := by
  funext b
  by_cases h : b = a <;> simp [update, h]
#align function.update_idem Function.update_idem

end Update

noncomputable section Extend

attribute [local instance] Classical.propDecidable

variable {α β γ : Sort _} {f : α → β}

/-- `extend f g e'` extends a function `g : α → γ`
along a function `f : α → β` to a function `β → γ`,
by using the values of `g` on the range of `f`
and the values of an auxiliary function `e' : β → γ` elsewhere.

Mostly useful when `f` is injective, or more generally when `g.factors_through f` -/
-- Explicit Sort so that `α` isn't inferred to be Prop via `exists_prop_decidable`
def extend {α : Sort u} {β γ} (f : α → β) (g : α → γ) (e' : β → γ) : β → γ := fun b ↦
  if h : ∃ a, f a = b then g (Classical.choose h) else e' b
#align function.extend Function.extend

/-- g factors through f : `f a = f b → g a = g b` -/
def FactorsThrough (g : α → γ) (f : α → β) : Prop :=
  ∀ ⦃a b⦄, f a = f b → g a = g b
#align function.factors_through Function.FactorsThrough

theorem extend_def (f : α → β) (g : α → γ) (e' : β → γ) (b : β) [Decidable (∃ a, f a = b)] :
    extend f g e' b = if h : ∃ a, f a = b then g (Classical.choose h) else e' b := by
  unfold extend
  congr
#align function.extend_def Function.extend_def

lemma Injective.FactorsThrough (hf : Injective f) (g : α → γ) : g.FactorsThrough f :=
  fun _ _ h => congr_arg g (hf h)
#align function.injective.factors_through Function.Injective.FactorsThrough

lemma FactorsThrough.extend_apply {g : α → γ} (hf : g.FactorsThrough f) (e' : β → γ) (a : α) :
  extend f g e' (f a) = g a := by
  simp only [extend_def, dif_pos, exists_apply_eq_apply]
  exact hf (Classical.choose_spec (exists_apply_eq_apply f a))
#align function.factors_through.extend_apply Function.FactorsThrough.extend_apply

@[simp]
theorem Injective.extend_apply (hf : Injective f) (g : α → γ) (e' : β → γ) (a : α) :
    extend f g e' (f a) = g a :=
  (hf.FactorsThrough g).extend_apply e' a
#align function.injective.extend_apply Function.Injective.extend_apply

@[simp]
theorem extend_apply' (g : α → γ) (e' : β → γ) (b : β) (hb : ¬∃ a, f a = b) :
    extend f g e' b = e' b := by
  simp [Function.extend_def, hb]
#align function.extend_apply' Function.extend_apply'

lemma factorsThrough_iff (g : α → γ) [Nonempty γ] :
  g.FactorsThrough f ↔ ∃ (e : β → γ), g = e ∘ f :=
⟨fun hf => ⟨extend f g (const β (Classical.arbitrary γ)),
      funext (fun x => by simp only [comp_apply, hf.extend_apply])⟩,
  fun h _ _ hf => by rw [Classical.choose_spec h, comp_apply, comp_apply, hf]⟩
#align function.factors_through_iff Function.factorsThrough_iff

lemma FactorsThrough.apply_extend {δ} {g : α → γ} (hf : FactorsThrough g f)
  (F : γ → δ) (e' : β → γ) (b : β) :
  F (extend f g e' b) = extend f (F ∘ g) (F ∘ e') b := by
  by_cases hb : ∃ a, f a = b
  case pos =>
    rcases hb with ⟨a, ha⟩
    subst b
    rw [hf.extend_apply, FactorsThrough.extend_apply, comp]
    case intro.hf =>
      intro a b h
      simp only [comp_apply]
      apply congr_arg
      exact hf h
  case neg =>
    rw [extend_apply' _ _ _ hb, extend_apply' _ _ _ hb, comp]
#align function.factors_through.apply_extend Function.FactorsThrough.apply_extend

lemma Injective.apply_extend {δ} (hf : Injective f) (F : γ → δ) (g : α → γ) (e' : β → γ) (b : β) :
  F (extend f g e' b) = extend f (F ∘ g) (F ∘ e') b :=
  (hf.FactorsThrough g).apply_extend F e' b
#align function.injective.apply_extend Function.Injective.apply_extend

theorem extend_injective (hf : Injective f) (e' : β → γ) : Injective fun g ↦ extend f g e' := by
  intro g₁ g₂ hg
  refine' funext fun x ↦ _
  have H := congr_fun hg (f x)
  simp only [hf.extend_apply] at H
  exact H
#align function.extend_injective Function.extend_injective

lemma FactorsThrough.extend_comp {g : α → γ} (e' : β → γ) (hf : FactorsThrough g f) :
  extend f g e' ∘ f = g :=
  funext $ fun a => hf.extend_apply e' a
#align function.factors_through.extend_comp Function.FactorsThrough.extend_comp

@[simp]
theorem extend_comp (hf : Injective f) (g : α → γ) (e' : β → γ) : extend f g e' ∘ f = g :=
  funext fun a ↦ hf.extend_apply g e' a
#align function.extend_comp Function.extend_comp

theorem Injective.surjective_comp_right' (hf : Injective f) (g₀ : β → γ) :
    Surjective fun g : β → γ ↦ g ∘ f :=
  fun g ↦ ⟨extend f g g₀, extend_comp hf _ _⟩
#align function.injective.surjective_comp_right' Function.Injective.surjective_comp_right'

theorem Injective.surjective_comp_right [Nonempty γ] (hf : Injective f) :
    Surjective fun g : β → γ ↦ g ∘ f :=
  hf.surjective_comp_right' fun _ ↦ Classical.choice ‹_›
#align function.injective.surjective_comp_right Function.Injective.surjective_comp_right

theorem Bijective.comp_right (hf : Bijective f) : Bijective fun g : β → γ ↦ g ∘ f :=
  ⟨hf.surjective.injective_comp_right, fun g ↦
    ⟨g ∘ surjInv hf.surjective,
     by simp only [comp.assoc g _ f, (leftInverse_surjInv hf).comp_eq_id, comp.right_id]⟩⟩
#align function.bijective.comp_right Function.Bijective.comp_right

end Extend

theorem uncurry_def {α β γ} (f : α → β → γ) : uncurry f = fun p ↦ f p.1 p.2 :=
  rfl
#align function.uncurry_def Function.uncurry_def

@[simp]
theorem uncurry_apply_pair {α β γ} (f : α → β → γ) (x : α) (y : β) : uncurry f (x, y) = f x y :=
  rfl
#align function.uncurry_apply_pair Function.uncurry_apply_pair

@[simp]
theorem curry_apply {α β γ} (f : α × β → γ) (x : α) (y : β) : curry f x y = f (x, y) :=
  rfl
#align function.curry_apply Function.curry_apply

section Bicomp

variable {α β γ δ ε : Type _}

/-- Compose a binary function `f` with a pair of unary functions `g` and `h`.
If both arguments of `f` have the same type and `g = h`, then `bicompl f g g = f on g`. -/
def bicompl (f : γ → δ → ε) (g : α → γ) (h : β → δ) (a b) :=
  f (g a) (h b)
#align function.bicompl Function.bicompl

/-- Compose an unary function `f` with a binary function `g`. -/
def bicompr (f : γ → δ) (g : α → β → γ) (a b) :=
  f (g a b)
#align function.bicompr Function.bicompr

-- Suggested local notation:
local notation f " ∘₂ " g => bicompr f g

theorem uncurry_bicompr (f : α → β → γ) (g : γ → δ) : uncurry (g ∘₂ f) = g ∘ uncurry f :=
  rfl
#align function.uncurry_bicompr Function.uncurry_bicompr

theorem uncurry_bicompl (f : γ → δ → ε) (g : α → γ) (h : β → δ) :
    uncurry (bicompl f g h) = uncurry f ∘ Prod.map g h :=
  rfl
#align function.uncurry_bicompl Function.uncurry_bicompl

end Bicomp

section Uncurry

variable {α β γ δ : Type _}

/-- Records a way to turn an element of `α` into a function from `β` to `γ`. The most generic use
is to recursively uncurry. For instance `f : α → β → γ → δ` will be turned into
`↿f : α × β × γ → δ`. One can also add instances for bundled maps. -/
class HasUncurry (α : Type _) (β : outParam (Type _)) (γ : outParam (Type _)) where
  /-- Uncurrying operator. The most generic use is to recursively uncurry. For instance
  `f : α → β → γ → δ` will be turned into `↿f : α × β × γ → δ`. One can also add instances
  for bundled maps.-/
  uncurry : α → β → γ
#align function.has_uncurry Function.HasUncurry

notation:arg "↿" x:arg => HasUncurry.uncurry x

instance hasUncurryBase : HasUncurry (α → β) α β :=
  ⟨id⟩

instance hasUncurryInduction [HasUncurry β γ δ] : HasUncurry (α → β) (α × γ) δ :=
  ⟨fun f p ↦ (↿(f p.1)) p.2⟩

end Uncurry

/-- A function is involutive, if `f ∘ f = id`. -/
def Involutive {α} (f : α → α) : Prop :=
  ∀ x, f (f x) = x
#align function.involutive Function.Involutive

theorem involutive_iff_iter_2_eq_id {α} {f : α → α} : Involutive f ↔ f^[2] = id :=
  funext_iff.symm
#align function.involutive_iff_iter_2_eq_id Function.involutive_iff_iter_2_eq_id

theorem _root_.Bool.involutive_not : Involutive not :=
  Bool.not_not

namespace Involutive

variable {α : Sort u} {f : α → α} (h : Involutive f)

@[simp]
theorem comp_self : f ∘ f = id :=
  funext h
#align function.involutive.comp_self Function.Involutive.comp_self

protected theorem leftInverse : LeftInverse f f := h
#align function.involutive.left_inverse Function.Involutive.leftInverse

protected theorem rightInverse : RightInverse f f := h
#align function.involutive.right_inverse Function.Involutive.rightInverse

protected theorem injective : Injective f := h.leftInverse.injective
#align function.involutive.injective Function.Involutive.injective

protected theorem surjective : Surjective f := fun x ↦ ⟨f x, h x⟩
#align function.involutive.surjective Function.Involutive.surjective

protected theorem bijective : Bijective f := ⟨h.injective, h.surjective⟩
#align function.involutive.bijective Function.Involutive.bijective

/-- Involuting an `ite` of an involuted value `x : α` negates the `Prop` condition in the `ite`. -/
protected theorem ite_not (P : Prop) [Decidable P] (x : α) : f (ite P x (f x)) = ite (¬P) x (f x) :=
  by rw [apply_ite f, h, ite_not]
#align function.involutive.ite_not Function.Involutive.ite_not

/-- An involution commutes across an equality. Compare to `Function.Injective.eq_iff`. -/
protected theorem eq_iff {x y : α} : f x = y ↔ x = f y :=
  h.injective.eq_iff' (h y)
#align function.involutive.eq_iff Function.Involutive.eq_iff

end Involutive

/-- The property of a binary function `f : α → β → γ` being injective.
Mathematically this should be thought of as the corresponding function `α × β → γ` being injective.
-/
def Injective2 {α β γ} (f : α → β → γ) : Prop :=
  ∀ ⦃a₁ a₂ b₁ b₂⦄, f a₁ b₁ = f a₂ b₂ → a₁ = a₂ ∧ b₁ = b₂
#align function.injective2 Function.Injective2

namespace Injective2

variable {α β γ : Sort _} {f : α → β → γ}

/-- A binary injective function is injective when only the left argument varies. -/
protected theorem left (hf : Injective2 f) (b : β) : Function.Injective fun a ↦ f a b :=
  fun _ _ h ↦ (hf h).left
#align function.injective2.left Function.Injective2.left

/-- A binary injective function is injective when only the right argument varies. -/
protected theorem right (hf : Injective2 f) (a : α) : Function.Injective (f a) :=
  fun _ _ h ↦ (hf h).right
#align function.injective2.right Function.Injective2.right

protected theorem uncurry {α β γ : Type _} {f : α → β → γ} (hf : Injective2 f) :
    Function.Injective (uncurry f) :=
  fun ⟨_, _⟩ ⟨_, _⟩ h ↦ (hf h).elim (congr_arg₂ _)
#align function.injective2.uncurry Function.Injective2.uncurry

/-- As a map from the left argument to a unary function, `f` is injective. -/
theorem left' (hf : Injective2 f) [Nonempty β] : Function.Injective f := fun a₁ a₂ h ↦
  let ⟨b⟩ := ‹Nonempty β›
  hf.left b <| (congr_fun h b : _)
#align function.injective2.left' Function.Injective2.left'

/-- As a map from the right argument to a unary function, `f` is injective. -/
theorem right' (hf : Injective2 f) [Nonempty α] : Function.Injective fun b a ↦ f a b :=
  fun b₁ b₂ h ↦
    let ⟨a⟩ := ‹Nonempty α›
    hf.right a <| (congr_fun h a : _)
#align function.injective2.right' Function.Injective2.right'

theorem eq_iff (hf : Injective2 f) {a₁ a₂ b₁ b₂} : f a₁ b₁ = f a₂ b₂ ↔ a₁ = a₂ ∧ b₁ = b₂ :=
  ⟨fun h ↦ hf h, fun ⟨h1, h2⟩ ↦ congr_arg₂ f h1 h2⟩
#align function.injective2.eq_iff Function.Injective2.eq_iff

end Injective2

section Sometimes

attribute [local instance] Classical.propDecidable

/-- `sometimes f` evaluates to some value of `f`, if it exists. This function is especially
interesting in the case where `α` is a proposition, in which case `f` is necessarily a
constant function, so that `sometimes f = f a` for all `a`. -/
noncomputable def sometimes {α β} [Nonempty β] (f : α → β) : β :=
  if h : Nonempty α then f (Classical.choice h) else Classical.choice ‹_›
#align function.sometimes Function.sometimes

theorem sometimes_eq {p : Prop} {α} [Nonempty α] (f : p → α) (a : p) : sometimes f = f a :=
  dif_pos ⟨a⟩
#align function.sometimes_eq Function.sometimes_eq

theorem sometimes_spec {p : Prop} {α} [Nonempty α] (P : α → Prop) (f : p → α) (a : p)
    (h : P (f a)) : P (sometimes f) :=
  by rwa [sometimes_eq]
#align function.sometimes_spec Function.sometimes_spec

end Sometimes

end Function

/-- `s.piecewise f g` is the function equal to `f` on the set `s`, and to `g` on its complement. -/
def Set.piecewise {α : Type u} {β : α → Sort v} (s : Set α) (f g : ∀ i, β i)
    [∀ j, Decidable (j ∈ s)] : ∀ i, β i :=
  fun i ↦ if i ∈ s then f i else g i
#align set.piecewise Set.piecewise

/-! ### Bijectivity of `eq.rec`, `eq.mp`, `eq.mpr`, and `cast` -/

theorem eq_rec_on_bijective {α : Sort _} {C : α → Sort _} :
    ∀ {a a' : α} (h : a = a'), Function.Bijective (@Eq.ndrec _ _ C · _ h)
  | _, _, rfl => ⟨fun _ _ ↦ id, fun x ↦ ⟨x, rfl⟩⟩
#align eq_rec_on_bijective eq_rec_on_bijective

theorem eq_mp_bijective {α β : Sort _} (h : α = β) : Function.Bijective (Eq.mp h) := by
  -- TODO: mathlib3 uses `eq_rec_on_bijective`, difference in elaboration here
  -- due to `@[macro_inline] possibly?
  cases h
  refine ⟨fun _ _ ↦ id, fun x ↦ ⟨x, rfl⟩⟩
#align eq_mp_bijective eq_mp_bijective

theorem eq_mpr_bijective {α β : Sort _} (h : α = β) : Function.Bijective (Eq.mpr h) := by
  cases h
  refine ⟨fun _ _ ↦ id, fun x ↦ ⟨x, rfl⟩⟩
#align eq_mpr_bijective eq_mpr_bijective

theorem cast_bijective {α β : Sort _} (h : α = β) : Function.Bijective (cast h) := by
  cases h
  refine ⟨fun _ _ ↦ id, fun x ↦ ⟨x, rfl⟩⟩
#align cast_bijective cast_bijective

/-! Note these lemmas apply to `Type _` not `Sort*`, as the latter interferes with `simp`, and
is trivial anyway.-/

@[simp]
theorem eq_rec_inj {α : Sort _} {a a' : α} (h : a = a') {C : α → Type _} (x y : C a) :
    (Eq.ndrec x h : C a') = Eq.ndrec y h ↔ x = y :=
  (eq_rec_on_bijective h).injective.eq_iff
#align eq_rec_inj eq_rec_inj

@[simp]
theorem cast_inj {α β : Type _} (h : α = β) {x y : α} : cast h x = cast h y ↔ x = y :=
  (cast_bijective h).injective.eq_iff
#align cast_inj cast_inj

theorem Function.LeftInverse.eq_rec_eq {α β : Sort _} {γ : β → Sort v} {f : α → β} {g : β → α}
    (h : Function.LeftInverse g f) (C : ∀ a : α, γ (f a)) (a : α) :
    -- TODO: mathlib3 uses `(congr_arg f (h a)).rec (C (g (f a)))` for LHS
    @Eq.rec β (f (g (f a))) (fun x _ ↦ γ x) (C (g (f a))) (f a) (congr_arg f (h a)) = C a :=
  eq_of_heq <| (eq_rec_heq _ _).trans <| by rw [h]
#align function.left_inverse.eq_rec_eq Function.LeftInverse.eq_rec_eq

theorem Function.LeftInverse.eq_rec_on_eq {α β : Sort _} {γ : β → Sort v} {f : α → β} {g : β → α}
    (h : Function.LeftInverse g f) (C : ∀ a : α, γ (f a)) (a : α) :
    -- TODO: mathlib3 uses `(congr_arg f (h a)).recOn (C (g (f a)))` for LHS
    @Eq.recOn β (f (g (f a))) (fun x _ ↦ γ x) (f a) (congr_arg f (h a)) (C (g (f a))) = C a :=
  h.eq_rec_eq _ _
#align function.left_inverse.eq_rec_on_eq Function.LeftInverse.eq_rec_on_eq

theorem Function.LeftInverse.cast_eq {α β : Sort _} {γ : β → Sort v} {f : α → β} {g : β → α}
    (h : Function.LeftInverse g f) (C : ∀ a : α, γ (f a)) (a : α) :
    cast (congr_arg (fun a ↦ γ (f a)) (h a)) (C (g (f a))) = C a := by
  rw [cast_eq_iff_heq, h]
#align function.left_inverse.cast_eq Function.LeftInverse.cast_eq

/-- A set of functions "separates points"
if for each pair of distinct points there is a function taking different values on them. -/
def Set.SeparatesPoints {α β : Type _} (A : Set (α → β)) : Prop :=
  ∀ ⦃x y : α⦄, x ≠ y → ∃ f ∈ A, (f x : β) ≠ f y
#align set.separates_points Set.SeparatesPoints

theorem IsSymmOp.flip_eq {α β} (op) [IsSymmOp α β op] : flip op = op :=
  funext fun a ↦ funext fun b ↦ (IsSymmOp.symm_op a b).symm
#align is_symm_op.flip_eq IsSymmOp.flip_eq

theorem InvImage.equivalence {α : Sort u} {β : Sort v} (r : β → β → Prop) (f : α → β)
    (h : Equivalence r) : Equivalence (InvImage r f) :=
  ⟨fun _ ↦ h.1 _, fun w ↦ h.symm w, fun h₁ h₂ ↦ InvImage.trans r f (fun _ _ _ ↦ h.trans) h₁ h₂⟩
#align inv_image.equivalence InvImage.equivalence

instance {α β : Type _} {r : α → β → Prop} {x : α × β} [Decidable (r x.1 x.2)] :
  Decidable (uncurry r x) :=
‹Decidable _›

instance {α β : Type _} {r : α × β → Prop} {a : α} {b : β} [Decidable (r (a, b))] :
  Decidable (curry r a b) :=
‹Decidable _›