/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import group_theory.submonoid.operations
import algebra.pointwise

/-! # Pointwise instances on `submonoid`s and `add_submonoid`s

This file provides:

* `submonoid.has_inv`
* `add_submonoid.has_neg`

and the actions

* `submonoid.pointwise_mul_action`
* `add_submonoid.pointwise_mul_action`

which matches the action of `mul_action_set`.

These are all available in the `pointwise` locale.

Additionally, it provides `add_submonoid.has_mul`, which is available globally to match
`submodule.has_mul`.

## Implementation notes

Most of the lemmas in this file are direct copies of lemmas from `algebra/pointwise.lean`.
While the statements of these lemmas are defeq, we repeat them here due to them not being
syntactically equal. Before adding new lemmas here, consider if they would also apply to the action
on `set`s.

-/

variables {α : Type*} {G : Type*} {M : Type*} {R : Type*} {A : Type*}
variables [monoid M] [add_monoid A]

namespace submonoid

variables [group G]

open_locale pointwise

/-- The submonoid with every element inverted. -/
@[to_additive /-" The additive submonoid with every element negated. "-/]
protected def has_inv : has_inv (submonoid G):=
{ inv := λ S,
  { carrier := (S : set G)⁻¹,
    one_mem' := show (1 : G)⁻¹ ∈ S, by { rw one_inv, exact S.one_mem },
    mul_mem' := λ a b (ha : a⁻¹ ∈ S) (hb : b⁻¹ ∈ S), show (a * b)⁻¹ ∈ S,
      by { rw mul_inv_rev, exact S.mul_mem hb ha } } }

localized "attribute [instance] submonoid.has_inv" in pointwise
open_locale pointwise

@[simp, to_additive] lemma coe_inv (S : submonoid G) : ↑(S⁻¹) = (S : set G)⁻¹ := rfl

@[simp, to_additive] lemma mem_inv {g : G} {S : submonoid G} : g ∈ S⁻¹ ↔ g⁻¹ ∈ S := iff.rfl

@[simp, to_additive] protected lemma inv_inv (S : submonoid G) : S⁻¹⁻¹ = S :=
set_like.coe_injective set.inv_inv

@[simp, to_additive] lemma inv_le_inv (S T : submonoid G) : S⁻¹ ≤ T⁻¹ ↔ S ≤ T :=
set_like.coe_subset_coe.symm.trans set.inv_subset_inv

@[to_additive] lemma inv_le (S T : submonoid G) : S⁻¹ ≤ T ↔ S ≤ T⁻¹ :=
set_like.coe_subset_coe.symm.trans set.inv_subset

/-- `submonoid.has_inv` as an order isomorphism. -/
@[to_additive /-" `add_submonoid.has_neg` as an order isomorphism "-/, simps]
def inv_order_iso : submonoid G ≃o submonoid G :=
{ to_fun := has_inv.inv,
  inv_fun := has_inv.inv,
  left_inv := submonoid.inv_inv,
  right_inv := submonoid.inv_inv,
  map_rel_iff' := inv_le_inv }

@[to_additive] lemma closure_inv (s : set G) : closure s⁻¹ = (closure s)⁻¹ :=
begin
  apply le_antisymm,
  { rw [closure_le, coe_inv, ←set.inv_subset, set.inv_inv],
    exact subset_closure },
  { rw [inv_le, closure_le, coe_inv, ←set.inv_subset],
    exact subset_closure }
end

@[simp, to_additive]
lemma inv_inf (S T : submonoid G) : (S ⊓ T)⁻¹ = S⁻¹ ⊓ T⁻¹ :=
set_like.coe_injective set.inter_inv

@[simp, to_additive]
lemma inv_sup (S T : submonoid G) : (S ⊔ T)⁻¹ = S⁻¹ ⊔ T⁻¹ :=
(inv_order_iso : submonoid G ≃o submonoid G).map_sup S T

@[simp, to_additive]
lemma inv_bot : (⊥ : submonoid G)⁻¹ = ⊥ :=
set_like.coe_injective $ (set.inv_singleton 1).trans $ congr_arg _ one_inv

@[simp, to_additive]
lemma inv_top : (⊤ : submonoid G)⁻¹ = ⊤ :=
set_like.coe_injective $ set.inv_univ

@[simp, to_additive]
lemma inv_infi {ι : Sort*} (S : ι → submonoid G) : (⨅ i, S i)⁻¹ = ⨅ i, (S i)⁻¹ :=
(inv_order_iso : submonoid G ≃o submonoid G).map_infi _

@[simp, to_additive]
lemma inv_supr {ι : Sort*} (S : ι → submonoid G) : (⨆ i, S i)⁻¹ = ⨆ i, (S i)⁻¹ :=
(inv_order_iso : submonoid G ≃o submonoid G).map_supr _

end submonoid

namespace submonoid

section monoid
variables [monoid α] [mul_distrib_mul_action α M]

/-- The action on a submonoid corresponding to applying the action to every element.

This is available as an instance in the `pointwise` locale. -/
protected def pointwise_mul_action : mul_action α (submonoid M) :=
{ smul := λ a S, S.map (mul_distrib_mul_action.to_monoid_End _ _ a),
  one_smul := λ S, (congr_arg (λ f, S.map f) (monoid_hom.map_one _)).trans S.map_id,
  mul_smul := λ a₁ a₂ S,
    (congr_arg (λ f, S.map f) (monoid_hom.map_mul _ _ _)).trans (S.map_map _ _).symm,}

localized "attribute [instance] submonoid.pointwise_mul_action" in pointwise
open_locale pointwise

@[simp] lemma coe_pointwise_smul (a : α) (S : submonoid M) : ↑(a • S) = a • (S : set M) := rfl

lemma smul_mem_pointwise_smul (m : M) (a : α) (S : submonoid M) : m ∈ S → a • m ∈ a • S :=
(set.smul_mem_smul_set : _ → _ ∈ a • (S : set M))

lemma mem_smul_pointwise_iff_exists (m : M) (a : α) (S : submonoid M) :
  m ∈ a • S ↔ ∃ (s : M), s ∈ S ∧ a • s = m :=
(set.mem_smul_set : m ∈ a • (S : set M) ↔ _)

instance pointwise_central_scalar [mul_distrib_mul_action αᵐᵒᵖ M] [is_central_scalar α M] :
  is_central_scalar α (submonoid M) :=
⟨λ a S, congr_arg (λ f, S.map f) $ monoid_hom.ext $ by exact op_smul_eq_smul _⟩

end monoid

section group
variables [group α] [mul_distrib_mul_action α M]

open_locale pointwise

@[simp] lemma smul_mem_pointwise_smul_iff {a : α} {S : submonoid M} {x : M} :
  a • x ∈ a • S ↔ x ∈ S :=
smul_mem_smul_set_iff

lemma mem_pointwise_smul_iff_inv_smul_mem {a : α} {S : submonoid M} {x : M} :
  x ∈ a • S ↔ a⁻¹ • x ∈ S :=
mem_smul_set_iff_inv_smul_mem

lemma mem_inv_pointwise_smul_iff {a : α} {S : submonoid M} {x : M} : x ∈ a⁻¹ • S ↔ a • x ∈ S :=
mem_inv_smul_set_iff

@[simp] lemma pointwise_smul_le_pointwise_smul_iff {a : α} {S T : submonoid M} :
  a • S ≤ a • T ↔ S ≤ T :=
set_smul_subset_set_smul_iff

lemma pointwise_smul_subset_iff {a : α} {S T : submonoid M} : a • S ≤ T ↔ S ≤ a⁻¹ • T :=
set_smul_subset_iff

lemma subset_pointwise_smul_iff {a : α} {S T : submonoid M} : S ≤ a • T ↔ a⁻¹ • S ≤ T :=
subset_set_smul_iff

end group

section group_with_zero
variables [group_with_zero α] [mul_distrib_mul_action α M]

open_locale pointwise

@[simp] lemma smul_mem_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) (S : submonoid M)
  (x : M) : a • x ∈ a • S ↔ x ∈ S :=
smul_mem_smul_set_iff₀ ha (S : set M) x

lemma mem_inv_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) (S : submonoid M) (x : M) :
  x ∈ a⁻¹ • S ↔ a • x ∈ S :=
mem_inv_smul_set_iff₀ ha (S : set M) x

@[simp] lemma pointwise_smul_le_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) {S T : submonoid M} :
  a • S ≤ a • T ↔ S ≤ T :=
set_smul_subset_set_smul_iff₀ ha

lemma pointwise_smul_le_iff₀ {a : α} (ha : a ≠ 0) {S T : submonoid M} : a • S ≤ T ↔ S ≤ a⁻¹ • T :=
set_smul_subset_iff₀ ha

lemma le_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) {S T : submonoid M} : S ≤ a • T ↔ a⁻¹ • S ≤ T :=
subset_set_smul_iff₀ ha

end group_with_zero

open_locale pointwise

@[to_additive]
lemma mem_closure_inv {G : Type*} [group G] (S : set G) (x : G) :
  x ∈ submonoid.closure S⁻¹ ↔ x⁻¹ ∈ submonoid.closure S :=
by rw [closure_inv, mem_inv]

end submonoid

namespace add_submonoid

section monoid
variables [monoid α] [distrib_mul_action α A]

/-- The action on an additive submonoid corresponding to applying the action to every element.

This is available as an instance in the `pointwise` locale. -/
protected def pointwise_mul_action : mul_action α (add_submonoid A) :=
{ smul := λ a S, S.map (distrib_mul_action.to_add_monoid_End _ _ a),
  one_smul := λ S, (congr_arg (λ f, S.map f) (monoid_hom.map_one _)).trans S.map_id,
  mul_smul := λ a₁ a₂ S,
    (congr_arg (λ f, S.map f) (monoid_hom.map_mul _ _ _)).trans (S.map_map _ _).symm,}

localized "attribute [instance] add_submonoid.pointwise_mul_action" in pointwise
open_locale pointwise

@[simp] lemma coe_pointwise_smul (a : α) (S : add_submonoid A) : ↑(a • S) = a • (S : set A) := rfl

lemma smul_mem_pointwise_smul (m : A) (a : α) (S : add_submonoid A) : m ∈ S → a • m ∈ a • S :=
(set.smul_mem_smul_set : _ → _ ∈ a • (S : set A))

instance pointwise_central_scalar [distrib_mul_action αᵐᵒᵖ A] [is_central_scalar α A] :
  is_central_scalar α (add_submonoid A) :=
⟨λ a S, congr_arg (λ f, S.map f) $ add_monoid_hom.ext $ by exact op_smul_eq_smul _⟩

end monoid

section group
variables [group α] [distrib_mul_action α A]

open_locale pointwise

@[simp] lemma smul_mem_pointwise_smul_iff {a : α} {S : add_submonoid A} {x : A} :
  a • x ∈ a • S ↔ x ∈ S :=
smul_mem_smul_set_iff

lemma mem_pointwise_smul_iff_inv_smul_mem {a : α} {S : add_submonoid A} {x : A} :
  x ∈ a • S ↔ a⁻¹ • x ∈ S :=
mem_smul_set_iff_inv_smul_mem

lemma mem_smul_pointwise_iff_exists (m : A) (a : α) (S : add_submonoid A) :
  m ∈ a • S ↔ ∃ (s : A), s ∈ S ∧ a • s = m :=
(set.mem_smul_set : m ∈ a • (S : set A) ↔ _)

lemma mem_inv_pointwise_smul_iff {a : α} {S : add_submonoid A} {x : A} : x ∈ a⁻¹ • S ↔ a • x ∈ S :=
mem_inv_smul_set_iff

@[simp] lemma pointwise_smul_le_pointwise_smul_iff {a : α} {S T : add_submonoid A} :
  a • S ≤ a • T ↔ S ≤ T :=
set_smul_subset_set_smul_iff

lemma pointwise_smul_le_iff {a : α} {S T : add_submonoid A} : a • S ≤ T ↔ S ≤ a⁻¹ • T :=
set_smul_subset_iff

lemma le_pointwise_smul_iff {a : α} {S T : add_submonoid A} : S ≤ a • T ↔ a⁻¹ • S ≤ T :=
subset_set_smul_iff

end group

section group_with_zero
variables [group_with_zero α] [distrib_mul_action α A]

open_locale pointwise

@[simp] lemma smul_mem_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) (S : add_submonoid A)
  (x : A) : a • x ∈ a • S ↔ x ∈ S :=
smul_mem_smul_set_iff₀ ha (S : set A) x

lemma mem_pointwise_smul_iff_inv_smul_mem₀ {a : α} (ha : a ≠ 0) (S : add_submonoid A) (x : A) :
  x ∈ a • S ↔ a⁻¹ • x ∈ S :=
mem_smul_set_iff_inv_smul_mem₀ ha (S : set A) x

lemma mem_inv_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) (S : add_submonoid A) (x : A) :
  x ∈ a⁻¹ • S ↔ a • x ∈ S :=
mem_inv_smul_set_iff₀ ha (S : set A) x

@[simp] lemma pointwise_smul_le_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) {S T : add_submonoid A} :
  a • S ≤ a • T ↔ S ≤ T :=
set_smul_subset_set_smul_iff₀ ha

lemma pointwise_smul_le_iff₀ {a : α} (ha : a ≠ 0) {S T : add_submonoid A} :
  a • S ≤ T ↔ S ≤ a⁻¹ • T :=
set_smul_subset_iff₀ ha

lemma le_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) {S T : add_submonoid A} :
  S ≤ a • T ↔ a⁻¹ • S ≤ T :=
subset_set_smul_iff₀ ha

end group_with_zero

open_locale pointwise

end add_submonoid

/-! ### Elementwise multiplication of two additive submonoids

These definitions are a cut-down versions of the ones around `submodule.has_mul`, as that API is
usually more useful. -/
namespace add_submonoid

variables [non_unital_non_assoc_semiring R]

/-- Multiplication of additive submonoids of a semiring R. The additive submonoid `S * T` is the
smallest R-submodule of `R` containing the elements `s * t` for `s ∈ S` and `t ∈ T`. -/
instance : has_mul (add_submonoid R) :=
⟨λ M N, ⨆ s : M, N.map $ add_monoid_hom.mul s.1⟩

theorem mul_mem_mul {M N : add_submonoid R} {m n : R} (hm : m ∈ M) (hn : n ∈ N) : m * n ∈ M * N :=
(le_supr _ ⟨m, hm⟩ : _ ≤ M * N) ⟨n, hn, rfl⟩

theorem mul_le {M N P : add_submonoid R} : M * N ≤ P ↔ ∀ (m ∈ M) (n ∈ N), m * n ∈ P :=
⟨λ H m hm n hn, H $ mul_mem_mul hm hn,
λ H, supr_le $ λ ⟨m, hm⟩, map_le_iff_le_comap.2 $ λ n hn, H m hm n hn⟩

@[elab_as_eliminator] protected theorem mul_induction_on
  {M N : add_submonoid R}
  {C : R → Prop} {r : R} (hr : r ∈ M * N)
  (hm : ∀ (m ∈ M) (n ∈ N), C (m * n))
  (ha : ∀ x y, C x → C y → C (x + y)) : C r :=
(@mul_le _ _ _ _ ⟨C, by simpa only [zero_mul] using hm _ (zero_mem _) _ (zero_mem _), ha⟩).2 hm hr

open_locale pointwise

variables R
-- this proof is copied directly from `submodule.span_mul_span`
theorem closure_mul_closure (S T : set R) : closure S * closure T = closure (S * T) :=
begin
  apply le_antisymm,
  { rw mul_le, intros a ha b hb,
    apply closure_induction ha,
    work_on_goal 0 { intros, apply closure_induction hb,
      work_on_goal 0 { intros, exact subset_closure ⟨_, _, ‹_›, ‹_›, rfl⟩ } },
    all_goals { intros, simp only [mul_zero, zero_mul, zero_mem,
        left_distrib, right_distrib, mul_smul_comm, smul_mul_assoc],
      try {apply add_mem _ _ _}, try {apply smul_mem _ _ _} }, assumption' },
  { rw closure_le, rintros _ ⟨a, b, ha, hb, rfl⟩,
    exact mul_mem_mul (subset_closure ha) (subset_closure hb) }
end
variables {R}

@[simp] theorem mul_bot (S : add_submonoid R) : S * ⊥ = ⊥ :=
eq_bot_iff.2 $ mul_le.2 $ λ m hm n hn, by rw [add_submonoid.mem_bot] at hn ⊢; rw [hn, mul_zero]

@[simp] theorem bot_mul (S : add_submonoid R) : ⊥ * S = ⊥ :=
eq_bot_iff.2 $ mul_le.2 $ λ m hm n hn, by rw [add_submonoid.mem_bot] at hm ⊢; rw [hm, zero_mul]

@[mono] theorem mul_le_mul {M N P Q : add_submonoid R} (hmp : M ≤ P) (hnq : N ≤ Q) :
  M * N ≤ P * Q :=
mul_le.2 $ λ m hm n hn, mul_mem_mul (hmp hm) (hnq hn)

theorem mul_le_mul_left {M N P : add_submonoid R} (h : M ≤ N) : M * P ≤ N * P :=
mul_le_mul h (le_refl P)

theorem mul_le_mul_right {M N P : add_submonoid R} (h : N ≤ P) : M * N ≤ M * P :=
mul_le_mul (le_refl M) h

lemma mul_subset_mul {M N : add_submonoid R} : (↑M : set R) * (↑N : set R) ⊆ (↑(M * N) : set R) :=
by { rintros _ ⟨i, j, hi, hj, rfl⟩, exact mul_mem_mul hi hj }

end add_submonoid


variables {α : Type} [comm_ring α]

local attribute [simp] mul_comm mul_assoc mul_left_comm

example (x y z : α) : (x - x) * y + z = z :=
begin
  simp [sub_eq_add_neg]
end
-- lean 3.6 removes simp attributes from sub_eq_add_neg
-- i.e., now it is required to provide that lemma to solve this example.

example (x y z w : α) : x * y + z * w  * x = x * w * z + y * x :=
  by simp [add_comm]
-- lean 3.6 removes simp attributes from add_comm
-- i.e., now it is required to provide that lemma to solve this example.


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

/-!
# Group actions on embeddings

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

This file provides a `mul_action G (α ↪ β)` instance that agrees with the `mul_action G (α → β)`
instances defined by `pi.mul_action`.

Note that unlike the `pi` instance, this requires `G` to be a group.
-/

universes u v w
variables {G G' α β : Type*}

namespace function.embedding

@[to_additive function.embedding.has_vadd]
instance [group G] [mul_action G β] : has_smul G (α ↪ β) :=
⟨λ g f, f.trans (mul_action.to_perm g).to_embedding⟩

@[to_additive]
lemma smul_def [group G] [mul_action G β] (g : G) (f : α ↪ β) :
  g • f = f.trans (mul_action.to_perm g).to_embedding := rfl
@[simp, to_additive]
lemma smul_apply [group G] [mul_action G β] (g : G) (f : α ↪ β) (a : α) : (g • f) a = g • f a :=
rfl
@[to_additive]
lemma coe_smul [group G] [mul_action G β] (g : G) (f : α ↪ β) : ⇑(g • f) = g • f := rfl

instance [group G] [group G'] [has_smul G G'] [mul_action G β] [mul_action G' β]
  [is_scalar_tower G G' β] : is_scalar_tower G G' (α ↪ β) :=
⟨λ x y z, function.embedding.ext $ λ i, smul_assoc x y (z i)⟩

@[to_additive]
instance [group G] [group G'] [mul_action G β] [mul_action G' β] [smul_comm_class G G' β] :
  smul_comm_class G G' (α ↪ β) :=
⟨λ x y z, function.embedding.ext $ λ i, smul_comm x y (z i)⟩

instance [group G] [mul_action G β] [mul_action Gᵐᵒᵖ β] [is_central_scalar G β] :
  is_central_scalar G (α ↪ β) :=
⟨λ r m, function.embedding.ext $ λ i, op_smul_eq_smul _ _⟩

@[to_additive]
instance [group G] [mul_action G β] : mul_action G (α ↪ β) :=
fun_like.coe_injective.mul_action _ coe_smul

end function.embedding


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

universes v l u_1 u u₂

namespace Mathlib

/-!
# Equalizers and coequalizers

This file defines (co)equalizers as special cases of (co)limits.

An equalizer is the categorical generalization of the subobject {a ∈ A | f(a) = g(a)} known
from abelian groups or modules. It is a limit cone over the diagram formed by `f` and `g`.

A coequalizer is the dual concept.

## Main definitions

* `walking_parallel_pair` is the indexing category used for (co)equalizer_diagrams
* `parallel_pair` is a functor from `walking_parallel_pair` to our category `C`.
* a `fork` is a cone over a parallel pair.
  * there is really only one interesting morphism in a fork: the arrow from the vertex of the fork
    to the domain of f and g. It is called `fork.ι`.
* an `equalizer` is now just a `limit (parallel_pair f g)`

Each of these has a dual.

## Main statements

* `equalizer.ι_mono` states that every equalizer map is a monomorphism
* `is_iso_limit_cone_parallel_pair_of_self` states that the identity on the domain of `f` is an
  equalizer of `f` and `f`.

## Implementation notes
As with the other special shapes in the limits library, all the definitions here are given as
`abbreviation`s of the general statements for limits, so all the `simp` lemmas and theorems about
general limits can be used.

## References

* [F. Borceux, *Handbook of Categorical Algebra 1*][borceux-vol1]
-/

namespace category_theory.limits

/-- The type of objects for the diagram indexing a (co)equalizer. -/
inductive walking_parallel_pair where
| zero : walking_parallel_pair
| one : walking_parallel_pair

/-- The type family of morphisms for the diagram indexing a (co)equalizer. -/
inductive walking_parallel_pair_hom : walking_parallel_pair → walking_parallel_pair → Type v where
| left : walking_parallel_pair_hom walking_parallel_pair.zero walking_parallel_pair.one
| right : walking_parallel_pair_hom walking_parallel_pair.zero walking_parallel_pair.one
| id : (X : walking_parallel_pair) → walking_parallel_pair_hom X X

/-- Satisfying the inhabited linter -/
protected instance walking_parallel_pair_hom.inhabited :
    Inhabited (walking_parallel_pair_hom walking_parallel_pair.zero walking_parallel_pair.one) :=
  { default := walking_parallel_pair_hom.left }

/-- Composition of morphisms in the indexing diagram for (co)equalizers. -/
def walking_parallel_pair_hom.comp (X : walking_parallel_pair) (Y : walking_parallel_pair)
    (Z : walking_parallel_pair) (f : walking_parallel_pair_hom X Y)
    (g : walking_parallel_pair_hom Y Z) : walking_parallel_pair_hom X Z :=
  sorry

protected instance walking_parallel_pair_hom_category : small_category walking_parallel_pair :=
  category.mk

@[simp] theorem walking_parallel_pair_hom_id (X : walking_parallel_pair) :
    walking_parallel_pair_hom.id X = 𝟙 :=
  rfl

/-- `parallel_pair f g` is the diagram in `C` consisting of the two morphisms `f` and `g` with
    common domain and codomain. -/
def parallel_pair {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y) :
    walking_parallel_pair ⥤ C :=
  functor.mk (fun (x : walking_parallel_pair) => sorry)
    fun (x y : walking_parallel_pair) (h : x ⟶ y) => sorry

@[simp] theorem parallel_pair_obj_zero {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y)
    (g : X ⟶ Y) : functor.obj (parallel_pair f g) walking_parallel_pair.zero = X :=
  rfl

@[simp] theorem parallel_pair_obj_one {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y)
    (g : X ⟶ Y) : functor.obj (parallel_pair f g) walking_parallel_pair.one = Y :=
  rfl

@[simp] theorem parallel_pair_map_left {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y)
    (g : X ⟶ Y) : functor.map (parallel_pair f g) walking_parallel_pair_hom.left = f :=
  rfl

@[simp] theorem parallel_pair_map_right {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y)
    (g : X ⟶ Y) : functor.map (parallel_pair f g) walking_parallel_pair_hom.right = g :=
  rfl

@[simp] theorem parallel_pair_functor_obj {C : Type u} [category C] {F : walking_parallel_pair ⥤ C}
    (j : walking_parallel_pair) :
    functor.obj
          (parallel_pair (functor.map F walking_parallel_pair_hom.left)
            (functor.map F walking_parallel_pair_hom.right))
          j =
        functor.obj F j :=
  sorry

/-- Every functor indexing a (co)equalizer is naturally isomorphic (actually, equal) to a
    `parallel_pair` -/
def diagram_iso_parallel_pair {C : Type u} [category C] (F : walking_parallel_pair ⥤ C) :
    F ≅
        parallel_pair (functor.map F walking_parallel_pair_hom.left)
          (functor.map F walking_parallel_pair_hom.right) :=
  nat_iso.of_components (fun (j : walking_parallel_pair) => eq_to_iso sorry) sorry

/-- A fork on `f` and `g` is just a `cone (parallel_pair f g)`. -/
def fork {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y) :=
  cone (parallel_pair f g)

/-- A cofork on `f` and `g` is just a `cocone (parallel_pair f g)`. -/
def cofork {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y) :=
  cocone (parallel_pair f g)

/-- A fork `t` on the parallel pair `f g : X ⟶ Y` consists of two morphisms `t.π.app zero : t.X ⟶ X`
    and `t.π.app one : t.X ⟶ Y`. Of these, only the first one is interesting, and we give it the
    shorter name `fork.ι t`. -/
def fork.ι {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y} (t : fork f g) :
    functor.obj (functor.obj (functor.const walking_parallel_pair) (cone.X t))
          walking_parallel_pair.zero ⟶
        functor.obj (parallel_pair f g) walking_parallel_pair.zero :=
  nat_trans.app (cone.π t) walking_parallel_pair.zero

/-- A cofork `t` on the parallel_pair `f g : X ⟶ Y` consists of two morphisms
    `t.ι.app zero : X ⟶ t.X` and `t.ι.app one : Y ⟶ t.X`. Of these, only the second one is
    interesting, and we give it the shorter name `cofork.π t`. -/
def cofork.π {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y} (t : cofork f g) :
    functor.obj (parallel_pair f g) walking_parallel_pair.one ⟶
        functor.obj (functor.obj (functor.const walking_parallel_pair) (cocone.X t))
          walking_parallel_pair.one :=
  nat_trans.app (cocone.ι t) walking_parallel_pair.one

@[simp] theorem fork.ι_eq_app_zero {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    (t : fork f g) : fork.ι t = nat_trans.app (cone.π t) walking_parallel_pair.zero :=
  rfl

@[simp] theorem cofork.π_eq_app_one {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} (t : cofork f g) :
    cofork.π t = nat_trans.app (cocone.ι t) walking_parallel_pair.one :=
  rfl

@[simp] theorem fork.app_zero_left {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    (s : fork f g) :
    nat_trans.app (cone.π s) walking_parallel_pair.zero ≫ f =
        nat_trans.app (cone.π s) walking_parallel_pair.one :=
  sorry

@[simp] theorem fork.app_zero_right {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} (s : fork f g) :
    nat_trans.app (cone.π s) walking_parallel_pair.zero ≫ g =
        nat_trans.app (cone.π s) walking_parallel_pair.one :=
  sorry

@[simp] theorem cofork.left_app_one_assoc {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} (s : cofork f g) {X' : C}
    (f' :
      functor.obj (functor.obj (functor.const walking_parallel_pair) (cocone.X s))
          walking_parallel_pair.one ⟶
        X') :
    f ≫ nat_trans.app (cocone.ι s) walking_parallel_pair.one ≫ f' =
        nat_trans.app (cocone.ι s) walking_parallel_pair.zero ≫ f' :=
  sorry

@[simp] theorem cofork.right_app_one_assoc {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} (s : cofork f g) {X' : C}
    (f' :
      functor.obj (functor.obj (functor.const walking_parallel_pair) (cocone.X s))
          walking_parallel_pair.one ⟶
        X') :
    g ≫ nat_trans.app (cocone.ι s) walking_parallel_pair.one ≫ f' =
        nat_trans.app (cocone.ι s) walking_parallel_pair.zero ≫ f' :=
  sorry

/-- A fork on `f g : X ⟶ Y` is determined by the morphism `ι : P ⟶ X` satisfying `ι ≫ f = ι ≫ g`.
-/
@[simp] theorem fork.of_ι_X {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    {P : C} (ι : P ⟶ X) (w : ι ≫ f = ι ≫ g) : cone.X (fork.of_ι ι w) = P :=
  Eq.refl (cone.X (fork.of_ι ι w))

/-- A cofork on `f g : X ⟶ Y` is determined by the morphism `π : Y ⟶ P` satisfying
    `f ≫ π = g ≫ π`. -/
@[simp] theorem cofork.of_π_ι_app {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    {P : C} (π : Y ⟶ P) (w : f ≫ π = g ≫ π) :
    ∀ (X_1 : walking_parallel_pair),
        nat_trans.app (cocone.ι (cofork.of_π π w)) X_1 =
          walking_parallel_pair.cases_on X_1 (f ≫ π) π :=
  fun (X_1 : walking_parallel_pair) => Eq.refl (nat_trans.app (cocone.ι (cofork.of_π π w)) X_1)

theorem fork.ι_of_ι {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y} {P : C}
    (ι : P ⟶ X) (w : ι ≫ f = ι ≫ g) : fork.ι (fork.of_ι ι w) = ι :=
  rfl

theorem cofork.π_of_π {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y} {P : C}
    (π : Y ⟶ P) (w : f ≫ π = g ≫ π) : cofork.π (cofork.of_π π w) = π :=
  rfl

theorem fork.condition {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    (t : fork f g) : fork.ι t ≫ f = fork.ι t ≫ g :=
  sorry

theorem cofork.condition {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    (t : cofork f g) : f ≫ cofork.π t = g ≫ cofork.π t :=
  sorry

/-- To check whether two maps are equalized by both maps of a fork, it suffices to check it for the
    first map -/
theorem fork.equalizer_ext {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    (s : fork f g) {W : C} {k : W ⟶ cone.X s} {l : W ⟶ cone.X s} (h : k ≫ fork.ι s = l ≫ fork.ι s)
    (j : walking_parallel_pair) : k ≫ nat_trans.app (cone.π s) j = l ≫ nat_trans.app (cone.π s) j :=
  sorry

/-- To check whether two maps are coequalized by both maps of a cofork, it suffices to check it for
    the second map -/
theorem cofork.coequalizer_ext {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    (s : cofork f g) {W : C} {k : cocone.X s ⟶ W} {l : cocone.X s ⟶ W}
    (h : cofork.π s ≫ k = cofork.π s ≫ l) (j : walking_parallel_pair) :
    nat_trans.app (cocone.ι s) j ≫ k = nat_trans.app (cocone.ι s) j ≫ l :=
  sorry

theorem fork.is_limit.hom_ext {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    {s : fork f g} (hs : is_limit s) {W : C} {k : W ⟶ cone.X s} {l : W ⟶ cone.X s}
    (h : k ≫ fork.ι s = l ≫ fork.ι s) : k = l :=
  is_limit.hom_ext hs (fork.equalizer_ext s h)

theorem cofork.is_colimit.hom_ext {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    {s : cofork f g} (hs : is_colimit s) {W : C} {k : cocone.X s ⟶ W} {l : cocone.X s ⟶ W}
    (h : cofork.π s ≫ k = cofork.π s ≫ l) : k = l :=
  is_colimit.hom_ext hs (cofork.coequalizer_ext s h)

/-- If `s` is a limit fork over `f` and `g`, then a morphism `k : W ⟶ X` satisfying
    `k ≫ f = k ≫ g` induces a morphism `l : W ⟶ s.X` such that `l ≫ fork.ι s = k`. -/
def fork.is_limit.lift' {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    {s : fork f g} (hs : is_limit s) {W : C} (k : W ⟶ X) (h : k ≫ f = k ≫ g) :
    Subtype fun (l : W ⟶ cone.X s) => l ≫ fork.ι s = k :=
  { val := is_limit.lift hs (fork.of_ι k h), property := sorry }

/-- If `s` is a colimit cofork over `f` and `g`, then a morphism `k : Y ⟶ W` satisfying
    `f ≫ k = g ≫ k` induces a morphism `l : s.X ⟶ W` such that `cofork.π s ≫ l = k`. -/
def cofork.is_colimit.desc' {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    {s : cofork f g} (hs : is_colimit s) {W : C} (k : Y ⟶ W) (h : f ≫ k = g ≫ k) :
    Subtype fun (l : cocone.X s ⟶ W) => cofork.π s ≫ l = k :=
  { val := is_colimit.desc hs (cofork.of_π k h), property := sorry }

/-- This is a slightly more convenient method to verify that a fork is a limit cone. It
    only asks for a proof of facts that carry any mathematical content -/
def fork.is_limit.mk {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    (t : fork f g) (lift : (s : fork f g) → cone.X s ⟶ cone.X t)
    (fac : ∀ (s : fork f g), lift s ≫ fork.ι t = fork.ι s)
    (uniq :
      ∀ (s : fork f g) (m : cone.X s ⟶ cone.X t),
        (∀ (j : walking_parallel_pair),
            m ≫ nat_trans.app (cone.π t) j = nat_trans.app (cone.π s) j) →
          m = lift s) :
    is_limit t :=
  is_limit.mk lift

/-- This is another convenient method to verify that a fork is a limit cone. It
    only asks for a proof of facts that carry any mathematical content, and allows access to the
    same `s` for all parts. -/
def fork.is_limit.mk' {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    (t : fork f g)
    (create :
      (s : fork f g) →
        Subtype
          fun
            (l :
            functor.obj (functor.obj (functor.const walking_parallel_pair) (cone.X s))
                walking_parallel_pair.zero ⟶
              functor.obj (functor.obj (functor.const walking_parallel_pair) (cone.X t))
                walking_parallel_pair.zero) =>
            l ≫ fork.ι t = fork.ι s ∧
              ∀
                {m :
                  functor.obj (functor.obj (functor.const walking_parallel_pair) (cone.X s))
                      walking_parallel_pair.zero ⟶
                    functor.obj (functor.obj (functor.const walking_parallel_pair) (cone.X t))
                      walking_parallel_pair.zero},
                m ≫ fork.ι t = fork.ι s → m = l) :
    is_limit t :=
  fork.is_limit.mk t (fun (s : fork f g) => subtype.val (create s)) sorry sorry

/-- This is a slightly more convenient method to verify that a cofork is a colimit cocone. It
    only asks for a proof of facts that carry any mathematical content -/
def cofork.is_colimit.mk {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    (t : cofork f g) (desc : (s : cofork f g) → cocone.X t ⟶ cocone.X s)
    (fac : ∀ (s : cofork f g), cofork.π t ≫ desc s = cofork.π s)
    (uniq :
      ∀ (s : cofork f g) (m : cocone.X t ⟶ cocone.X s),
        (∀ (j : walking_parallel_pair),
            nat_trans.app (cocone.ι t) j ≫ m = nat_trans.app (cocone.ι s) j) →
          m = desc s) :
    is_colimit t :=
  is_colimit.mk desc

/-- This is another convenient method to verify that a fork is a limit cone. It
    only asks for a proof of facts that carry any mathematical content, and allows access to the
    same `s` for all parts. -/
def cofork.is_colimit.mk' {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    (t : cofork f g)
    (create :
      (s : cofork f g) →
        Subtype
          fun (l : cocone.X t ⟶ cocone.X s) =>
            cofork.π t ≫ l = cofork.π s ∧
              ∀
                {m :
                  functor.obj (functor.obj (functor.const walking_parallel_pair) (cocone.X t))
                      walking_parallel_pair.one ⟶
                    functor.obj (functor.obj (functor.const walking_parallel_pair) (cocone.X s))
                      walking_parallel_pair.one},
                cofork.π t ≫ m = cofork.π s → m = l) :
    is_colimit t :=
  cofork.is_colimit.mk t (fun (s : cofork f g) => subtype.val (create s)) sorry sorry

/--
Given a limit cone for the pair `f g : X ⟶ Y`, for any `Z`, morphisms from `Z` to its point are in
bijection with morphisms `h : Z ⟶ X` such that `h ≫ f = h ≫ g`.
Further, this bijection is natural in `Z`: see `fork.is_limit.hom_iso_natural`.
This is a special case of `is_limit.hom_iso'`, often useful to construct adjunctions.
-/
def fork.is_limit.hom_iso {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    {t : fork f g} (ht : is_limit t) (Z : C) :
    (Z ⟶ cone.X t) ≃ Subtype fun (h : Z ⟶ X) => h ≫ f = h ≫ g :=
  equiv.mk (fun (k : Z ⟶ cone.X t) => { val := k ≫ fork.ι t, property := sorry })
    (fun (h : Subtype fun (h : Z ⟶ X) => h ≫ f = h ≫ g) =>
      subtype.val (fork.is_limit.lift' ht ↑h sorry))
    sorry sorry

/-- The bijection of `fork.is_limit.hom_iso` is natural in `Z`. -/
theorem fork.is_limit.hom_iso_natural {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} {t : fork f g} (ht : is_limit t) {Z : C} {Z' : C} (q : Z' ⟶ Z) (k : Z ⟶ cone.X t) :
    ↑(coe_fn (fork.is_limit.hom_iso ht Z') (q ≫ k)) =
        q ≫ ↑(coe_fn (fork.is_limit.hom_iso ht Z) k) :=
  category.assoc q k (fork.ι t)

/--
Given a colimit cocone for the pair `f g : X ⟶ Y`, for any `Z`, morphisms from the cocone point
to `Z` are in bijection with morphisms `h : Y ⟶ Z` such that `f ≫ h = g ≫ h`.
Further, this bijection is natural in `Z`: see `cofork.is_colimit.hom_iso_natural`.
This is a special case of `is_colimit.hom_iso'`, often useful to construct adjunctions.
-/
def cofork.is_colimit.hom_iso {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    {t : cofork f g} (ht : is_colimit t) (Z : C) :
    (cocone.X t ⟶ Z) ≃ Subtype fun (h : Y ⟶ Z) => f ≫ h = g ≫ h :=
  equiv.mk (fun (k : cocone.X t ⟶ Z) => { val := cofork.π t ≫ k, property := sorry })
    (fun (h : Subtype fun (h : Y ⟶ Z) => f ≫ h = g ≫ h) =>
      subtype.val (cofork.is_colimit.desc' ht ↑h sorry))
    sorry sorry

/-- The bijection of `cofork.is_colimit.hom_iso` is natural in `Z`. -/
theorem cofork.is_colimit.hom_iso_natural {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} {t : cofork f g} {Z : C} {Z' : C} (q : Z ⟶ Z') (ht : is_colimit t)
    (k : cocone.X t ⟶ Z) :
    ↑(coe_fn (cofork.is_colimit.hom_iso ht Z') (k ≫ q)) =
        ↑(coe_fn (cofork.is_colimit.hom_iso ht Z) k) ≫ q :=
  Eq.symm (category.assoc (cofork.π t) k q)

/-- This is a helper construction that can be useful when verifying that a category has all
    equalizers. Given `F : walking_parallel_pair ⥤ C`, which is really the same as
    `parallel_pair (F.map left) (F.map right)`, and a fork on `F.map left` and `F.map right`,
    we get a cone on `F`.

    If you're thinking about using this, have a look at `has_equalizers_of_has_limit_parallel_pair`,
    which you may find to be an easier way of achieving your goal. -/
def cone.of_fork {C : Type u} [category C] {F : walking_parallel_pair ⥤ C}
    (t :
      fork (functor.map F walking_parallel_pair_hom.left)
        (functor.map F walking_parallel_pair_hom.right)) :
    cone F :=
  cone.mk (cone.X t)
    (nat_trans.mk fun (X : walking_parallel_pair) => nat_trans.app (cone.π t) X ≫ eq_to_hom sorry)

/-- This is a helper construction that can be useful when verifying that a category has all
    coequalizers. Given `F : walking_parallel_pair ⥤ C`, which is really the same as
    `parallel_pair (F.map left) (F.map right)`, and a cofork on `F.map left` and `F.map right`,
    we get a cocone on `F`.

    If you're thinking about using this, have a look at
    `has_coequalizers_of_has_colimit_parallel_pair`, which you may find to be an easier way of
    achieving your goal. -/
def cocone.of_cofork {C : Type u} [category C] {F : walking_parallel_pair ⥤ C}
    (t :
      cofork (functor.map F walking_parallel_pair_hom.left)
        (functor.map F walking_parallel_pair_hom.right)) :
    cocone F :=
  cocone.mk (cocone.X t)
    (nat_trans.mk fun (X : walking_parallel_pair) => eq_to_hom sorry ≫ nat_trans.app (cocone.ι t) X)

@[simp] theorem cone.of_fork_π {C : Type u} [category C] {F : walking_parallel_pair ⥤ C}
    (t :
      fork (functor.map F walking_parallel_pair_hom.left)
        (functor.map F walking_parallel_pair_hom.right))
    (j : walking_parallel_pair) :
    nat_trans.app (cone.π (cone.of_fork t)) j =
        nat_trans.app (cone.π t) j ≫
          eq_to_hom
            (eq.mpr
              (id
                (Eq.trans
                  ((fun (a a_1 : C) (e_1 : a = a_1) (ᾰ ᾰ_1 : C) (e_2 : ᾰ = ᾰ_1) =>
                      congr (congr_arg Eq e_1) e_2)
                    (functor.obj
                      (parallel_pair (functor.map F walking_parallel_pair_hom.left)
                        (functor.map F walking_parallel_pair_hom.right))
                      j)
                    (functor.obj F j) (parallel_pair_functor_obj j) (functor.obj F j)
                    (functor.obj F j) (Eq.refl (functor.obj F j)))
                  (propext (eq_self_iff_true (functor.obj F j)))))
              trivial) :=
  rfl

@[simp] theorem cocone.of_cofork_ι {C : Type u} [category C] {F : walking_parallel_pair ⥤ C}
    (t :
      cofork (functor.map F walking_parallel_pair_hom.left)
        (functor.map F walking_parallel_pair_hom.right))
    (j : walking_parallel_pair) :
    nat_trans.app (cocone.ι (cocone.of_cofork t)) j =
        eq_to_hom
            (eq.mpr
              (id
                (Eq.trans
                  ((fun (a a_1 : C) (e_1 : a = a_1) (ᾰ ᾰ_1 : C) (e_2 : ᾰ = ᾰ_1) =>
                      congr (congr_arg Eq e_1) e_2)
                    (functor.obj F j) (functor.obj F j) (Eq.refl (functor.obj F j))
                    (functor.obj
                      (parallel_pair (functor.map F walking_parallel_pair_hom.left)
                        (functor.map F walking_parallel_pair_hom.right))
                      j)
                    (functor.obj F j) (parallel_pair_functor_obj j))
                  (propext (eq_self_iff_true (functor.obj F j)))))
              trivial) ≫
          nat_trans.app (cocone.ι t) j :=
  rfl

/-- Given `F : walking_parallel_pair ⥤ C`, which is really the same as
    `parallel_pair (F.map left) (F.map right)` and a cone on `F`, we get a fork on
    `F.map left` and `F.map right`. -/
def fork.of_cone {C : Type u} [category C] {F : walking_parallel_pair ⥤ C} (t : cone F) :
    fork (functor.map F walking_parallel_pair_hom.left)
        (functor.map F walking_parallel_pair_hom.right) :=
  cone.mk (cone.X t)
    (nat_trans.mk fun (X : walking_parallel_pair) => nat_trans.app (cone.π t) X ≫ eq_to_hom sorry)

/-- Given `F : walking_parallel_pair ⥤ C`, which is really the same as
    `parallel_pair (F.map left) (F.map right)` and a cocone on `F`, we get a cofork on
    `F.map left` and `F.map right`. -/
def cofork.of_cocone {C : Type u} [category C] {F : walking_parallel_pair ⥤ C} (t : cocone F) :
    cofork (functor.map F walking_parallel_pair_hom.left)
        (functor.map F walking_parallel_pair_hom.right) :=
  cocone.mk (cocone.X t)
    (nat_trans.mk fun (X : walking_parallel_pair) => eq_to_hom sorry ≫ nat_trans.app (cocone.ι t) X)

@[simp] theorem fork.of_cone_π {C : Type u} [category C] {F : walking_parallel_pair ⥤ C}
    (t : cone F) (j : walking_parallel_pair) :
    nat_trans.app (cone.π (fork.of_cone t)) j =
        nat_trans.app (cone.π t) j ≫
          eq_to_hom
            (eq.mpr
              (id
                (Eq.trans
                  ((fun (a a_1 : C) (e_1 : a = a_1) (ᾰ ᾰ_1 : C) (e_2 : ᾰ = ᾰ_1) =>
                      congr (congr_arg Eq e_1) e_2)
                    (functor.obj F j) (functor.obj F j) (Eq.refl (functor.obj F j))
                    (functor.obj
                      (parallel_pair (functor.map F walking_parallel_pair_hom.left)
                        (functor.map F walking_parallel_pair_hom.right))
                      j)
                    (functor.obj F j) (parallel_pair_functor_obj j))
                  (propext (eq_self_iff_true (functor.obj F j)))))
              trivial) :=
  rfl

@[simp] theorem cofork.of_cocone_ι {C : Type u} [category C] {F : walking_parallel_pair ⥤ C}
    (t : cocone F) (j : walking_parallel_pair) :
    nat_trans.app (cocone.ι (cofork.of_cocone t)) j =
        eq_to_hom
            (eq.mpr
              (id
                (Eq.trans
                  ((fun (a a_1 : C) (e_1 : a = a_1) (ᾰ ᾰ_1 : C) (e_2 : ᾰ = ᾰ_1) =>
                      congr (congr_arg Eq e_1) e_2)
                    (functor.obj
                      (parallel_pair (functor.map F walking_parallel_pair_hom.left)
                        (functor.map F walking_parallel_pair_hom.right))
                      j)
                    (functor.obj F j) (parallel_pair_functor_obj j) (functor.obj F j)
                    (functor.obj F j) (Eq.refl (functor.obj F j)))
                  (propext (eq_self_iff_true (functor.obj F j)))))
              trivial) ≫
          nat_trans.app (cocone.ι t) j :=
  rfl

/--
Helper function for constructing morphisms between equalizer forks.
-/
@[simp] theorem fork.mk_hom_hom {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    {s : fork f g} {t : fork f g} (k : cone.X s ⟶ cone.X t) (w : k ≫ fork.ι t = fork.ι s) :
    cone_morphism.hom (fork.mk_hom k w) = k :=
  Eq.refl (cone_morphism.hom (fork.mk_hom k w))

/--
To construct an isomorphism between forks,
it suffices to give an isomorphism between the cone points
and check that it commutes with the `ι` morphisms.
-/
@[simp] theorem fork.ext_hom {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    {s : fork f g} {t : fork f g} (i : cone.X s ≅ cone.X t) (w : iso.hom i ≫ fork.ι t = fork.ι s) :
    iso.hom (fork.ext i w) = fork.mk_hom (iso.hom i) w :=
  Eq.refl (iso.hom (fork.ext i w))

/--
Helper function for constructing morphisms between coequalizer coforks.
-/
@[simp] theorem cofork.mk_hom_hom {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    {s : cofork f g} {t : cofork f g} (k : cocone.X s ⟶ cocone.X t)
    (w : cofork.π s ≫ k = cofork.π t) : cocone_morphism.hom (cofork.mk_hom k w) = k :=
  Eq.refl (cocone_morphism.hom (cofork.mk_hom k w))

/--
To construct an isomorphism between coforks,
it suffices to give an isomorphism between the cocone points
and check that it commutes with the `π` morphisms.
-/
def cofork.ext {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y} {s : cofork f g}
    {t : cofork f g} (i : cocone.X s ≅ cocone.X t) (w : cofork.π s ≫ iso.hom i = cofork.π t) :
    s ≅ t :=
  iso.mk (cofork.mk_hom (iso.hom i) w) (cofork.mk_hom (iso.inv i) sorry)

/--
`has_equalizer f g` represents a particular choice of limiting cone
for the parallel pair of morphisms `f` and `g`.
-/
def has_equalizer {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y) :=
  has_limit (parallel_pair f g)

/-- If an equalizer of `f` and `g` exists, we can access an arbitrary choice of such by
    saying `equalizer f g`. -/
def equalizer {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y)
    [has_equalizer f g] : C :=
  limit (parallel_pair f g)

/-- If an equalizer of `f` and `g` exists, we can access the inclusion
    `equalizer f g ⟶ X` by saying `equalizer.ι f g`. -/
def equalizer.ι {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y)
    [has_equalizer f g] : equalizer f g ⟶ X :=
  limit.π (parallel_pair f g) walking_parallel_pair.zero

/--
An equalizer cone for a parallel pair `f` and `g`.
-/
def equalizer.fork {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y)
    [has_equalizer f g] : fork f g :=
  limit.cone (parallel_pair f g)

@[simp] theorem equalizer.fork_ι {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y)
    [has_equalizer f g] : fork.ι (equalizer.fork f g) = equalizer.ι f g :=
  rfl

@[simp] theorem equalizer.fork_π_app_zero {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y)
    (g : X ⟶ Y) [has_equalizer f g] :
    nat_trans.app (cone.π (equalizer.fork f g)) walking_parallel_pair.zero = equalizer.ι f g :=
  rfl

theorem equalizer.condition {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y)
    [has_equalizer f g] : equalizer.ι f g ≫ f = equalizer.ι f g ≫ g :=
  fork.condition (limit.cone (parallel_pair f g))

/-- The equalizer built from `equalizer.ι f g` is limiting. -/
def equalizer_is_equalizer {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y)
    [has_equalizer f g] : is_limit (fork.of_ι (equalizer.ι f g) (equalizer.condition f g)) :=
  is_limit.of_iso_limit (limit.is_limit (parallel_pair f g))
    (fork.ext (iso.refl (cone.X (limit.cone (parallel_pair f g)))) sorry)

/-- A morphism `k : W ⟶ X` satisfying `k ≫ f = k ≫ g` factors through the equalizer of `f` and `g`
    via `equalizer.lift : W ⟶ equalizer f g`. -/
def equalizer.lift {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    [has_equalizer f g] {W : C} (k : W ⟶ X) (h : k ≫ f = k ≫ g) : W ⟶ equalizer f g :=
  limit.lift (parallel_pair f g) (fork.of_ι k h)

@[simp] theorem equalizer.lift_ι_assoc {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} [has_equalizer f g] {W : C} (k : W ⟶ X) (h : k ≫ f = k ≫ g) {X' : C} (f' : X ⟶ X') :
    equalizer.lift k h ≫ equalizer.ι f g ≫ f' = k ≫ f' :=
  sorry

/-- A morphism `k : W ⟶ X` satisfying `k ≫ f = k ≫ g` induces a morphism `l : W ⟶ equalizer f g`
    satisfying `l ≫ equalizer.ι f g = k`. -/
def equalizer.lift' {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    [has_equalizer f g] {W : C} (k : W ⟶ X) (h : k ≫ f = k ≫ g) :
    Subtype fun (l : W ⟶ equalizer f g) => l ≫ equalizer.ι f g = k :=
  { val := equalizer.lift k h, property := equalizer.lift_ι k h }

/-- Two maps into an equalizer are equal if they are are equal when composed with the equalizer
    map. -/
theorem equalizer.hom_ext {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    [has_equalizer f g] {W : C} {k : W ⟶ equalizer f g} {l : W ⟶ equalizer f g}
    (h : k ≫ equalizer.ι f g = l ≫ equalizer.ι f g) : k = l :=
  fork.is_limit.hom_ext (limit.is_limit (parallel_pair f g)) h

/-- An equalizer morphism is a monomorphism -/
protected instance equalizer.ι_mono {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} [has_equalizer f g] : mono (equalizer.ι f g) :=
  mono.mk
    fun (Z : C) (h k : Z ⟶ equalizer f g) (w : h ≫ equalizer.ι f g = k ≫ equalizer.ι f g) =>
      equalizer.hom_ext w

/-- The equalizer morphism in any limit cone is a monomorphism. -/
theorem mono_of_is_limit_parallel_pair {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} {c : cone (parallel_pair f g)} (i : is_limit c) : mono (fork.ι c) :=
  sorry

/-- The identity determines a cone on the equalizer diagram of `f` and `g` if `f = g`. -/
def id_fork {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y} (h : f = g) :
    fork f g :=
  fork.of_ι 𝟙 sorry

/-- The identity on `X` is an equalizer of `(f, g)`, if `f = g`. -/
def is_limit_id_fork {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y} (h : f = g) :
    is_limit (id_fork h) :=
  fork.is_limit.mk (id_fork h) (fun (s : fork f g) => fork.ι s) sorry sorry

/-- Every equalizer of `(f, g)`, where `f = g`, is an isomorphism. -/
def is_iso_limit_cone_parallel_pair_of_eq {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} (h₀ : f = g) {c : cone (parallel_pair f g)} (h : is_limit c) :
    is_iso (nat_trans.app (cone.π c) walking_parallel_pair.zero) :=
  is_iso.of_iso (is_limit.cone_point_unique_up_to_iso h (is_limit_id_fork h₀))

/-- The equalizer of `(f, g)`, where `f = g`, is an isomorphism. -/
def equalizer.ι_of_eq {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    [has_equalizer f g] (h : f = g) : is_iso (equalizer.ι f g) :=
  is_iso_limit_cone_parallel_pair_of_eq h (limit.is_limit (parallel_pair f g))

/-- Every equalizer of `(f, f)` is an isomorphism. -/
def is_iso_limit_cone_parallel_pair_of_self {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {c : cone (parallel_pair f f)} (h : is_limit c) :
    is_iso (nat_trans.app (cone.π c) walking_parallel_pair.zero) :=
  is_iso_limit_cone_parallel_pair_of_eq sorry h

/-- An equalizer that is an epimorphism is an isomorphism. -/
def is_iso_limit_cone_parallel_pair_of_epi {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} {c : cone (parallel_pair f g)} (h : is_limit c)
    [epi (nat_trans.app (cone.π c) walking_parallel_pair.zero)] :
    is_iso (nat_trans.app (cone.π c) walking_parallel_pair.zero) :=
  is_iso_limit_cone_parallel_pair_of_eq sorry h

protected instance has_equalizer_of_self {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) :
    has_equalizer f f :=
  has_limit.mk (limit_cone.mk (id_fork rfl) (is_limit_id_fork rfl))

/-- The equalizer inclusion for `(f, f)` is an isomorphism. -/
protected instance equalizer.ι_of_self {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) :
    is_iso (equalizer.ι f f) :=
  equalizer.ι_of_eq sorry

/-- The equalizer of a morphism with itself is isomorphic to the source. -/
def equalizer.iso_source_of_self {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) :
    equalizer f f ≅ X :=
  as_iso (equalizer.ι f f)

@[simp] theorem equalizer.iso_source_of_self_hom {C : Type u} [category C] {X : C} {Y : C}
    (f : X ⟶ Y) : iso.hom (equalizer.iso_source_of_self f) = equalizer.ι f f :=
  rfl

@[simp] theorem equalizer.iso_source_of_self_inv {C : Type u} [category C] {X : C} {Y : C}
    (f : X ⟶ Y) :
    iso.inv (equalizer.iso_source_of_self f) =
        equalizer.lift 𝟙
          (eq.mpr
            (id
              (Eq.trans
                ((fun (a a_1 : X ⟶ Y) (e_1 : a = a_1) (ᾰ ᾰ_1 : X ⟶ Y) (e_2 : ᾰ = ᾰ_1) =>
                    congr (congr_arg Eq e_1) e_2)
                  (𝟙 ≫ f) f (category.id_comp f) (𝟙 ≫ f) f (category.id_comp f))
                (propext (eq_self_iff_true f))))
            trivial) :=
  rfl

/--
`has_coequalizer f g` represents a particular choice of colimiting cocone
for the parallel pair of morphisms `f` and `g`.
-/
def has_coequalizer {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y) :=
  has_colimit (parallel_pair f g)

/-- If a coequalizer of `f` and `g` exists, we can access an arbitrary choice of such by
    saying `coequalizer f g`. -/
def coequalizer {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y)
    [has_coequalizer f g] : C :=
  colimit (parallel_pair f g)

/--  If a coequalizer of `f` and `g` exists, we can access the corresponding projection by
    saying `coequalizer.π f g`. -/
def coequalizer.π {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y)
    [has_coequalizer f g] : Y ⟶ coequalizer f g :=
  colimit.ι (parallel_pair f g) walking_parallel_pair.one

/--
An arbitrary choice of coequalizer cocone for a parallel pair `f` and `g`.
-/
def coequalizer.cofork {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y)
    [has_coequalizer f g] : cofork f g :=
  colimit.cocone (parallel_pair f g)

@[simp] theorem coequalizer.cofork_π {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y)
    (g : X ⟶ Y) [has_coequalizer f g] : cofork.π (coequalizer.cofork f g) = coequalizer.π f g :=
  rfl

@[simp] theorem coequalizer.cofork_ι_app_one {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y)
    (g : X ⟶ Y) [has_coequalizer f g] :
    nat_trans.app (cocone.ι (coequalizer.cofork f g)) walking_parallel_pair.one =
        coequalizer.π f g :=
  rfl

theorem coequalizer.condition_assoc {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y)
    (g : X ⟶ Y) [has_coequalizer f g] {X' : C} (f' : coequalizer f g ⟶ X') :
    f ≫ coequalizer.π f g ≫ f' = g ≫ coequalizer.π f g ≫ f' :=
  sorry

/-- The cofork built from `coequalizer.π f g` is colimiting. -/
def coequalizer_is_coequalizer {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y)
    [has_coequalizer f g] :
    is_colimit (cofork.of_π (coequalizer.π f g) (coequalizer.condition f g)) :=
  is_colimit.of_iso_colimit (colimit.is_colimit (parallel_pair f g))
    (cofork.ext (iso.refl (cocone.X (colimit.cocone (parallel_pair f g)))) sorry)

/-- Any morphism `k : Y ⟶ W` satisfying `f ≫ k = g ≫ k` factors through the coequalizer of `f`
    and `g` via `coequalizer.desc : coequalizer f g ⟶ W`. -/
def coequalizer.desc {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    [has_coequalizer f g] {W : C} (k : Y ⟶ W) (h : f ≫ k = g ≫ k) : coequalizer f g ⟶ W :=
  colimit.desc (parallel_pair f g) (cofork.of_π k h)

@[simp] theorem coequalizer.π_desc_assoc {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} [has_coequalizer f g] {W : C} (k : Y ⟶ W) (h : f ≫ k = g ≫ k) {X' : C}
    (f' : W ⟶ X') : coequalizer.π f g ≫ coequalizer.desc k h ≫ f' = k ≫ f' :=
  sorry

/-- Any morphism `k : Y ⟶ W` satisfying `f ≫ k = g ≫ k` induces a morphism
    `l : coequalizer f g ⟶ W` satisfying `coequalizer.π ≫ g = l`. -/
def coequalizer.desc' {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    [has_coequalizer f g] {W : C} (k : Y ⟶ W) (h : f ≫ k = g ≫ k) :
    Subtype fun (l : coequalizer f g ⟶ W) => coequalizer.π f g ≫ l = k :=
  { val := coequalizer.desc k h, property := coequalizer.π_desc k h }

/-- Two maps from a coequalizer are equal if they are equal when composed with the coequalizer
    map -/
theorem coequalizer.hom_ext {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    [has_coequalizer f g] {W : C} {k : coequalizer f g ⟶ W} {l : coequalizer f g ⟶ W}
    (h : coequalizer.π f g ≫ k = coequalizer.π f g ≫ l) : k = l :=
  cofork.is_colimit.hom_ext (colimit.is_colimit (parallel_pair f g)) h

/-- A coequalizer morphism is an epimorphism -/
protected instance coequalizer.π_epi {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} [has_coequalizer f g] : epi (coequalizer.π f g) :=
  epi.mk
    fun (Z : C) (h k : coequalizer f g ⟶ Z) (w : coequalizer.π f g ≫ h = coequalizer.π f g ≫ k) =>
      coequalizer.hom_ext w

/-- The coequalizer morphism in any colimit cocone is an epimorphism. -/
theorem epi_of_is_colimit_parallel_pair {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} {c : cocone (parallel_pair f g)} (i : is_colimit c) :
    epi (nat_trans.app (cocone.ι c) walking_parallel_pair.one) :=
  sorry

/-- The identity determines a cocone on the coequalizer diagram of `f` and `g`, if `f = g`. -/
def id_cofork {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y} (h : f = g) :
    cofork f g :=
  cofork.of_π 𝟙 sorry

/-- The identity on `Y` is a coequalizer of `(f, g)`, where `f = g`.  -/
def is_colimit_id_cofork {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    (h : f = g) : is_colimit (id_cofork h) :=
  cofork.is_colimit.mk (id_cofork h) (fun (s : cofork f g) => cofork.π s) sorry sorry

/-- Every coequalizer of `(f, g)`, where `f = g`, is an isomorphism. -/
def is_iso_colimit_cocone_parallel_pair_of_eq {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} (h₀ : f = g) {c : cocone (parallel_pair f g)} (h : is_colimit c) :
    is_iso (nat_trans.app (cocone.ι c) walking_parallel_pair.one) :=
  is_iso.of_iso (is_colimit.cocone_point_unique_up_to_iso (is_colimit_id_cofork h₀) h)

/-- The coequalizer of `(f, g)`, where `f = g`, is an isomorphism. -/
def coequalizer.π_of_eq {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    [has_coequalizer f g] (h : f = g) : is_iso (coequalizer.π f g) :=
  is_iso_colimit_cocone_parallel_pair_of_eq h (colimit.is_colimit (parallel_pair f g))

/-- Every coequalizer of `(f, f)` is an isomorphism. -/
def is_iso_colimit_cocone_parallel_pair_of_self {C : Type u} [category C] {X : C} {Y : C}
    {f : X ⟶ Y} {c : cocone (parallel_pair f f)} (h : is_colimit c) :
    is_iso (nat_trans.app (cocone.ι c) walking_parallel_pair.one) :=
  is_iso_colimit_cocone_parallel_pair_of_eq sorry h

/-- A coequalizer that is a monomorphism is an isomorphism. -/
def is_iso_limit_cocone_parallel_pair_of_epi {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} {c : cocone (parallel_pair f g)} (h : is_colimit c)
    [mono (nat_trans.app (cocone.ι c) walking_parallel_pair.one)] :
    is_iso (nat_trans.app (cocone.ι c) walking_parallel_pair.one) :=
  is_iso_colimit_cocone_parallel_pair_of_eq sorry h

protected instance has_coequalizer_of_self {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) :
    has_coequalizer f f :=
  has_colimit.mk (colimit_cocone.mk (id_cofork rfl) (is_colimit_id_cofork rfl))

/-- The coequalizer projection for `(f, f)` is an isomorphism. -/
protected instance coequalizer.π_of_self {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) :
    is_iso (coequalizer.π f f) :=
  coequalizer.π_of_eq sorry

/-- The coequalizer of a morphism with itself is isomorphic to the target. -/
def coequalizer.iso_target_of_self {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) :
    coequalizer f f ≅ Y :=
  iso.symm (as_iso (coequalizer.π f f))

@[simp] theorem coequalizer.iso_target_of_self_hom {C : Type u} [category C] {X : C} {Y : C}
    (f : X ⟶ Y) :
    iso.hom (coequalizer.iso_target_of_self f) =
        coequalizer.desc 𝟙
          (eq.mpr
            (id
              (Eq.trans
                ((fun (a a_1 : X ⟶ Y) (e_1 : a = a_1) (ᾰ ᾰ_1 : X ⟶ Y) (e_2 : ᾰ = ᾰ_1) =>
                    congr (congr_arg Eq e_1) e_2)
                  (f ≫ 𝟙) f (category.comp_id f) (f ≫ 𝟙) f (category.comp_id f))
                (propext (eq_self_iff_true f))))
            trivial) :=
  rfl

@[simp] theorem coequalizer.iso_target_of_self_inv {C : Type u} [category C] {X : C} {Y : C}
    (f : X ⟶ Y) : iso.inv (coequalizer.iso_target_of_self f) = coequalizer.π f f :=
  rfl

/--
The comparison morphism for the equalizer of `f,g`.
This is an isomorphism iff `G` preserves the equalizer of `f,g`; see
`category_theory/limits/preserves/shapes/equalizers.lean`
-/
def equalizer_comparison {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y)
    {D : Type u₂} [category D] (G : C ⥤ D) [has_equalizer f g]
    [has_equalizer (functor.map G f) (functor.map G g)] :
    functor.obj G (equalizer f g) ⟶ equalizer (functor.map G f) (functor.map G g) :=
  equalizer.lift (functor.map G (equalizer.ι f g)) sorry

@[simp] theorem equalizer_comparison_comp_π_assoc {C : Type u} [category C] {X : C} {Y : C}
    (f : X ⟶ Y) (g : X ⟶ Y) {D : Type u₂} [category D] (G : C ⥤ D) [has_equalizer f g]
    [has_equalizer (functor.map G f) (functor.map G g)] {X' : D} (f' : functor.obj G X ⟶ X') :
    equalizer_comparison f g G ≫ equalizer.ι (functor.map G f) (functor.map G g) ≫ f' =
        functor.map G (equalizer.ι f g) ≫ f' :=
  sorry

@[simp] theorem map_lift_equalizer_comparison {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y)
    (g : X ⟶ Y) {D : Type u₂} [category D] (G : C ⥤ D) [has_equalizer f g]
    [has_equalizer (functor.map G f) (functor.map G g)] {Z : C} {h : Z ⟶ X} (w : h ≫ f = h ≫ g) :
    functor.map G (equalizer.lift h w) ≫ equalizer_comparison f g G =
        equalizer.lift (functor.map G h)
          (eq.mpr
            (id
              ((fun (a a_1 : functor.obj G Z ⟶ functor.obj G Y) (e_1 : a = a_1)
                  (ᾰ ᾰ_1 : functor.obj G Z ⟶ functor.obj G Y) (e_2 : ᾰ = ᾰ_1) =>
                  congr (congr_arg Eq e_1) e_2)
                (functor.map G h ≫ functor.map G f) (functor.map G (h ≫ g))
                (Eq.trans (Eq.symm (functor.map_comp G h f))
                  ((fun (c : C ⥤ D) {X Y : C} (ᾰ ᾰ_1 : X ⟶ Y) (e_4 : ᾰ = ᾰ_1) =>
                      congr_arg (functor.map c) e_4)
                    G (h ≫ f) (h ≫ g) w))
                (functor.map G h ≫ functor.map G g) (functor.map G (h ≫ g))
                (Eq.symm (functor.map_comp G h g))))
            (Eq.refl (functor.map G (h ≫ g)))) :=
  sorry

/-- The comparison morphism for the coequalizer of `f,g`. -/
def coequalizer_comparison {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y)
    {D : Type u₂} [category D] (G : C ⥤ D) [has_coequalizer f g]
    [has_coequalizer (functor.map G f) (functor.map G g)] :
    coequalizer (functor.map G f) (functor.map G g) ⟶ functor.obj G (coequalizer f g) :=
  coequalizer.desc (functor.map G (coequalizer.π f g)) sorry

@[simp] theorem ι_comp_coequalizer_comparison {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y)
    (g : X ⟶ Y) {D : Type u₂} [category D] (G : C ⥤ D) [has_coequalizer f g]
    [has_coequalizer (functor.map G f) (functor.map G g)] :
    coequalizer.π (functor.map G f) (functor.map G g) ≫ coequalizer_comparison f g G =
        functor.map G (coequalizer.π f g) :=
  coequalizer.π_desc (functor.map G (coequalizer.π f g)) (coequalizer_comparison._proof_1 f g G)

@[simp] theorem coequalizer_comparison_map_desc_assoc {C : Type u} [category C] {X : C} {Y : C}
    (f : X ⟶ Y) (g : X ⟶ Y) {D : Type u₂} [category D] (G : C ⥤ D) [has_coequalizer f g]
    [has_coequalizer (functor.map G f) (functor.map G g)] {Z : C} {h : Y ⟶ Z} (w : f ≫ h = g ≫ h)
    {X' : D} (f' : functor.obj G Z ⟶ X') :
    coequalizer_comparison f g G ≫ functor.map G (coequalizer.desc h w) ≫ f' =
        coequalizer.desc (functor.map G h)
            (eq.mpr
              (id
                ((fun (a a_1 : functor.obj G X ⟶ functor.obj G Z) (e_1 : a = a_1)
                    (ᾰ ᾰ_1 : functor.obj G X ⟶ functor.obj G Z) (e_2 : ᾰ = ᾰ_1) =>
                    congr (congr_arg Eq e_1) e_2)
                  (functor.map G f ≫ functor.map G h) (functor.map G (g ≫ h))
                  (Eq.trans (Eq.symm (functor.map_comp G f h))
                    ((fun (c : C ⥤ D) {X Y : C} (ᾰ ᾰ_1 : X ⟶ Y) (e_4 : ᾰ = ᾰ_1) =>
                        congr_arg (functor.map c) e_4)
                      G (f ≫ h) (g ≫ h) w))
                  (functor.map G g ≫ functor.map G h) (functor.map G (g ≫ h))
                  (Eq.symm (functor.map_comp G g h))))
              (Eq.refl (functor.map G (g ≫ h)))) ≫
          f' :=
  sorry

/-- `has_equalizers` represents a choice of equalizer for every pair of morphisms -/
def has_equalizers (C : Type u) [category C] := has_limits_of_shape walking_parallel_pair C

/-- `has_coequalizers` represents a choice of coequalizer for every pair of morphisms -/
def has_coequalizers (C : Type u) [category C] := has_colimits_of_shape walking_parallel_pair C

/-- If `C` has all limits of diagrams `parallel_pair f g`, then it has all equalizers -/
theorem has_equalizers_of_has_limit_parallel_pair (C : Type u) [category C]
    [∀ {X Y : C} {f g : X ⟶ Y}, has_limit (parallel_pair f g)] : has_equalizers C :=
  has_limits_of_shape.mk
    fun (F : walking_parallel_pair ⥤ C) => has_limit_of_iso (iso.symm (diagram_iso_parallel_pair F))

/-- If `C` has all colimits of diagrams `parallel_pair f g`, then it has all coequalizers -/
theorem has_coequalizers_of_has_colimit_parallel_pair (C : Type u) [category C]
    [∀ {X Y : C} {f g : X ⟶ Y}, has_colimit (parallel_pair f g)] : has_coequalizers C :=
  has_colimits_of_shape.mk
    fun (F : walking_parallel_pair ⥤ C) => has_colimit_of_iso (diagram_iso_parallel_pair F)

-- In this section we show that a split mono `f` equalizes `(retraction f ≫ f)` and `(𝟙 Y)`.

/--
A split mono `f` equalizes `(retraction f ≫ f)` and `(𝟙 Y)`.
Here we build the cone, and show in `split_mono_equalizes` that it is a limit cone.
-/
@[simp] theorem cone_of_split_mono_X {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y)
    [split_mono f] : cone.X (cone_of_split_mono f) = X :=
  Eq.refl (cone.X (cone_of_split_mono f))

/--
A split mono `f` equalizes `(retraction f ≫ f)` and `(𝟙 Y)`.
-/
def split_mono_equalizes {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) [split_mono f] :
    is_limit (cone_of_split_mono f) :=
  fork.is_limit.mk' (cone_of_split_mono f)
    fun (s : fork 𝟙 (retraction f ≫ f)) => { val := fork.ι s ≫ retraction f, property := sorry }

-- In this section we show that a split epi `f` coequalizes `(f ≫ section_ f)` and `(𝟙 X)`.

/--
A split epi `f` coequalizes `(f ≫ section_ f)` and `(𝟙 X)`.
Here we build the cocone, and show in `split_epi_coequalizes` that it is a colimit cocone.
-/
def cocone_of_split_epi {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) [split_epi f] :
    cocone (parallel_pair 𝟙 (f ≫ section_ f)) :=
  cofork.of_π f sorry

/--
A split epi `f` coequalizes `(f ≫ section_ f)` and `(𝟙 X)`.
-/
def split_epi_coequalizes {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) [split_epi f] :
    is_colimit (cocone_of_split_epi f) :=
  cofork.is_colimit.mk' (cocone_of_split_epi f)
    fun (s : cofork 𝟙 (f ≫ section_ f)) => { val := section_ f ≫ cofork.π s, property := sorry }

end Mathlib


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Floris van Doorn
-/
import order.hom.complete_lattice
import topology.bases
import topology.homeomorph
import topology.continuous_function.basic

/-!
# Open sets

## Summary

We define the subtype of open sets in a topological space.

## Main Definitions

- `opens α` is the type of open subsets of a topological space `α`.
- `open_nhds_of x` is the type of open subsets of a topological space `α` containing `x : α`.
-/

open filter function order set

variables {α β γ : Type*} [topological_space α] [topological_space β] [topological_space γ]

namespace topological_space
variable (α)
/-- The type of open subsets of a topological space. -/
def opens := {s : set α // is_open s}

variable {α}
namespace opens
instance : has_coe (opens α) (set α) := { coe := subtype.val }

lemma val_eq_coe (U : opens α) : U.1 = ↑U := rfl

/-- the coercion `opens α → set α` applied to a pair is the same as taking the first component -/
lemma coe_mk {α : Type*} [topological_space α] {U : set α} {hU : is_open U} :
  ↑(⟨U, hU⟩ : opens α) = U := rfl

instance : has_subset (opens α) :=
{ subset := λ U V, (U : set α) ⊆ V }

instance : has_mem α (opens α) :=
{ mem := λ a U, a ∈ (U : set α) }

@[simp] lemma subset_coe {U V : opens α} : ((U : set α) ⊆ (V : set α)) = (U ⊆ V) := rfl

@[simp] lemma mem_coe {x : α} {U : opens α} : (x ∈ (U : set α)) = (x ∈ U) := rfl

@[ext] lemma ext {U V : opens α} (h : (U : set α) = V) : U = V := subtype.ext h
@[ext] lemma ext_iff {U V : opens α} : (U : set α) = V ↔ U = V := subtype.ext_iff.symm

instance : partial_order (opens α) := subtype.partial_order _

/-- The interior of a set, as an element of `opens`. -/
def interior (s : set α) : opens α := ⟨interior s, is_open_interior⟩

lemma gc : galois_connection (coe : opens α → set α) interior :=
λ U s, ⟨λ h, interior_maximal h U.property, λ h, le_trans h interior_subset⟩

open order_dual (of_dual to_dual)

/-- The galois coinsertion between sets and opens. -/
def gi : galois_coinsertion subtype.val (@interior α _) :=
{ choice := λ s hs, ⟨s, interior_eq_iff_open.mp $ le_antisymm interior_subset hs⟩,
  gc := gc,
  u_l_le := λ _, interior_subset,
  choice_eq := λ s hs, le_antisymm hs interior_subset }

instance : complete_lattice (opens α) :=
complete_lattice.copy (galois_coinsertion.lift_complete_lattice gi)
/- le  -/ (λ U V, U ⊆ V) rfl
/- top -/ ⟨univ, is_open_univ⟩ (ext interior_univ.symm)
/- bot -/ ⟨∅, is_open_empty⟩ rfl
/- sup -/ (λ U V, ⟨↑U ∪ ↑V, U.2.union V.2⟩) rfl
/- inf -/ (λ U V, ⟨↑U ∩ ↑V, U.2.inter V.2⟩)
  (funext $ λ U, funext $ λ V, ext (U.2.inter V.2).interior_eq.symm)
/- Sup -/ _ rfl
/- Inf -/ _ rfl

lemma le_def {U V : opens α} : U ≤ V ↔ (U : set α) ≤ (V : set α) := iff.rfl

@[simp] lemma mk_inf_mk {U V : set α} {hU : is_open U} {hV : is_open V} :
  (⟨U, hU⟩ ⊓ ⟨V, hV⟩ : opens α) = ⟨U ⊓ V, is_open.inter hU hV⟩ := rfl
@[simp, norm_cast] lemma coe_inf {U V : opens α} : ((U ⊓ V : opens α) : set α) = U ∩ V := rfl
@[simp] lemma coe_bot : ((⊥ : opens α) : set α) = ∅ := rfl
@[simp] lemma coe_top : ((⊤ : opens α) : set α) = set.univ := rfl
@[simp] lemma coe_Sup {S : set (opens α)} : (↑(Sup S) : set α) = ⋃ i ∈ S, ↑i := (@gc α _).l_Sup

instance : has_inter (opens α) := ⟨λ U V, U ⊓ V⟩
instance : has_union (opens α) := ⟨λ U V, U ⊔ V⟩
instance : has_emptyc (opens α) := ⟨⊥⟩
instance : inhabited (opens α) := ⟨∅⟩

@[simp] lemma inter_eq (U V : opens α) : U ∩ V = U ⊓ V := rfl
@[simp] lemma union_eq (U V : opens α) : U ∪ V = U ⊔ V := rfl
@[simp] lemma empty_eq : (∅ : opens α) = ⊥ := rfl

lemma supr_def {ι} (s : ι → opens α) : (⨆ i, s i) = ⟨⋃ i, s i, is_open_Union $ λ i, (s i).2⟩ :=
by { ext, simp only [supr, coe_Sup, bUnion_range], refl }

@[simp] lemma supr_mk {ι} (s : ι → set α) (h : Π i, is_open (s i)) :
  (⨆ i, ⟨s i, h i⟩ : opens α) = ⟨⋃ i, s i, is_open_Union h⟩ :=
by { rw supr_def, simp }

@[simp] lemma supr_s {ι} (s : ι → opens α) : ((⨆ i, s i : opens α) : set α) = ⋃ i, s i :=
by simp [supr_def]

@[simp] theorem mem_supr {ι} {x : α} {s : ι → opens α} : x ∈ supr s ↔ ∃ i, x ∈ s i :=
by { rw [←mem_coe], simp, }

@[simp] lemma mem_Sup {Us : set (opens α)} {x : α} : x ∈ Sup Us ↔ ∃ u ∈ Us, x ∈ u :=
by simp_rw [Sup_eq_supr, mem_supr]

instance : frame (opens α) :=
{ Sup := Sup,
  inf_Sup_le_supr_inf := λ a s,
    (ext $ by simp only [coe_inf, supr_s, coe_Sup, set.inter_Union₂]).le,
  ..opens.complete_lattice }

lemma open_embedding_of_le {U V : opens α} (i : U ≤ V) :
  open_embedding (set.inclusion i) :=
{ inj := set.inclusion_injective i,
  induced := (@induced_compose _ _ _ _ (set.inclusion i) coe).symm,
  open_range :=
  begin
    rw set.range_inclusion i,
    exact U.property.preimage continuous_subtype_val
  end, }

lemma not_nonempty_iff_eq_bot (U : opens α) : ¬ set.nonempty (U : set α) ↔ U = ⊥ :=
by rw [← subtype.coe_injective.eq_iff, opens.coe_bot, ← set.not_nonempty_iff_eq_empty]

lemma ne_bot_iff_nonempty (U : opens α) : U ≠ ⊥ ↔ set.nonempty (U : set α) :=
by rw [ne.def, ← opens.not_nonempty_iff_eq_bot, not_not]

/-- A set of `opens α` is a basis if the set of corresponding sets is a topological basis. -/
def is_basis (B : set (opens α)) : Prop := is_topological_basis ((coe : _ → set α) '' B)

lemma is_basis_iff_nbhd {B : set (opens α)} :
  is_basis B ↔ ∀ {U : opens α} {x}, x ∈ U → ∃ U' ∈ B, x ∈ U' ∧ U' ⊆ U :=
begin
  split; intro h,
  { rintros ⟨sU, hU⟩ x hx,
    rcases h.mem_nhds_iff.mp (is_open.mem_nhds hU hx)
      with ⟨sV, ⟨⟨V, H₁, H₂⟩, hsV⟩⟩,
    refine ⟨V, H₁, _⟩,
    cases V, dsimp at H₂, subst H₂, exact hsV },
  { refine is_topological_basis_of_open_of_nhds _ _,
    { rintros sU ⟨U, ⟨H₁, H₂⟩⟩, subst H₂, exact U.property },
    { intros x sU hx hsU,
      rcases @h (⟨sU, hsU⟩ : opens α) x hx with ⟨V, hV, H⟩,
      exact ⟨V, ⟨V, hV, rfl⟩, H⟩ } }
end

lemma is_basis_iff_cover {B : set (opens α)} :
  is_basis B ↔ ∀ U : opens α, ∃ Us ⊆ B, U = Sup Us :=
begin
  split,
  { intros hB U,
    refine ⟨{V : opens α | V ∈ B ∧ V ⊆ U}, λ U hU, hU.left, _⟩,
    apply ext,
    rw [coe_Sup, hB.open_eq_sUnion' U.prop],
    simp_rw [sUnion_eq_bUnion, Union, supr_and, supr_image],
    refl },
  { intro h,
    rw is_basis_iff_nbhd,
    intros U x hx,
    rcases h U with ⟨Us, hUs, rfl⟩,
    rcases mem_Sup.1 hx with ⟨U, Us, xU⟩,
    exact ⟨U, hUs Us, xU, le_Sup Us⟩ }
end

/-- The preimage of an open set, as an open set. -/
def comap (f : C(α, β)) : frame_hom (opens β) (opens α) :=
{ to_fun := λ s, ⟨f ⁻¹' s, s.2.preimage f.continuous⟩,
  map_Sup' := λ s, ext $ by simp only [coe_Sup, preimage_Union, coe_mk, mem_image, Union_exists,
    bUnion_and', Union_Union_eq_right],
  map_inf' := λ a b, rfl,
  map_top' := rfl }

@[simp] lemma comap_id : comap (continuous_map.id α) = frame_hom.id _ :=
frame_hom.ext $ λ a, ext rfl

lemma comap_mono (f : C(α, β)) {s t : opens β} (h : s ≤ t) : comap f s ≤ comap f t :=
order_hom_class.mono (comap f) h

@[simp] lemma coe_comap (f : C(α, β)) (U : opens β) : ↑(comap f U) = f ⁻¹' U := rfl

@[simp] lemma comap_val (f : C(α, β)) (U : opens β) : (comap f U).1 = f ⁻¹' U := rfl

protected lemma comap_comp (g : C(β, γ)) (f : C(α, β)) :
  comap (g.comp f) = (comap f).comp (comap g) := rfl

protected lemma comap_comap (g : C(β, γ)) (f : C(α, β)) (U : opens γ) :
  comap f (comap g U) = comap (g.comp f) U := rfl

lemma comap_injective [t0_space β] : injective (comap : C(α, β) → frame_hom (opens β) (opens α)) :=
λ f g h, continuous_map.ext $ λ a, indistinguishable.eq $ λ s hs, begin
  simp_rw ←mem_preimage,
  congr' 2,
  have := fun_like.congr_fun h ⟨_, hs⟩,
  exact congr_arg (coe : opens α → set α) this,
end

/-- A homeomorphism induces an equivalence on open sets, by taking comaps. -/
@[simp] protected def equiv (f : α ≃ₜ β) : opens α ≃ opens β :=
{ to_fun := opens.comap f.symm.to_continuous_map,
  inv_fun := opens.comap f.to_continuous_map,
  left_inv := by { intro U, ext1, exact f.to_equiv.preimage_symm_preimage _ },
  right_inv := by { intro U, ext1, exact f.to_equiv.symm_preimage_preimage _ } }

/-- A homeomorphism induces an order isomorphism on open sets, by taking comaps. -/
@[simp] protected def order_iso (f : α ≃ₜ β) : opens α ≃o opens β :=
{ to_equiv := opens.equiv f,
  map_rel_iff' := λ U V, f.symm.surjective.preimage_subset_preimage_iff }

end opens

/-- The open neighborhoods of a point. See also `opens` or `nhds`. -/
def open_nhds_of (x : α) : Type* := { s : set α // is_open s ∧ x ∈ s }

instance open_nhds_of.inhabited {α : Type*} [topological_space α] (x : α) :
  inhabited (open_nhds_of x) := ⟨⟨set.univ, is_open_univ, set.mem_univ _⟩⟩

end topological_space


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

/-!
# Computability theory and the halting problem

A universal partial recursive function, Rice's theorem, and the halting problem.

## References

* [Mario Carneiro, *Formalizing computability theory via partial recursive functions*][carneiro2019]
-/

open encodable denumerable

namespace nat.partrec
open computable part

theorem merge' {f g}
  (hf : nat.partrec f) (hg : nat.partrec g) :
  ∃ h, nat.partrec h ∧ ∀ a,
    (∀ x ∈ h a, x ∈ f a ∨ x ∈ g a) ∧
    ((h a).dom ↔ (f a).dom ∨ (g a).dom) :=
begin
  obtain ⟨cf, rfl⟩ := code.exists_code.1 hf,
  obtain ⟨cg, rfl⟩ := code.exists_code.1 hg,
  have : nat.partrec (λ n,
    (nat.rfind_opt (λ k, cf.evaln k n <|> cg.evaln k n))) :=
  partrec.nat_iff.1 (partrec.rfind_opt $
    primrec.option_orelse.to_comp.comp
      (code.evaln_prim.to_comp.comp $ (snd.pair (const cf)).pair fst)
      (code.evaln_prim.to_comp.comp $ (snd.pair (const cg)).pair fst)),
  refine ⟨_, this, λ n, _⟩,
  suffices, refine ⟨this,
    ⟨λ h, (this _ ⟨h, rfl⟩).imp Exists.fst Exists.fst, _⟩⟩,
  { intro h, rw nat.rfind_opt_dom,
    simp only [dom_iff_mem, code.evaln_complete, option.mem_def] at h,
    obtain ⟨x, k, e⟩ | ⟨x, k, e⟩ := h,
    { refine ⟨k, x, _⟩, simp only [e, option.some_orelse, option.mem_def] },
    { refine ⟨k, _⟩,
      cases cf.evaln k n with y,
      { exact ⟨x, by simp only [e, option.mem_def, option.none_orelse]⟩ },
      { exact ⟨y, by simp only [option.some_orelse, option.mem_def]⟩ } } },
  intros x h,
  obtain ⟨k, e⟩ := nat.rfind_opt_spec h,
  revert e,
  simp only [option.mem_def]; cases e' : cf.evaln k n with y; simp; intro,
  { exact or.inr (code.evaln_sound e) },
  { subst y,
      exact or.inl (code.evaln_sound e') }
end

end nat.partrec

namespace partrec
variables {α : Type*} {β : Type*} {γ : Type*} {σ : Type*}
variables [primcodable α] [primcodable β] [primcodable γ] [primcodable σ]

open computable part nat.partrec (code) nat.partrec.code

theorem merge' {f g : α →. σ}
  (hf : partrec f) (hg : partrec g) :
  ∃ k : α →. σ, partrec k ∧ ∀ a,
    (∀ x ∈ k a, x ∈ f a ∨ x ∈ g a) ∧
    ((k a).dom ↔ (f a).dom ∨ (g a).dom) :=
let ⟨k, hk, H⟩ :=
  nat.partrec.merge' (bind_decode₂_iff.1 hf) (bind_decode₂_iff.1 hg) in
begin
  let k' := λ a, (k (encode a)).bind (λ n, decode σ n),
  refine ⟨k', ((nat_iff.2 hk).comp computable.encode).bind
    (computable.decode.of_option.comp snd).to₂, λ a, _⟩,
  suffices, refine ⟨this,
    ⟨λ h, (this _ ⟨h, rfl⟩).imp Exists.fst Exists.fst, _⟩⟩,
  { intro h,
    rw bind_dom,
    have hk : (k (encode a)).dom :=
      (H _).2.2 (by simpa only [encodek₂, bind_some, coe_some] using h),
    existsi hk,
    simp only [exists_prop, mem_map_iff, mem_coe, mem_bind_iff, option.mem_def] at H,
    obtain ⟨a', ha', y, hy, e⟩ | ⟨a', ha', y, hy, e⟩ := (H _).1 _ ⟨hk, rfl⟩;
    { simp only [e.symm, encodek] } },
  intros x h', simp only [k', exists_prop, mem_coe, mem_bind_iff, option.mem_def] at h',
  obtain ⟨n, hn, hx⟩ := h',
  have := (H _).1 _ hn,
  simp [mem_decode₂, encode_injective.eq_iff] at this,
  obtain ⟨a', ha, rfl⟩ | ⟨a', ha, rfl⟩ := this; simp only [encodek] at hx; rw hx at ha,
  { exact or.inl ha },
  exact or.inr ha
end

theorem merge {f g : α →. σ}
  (hf : partrec f) (hg : partrec g)
  (H : ∀ a (x ∈ f a) (y ∈ g a), x = y) :
  ∃ k : α →. σ, partrec k ∧ ∀ a x, x ∈ k a ↔ x ∈ f a ∨ x ∈ g a :=
let ⟨k, hk, K⟩ := merge' hf hg in
⟨k, hk, λ a x, ⟨(K _).1 _, λ h, begin
  have : (k a).dom := (K _).2.2 (h.imp Exists.fst Exists.fst),
  refine ⟨this, _⟩,
  cases h with h h; cases (K _).1 _ ⟨this, rfl⟩ with h' h',
  { exact mem_unique h' h },
  { exact (H _ _ h _ h').symm },
  { exact H _ _ h' _ h },
  { exact mem_unique h' h }
end⟩⟩

theorem cond {c : α → bool} {f : α →. σ} {g : α →. σ}
  (hc : computable c) (hf : partrec f) (hg : partrec g) :
  partrec (λ a, cond (c a) (f a) (g a)) :=
let ⟨cf, ef⟩ := exists_code.1 hf,
    ⟨cg, eg⟩ := exists_code.1 hg in
((eval_part.comp
    (computable.cond hc (const cf) (const cg)) computable.id).bind
  ((@computable.decode σ _).comp snd).of_option.to₂).of_eq $
λ a, by cases c a; simp [ef, eg, encodek]

theorem sum_cases
  {f : α → β ⊕ γ} {g : α → β →. σ} {h : α → γ →. σ}
  (hf : computable f) (hg : partrec₂ g) (hh : partrec₂ h) :
  @partrec _ σ _ _ (λ a, sum.cases_on (f a) (g a) (h a)) :=
option_some_iff.1 $ (cond
  (sum_cases hf (const tt).to₂ (const ff).to₂)
  (sum_cases_left hf (option_some_iff.2 hg).to₂ (const option.none).to₂)
  (sum_cases_right hf (const option.none).to₂ (option_some_iff.2 hh).to₂))
.of_eq $ λ a, by cases f a; simp only [bool.cond_tt, bool.cond_ff]

end partrec

/-- A computable predicate is one whose indicator function is computable. -/
def computable_pred {α} [primcodable α] (p : α → Prop) :=
∃ [D : decidable_pred p],
by exactI computable (λ a, to_bool (p a))

/-- A recursively enumerable predicate is one which is the domain of a computable partial function.
 -/
def re_pred {α} [primcodable α] (p : α → Prop) :=
partrec (λ a, part.assert (p a) (λ _, part.some ()))

theorem re_pred.of_eq {α} [primcodable α]
  {p q : α → Prop}
  (hp : re_pred p) (H : ∀ a, p a ↔ q a) : re_pred q :=
(funext (λ a, propext (H a)) : p = q) ▸ hp

theorem partrec.dom_re {α β} [primcodable α] [primcodable β]
  {f : α →. β} (h : partrec f) : re_pred (λ a, (f a).dom) :=
(h.map (computable.const ()).to₂).of_eq $ λ n, part.ext $ λ _, by simp [part.dom_iff_mem]

theorem computable_pred.of_eq {α} [primcodable α]
  {p q : α → Prop}
  (hp : computable_pred p) (H : ∀ a, p a ↔ q a) : computable_pred q :=
(funext (λ a, propext (H a)) : p = q) ▸ hp

namespace computable_pred
variables {α : Type*} {σ : Type*}
variables [primcodable α] [primcodable σ]
open nat.partrec (code) nat.partrec.code computable

theorem computable_iff {p : α → Prop} :
  computable_pred p ↔ ∃ f : α → bool, computable f ∧ p = λ a, f a :=
⟨λ ⟨D, h⟩, by exactI ⟨_, h, funext $ λ a, propext (to_bool_iff _).symm⟩,
 by rintro ⟨f, h, rfl⟩; exact ⟨by apply_instance, by simpa using h⟩⟩

protected theorem not {p : α → Prop}
  (hp : computable_pred p) : computable_pred (λ a, ¬ p a) :=
by obtain ⟨f, hf, rfl⟩ := computable_iff.1 hp; exact
  ⟨by apply_instance,
    (cond hf (const ff) (const tt)).of_eq
      (λ n, by {dsimp, cases f n; refl})⟩

theorem to_re {p : α → Prop} (hp : computable_pred p) : re_pred p :=
begin
  obtain ⟨f, hf, rfl⟩ := computable_iff.1 hp,
  unfold re_pred,
  refine (partrec.cond hf (decidable.partrec.const' (part.some ())) partrec.none).of_eq
    (λ n, part.ext $ λ a, _),
  cases a, cases f n; simp
end

theorem rice₂ (C : set code)
  (H : ∀ cf cg, eval cf = eval cg → (cf ∈ C ↔ cg ∈ C)) :
  computable_pred (λ c, c ∈ C) ↔ C = ∅ ∨ C = set.univ :=
by classical; exact
have hC : ∀ f, f ∈ C ↔ eval f ∈ eval '' C,
from λ f, ⟨set.mem_image_of_mem _, λ ⟨g, hg, e⟩, (H _ _ e).1 hg⟩,
⟨λ h, or_iff_not_imp_left.2 $ λ C0,
  set.eq_univ_of_forall $ λ cg,
  let ⟨cf, fC⟩ := set.nonempty_iff_ne_empty.2 C0 in
  (hC _).2 $ rice (eval '' C) (h.of_eq hC)
    (partrec.nat_iff.1 $ eval_part.comp (const cf) computable.id)
    (partrec.nat_iff.1 $ eval_part.comp (const cg) computable.id)
    ((hC _).1 fC),
λ h, by obtain rfl | rfl := h; simp [computable_pred, set.mem_empty_iff_false];
  exact ⟨by apply_instance, computable.const _⟩⟩

theorem halting_problem_re (n) : re_pred (λ c, (eval c n).dom) :=
(eval_part.comp computable.id (computable.const _)).dom_re

theorem halting_problem (n) : ¬ computable_pred (λ c, (eval c n).dom)
| h := rice {f | (f n).dom} h nat.partrec.zero nat.partrec.none trivial

-- Post's theorem on the equivalence of r.e., co-r.e. sets and
-- computable sets. The assumption that p is decidable is required
-- unless we assume Markov's principle or LEM.
@[nolint decidable_classical]
theorem computable_iff_re_compl_re {p : α → Prop} [decidable_pred p] :
  computable_pred p ↔ re_pred p ∧ re_pred (λ a, ¬ p a) :=
⟨λ h, ⟨h.to_re, h.not.to_re⟩, λ ⟨h₁, h₂⟩, ⟨‹_›, begin
  obtain ⟨k, pk, hk⟩ := partrec.merge
    (h₁.map (computable.const tt).to₂)
    (h₂.map (computable.const ff).to₂) _,
  { refine partrec.of_eq pk (λ n, part.eq_some_iff.2 _),
    rw hk, simp, apply decidable.em },
  { intros a x hx y hy, simp at hx hy, cases hy.1 hx.1 }
end⟩⟩

theorem computable_iff_re_compl_re' {p : α → Prop} :
  computable_pred p ↔ re_pred p ∧ re_pred (λ a, ¬ p a) :=
by classical; exact computable_iff_re_compl_re

theorem halting_problem_not_re (n) : ¬ re_pred (λ c, ¬ (eval c n).dom)
| h := halting_problem _ $ computable_iff_re_compl_re'.2 ⟨halting_problem_re _, h⟩

end computable_pred

namespace nat
open vector part

/-- A simplified basis for `partrec`. -/
inductive partrec' : ∀ {n}, (vector ℕ n →. ℕ) → Prop
| prim {n f} : @primrec' n f → @partrec' n f
| comp {m n f} (g : fin n → vector ℕ m →. ℕ) :
  partrec' f → (∀ i, partrec' (g i)) →
  partrec' (λ v, m_of_fn (λ i, g i v) >>= f)
| rfind {n} {f : vector ℕ (n+1) → ℕ} : @partrec' (n+1) f →
  partrec' (λ v, rfind (λ n, some (f (n ::ᵥ v) = 0)))

end nat

namespace nat.partrec'
open vector partrec computable nat (partrec') nat.partrec'

theorem to_part {n f} (pf : @partrec' n f) : partrec f :=
begin
  induction pf,
  case nat.partrec'.prim : n f hf { exact hf.to_prim.to_comp },
  case nat.partrec'.comp : m n f g _ _ hf hg
  { exact (vector_m_of_fn (λ i, hg i)).bind (hf.comp snd) },
  case nat.partrec'.rfind : n f _ hf
  { have := ((primrec.eq.comp primrec.id (primrec.const 0)).to_comp.comp
      (hf.comp (vector_cons.comp snd fst))).to₂.partrec₂,
    exact this.rfind },
end

theorem of_eq {n} {f g : vector ℕ n →. ℕ}
  (hf : partrec' f) (H : ∀ i, f i = g i) : partrec' g :=
(funext H : f = g) ▸ hf

theorem of_prim {n} {f : vector ℕ n → ℕ} (hf : primrec f) : @partrec' n f :=
prim (nat.primrec'.of_prim hf)

theorem head {n : ℕ} : @partrec' n.succ (@head ℕ n) :=
prim nat.primrec'.head

theorem tail {n f} (hf : @partrec' n f) : @partrec' n.succ (λ v, f v.tail) :=
(hf.comp _ (λ i, @prim _ _ $ nat.primrec'.nth i.succ)).of_eq $
λ v, by simp; rw [← of_fn_nth v.tail]; congr; funext i; simp

protected theorem bind {n f g}
  (hf : @partrec' n f) (hg : @partrec' (n+1) g) :
  @partrec' n (λ v, (f v).bind (λ a, g (a ::ᵥ v))) :=
(@comp n (n+1) g
  (λ i, fin.cases f (λ i v, some (v.nth i)) i) hg
  (λ i, begin
    refine fin.cases _ (λ i, _) i; simp *,
    exact prim (nat.primrec'.nth _)
  end)).of_eq $
λ v, by simp [m_of_fn, part.bind_assoc, pure]

protected theorem map {n f} {g : vector ℕ (n+1) → ℕ}
  (hf : @partrec' n f) (hg : @partrec' (n+1) g) :
  @partrec' n (λ v, (f v).map (λ a, g (a ::ᵥ v))) :=
by simp [(part.bind_some_eq_map _ _).symm];
   exact hf.bind hg

local attribute [-instance] part.has_zero

/-- Analogous to `nat.partrec'` for `ℕ`-valued functions, a predicate for partial recursive
  vector-valued functions.-/
def vec {n m} (f : vector ℕ n → vector ℕ m) :=
∀ i, partrec' (λ v, (f v).nth i)

theorem vec.prim {n m f} (hf : @nat.primrec'.vec n m f) : vec f :=
λ i, prim $ hf i

protected theorem nil {n} : @vec n 0 (λ _, nil) := λ i, i.elim0

protected theorem cons {n m} {f : vector ℕ n → ℕ} {g}
  (hf : @partrec' n f) (hg : @vec n m g) :
  vec (λ v, f v ::ᵥ g v) :=
λ i, fin.cases (by simp *) (λ i, by simp only [hg i, nth_cons_succ]) i

theorem idv {n} : @vec n n id := vec.prim nat.primrec'.idv

theorem comp' {n m f g} (hf : @partrec' m f) (hg : @vec n m g) :
  partrec' (λ v, f (g v)) :=
(hf.comp _ hg).of_eq $ λ v, by simp

theorem comp₁ {n} (f : ℕ →. ℕ) {g : vector ℕ n → ℕ}
  (hf : @partrec' 1 (λ v, f v.head)) (hg : @partrec' n g) :
  @partrec' n (λ v, f (g v)) :=
by simpa using hf.comp' (partrec'.cons hg partrec'.nil)

theorem rfind_opt {n} {f : vector ℕ (n+1) → ℕ}
  (hf : @partrec' (n+1) f) :
  @partrec' n (λ v, nat.rfind_opt (λ a, of_nat (option ℕ) (f (a ::ᵥ v)))) :=
((rfind $ (of_prim (primrec.nat_sub.comp (primrec.const 1) primrec.vector_head))
   .comp₁ (λ n, part.some (1 - n)) hf)
   .bind ((prim nat.primrec'.pred).comp₁ nat.pred hf)).of_eq $
λ v, part.ext $ λ b, begin
  simp only [nat.rfind_opt, exists_prop, tsub_eq_zero_iff_le, pfun.coe_val,
    part.mem_bind_iff, part.mem_some_iff, option.mem_def, part.mem_coe],
  refine exists_congr (λ a,
    (and_congr (iff_of_eq _) iff.rfl).trans (and_congr_right (λ h, _))),
  { congr, funext n,
    simp only [part.some_inj, pfun.coe_val], cases f (n ::ᵥ v); simp [nat.succ_le_succ]; refl },
  { have := nat.rfind_spec h,
    simp only [pfun.coe_val, part.mem_some_iff] at this,
    cases f (a ::ᵥ v) with c, {cases this},
    rw [← option.some_inj, eq_comm], refl }
end

open nat.partrec.code
theorem of_part : ∀ {n f}, partrec f → @partrec' n f :=
suffices ∀ f, nat.partrec f → @partrec' 1 (λ v, f v.head), from
λ n f hf, begin
  let g, swap,
  exact (comp₁ g (this g hf) (prim nat.primrec'.encode)).of_eq
    (λ i, by dsimp only [g]; simp [encodek, part.map_id']),
end,
λ f hf, begin
  obtain ⟨c, rfl⟩ := exists_code.1 hf,
  simpa [eval_eq_rfind_opt] using
    (rfind_opt $ of_prim $ primrec.encode_iff.2 $ evaln_prim.comp $
      (primrec.vector_head.pair (primrec.const c)).pair $
      primrec.vector_head.comp primrec.vector_tail)
end

theorem part_iff {n f} : @partrec' n f ↔ partrec f := ⟨to_part, of_part⟩

theorem part_iff₁ {f : ℕ →. ℕ} :
  @partrec' 1 (λ v, f v.head) ↔ partrec f :=
part_iff.trans ⟨
  λ h, (h.comp $ (primrec.vector_of_fn $
    λ i, primrec.id).to_comp).of_eq (λ v, by simp only [id.def, head_of_fn]),
  λ h, h.comp vector_head⟩

theorem part_iff₂ {f : ℕ → ℕ →. ℕ} :
  @partrec' 2 (λ v, f v.head v.tail.head) ↔ partrec₂ f :=
part_iff.trans ⟨
  λ h, (h.comp $ vector_cons.comp fst $
    vector_cons.comp snd (const nil)).of_eq (λ v, by simp only [cons_head, cons_tail]),
  λ h, h.comp vector_head (vector_head.comp vector_tail)⟩

theorem vec_iff {m n f} : @vec m n f ↔ computable f :=
⟨λ h, by simpa only [of_fn_nth] using vector_of_fn (λ i, to_part (h i)),
 λ h i, of_part $ vector_nth.comp h (const i)⟩

end nat.partrec'