/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Stephen Morgan, Scott Morrison, Floris van Doorn

! This file was ported from Lean 3 source module category_theory.limits.cones
! leanprover-community/mathlib commit 740acc0e6f9adf4423f92a485d0456fc271482da
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Functor.Const
import Mathlib.CategoryTheory.DiscreteCategory
import Mathlib.CategoryTheory.Yoneda
import Mathlib.CategoryTheory.Functor.ReflectsIso

/-!
# Cones and cocones

We define `Cone F`, a cone over a functor `F`,
and `F.cones : Cᵒᵖ ⥤ Type`, the functor associating to `X` the cones over `F` with cone point `X`.

A cone `c` is defined by specifying its cone point `c.pt` and a natural transformation `c.π`
from the constant `c.pt` valued functor to `F`.

We provide `c.w f : c.π.app j ≫ F.map f = c.π.app j'` for any `f : j ⟶ j'`
as a wrapper for `c.π.naturality f` avoiding unneeded identity morphisms.

We define `c.extend f`, where `c : cone F` and `f : Y ⟶ c.pt` for some other `Y`,
which replaces the cone point by `Y` and inserts `f` into each of the components of the cone.
Similarly we have `c.whisker F` producing a `Cone (E ⋙ F)`

We define morphisms of cones, and the category of cones.

We define `Cone.postcompose α : cone F ⥤ cone G` for `α` a natural transformation `F ⟶ G`.

And, of course, we dualise all this to cocones as well.

For more results about the category of cones, see `cone_category.lean`.
-/

-- morphism levels before object levels. See note [CategoryTheory universes].
universe v₁ v₂ v₃ v₄ u₁ u₂ u₃ u₄

open CategoryTheory

variable {J : Type u₁} [Category.{v₁} J]

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

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

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

open CategoryTheory

open CategoryTheory.Category

open CategoryTheory.Functor

open Opposite

namespace CategoryTheory

namespace Functor

variable (F : J ⥤ C)

/-- `F.cones` is the functor assigning to an object `X` the type of
natural transformations from the constant functor with value `X` to `F`.
An object representing this functor is a limit of `F`.
-/
@[simps!]
def cones : Cᵒᵖ ⥤ Type max u₁ v₃ :=
  (const J).op ⋙ yoneda.obj F
#align category_theory.functor.cones CategoryTheory.Functor.cones

/-- `F.cocones` is the functor assigning to an object `X` the type of
natural transformations from `F` to the constant functor with value `X`.
An object corepresenting this functor is a colimit of `F`.
-/
@[simps!]
def cocones : C ⥤ Type max u₁ v₃ :=
  const J ⋙ coyoneda.obj (op F)
#align category_theory.functor.cocones CategoryTheory.Functor.cocones

end Functor

section

variable (J C)

/-- Functorially associated to each functor `J ⥤ C`, we have the `C`-presheaf consisting of
cones with a given cone point.
-/
@[simps!]
def cones : (J ⥤ C) ⥤ Cᵒᵖ ⥤ Type max u₁ v₃ where
  obj := Functor.cones
  map f := whiskerLeft (const J).op (yoneda.map f)
#align category_theory.cones CategoryTheory.cones

/-- Contravariantly associated to each functor `J ⥤ C`, we have the `C`-copresheaf consisting of
cocones with a given cocone point.
-/
@[simps!]
def cocones : (J ⥤ C)ᵒᵖ ⥤ C ⥤ Type max u₁ v₃ where
  obj F := Functor.cocones (unop F)
  map f := whiskerLeft (const J) (coyoneda.map f)
#align category_theory.cocones CategoryTheory.cocones

end

namespace Limits

section

/-- A `c : Cone F` is:
* an object `c.pt` and
* a natural transformation `c.π : c.pt ⟶ F` from the constant `c.pt` functor to `F`.

`Cone F` is equivalent, via `cone.equiv` below, to `Σ X, F.cones.obj X`.
-/
structure Cone (F : J ⥤ C) where
  /-- An object of `C` -/
  pt : C
  /-- A natural transformation from the constant functor at `X` to `F` -/
  π : (const J).obj pt ⟶ F
#align category_theory.limits.cone CategoryTheory.Limits.Cone
set_option linter.uppercaseLean3 false in
#align category_theory.limits.cone.X CategoryTheory.Limits.Cone.pt

instance inhabitedCone (F : Discrete PUnit ⥤ C) : Inhabited (Cone F) :=
  ⟨{  pt := F.obj ⟨⟨⟩⟩
      π := { app := fun ⟨⟨⟩⟩ => 𝟙 _
             naturality := by
              intro X Y f
              match X, Y, f with
              | .mk A, .mk B, .up g =>
                aesop_cat
           }
  }⟩
#align category_theory.limits.inhabited_cone CategoryTheory.Limits.inhabitedCone

@[reassoc (attr := simp)]
theorem Cone.w {F : J ⥤ C} (c : Cone F) {j j' : J} (f : j ⟶ j') :
    c.π.app j ≫ F.map f = c.π.app j' := by
  rw [← c.π.naturality f]
  apply id_comp
#align category_theory.limits.cone.w CategoryTheory.Limits.Cone.w

/-- A `c : Cocone F` is
* an object `c.pt` and
* a natural transformation `c.ι : F ⟶ c.pt` from `F` to the constant `c.pt` functor.

`Cocone F` is equivalent, via `cone.equiv` below, to `Σ X, F.cocones.obj X`.
-/
structure Cocone (F : J ⥤ C) where
  /-- An object of `C` -/
  pt : C
  /-- A natural transformation from `F` to the constant functor at `pt` -/
  ι : F ⟶ (const J).obj pt
#align category_theory.limits.cocone CategoryTheory.Limits.Cocone
set_option linter.uppercaseLean3 false in
#align category_theory.limits.cocone.X CategoryTheory.Limits.Cocone.pt

instance inhabitedCocone (F : Discrete PUnit ⥤ C) : Inhabited (Cocone F) :=
  ⟨{  pt := F.obj ⟨⟨⟩⟩
      ι := { app := fun ⟨⟨⟩⟩ => 𝟙 _
             naturality := by
              intro X Y f
              match X, Y, f with
              | .mk A, .mk B, .up g =>
                aesop_cat
           }
  }⟩
#align category_theory.limits.inhabited_cocone CategoryTheory.Limits.inhabitedCocone

@[reassoc (attr := simp 1001)]
theorem Cocone.w {F : J ⥤ C} (c : Cocone F) {j j' : J} (f : j ⟶ j') :
    F.map f ≫ c.ι.app j' = c.ι.app j := by
  rw [c.ι.naturality f]
  apply comp_id
#align category_theory.limits.cocone.w CategoryTheory.Limits.Cocone.w

end

variable {F : J ⥤ C}

namespace Cone

/-- The isomorphism between a cone on `F` and an element of the functor `F.cones`. -/
@[simps!]
def equiv (F : J ⥤ C) : Cone F ≅ ΣX, F.cones.obj X
    where
  hom c := ⟨op c.pt, c.π⟩
  inv c :=
    { pt := c.1.unop
      π := c.2 }
  hom_inv_id := by
    funext X
    cases X
    rfl
  inv_hom_id := by
    funext X
    cases X
    rfl
#align category_theory.limits.cone.equiv CategoryTheory.Limits.Cone.equiv

/-- A map to the vertex of a cone naturally induces a cone by composition. -/
@[simps]
def extensions (c : Cone F) : yoneda.obj c.pt ⋙ uliftFunctor.{u₁} ⟶ F.cones where
  app X f := (const J).map f.down ≫ c.π
  naturality := by
    intros X Y f
    dsimp [yoneda,const]
    funext X
    aesop_cat
#align category_theory.limits.cone.extensions CategoryTheory.Limits.Cone.extensions

/-- A map to the vertex of a cone induces a cone by composition. -/
@[simps]
def extend (c : Cone F) {X : C} (f : X ⟶ c.pt) : Cone F :=
  { pt := X
    π := c.extensions.app (op X) ⟨f⟩ }
#align category_theory.limits.cone.extend CategoryTheory.Limits.Cone.extend

/-- Whisker a cone by precomposition of a functor. -/
@[simps]
def whisker (E : K ⥤ J) (c : Cone F) : Cone (E ⋙ F)
    where
  pt := c.pt
  π := whiskerLeft E c.π
#align category_theory.limits.cone.whisker CategoryTheory.Limits.Cone.whisker

end Cone

namespace Cocone

/-- The isomorphism between a cocone on `F` and an element of the functor `F.cocones`. -/
def equiv (F : J ⥤ C) : Cocone F ≅ ΣX, F.cocones.obj X
    where
  hom c := ⟨c.pt, c.ι⟩
  inv c :=
    { pt := c.1
      ι := c.2 }
  hom_inv_id := by
    funext X
    cases X
    rfl
  inv_hom_id := by
    funext X
    cases X
    rfl
#align category_theory.limits.cocone.equiv CategoryTheory.Limits.Cocone.equiv

/-- A map from the vertex of a cocone naturally induces a cocone by composition. -/
@[simps]
def extensions (c : Cocone F) : coyoneda.obj (op c.pt) ⋙ uliftFunctor.{u₁} ⟶ F.cocones where
  app X f := c.ι ≫ (const J).map f.down
  naturality := fun {X} {Y} f => by
    dsimp [coyoneda,const]
    funext X
    aesop_cat
#align category_theory.limits.cocone.extensions CategoryTheory.Limits.Cocone.extensions

/-- A map from the vertex of a cocone induces a cocone by composition. -/
@[simps]
def extend (c : Cocone F) {Y : C} (f : c.pt ⟶ Y) : Cocone F where
  pt := Y
  ι := c.extensions.app Y ⟨f⟩
#align category_theory.limits.cocone.extend CategoryTheory.Limits.Cocone.extend

/-- Whisker a cocone by precomposition of a functor. See `whiskering` for a functorial
version.
-/
@[simps]
def whisker (E : K ⥤ J) (c : Cocone F) : Cocone (E ⋙ F) where
  pt := c.pt
  ι := whiskerLeft E c.ι
#align category_theory.limits.cocone.whisker CategoryTheory.Limits.Cocone.whisker

end Cocone

/-- A cone morphism between two cones for the same diagram is a morphism of the cone points which
commutes with the cone legs. -/
@[ext]
structure ConeMorphism (A B : Cone F) where
  /-- A morphism between the two vertex objects of the cones -/
  Hom : A.pt ⟶ B.pt
  /-- The triangle consisting of the two natural tranformations and `Hom` commutes -/
  w : ∀ j : J, Hom ≫ B.π.app j = A.π.app j := by aesop_cat
#align category_theory.limits.cone_morphism CategoryTheory.Limits.ConeMorphism
#align category_theory.limits.cone_morphism.w' CategoryTheory.Limits.ConeMorphism.w

attribute [reassoc (attr := simp)] ConeMorphism.w

instance inhabitedConeMorphism (A : Cone F) : Inhabited (ConeMorphism A A) :=
  ⟨{ Hom := 𝟙 _ }⟩
#align category_theory.limits.inhabited_cone_morphism CategoryTheory.Limits.inhabitedConeMorphism

/-- The category of cones on a given diagram. -/
@[simps]
instance Cone.category : Category (Cone F) where
  Hom A B := ConeMorphism A B
  comp f g := { Hom := f.Hom ≫ g.Hom }
  id B := { Hom := 𝟙 B.pt }
#align category_theory.limits.cone.category CategoryTheory.Limits.Cone.category

namespace Cones

/-- To give an isomorphism between cones, it suffices to give an
  isomorphism between their vertices which commutes with the cone
  maps. -/
-- Porting note: `@[ext]` used to accept lemmas like this. Now we add an aesop rule
@[aesop apply safe (rule_sets [CategoryTheory]), simps]
def ext {c c' : Cone F} (φ : c.pt ≅ c'.pt) (w : ∀ j, c.π.app j = φ.hom ≫ c'.π.app j) : c ≅ c' where
  hom := { Hom := φ.hom }
  inv :=
    { Hom := φ.inv
      w := fun j => φ.inv_comp_eq.mpr (w j) }
#align category_theory.limits.cones.ext CategoryTheory.Limits.Cones.ext

/-- Eta rule for cones. -/
@[simps!]
def eta (c : Cone F) : c ≅ ⟨c.pt, c.π⟩ :=
  Cones.ext (Iso.refl _) (by aesop_cat)
#align category_theory.limits.cones.eta CategoryTheory.Limits.Cones.eta

/-- Given a cone morphism whose object part is an isomorphism, produce an
isomorphism of cones.
-/
theorem cone_iso_of_hom_iso {K : J ⥤ C} {c d : Cone K} (f : c ⟶ d) [i : IsIso f.Hom] : IsIso f :=
  ⟨⟨{   Hom := inv f.Hom
        w := fun j => (asIso f.Hom).inv_comp_eq.2 (f.w j).symm }, by aesop_cat⟩⟩
#align category_theory.limits.cones.cone_iso_of_hom_iso CategoryTheory.Limits.Cones.cone_iso_of_hom_iso

/--
Functorially postcompose a cone for `F` by a natural transformation `F ⟶ G` to give a cone for `G`.
-/
@[simps]
def postcompose {G : J ⥤ C} (α : F ⟶ G) : Cone F ⥤ Cone G where
  obj c :=
    { pt := c.pt
      π := c.π ≫ α }
  map f := { Hom := f.Hom }
#align category_theory.limits.cones.postcompose CategoryTheory.Limits.Cones.postcompose

/-- Postcomposing a cone by the composite natural transformation `α ≫ β` is the same as
postcomposing by `α` and then by `β`. -/
@[simps!]
def postcomposeComp {G H : J ⥤ C} (α : F ⟶ G) (β : G ⟶ H) :
    postcompose (α ≫ β) ≅ postcompose α ⋙ postcompose β :=
  NatIso.ofComponents (fun s => Cones.ext (Iso.refl _) (by aesop_cat)) (by aesop_cat)
#align category_theory.limits.cones.postcompose_comp CategoryTheory.Limits.Cones.postcomposeComp

/-- Postcomposing by the identity does not change the cone up to isomorphism. -/
@[simps!]
def postcomposeId : postcompose (𝟙 F) ≅ 𝟭 (Cone F) :=
  NatIso.ofComponents (fun s => Cones.ext (Iso.refl _) (by aesop_cat)) (by aesop_cat)
#align category_theory.limits.cones.postcompose_id CategoryTheory.Limits.Cones.postcomposeId

/-- If `F` and `G` are naturally isomorphic functors, then they have equivalent categories of
cones.
-/
@[simps]
def postcomposeEquivalence {G : J ⥤ C} (α : F ≅ G) : Cone F ≌ Cone G where
  functor := postcompose α.hom
  inverse := postcompose α.inv
  unitIso := NatIso.ofComponents (fun s => Cones.ext (Iso.refl _) (by aesop_cat)) (by aesop_cat)
  counitIso := NatIso.ofComponents (fun s => Cones.ext (Iso.refl _) (by aesop_cat)) (by aesop_cat)
#align category_theory.limits.cones.postcompose_equivalence CategoryTheory.Limits.Cones.postcomposeEquivalence

/-- Whiskering on the left by `E : K ⥤ J` gives a functor from `Cone F` to `Cone (E ⋙ F)`.
-/
@[simps]
def whiskering (E : K ⥤ J) : Cone F ⥤ Cone (E ⋙ F) where
  obj c := c.whisker E
  map f := { Hom := f.Hom }
#align category_theory.limits.cones.whiskering CategoryTheory.Limits.Cones.whiskering

/-- Whiskering by an equivalence gives an equivalence between categories of cones.
-/
@[simps]
def whiskeringEquivalence (e : K ≌ J) : Cone F ≌ Cone (e.functor ⋙ F) where
  functor := whiskering e.functor
  inverse := whiskering e.inverse ⋙ postcompose (e.invFunIdAssoc F).hom
  unitIso := NatIso.ofComponents (fun s => Cones.ext (Iso.refl _) (by aesop_cat)) (by aesop_cat)
  counitIso :=
    NatIso.ofComponents
      (fun s =>
        Cones.ext (Iso.refl _)
          (by
            intro k
            dsimp
            -- See library note [dsimp, simp]
            simpa [e.counit_app_functor] using s.w (e.unitInv.app k)))
      (by aesop_cat)
#align category_theory.limits.cones.whiskering_equivalence CategoryTheory.Limits.Cones.whiskeringEquivalence

/-- The categories of cones over `F` and `G` are equivalent if `F` and `G` are naturally isomorphic
(possibly after changing the indexing category by an equivalence).
-/
@[simps! functor inverse unitIso counitIso]
def equivalenceOfReindexing {G : K ⥤ C} (e : K ≌ J) (α : e.functor ⋙ F ≅ G) : Cone F ≌ Cone G :=
  (whiskeringEquivalence e).trans (postcomposeEquivalence α)
#align category_theory.limits.cones.equivalence_of_reindexing CategoryTheory.Limits.Cones.equivalenceOfReindexing

section

variable (F)

/-- Forget the cone structure and obtain just the cone point. -/
@[simps]
def forget : Cone F ⥤ C where
  obj t := t.pt
  map f := f.Hom
#align category_theory.limits.cones.forget CategoryTheory.Limits.Cones.forget

variable (G : C ⥤ D)

/-- A functor `G : C ⥤ D` sends cones over `F` to cones over `F ⋙ G` functorially. -/
@[simps]
def functoriality : Cone F ⥤ Cone (F ⋙ G) where
  obj A :=
    { pt := G.obj A.pt
      π :=
        { app := fun j => G.map (A.π.app j)
          naturality := by intros; erw [← G.map_comp]; aesop_cat } }
  map f :=
    { Hom := G.map f.Hom
      w := fun j => by simp [-ConeMorphism.w, ← f.w j] }
#align category_theory.limits.cones.functoriality CategoryTheory.Limits.Cones.functoriality

instance functorialityFull [Full G] [Faithful G] : Full (functoriality F G) where
  preimage t :=
    { Hom := G.preimage t.Hom
      w := fun j => G.map_injective (by simpa using t.w j) }
#align category_theory.limits.cones.functoriality_full CategoryTheory.Limits.Cones.functorialityFull

instance functorialityFaithful [Faithful G] : Faithful (Cones.functoriality F G) where
  map_injective {c} {c'} f g e := by
    apply ConeMorphism.ext f g
    let f := ConeMorphism.mk.inj e; dsimp [functoriality]
    apply G.map_injective f
#align category_theory.limits.cones.functoriality_faithful CategoryTheory.Limits.Cones.functorialityFaithful

/-- If `e : C ≌ D` is an equivalence of categories, then `functoriality F e.functor` induces an
equivalence between cones over `F` and cones over `F ⋙ e.functor`.
-/
@[simps]
def functorialityEquivalence (e : C ≌ D) : Cone F ≌ Cone (F ⋙ e.functor) :=
  let f : (F ⋙ e.functor) ⋙ e.inverse ≅ F :=
    Functor.associator _ _ _ ≪≫ isoWhiskerLeft _ e.unitIso.symm ≪≫ Functor.rightUnitor _
  { functor := functoriality F e.functor
    inverse := functoriality (F ⋙ e.functor) e.inverse ⋙ (postcomposeEquivalence f).functor
    unitIso :=
      NatIso.ofComponents (fun c => Cones.ext (e.unitIso.app _) (by aesop_cat)) (by aesop_cat)
    counitIso :=
      NatIso.ofComponents (fun c => Cones.ext (e.counitIso.app _) (by aesop_cat)) (by aesop_cat)
  }
#align category_theory.limits.cones.functoriality_equivalence CategoryTheory.Limits.Cones.functorialityEquivalence

/-- If `F` reflects isomorphisms, then `Cones.functoriality F` reflects isomorphisms
as well.
-/
instance reflects_cone_isomorphism (F : C ⥤ D) [ReflectsIsomorphisms F] (K : J ⥤ C) :
    ReflectsIsomorphisms (Cones.functoriality K F) := by
  constructor
  intro A B f _
  haveI : IsIso (F.map f.Hom) :=
    (Cones.forget (K ⋙ F)).map_isIso ((Cones.functoriality K F).map f)
  haveI := ReflectsIsomorphisms.reflects F f.Hom
  apply cone_iso_of_hom_iso
#align category_theory.limits.cones.reflects_cone_isomorphism CategoryTheory.Limits.Cones.reflects_cone_isomorphism

end

end Cones

/-- A cocone morphism between two cocones for the same diagram is a morphism of the cocone points
which commutes with the cocone legs. -/
@[ext]
structure CoconeMorphism (A B : Cocone F) where
  /-- A morphism between the (co)vertex objects in `C` -/
  Hom : A.pt ⟶ B.pt
  /-- The triangle made from the two natural transformations and `Hom` commutes -/
  w : ∀ j : J, A.ι.app j ≫ Hom = B.ι.app j := by aesop_cat
#align category_theory.limits.cocone_morphism CategoryTheory.Limits.CoconeMorphism
#align category_theory.limits.cocone_morphism.w' CategoryTheory.Limits.CoconeMorphism.w

instance inhabitedCoconeMorphism (A : Cocone F) : Inhabited (CoconeMorphism A A) :=
  ⟨{ Hom := 𝟙 _ }⟩
#align category_theory.limits.inhabited_cocone_morphism CategoryTheory.Limits.inhabitedCoconeMorphism

attribute [reassoc (attr := simp)] CoconeMorphism.w

@[simps]
instance Cocone.category : Category (Cocone F) where
  Hom A B := CoconeMorphism A B
  comp f g := { Hom := f.Hom ≫ g.Hom }
  id B := { Hom := 𝟙 B.pt }
#align category_theory.limits.cocone.category CategoryTheory.Limits.Cocone.category

namespace Cocones

/-- To give an isomorphism between cocones, it suffices to give an
  isomorphism between their vertices which commutes with the cocone
  maps. -/
-- Porting note: `@[ext]` used to accept lemmas like this. Now we add an aesop rule
@[aesop apply safe (rule_sets [CategoryTheory]), simps]
def ext {c c' : Cocone F} (φ : c.pt ≅ c'.pt) (w : ∀ j, c.ι.app j ≫ φ.hom = c'.ι.app j)
    : c ≅ c' where
  hom := { Hom := φ.hom }
  inv :=
    { Hom := φ.inv
      w := fun j => φ.comp_inv_eq.mpr (w j).symm }
#align category_theory.limits.cocones.ext CategoryTheory.Limits.Cocones.ext

/-- Eta rule for cocones. -/
@[simps!]
def eta (c : Cocone F) : c ≅ ⟨c.pt, c.ι⟩ :=
  Cocones.ext (Iso.refl _) (by aesop_cat)
#align category_theory.limits.cocones.eta CategoryTheory.Limits.Cocones.eta

/-- Given a cocone morphism whose object part is an isomorphism, produce an
isomorphism of cocones.
-/
theorem cocone_iso_of_hom_iso {K : J ⥤ C} {c d : Cocone K} (f : c ⟶ d) [i : IsIso f.Hom] :
    IsIso f :=
  ⟨⟨{   Hom := inv f.Hom
        w := fun j => (asIso f.Hom).comp_inv_eq.2 (f.w j).symm }, by aesop_cat⟩⟩
#align category_theory.limits.cocones.cocone_iso_of_hom_iso CategoryTheory.Limits.Cocones.cocone_iso_of_hom_iso

/-- Functorially precompose a cocone for `F` by a natural transformation `G ⟶ F` to give a cocone
for `G`. -/
@[simps]
def precompose {G : J ⥤ C} (α : G ⟶ F) : Cocone F ⥤ Cocone G where
  obj c :=
    { pt := c.pt
      ι := α ≫ c.ι }
  map f := { Hom := f.Hom }
#align category_theory.limits.cocones.precompose CategoryTheory.Limits.Cocones.precompose

/-- Precomposing a cocone by the composite natural transformation `α ≫ β` is the same as
precomposing by `β` and then by `α`. -/
def precomposeComp {G H : J ⥤ C} (α : F ⟶ G) (β : G ⟶ H) :
    precompose (α ≫ β) ≅ precompose β ⋙ precompose α :=
  NatIso.ofComponents (fun s => Cocones.ext (Iso.refl _) (by aesop_cat)) (by aesop_cat)
#align category_theory.limits.cocones.precompose_comp CategoryTheory.Limits.Cocones.precomposeComp

/-- Precomposing by the identity does not change the cocone up to isomorphism. -/
def precomposeId : precompose (𝟙 F) ≅ 𝟭 (Cocone F) :=
  NatIso.ofComponents (fun s => Cocones.ext (Iso.refl _) (by aesop_cat)) (by aesop_cat)
#align category_theory.limits.cocones.precompose_id CategoryTheory.Limits.Cocones.precomposeId

/-- If `F` and `G` are naturally isomorphic functors, then they have equivalent categories of
cocones.
-/
@[simps]
def precomposeEquivalence {G : J ⥤ C} (α : G ≅ F) : Cocone F ≌ Cocone G where
  functor := precompose α.hom
  inverse := precompose α.inv
  unitIso := NatIso.ofComponents (fun s => Cocones.ext (Iso.refl _) (by aesop_cat)) (by aesop_cat)
  counitIso := NatIso.ofComponents (fun s => Cocones.ext (Iso.refl _) (by aesop_cat)) (by aesop_cat)
#align category_theory.limits.cocones.precompose_equivalence CategoryTheory.Limits.Cocones.precomposeEquivalence

/-- Whiskering on the left by `E : K ⥤ J` gives a functor from `Cocone F` to `Cocone (E ⋙ F)`.
-/
@[simps]
def whiskering (E : K ⥤ J) : Cocone F ⥤ Cocone (E ⋙ F) where
  obj c := c.whisker E
  map f := { Hom := f.Hom }
#align category_theory.limits.cocones.whiskering CategoryTheory.Limits.Cocones.whiskering

/-- Whiskering by an equivalence gives an equivalence between categories of cones.
-/
@[simps]
def whiskeringEquivalence (e : K ≌ J) : Cocone F ≌ Cocone (e.functor ⋙ F) where
  functor := whiskering e.functor
  inverse :=
    whiskering e.inverse ⋙
      precompose
        ((Functor.leftUnitor F).inv ≫
          whiskerRight e.counitIso.inv F ≫ (Functor.associator _ _ _).inv)
  unitIso := NatIso.ofComponents (fun s => Cocones.ext (Iso.refl _) (by aesop_cat)) (by aesop_cat)
  counitIso :=
    NatIso.ofComponents
      (fun s =>
        Cocones.ext (Iso.refl _)
          (by
            intro k
            dsimp
            simpa [e.counitInv_app_functor k] using s.w (e.unit.app k)))
      (by aesop_cat)
#align category_theory.limits.cocones.whiskering_equivalence CategoryTheory.Limits.Cocones.whiskeringEquivalence

/--
The categories of cocones over `F` and `G` are equivalent if `F` and `G` are naturally isomorphic
(possibly after changing the indexing category by an equivalence).
-/
@[simps! functor_obj]
def equivalenceOfReindexing {G : K ⥤ C} (e : K ≌ J) (α : e.functor ⋙ F ≅ G) : Cocone F ≌ Cocone G :=
  (whiskeringEquivalence e).trans (precomposeEquivalence α.symm)
#align category_theory.limits.cocones.equivalence_of_reindexing CategoryTheory.Limits.Cocones.equivalenceOfReindexing

section

variable (F)

/-- Forget the cocone structure and obtain just the cocone point. -/
@[simps]
def forget : Cocone F ⥤ C where
  obj t := t.pt
  map f := f.Hom
#align category_theory.limits.cocones.forget CategoryTheory.Limits.Cocones.forget

variable (G : C ⥤ D)

/-- A functor `G : C ⥤ D` sends cocones over `F` to cocones over `F ⋙ G` functorially. -/
@[simps]
def functoriality : Cocone F ⥤ Cocone (F ⋙ G) where
  obj A :=
    { pt := G.obj A.pt
      ι :=
        { app := fun j => G.map (A.ι.app j)
          naturality := by intros; erw [← G.map_comp]; aesop_cat } }
  map f :=
    { Hom := G.map f.Hom
      w := by intros; rw [← Functor.map_comp, CoconeMorphism.w] }
  map_id := by aesop_cat
  map_comp := by aesop_cat
#align category_theory.limits.cocones.functoriality CategoryTheory.Limits.Cocones.functoriality

instance functorialityFull [Full G] [Faithful G] : Full (functoriality F G) where
  preimage t :=
    { Hom := G.preimage t.Hom
      w := fun j => G.map_injective (by simpa using t.w j) }
#align category_theory.limits.cocones.functoriality_full CategoryTheory.Limits.Cocones.functorialityFull

instance functoriality_faithful [Faithful G] : Faithful (functoriality F G) where
  map_injective {X} {Y} f g e := by
    apply CoconeMorphism.ext
    let h := CoconeMorphism.mk.inj e
    apply G.map_injective h
#align category_theory.limits.cocones.functoriality_faithful CategoryTheory.Limits.Cocones.functoriality_faithful

/-- If `e : C ≌ D` is an equivalence of categories, then `functoriality F e.functor` induces an
equivalence between cocones over `F` and cocones over `F ⋙ e.functor`.
-/
@[simps]
def functorialityEquivalence (e : C ≌ D) : Cocone F ≌ Cocone (F ⋙ e.functor) :=
  let f : (F ⋙ e.functor) ⋙ e.inverse ≅ F :=
    Functor.associator _ _ _ ≪≫ isoWhiskerLeft _ e.unitIso.symm ≪≫ Functor.rightUnitor _
  { functor := functoriality F e.functor
    inverse := functoriality (F ⋙ e.functor) e.inverse ⋙ (precomposeEquivalence f.symm).functor
    unitIso :=
      NatIso.ofComponents (fun c => Cocones.ext (e.unitIso.app _) (by aesop_cat)) (by aesop_cat)
    counitIso :=
      NatIso.ofComponents
        (fun c =>
          Cocones.ext (e.counitIso.app _)
            (by
              -- Unfortunately this doesn't work by `tidy`.
              -- In this configuration `simp` reaches a dead-end and needs help.
              intro j
              dsimp
              simp only [← Equivalence.counitInv_app_functor, Iso.inv_hom_id_app, map_comp,
                Equivalence.fun_inv_map, assoc, id_comp, Iso.inv_hom_id_app_assoc]
              dsimp; simp))-- See note [dsimp, simp].
      fun {c} {c'} f => by
        apply CoconeMorphism.ext
        simp
  }
#align category_theory.limits.cocones.functoriality_equivalence CategoryTheory.Limits.Cocones.functorialityEquivalence

/-- If `F` reflects isomorphisms, then `cocones.functoriality F` reflects isomorphisms
as well.
-/
instance reflects_cocone_isomorphism (F : C ⥤ D) [ReflectsIsomorphisms F] (K : J ⥤ C) :
    ReflectsIsomorphisms (Cocones.functoriality K F) := by
  constructor
  intro A B f _
  haveI : IsIso (F.map f.Hom) :=
    (Cocones.forget (K ⋙ F)).map_isIso ((Cocones.functoriality K F).map f)
  haveI := ReflectsIsomorphisms.reflects F f.Hom
  apply cocone_iso_of_hom_iso
#align category_theory.limits.cocones.reflects_cocone_isomorphism CategoryTheory.Limits.Cocones.reflects_cocone_isomorphism

end

end Cocones

end Limits

namespace Functor

variable (H : C ⥤ D) {F : J ⥤ C} {G : J ⥤ C}

open CategoryTheory.Limits

/-- The image of a cone in C under a functor G : C ⥤ D is a cone in D. -/
@[simps!]
def mapCone (c : Cone F) : Cone (F ⋙ H) :=
  (Cones.functoriality F H).obj c
#align category_theory.functor.map_cone CategoryTheory.Functor.mapCone

/-- The image of a cocone in C under a functor G : C ⥤ D is a cocone in D. -/
@[simps!]
def mapCocone (c : Cocone F) : Cocone (F ⋙ H) :=
  (Cocones.functoriality F H).obj c
#align category_theory.functor.map_cocone CategoryTheory.Functor.mapCocone

/-- Given a cone morphism `c ⟶ c'`, construct a cone morphism on the mapped cones functorially.  -/
def mapConeMorphism {c c' : Cone F} (f : c ⟶ c') : H.mapCone c ⟶ H.mapCone c' :=
  (Cones.functoriality F H).map f
#align category_theory.functor.map_cone_morphism CategoryTheory.Functor.mapConeMorphism

/-- Given a cocone morphism `c ⟶ c'`, construct a cocone morphism on the mapped cocones
functorially. -/
def mapCoconeMorphism {c c' : Cocone F} (f : c ⟶ c') : H.mapCocone c ⟶ H.mapCocone c' :=
  (Cocones.functoriality F H).map f
#align category_theory.functor.map_cocone_morphism CategoryTheory.Functor.mapCoconeMorphism

/-- If `H` is an equivalence, we invert `H.mapCone` and get a cone for `F` from a cone
for `F ⋙ H`.-/
def mapConeInv [IsEquivalence H] (c : Cone (F ⋙ H)) : Cone F :=
  (Limits.Cones.functorialityEquivalence F (asEquivalence H)).inverse.obj c
#align category_theory.functor.map_cone_inv CategoryTheory.Functor.mapConeInv

/-- `mapCone` is the left inverse to `mapConeInv`. -/
def mapConeMapConeInv {F : J ⥤ D} (H : D ⥤ C) [IsEquivalence H] (c : Cone (F ⋙ H)) :
    mapCone H (mapConeInv H c) ≅ c :=
  (Limits.Cones.functorialityEquivalence F (asEquivalence H)).counitIso.app c
#align category_theory.functor.map_cone_map_cone_inv CategoryTheory.Functor.mapConeMapConeInv

/-- `MapCone` is the right inverse to `mapConeInv`. -/
def mapConeInvMapCone {F : J ⥤ D} (H : D ⥤ C) [IsEquivalence H] (c : Cone F) :
    mapConeInv H (mapCone H c) ≅ c :=
  (Limits.Cones.functorialityEquivalence F (asEquivalence H)).unitIso.symm.app c
#align category_theory.functor.map_cone_inv_map_cone CategoryTheory.Functor.mapConeInvMapCone

/-- If `H` is an equivalence, we invert `H.mapCone` and get a cone for `F` from a cone
for `F ⋙ H`.-/
def mapCoconeInv [IsEquivalence H] (c : Cocone (F ⋙ H)) : Cocone F :=
  (Limits.Cocones.functorialityEquivalence F (asEquivalence H)).inverse.obj c
#align category_theory.functor.map_cocone_inv CategoryTheory.Functor.mapCoconeInv

/-- `mapCocone` is the left inverse to `mapCoconeInv`. -/
def mapCoconeMapCoconeInv {F : J ⥤ D} (H : D ⥤ C) [IsEquivalence H] (c : Cocone (F ⋙ H)) :
    mapCocone H (mapCoconeInv H c) ≅ c :=
  (Limits.Cocones.functorialityEquivalence F (asEquivalence H)).counitIso.app c
#align category_theory.functor.map_cocone_map_cocone_inv CategoryTheory.Functor.mapCoconeMapCoconeInv

/-- `mapCocone` is the right inverse to `mapCoconeInv`. -/
def mapCoconeInvMapCocone {F : J ⥤ D} (H : D ⥤ C) [IsEquivalence H] (c : Cocone F) :
    mapCoconeInv H (mapCocone H c) ≅ c :=
  (Limits.Cocones.functorialityEquivalence F (asEquivalence H)).unitIso.symm.app c
#align category_theory.functor.map_cocone_inv_map_cocone CategoryTheory.Functor.mapCoconeInvMapCocone

/-- `functoriality F _ ⋙ postcompose (whisker_left F _)` simplifies to `functoriality F _`. -/
@[simps!]
def functorialityCompPostcompose {H H' : C ⥤ D} (α : H ≅ H') :
    Cones.functoriality F H ⋙ Cones.postcompose (whiskerLeft F α.hom) ≅ Cones.functoriality F H' :=
  NatIso.ofComponents (fun c => Cones.ext (α.app _) (by aesop_cat)) (by aesop_cat)
#align category_theory.functor.functoriality_comp_postcompose CategoryTheory.Functor.functorialityCompPostcompose

/-- For `F : J ⥤ C`, given a cone `c : Cone F`, and a natural isomorphism `α : H ≅ H'` for functors
`H H' : C ⥤ D`, the postcomposition of the cone `H.mapCone` using the isomorphism `α` is
isomorphic to the cone `H'.mapCone`.
-/
@[simps!]
def postcomposeWhiskerLeftMapCone {H H' : C ⥤ D} (α : H ≅ H') (c : Cone F) :
    (Cones.postcompose (whiskerLeft F α.hom : _)).obj (mapCone H c) ≅ mapCone H' c :=
  (functorialityCompPostcompose α).app c
#align category_theory.functor.postcompose_whisker_left_map_cone CategoryTheory.Functor.postcomposeWhiskerLeftMapCone

/--
`mapCone` commutes with `postcompose`. In particular, for `F : J ⥤ C`, given a cone `c : Cone F`, a
natural transformation `α : F ⟶ G` and a functor `H : C ⥤ D`, we have two obvious ways of producing
a cone over `G ⋙ H`, and they are both isomorphic.
-/
@[simps!]
def mapConePostcompose {α : F ⟶ G} {c} :
    mapCone H ((Cones.postcompose α).obj c) ≅
      (Cones.postcompose (whiskerRight α H : _)).obj (mapCone H c) :=
  Cones.ext (Iso.refl _) (by aesop_cat)
#align category_theory.functor.map_cone_postcompose CategoryTheory.Functor.mapConePostcompose

/-- `mapCone` commutes with `postcomposeEquivalence`
-/
@[simps!]
def mapConePostcomposeEquivalenceFunctor {α : F ≅ G} {c} :
    mapCone H ((Cones.postcomposeEquivalence α).functor.obj c) ≅
      (Cones.postcomposeEquivalence (isoWhiskerRight α H : _)).functor.obj (mapCone H c) :=
  Cones.ext (Iso.refl _) (by aesop_cat)
#align category_theory.functor.map_cone_postcompose_equivalence_functor CategoryTheory.Functor.mapConePostcomposeEquivalenceFunctor

/-- `functoriality F _ ⋙ precompose (whiskerLeft F _)` simplifies to `functoriality F _`. -/
@[simps!]
def functorialityCompPrecompose {H H' : C ⥤ D} (α : H ≅ H') :
    Cocones.functoriality F H ⋙ Cocones.precompose (whiskerLeft F α.inv) ≅
      Cocones.functoriality F H' :=
  NatIso.ofComponents (fun c => Cocones.ext (α.app _) (by aesop_cat)) (by aesop_cat)
#align category_theory.functor.functoriality_comp_precompose CategoryTheory.Functor.functorialityCompPrecompose

/--
For `F : J ⥤ C`, given a cocone `c : Cocone F`, and a natural isomorphism `α : H ≅ H'` for functors
`H H' : C ⥤ D`, the precomposition of the cocone `H.mapCocone` using the isomorphism `α` is
isomorphic to the cocone `H'.mapCocone`.
-/
@[simps!]
def precomposeWhiskerLeftMapCocone {H H' : C ⥤ D} (α : H ≅ H') (c : Cocone F) :
    (Cocones.precompose (whiskerLeft F α.inv : _)).obj (mapCocone H c) ≅ mapCocone H' c :=
  (functorialityCompPrecompose α).app c
#align category_theory.functor.precompose_whisker_left_map_cocone CategoryTheory.Functor.precomposeWhiskerLeftMapCocone

/-- `map_cocone` commutes with `precompose`. In particular, for `F : J ⥤ C`, given a cocone
`c : Cocone F`, a natural transformation `α : F ⟶ G` and a functor `H : C ⥤ D`, we have two obvious
ways of producing a cocone over `G ⋙ H`, and they are both isomorphic.
-/
@[simps!]
def mapCoconePrecompose {α : F ⟶ G} {c} :
    mapCocone H ((Cocones.precompose α).obj c) ≅
      (Cocones.precompose (whiskerRight α H : _)).obj (mapCocone H c) :=
  Cocones.ext (Iso.refl _) (by aesop_cat)
#align category_theory.functor.map_cocone_precompose CategoryTheory.Functor.mapCoconePrecompose

/-- `mapCocone` commutes with `precomposeEquivalence`
-/
@[simps!]
def mapCoconePrecomposeEquivalenceFunctor {α : F ≅ G} {c} :
    mapCocone H ((Cocones.precomposeEquivalence α).functor.obj c) ≅
      (Cocones.precomposeEquivalence (isoWhiskerRight α H : _)).functor.obj (mapCocone H c) :=
  Cocones.ext (Iso.refl _) (by aesop_cat)
#align category_theory.functor.map_cocone_precompose_equivalence_functor CategoryTheory.Functor.mapCoconePrecomposeEquivalenceFunctor

/-- `mapCone` commutes with `whisker`
-/
@[simps!]
def mapConeWhisker {E : K ⥤ J} {c : Cone F} : mapCone H (c.whisker E) ≅ (mapCone H c).whisker E :=
  Cones.ext (Iso.refl _) (by aesop_cat)
#align category_theory.functor.map_cone_whisker CategoryTheory.Functor.mapConeWhisker

/-- `mapCocone` commutes with `whisker`
-/
@[simps!]
def mapCoconeWhisker {E : K ⥤ J} {c : Cocone F} :
    mapCocone H (c.whisker E) ≅ (mapCocone H c).whisker E :=
  Cocones.ext (Iso.refl _) (by aesop_cat)
#align category_theory.functor.map_cocone_whisker CategoryTheory.Functor.mapCoconeWhisker

end Functor

end CategoryTheory

namespace CategoryTheory.Limits

section

variable {F : J ⥤ C}

/-- Change a `Cocone F` into a `Cone F.op`. -/
@[simps]
def Cocone.op (c : Cocone F) : Cone F.op where
  pt := Opposite.op c.pt
  π := NatTrans.op c.ι
#align category_theory.limits.cocone.op CategoryTheory.Limits.Cocone.op

/-- Change a `Cone F` into a `Cocone F.op`. -/
@[simps]
def Cone.op (c : Cone F) : Cocone F.op where
  pt := Opposite.op c.pt
  ι := NatTrans.op c.π
#align category_theory.limits.cone.op CategoryTheory.Limits.Cone.op

/-- Change a `Cocone F.op` into a `Cone F`. -/
@[simps]
def Cocone.unop (c : Cocone F.op) : Cone F
    where
  pt := Opposite.unop c.pt
  π := NatTrans.removeOp c.ι
#align category_theory.limits.cocone.unop CategoryTheory.Limits.Cocone.unop

/-- Change a `Cone F.op` into a `Cocone F`. -/
@[simps]
def Cone.unop (c : Cone F.op) : Cocone F
    where
  pt := Opposite.unop c.pt
  ι := NatTrans.removeOp c.π
#align category_theory.limits.cone.unop CategoryTheory.Limits.Cone.unop

variable (F)

/-- The category of cocones on `F`
is equivalent to the opposite category of
the category of cones on the opposite of `F`.
-/
def coconeEquivalenceOpConeOp : Cocone F ≌ (Cone F.op)ᵒᵖ where
  functor :=
    { obj := fun c => op (Cocone.op c)
      map := fun {X} {Y} f =>
        Quiver.Hom.op
          { Hom := f.Hom.op
            w := fun j => by
              apply Quiver.Hom.unop_inj
              dsimp
              apply CoconeMorphism.w } }
  inverse :=
    { obj := fun c => Cone.unop (unop c)
      map := fun {X} {Y} f =>
        { Hom := f.unop.Hom.unop
          w := fun j => by
            apply Quiver.Hom.op_inj
            dsimp
            apply ConeMorphism.w } }
  unitIso :=
    NatIso.ofComponents
      (fun c =>
        Cocones.ext (Iso.refl _)
          (by
            dsimp
            simp))
      fun {X} {Y} f => by
      apply CoconeMorphism.ext
      simp
  counitIso :=
    NatIso.ofComponents
      (fun c => by
        induction c using Opposite.rec
        dsimp
        apply Iso.op
        exact
          Cones.ext (Iso.refl _)
            (by
              dsimp
              simp))
      fun {X} {Y} f =>
      Quiver.Hom.unop_inj
        (ConeMorphism.ext _ _
          (by
            dsimp
            simp))
  functor_unitIso_comp c := by
    apply Quiver.Hom.unop_inj
    apply ConeMorphism.ext
    dsimp
    apply comp_id
#align category_theory.limits.cocone_equivalence_op_cone_op CategoryTheory.Limits.coconeEquivalenceOpConeOp

attribute [simps] coconeEquivalenceOpConeOp

end

section

variable {F : J ⥤ Cᵒᵖ}
/- Porting note: removed a few simps configs
`@[simps (config :=
      { rhsMd := semireducible
        simpRhs := true })]`
and replace with `@[simps]`-/
-- Here and below we only automatically generate the `@[simp]` lemma for the `X` field,
-- as we can write a simpler `rfl` lemma for the components of the natural transformation by hand.
/-- Change a cocone on `F.leftOp : Jᵒᵖ ⥤ C` to a cocone on `F : J ⥤ Cᵒᵖ`. -/
@[simps!]
def coneOfCoconeLeftOp (c : Cocone F.leftOp) : Cone F where
  pt := op c.pt
  π := NatTrans.removeLeftOp c.ι
#align category_theory.limits.cone_of_cocone_left_op CategoryTheory.Limits.coneOfCoconeLeftOp

/-- Change a cone on `F : J ⥤ Cᵒᵖ` to a cocone on `F.leftOp : Jᵒᵖ ⥤ C`. -/
@[simps!]
def coconeLeftOpOfCone (c : Cone F) : Cocone F.leftOp where
  pt := unop c.pt
  ι := NatTrans.leftOp c.π
#align category_theory.limits.cocone_left_op_of_cone CategoryTheory.Limits.coconeLeftOpOfCone

/- When trying use `@[simps]` to generate the `ι_app` field of this definition, `@[simps]` tries to
  reduce the RHS using `expr.dsimp` and `expr.simp`, but for some reason the expression is not
  being simplified properly. -/
/-- Change a cone on `F.leftOp : Jᵒᵖ ⥤ C` to a cocone on `F : J ⥤ Cᵒᵖ`. -/
@[simps pt]
def coconeOfConeLeftOp (c : Cone F.leftOp) : Cocone F where
  pt := op c.pt
  ι := NatTrans.removeLeftOp c.π
#align category_theory.limits.cocone_of_cone_left_op CategoryTheory.Limits.coconeOfConeLeftOp

@[simp]
theorem coconeOfConeLeftOp_ι_app (c : Cone F.leftOp) (j) :
    (coconeOfConeLeftOp c).ι.app j = (c.π.app (op j)).op := by
  dsimp only [coconeOfConeLeftOp]
  simp
#align category_theory.limits.cocone_of_cone_left_op_ι_app CategoryTheory.Limits.coconeOfConeLeftOp_ι_app

/-- Change a cocone on `F : J ⥤ Cᵒᵖ` to a cone on `F.leftOp : Jᵒᵖ ⥤ C`. -/
@[simps!]
def coneLeftOpOfCocone (c : Cocone F) : Cone F.leftOp where
  pt := unop c.pt
  π := NatTrans.leftOp c.ι
#align category_theory.limits.cone_left_op_of_cocone CategoryTheory.Limits.coneLeftOpOfCocone

end

section

variable {F : Jᵒᵖ ⥤ C}

/-- Change a cocone on `F.rightOp : J ⥤ Cᵒᵖ` to a cone on `F : Jᵒᵖ ⥤ C`. -/
@[simps]
def coneOfCoconeRightOp (c : Cocone F.rightOp) : Cone F where
  pt := unop c.pt
  π := NatTrans.removeRightOp c.ι
#align category_theory.limits.cone_of_cocone_right_op CategoryTheory.Limits.coneOfCoconeRightOp

/-- Change a cone on `F : Jᵒᵖ ⥤ C` to a cocone on `F.rightOp : Jᵒᵖ ⥤ C`. -/
@[simps]
def coconeRightOpOfCone (c : Cone F) : Cocone F.rightOp where
  pt := op c.pt
  ι := NatTrans.rightOp c.π
#align category_theory.limits.cocone_right_op_of_cone CategoryTheory.Limits.coconeRightOpOfCone

/-- Change a cone on `F.rightOp : J ⥤ Cᵒᵖ` to a cocone on `F : Jᵒᵖ ⥤ C`. -/
@[simps]
def coconeOfConeRightOp (c : Cone F.rightOp) : Cocone F where
  pt := unop c.pt
  ι := NatTrans.removeRightOp c.π
#align category_theory.limits.cocone_of_cone_right_op CategoryTheory.Limits.coconeOfConeRightOp

/-- Change a cocone on `F : Jᵒᵖ ⥤ C` to a cone on `F.rightOp : J ⥤ Cᵒᵖ`. -/
@[simps]
def coneRightOpOfCocone (c : Cocone F) : Cone F.rightOp where
  pt := op c.pt
  π := NatTrans.rightOp c.ι
#align category_theory.limits.cone_right_op_of_cocone CategoryTheory.Limits.coneRightOpOfCocone

end

section

variable {F : Jᵒᵖ ⥤ Cᵒᵖ}

/-- Change a cocone on `F.unop : J ⥤ C` into a cone on `F : Jᵒᵖ ⥤ Cᵒᵖ`. -/
@[simps]
def coneOfCoconeUnop (c : Cocone F.unop) : Cone F where
  pt := op c.pt
  π := NatTrans.removeUnop c.ι
#align category_theory.limits.cone_of_cocone_unop CategoryTheory.Limits.coneOfCoconeUnop

/-- Change a cone on `F : Jᵒᵖ ⥤ Cᵒᵖ` into a cocone on `F.unop : J ⥤ C`. -/
@[simps]
def coconeUnopOfCone (c : Cone F) : Cocone F.unop where
  pt := unop c.pt
  ι := NatTrans.unop c.π
#align category_theory.limits.cocone_unop_of_cone CategoryTheory.Limits.coconeUnopOfCone

/-- Change a cone on `F.unop : J ⥤ C` into a cocone on `F : Jᵒᵖ ⥤ Cᵒᵖ`. -/
@[simps]
def coconeOfConeUnop (c : Cone F.unop) : Cocone F where
  pt := op c.pt
  ι := NatTrans.removeUnop c.π
#align category_theory.limits.cocone_of_cone_unop CategoryTheory.Limits.coconeOfConeUnop

/-- Change a cocone on `F : Jᵒᵖ ⥤ Cᵒᵖ` into a cone on `F.unop : J ⥤ C`. -/
@[simps]
def coneUnopOfCocone (c : Cocone F) : Cone F.unop where
  pt := unop c.pt
  π := NatTrans.unop c.ι
#align category_theory.limits.cone_unop_of_cocone CategoryTheory.Limits.coneUnopOfCocone

end

end CategoryTheory.Limits

namespace CategoryTheory.Functor

open CategoryTheory.Limits

variable {F : J ⥤ C}

section

variable (G : C ⥤ D)

/-- The opposite cocone of the image of a cone is the image of the opposite cocone. -/
-- Porting note: removed @[simps (config := { rhsMd := semireducible })] and replaced with
@[simps!]
def mapConeOp (t : Cone F) : (mapCone G t).op ≅ mapCocone G.op t.op :=
  Cocones.ext (Iso.refl _) (by aesop_cat)
#align category_theory.functor.map_cone_op CategoryTheory.Functor.mapConeOp

/-- The opposite cone of the image of a cocone is the image of the opposite cone. -/
-- Porting note: removed @[simps (config := { rhsMd := semireducible })] and replaced with
@[simps!]
def mapCoconeOp {t : Cocone F} : (mapCocone G t).op ≅ mapCone G.op t.op :=
  Cones.ext (Iso.refl _) (by aesop_cat)
#align category_theory.functor.map_cocone_op CategoryTheory.Functor.mapCoconeOp

end

end CategoryTheory.Functor


example (P Q : Prop) (p : P) (q : Q) : P ∧ Q :=
begin
    split,
    exact p,
    exact q,
end


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Stephen Morgan, Scott Morrison, Johannes Hölzl
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.fully_faithful
import Mathlib.data.equiv.basic
import Mathlib.PostPort

universes u v w u' u_1 u_2

namespace Mathlib

/-!
# The category `Type`.

In this section we set up the theory so that Lean's types and functions between them
can be viewed as a `large_category` in our framework.

Lean can not transparently view a function as a morphism in this category,
and needs a hint in order to be able to type check.
We provide the abbreviation `as_hom f` to guide type checking,
as well as a corresponding notation `↾ f`. (Entered as `\upr `.)

We provide various simplification lemmas for functors and natural transformations valued in `Type`.

We define `ulift_functor`, from `Type u` to `Type (max u v)`, and show that it is fully faithful
(but not, of course, essentially surjective).

We prove some basic facts about the category `Type`:
*  epimorphisms are surjections and monomorphisms are injections,
* `iso` is both `iso` and `equiv` to `equiv` (at least within a fixed universe),
* every type level `is_lawful_functor` gives a categorical functor `Type ⥤ Type`
  (the corresponding fact about monads is in `src/category_theory/monad/types.lean`).
-/

namespace category_theory

protected instance types : large_category (Type u) := category.mk

theorem types_hom {α : Type u} {β : Type u} : (α ⟶ β) = (α → β) := rfl

theorem types_id (X : Type u) : 𝟙 = id := rfl

theorem types_comp {X : Type u} {Y : Type u} {Z : Type u} (f : X ⟶ Y) (g : Y ⟶ Z) : f ≫ g = g ∘ f :=
  rfl

@[simp] theorem types_id_apply (X : Type u) (x : X) : 𝟙 = x := rfl

@[simp] theorem types_comp_apply {X : Type u} {Y : Type u} {Z : Type u} (f : X ⟶ Y) (g : Y ⟶ Z)
    (x : X) : category_struct.comp f g x = g (f x) :=
  rfl

@[simp] theorem hom_inv_id_apply {X : Type u} {Y : Type u} (f : X ≅ Y) (x : X) :
    iso.inv f (iso.hom f x) = x :=
  congr_fun (iso.hom_inv_id f) x

@[simp] theorem inv_hom_id_apply {X : Type u} {Y : Type u} (f : X ≅ Y) (y : Y) :
    iso.hom f (iso.inv f y) = y :=
  congr_fun (iso.inv_hom_id f) y

/-- `as_hom f` helps Lean type check a function as a morphism in the category `Type`. -/
-- Unfortunately without this wrapper we can't use `category_theory` idioms, such as `is_iso f`.

-- If you don't mind some notation you can use fewer keystrokes:

def as_hom {α : Type u} {β : Type u} (f : α → β) : α ⟶ β := f

prefix:200 "↾" => Mathlib.category_theory.as_hom

namespace functor

/--
The sections of a functor `J ⥤ Type` are
the choices of a point `u j : F.obj j` for each `j`,
such that `F.map f (u j) = u j` for every morphism `f : j ⟶ j'`.

We later use these to define limits in `Type` and in many concrete categories.
-/
def sections {J : Type u} [category J] (F : J ⥤ Type w) : set ((j : J) → obj F j) :=
  set_of fun (u : (j : J) → obj F j) => ∀ {j j' : J} (f : j ⟶ j'), map F f (u j) = u j'

end functor

namespace functor_to_types

@[simp] theorem map_comp_apply {C : Type u} [category C] (F : C ⥤ Type w) {X : C} {Y : C} {Z : C}
    (f : X ⟶ Y) (g : Y ⟶ Z) (a : functor.obj F X) :
    functor.map F (f ≫ g) a = functor.map F g (functor.map F f a) :=
  sorry

@[simp] theorem map_id_apply {C : Type u} [category C] (F : C ⥤ Type w) {X : C}
    (a : functor.obj F X) : functor.map F 𝟙 a = a :=
  sorry

theorem naturality {C : Type u} [category C] (F : C ⥤ Type w) (G : C ⥤ Type w) {X : C} {Y : C}
    (σ : F ⟶ G) (f : X ⟶ Y) (x : functor.obj F X) :
    nat_trans.app σ Y (functor.map F f x) = functor.map G f (nat_trans.app σ X x) :=
  congr_fun (nat_trans.naturality σ f) x

@[simp] theorem comp {C : Type u} [category C] (F : C ⥤ Type w) (G : C ⥤ Type w) (H : C ⥤ Type w)
    {X : C} (σ : F ⟶ G) (τ : G ⟶ H) (x : functor.obj F X) :
    nat_trans.app (σ ≫ τ) X x = nat_trans.app τ X (nat_trans.app σ X x) :=
  rfl

@[simp] theorem hcomp {C : Type u} [category C] (F : C ⥤ Type w) (G : C ⥤ Type w) (σ : F ⟶ G)
    {D : Type u'} [𝒟 : category D] (I : D ⥤ C) (J : D ⥤ C) (ρ : I ⟶ J) {W : D}
    (x : functor.obj (I ⋙ F) W) :
    nat_trans.app (ρ ◫ σ) W x =
        functor.map G (nat_trans.app ρ W) (nat_trans.app σ (functor.obj I W) x) :=
  rfl

@[simp] theorem map_inv_map_hom_apply {C : Type u} [category C] (F : C ⥤ Type w) {X : C} {Y : C}
    (f : X ≅ Y) (x : functor.obj F X) :
    functor.map F (iso.inv f) (functor.map F (iso.hom f) x) = x :=
  congr_fun (iso.hom_inv_id (functor.map_iso F f)) x

@[simp] theorem map_hom_map_inv_apply {C : Type u} [category C] (F : C ⥤ Type w) {X : C} {Y : C}
    (f : X ≅ Y) (y : functor.obj F Y) :
    functor.map F (iso.hom f) (functor.map F (iso.inv f) y) = y :=
  congr_fun (iso.inv_hom_id (functor.map_iso F f)) y

@[simp] theorem hom_inv_id_app_apply {C : Type u} [category C] (F : C ⥤ Type w) (G : C ⥤ Type w)
    (α : F ≅ G) (X : C) (x : functor.obj F X) :
    nat_trans.app (iso.inv α) X (nat_trans.app (iso.hom α) X x) = x :=
  congr_fun (iso.hom_inv_id_app α X) x

@[simp] theorem inv_hom_id_app_apply {C : Type u} [category C] (F : C ⥤ Type w) (G : C ⥤ Type w)
    (α : F ≅ G) (X : C) (x : functor.obj G X) :
    nat_trans.app (iso.hom α) X (nat_trans.app (iso.inv α) X x) = x :=
  congr_fun (iso.inv_hom_id_app α X) x

end functor_to_types

/--
The isomorphism between a `Type` which has been `ulift`ed to the same universe,
and the original type.
-/
def ulift_trivial (V : Type u) : ulift V ≅ V :=
  iso.mk (id fun (ᾰ : ulift V) => ulift.cases_on ᾰ fun (ᾰ : V) => ᾰ) ulift.up

/--
The functor embedding `Type u` into `Type (max u v)`.
Write this as `ulift_functor.{5 2}` to get `Type 2 ⥤ Type 5`.
-/
def ulift_functor : Type u ⥤ Type (max u v) :=
  functor.mk (fun (X : Type u) => ulift X)
    fun (X Y : Type u) (f : X ⟶ Y) (x : ulift X) => ulift.up (f (ulift.down x))

@[simp] theorem ulift_functor_map {X : Type u} {Y : Type u} (f : X ⟶ Y) (x : ulift X) :
    functor.map ulift_functor f x = ulift.up (f (ulift.down x)) :=
  rfl

protected instance ulift_functor_full : full ulift_functor :=
  full.mk
    fun (X Y : Type u) (f : functor.obj ulift_functor X ⟶ functor.obj ulift_functor Y) (x : X) =>
      ulift.down (f (ulift.up x))

protected instance ulift_functor_faithful : faithful ulift_functor := faithful.mk

/-- Any term `x` of a type `X` corresponds to a morphism `punit ⟶ X`. -/
-- TODO We should connect this to a general story about concrete categories

-- whose forgetful functor is representable.

def hom_of_element {X : Type u} (x : X) : PUnit ⟶ X := fun (_x : PUnit) => x

theorem hom_of_element_eq_iff {X : Type u} (x : X) (y : X) :
    hom_of_element x = hom_of_element y ↔ x = y :=
  sorry

/--
A morphism in `Type` is a monomorphism if and only if it is injective.

See https://stacks.math.columbia.edu/tag/003C.
-/
theorem mono_iff_injective {X : Type u} {Y : Type u} (f : X ⟶ Y) : mono f ↔ function.injective f :=
  sorry

/--
A morphism in `Type` is an epimorphism if and only if it is surjective.

See https://stacks.math.columbia.edu/tag/003C.
-/
theorem epi_iff_surjective {X : Type u} {Y : Type u} (f : X ⟶ Y) : epi f ↔ function.surjective f :=
  sorry

/-- `of_type_functor m` converts from Lean's `Type`-based `category` to `category_theory`. This
allows us to use these functors in category theory. -/
def of_type_functor (m : Type u → Type v) [Functor m] [is_lawful_functor m] : Type u ⥤ Type v :=
  functor.mk m fun (α β : Type u) => Functor.map

@[simp] theorem of_type_functor_obj (m : Type u → Type v) [Functor m] [is_lawful_functor m] :
    functor.obj (of_type_functor m) = m :=
  rfl

@[simp] theorem of_type_functor_map (m : Type u → Type v) [Functor m] [is_lawful_functor m]
    {α : Type u} {β : Type u} (f : α → β) : functor.map (of_type_functor m) f = Functor.map f :=
  rfl

end category_theory

-- Isomorphisms in Type and equivalences.

namespace equiv

/--
Any equivalence between types in the same universe gives
a categorical isomorphism between those types.
-/
def to_iso {X : Type u} {Y : Type u} (e : X ≃ Y) : X ≅ Y :=
  category_theory.iso.mk (to_fun e) (inv_fun e)

@[simp] theorem to_iso_hom {X : Type u} {Y : Type u} {e : X ≃ Y} :
    category_theory.iso.hom (to_iso e) = ⇑e :=
  rfl

@[simp] theorem to_iso_inv {X : Type u} {Y : Type u} {e : X ≃ Y} :
    category_theory.iso.inv (to_iso e) = ⇑(equiv.symm e) :=
  rfl

end equiv

namespace category_theory.iso

/--
Any isomorphism between types gives an equivalence.
-/
def to_equiv {X : Type u} {Y : Type u} (i : X ≅ Y) : X ≃ Y := equiv.mk (hom i) (inv i) sorry sorry

@[simp] theorem to_equiv_fun {X : Type u} {Y : Type u} (i : X ≅ Y) : ⇑(to_equiv i) = hom i := rfl

@[simp] theorem to_equiv_symm_fun {X : Type u} {Y : Type u} (i : X ≅ Y) :
    ⇑(equiv.symm (to_equiv i)) = inv i :=
  rfl

@[simp] theorem to_equiv_id (X : Type u) : to_equiv (refl X) = equiv.refl X := rfl

@[simp] theorem to_equiv_comp {X : Type u} {Y : Type u} {Z : Type u} (f : X ≅ Y) (g : Y ≅ Z) :
    to_equiv (f ≪≫ g) = equiv.trans (to_equiv f) (to_equiv g) :=
  rfl

end category_theory.iso

namespace category_theory

/-- A morphism in `Type u` is an isomorphism if and only if it is bijective. -/
def is_iso_equiv_bijective {X : Type u} {Y : Type u} (f : X ⟶ Y) :
    is_iso f ≃ function.bijective f :=
  equiv_of_subsingleton_of_subsingleton sorry
    fun (b : function.bijective f) => is_iso.mk (iso.inv (equiv.to_iso (equiv.of_bijective f b)))

end category_theory

-- We prove `equiv_iso_iso` and then use that to sneakily construct `equiv_equiv_iso`.

-- (In this order the proofs are handled by `obviously`.)

/-- Equivalences (between types in the same universe) are the same as (isomorphic to) isomorphisms
of types. -/
@[simp] theorem equiv_iso_iso_hom {X : Type u} {Y : Type u} (e : X ≃ Y) :
    category_theory.iso.hom equiv_iso_iso e = equiv.to_iso e :=
  Eq.refl (category_theory.iso.hom equiv_iso_iso e)

/-- Equivalences (between types in the same universe) are the same as (equivalent to) isomorphisms
of types. -/
-- We leave `X` and `Y` as explicit arguments here, because the coercions from `equiv` to a function

-- won't fire without them.

-- TODO: is it still true?

def equiv_equiv_iso (X : Type u) (Y : Type u) : X ≃ Y ≃ (X ≅ Y) :=
  category_theory.iso.to_equiv equiv_iso_iso

@[simp] theorem equiv_equiv_iso_hom {X : Type u} {Y : Type u} (e : X ≃ Y) :
    coe_fn (equiv_equiv_iso X Y) e = equiv.to_iso e :=
  rfl

@[simp] theorem equiv_equiv_iso_inv {X : Type u} {Y : Type u} (e : X ≅ Y) :
    coe_fn (equiv.symm (equiv_equiv_iso X Y)) e = category_theory.iso.to_equiv e :=
  rfl

end Mathlib


-- Copyright © 2019 François G. Dorais. All rights reserved.
-- Released under Apache 2.0 license as described in the file LICENSE.

import .basic
import .magma

set_option default_priority 0

namespace algebra

signature semigroup (α : Type*) :=
(op : α → α → α)

namespace semigroup_sig

@[signature_instance]
definition to_magma {α} (s : semigroup_sig α) : magma_sig α :=
{ op := s.op
}

end semigroup_sig

variables {α : Type*} (s : semigroup_sig α)
local infix ∙ := s.op

@[theory]
class semigroup : Prop := intro ::
(associative : identity.op_associative s.op)

namespace semigroup
variable [i : semigroup s]
include i

instance to_magma : magma s.to_magma := magma.infer _

end semigroup

@[theory]
class comm_semigroup : Prop := intro ::
(associative : identity.op_associative s.op)
(commutative : identity.op_commutative s.op)

namespace comm_semigroup
variable [i : comm_semigroup s]
include i

instance to_semigroup : semigroup s := semigroup.infer _

instance to_comm_magma : comm_magma s.to_magma := comm_magma.infer _

@[identity_instance]
theorem left_commutative : identity.op_left_commutative s.op :=
λ x y z,
show x ∙ (y ∙ z) = y ∙ (x ∙ z),
from calc x ∙ (y ∙ z)
= (x ∙ y) ∙ z : by rw op_associative s.op ...
= (y ∙ x) ∙ z : by rw op_commutative s.op x y ...
= y ∙ (x ∙ z) : by rw op_associative s.op

@[identity_instance]
theorem right_commutative : identity.op_right_commutative s.op :=
λ x y z,
show (x ∙ y) ∙ z = (x ∙ z) ∙ y,
from calc (x ∙ y) ∙ z
= x ∙ (y ∙ z) : by rw op_associative s.op ...
= x ∙ (z ∙ y) : by rw op_commutative s.op y z ...
= (x ∙ z) ∙ y : by rw op_associative s.op

end comm_semigroup

@[theory]
class cancel_semigroup : Prop := intro ::
(associative : identity.op_associative s.op)
(left_cancellative : identity.op_left_cancellative s.op)
(right_cancellative : identity.op_right_cancellative s.op)

namespace cancel_semigroup
variable [i : cancel_semigroup s]
include i

instance to_semigroup : semigroup s := semigroup.infer _

instance to_cancel_magma : cancel_magma s.to_magma := cancel_magma.infer _

end cancel_semigroup

@[theory]
class cancel_comm_semigroup : Prop := intro ::
(associative : identity.op_associative s.op)
(commutative : identity.op_commutative s.op)
(right_cancellative : identity.op_right_cancellative s.op)

namespace cancel_comm_semigroup
variable [i : cancel_comm_semigroup s]
include i

instance to_comm_semigroup : comm_semigroup s := comm_semigroup.infer _

instance to_cancel_comm_magma : cancel_comm_magma s.to_magma := cancel_comm_magma.infer _

instance to_cancel_semigroup : cancel_semigroup s := cancel_semigroup.infer _

end cancel_comm_semigroup

end algebra


import data.matrix.basic
import analysis.calculus.fderiv
import analysis.calculus.deriv
import linear_algebra.matrix.adjugate
import analysis.normed_space.finite_dimension
import topology.algebra.module.basic
open matrix
open_locale matrix
variable n: ℕ

variables {𝕜: Type} [nondiscrete_normed_field 𝕜] -- def 𝕜 := ℝ if you wish to simp things
local attribute [instance] real.nondiscrete_normed_field matrix.normed_group matrix.normed_space -- introduce an arbitrary canonical instance of normed_group and normed_space.
local notation `mat`:1000 := matrix (fin n) (fin n) 𝕜
local notation `trc`:1000 := trace (fin n) 𝕜 𝕜

-- theorem jacobi {A': 𝕜 →L[𝕜] mat} (A: 𝕜 -> mat) (t: 𝕜) (h: has_fderiv_at A A' t):
--   has_fderiv_at (det ∘ A ) (trace (fin n) 𝕜 𝕜 ((adjugate (A t)) ⬝ (A' t))) t :=

def detdiff (A: mat): ∃ det': mat →L[𝕜] 𝕜, has_fderiv_at det det' A := begin -- determinant is differentiable
  sorry
end
#check (1 : 𝕜 →L[𝕜] 𝕜).smul_right

lemma linearity (f: 𝕜 →L[𝕜] 𝕜): (1: 𝕜 →L[𝕜] 𝕜).smul_right (f 1) = f := begin
  have h: ∀x: 𝕜, (1: 𝕜 →L[𝕜] 𝕜).smul_right (f 1) x = f x := by {
    intro x,
    sorry,
  },
  simp,
end

-- #check [has_coe_to_fun continuous_linear_map]
theorem jacobi {A': 𝕜 →L[𝕜] mat} (A: 𝕜 -> mat) (t: 𝕜) (h: has_fderiv_at A A' t):
  has_deriv_at (det ∘ A) (trc (adjugate (A t) ⬝ (A' t))) t := begin
    -- L1: (det ∘ A)'(t) = (det)'(A t) ∘ A'(t)
    cases detdiff n (A t) with det' h',
    have L1: has_fderiv_at (det ∘ A) (det'.comp A') t := has_fderiv_at.comp t h' h,

    have suffice: (det'.comp A') 1 = (trace (fin n) 𝕜 𝕜 (adjugate (A t) ⬝ (A' t))) := sorry,

    rw ← suffice,
    unfold has_deriv_at,
    unfold has_fderiv_at at L1,
    unfold has_deriv_at_filter,
    have obvious: (1 : 𝕜 →L[𝕜] 𝕜).smul_right (det'.comp A' 1) = (det'.comp A') := linearity (det'.comp A'),
    rw obvious, exact L1,
end


import Basic
import Utils

variables {NT T : Type}

constant fresh : (list NT) → NT
constant isFresh (α : list NT) (A = fresh α) : A ∉ α

def StartTransform (g1 : CFG NT T) (g2 : CFG NT T) : Prop :=
  ∃ SNew : NT,
       (¬ (CFG_NonTerms g1 SNew))
      ∧((g2.start = SNew)
      ∧(g2.rules = g1.rules ∪ { (SNew, [Symbol.NonTerminal g1.start]) }))

lemma StartSoundness1 (g1 : CFG NT T) (g2 : CFG NT T) : (StartTransform g1 g2) →
  (∀ w_1 : list (Symbol NT T), ∀ w_2 : list (Symbol NT T),
  CFG_Derives_1_Step g1 w_1 w_2 → CFG_Derives_1_Step g2 w_1 w_2
  ) :=
  begin
    intro hTrans,
    intros w1 w2,
    intro h1,
    unfold CFG_Derives_1_Step at h1,
    cases h1 with r h2,
    have h3 : r ∈ g1.rules := and.elim_left h2,
    unfold StartTransform at hTrans,
    cases hTrans with _ hTrans,
    have h4 : r ∈ g2.rules :=
    begin
      have h5 : g2.rules = g1.rules ∪ {(hTrans_w, [Symbol.NonTerminal g1.start])} := and.elim_right (and.elim_right hTrans),
      rw h5,
      apply (iff.elim_right (set.mem_union r g1.rules {(hTrans_w, [Symbol.NonTerminal g1.start])})),
      apply or.intro_left,
      exact h3,
    end,
    unfold CFG_Derives_1_Step,
    use r,
    exact and.intro h4 (and.elim_right h2),
  end

lemma StartSoundness2 (g1 : CFG NT T) (g2 : CFG NT T) : (StartTransform g1 g2) →
  (∀ w_1 : list (Symbol NT T), ∀ w_2 : list (Symbol NT T),
  CFG_Derives g1 w_1 w_2 → CFG_Derives g2 w_1 w_2
  ) := by
  {
    intros hTrans w1 w2,
    intro h1,
    unfold CFG_Derives at h1,
    induction h1 with α β h2 h3,
    {
      unfold CFG_Derives,
    },
    {
      have h4 : CFG_Derives_1_Step g2 α β := StartSoundness1 g1 g2 hTrans α β h3,
      unfold CFG_Derives at h1_ih,
      unfold CFG_Derives,
      exact relation.refl_trans_gen.tail h1_ih h4,
    },
  }

lemma StartSoundness3 (g1 : CFG NT T) (g2 : CFG NT T) : (StartTransform g1 g2) →
  (∀ w : list T,
  CFG_Generates g1 w → CFG_Generates g2 w
  ) := by
  {
    intros hTrans w h1,
    unfold CFG_Generates at h1,
    have hTransOrig := hTrans,
    unfold StartTransform at hTrans,
    cases hTrans with SNew hTrans,
    have h2 : CFG_Derives g2 [Symbol.NonTerminal SNew] [Symbol.NonTerminal g1.start] := by
    {
      unfold CFG_Derives,
      apply relation.refl_trans_gen.single,
      unfold CFG_Derives_1_Step,
      use (SNew, [Symbol.NonTerminal g1.start]),
      split,
      {
        rw (and.elim_right (and.elim_right hTrans)),
        have h3 : (SNew, [Symbol.NonTerminal g1.start]) ∈ {(SNew, [Symbol.NonTerminal g1.start])} := by
        {refine set.mem_singleton (SNew, [Symbol.NonTerminal g1.start]), exact nat,},
        exact g1.rules.mem_union_right rfl,
      },
      {
        use ([]),
        use ([]),
        split,
        {
          exact rfl,
        },
        {
          exact rfl,
        },
      },
    },
    have h5 := StartSoundness2 g1 g2 hTransOrig [Symbol.NonTerminal g1.start] (liftWordToSf w NT) h1,
    unfold CFG_Derives at h2 h5,
    have h6 := relation.refl_trans_gen.trans h2 h5,
    have h7 := (and.elim_left (and.elim_right hTrans)),
    rw ← h7 at h6,
    unfold CFG_Generates, unfold CFG_Derives, exact h6,
  }

lemma StartCompleteness2 (g1 : CFG NT T) (g2 : CFG NT T) (α : list (Symbol NT T)):
  (StartTransform g1 g2) → (CFG_Derives_1_Step g2 [Symbol.NonTerminal g2.start] α) → α = [Symbol.NonTerminal g1.start] := by
  {
    intros hTrans h1,
    unfold CFG_Derives_1_Step at h1,
    cases h1 with r h2,
    have h3 := and.elim_left h2,
    have h4 := and.elim_right h2,
    cases h4 with a h5,
    cases h5 with c h6,
    have h7 := and.elim_left h6,
    have h8 := and.elim_right h6,
    have h9 : (a = []) ∧ (c = []) ∧ (Symbol.NonTerminal r.fst = Symbol.NonTerminal g2.start) := by
    {
      exact singleton_eq_append_implies_empty a c (Symbol.NonTerminal r.fst) (Symbol.NonTerminal g2.start) h7,
    },
    have h10 := and.elim_left h9, have h11 := and.elim_left (and.elim_right h9), have h12 := and.elim_right (and.elim_right h9),
    simp [h10, h11] at h8,
    simp at h12,
    have h13 : r.snd = [Symbol.NonTerminal g1.start] := by
    {
      unfold StartTransform at hTrans,
      cases hTrans with SNew,
      have h13 := and.elim_left hTrans_h, have h14 := and.elim_left (and.elim_right hTrans_h), have h15 := and.elim_right (and.elim_right hTrans_h),
      simp [h15] at h3,
      rw [← h14] at h3 h13,
      cases h3,
      {
        simp [h3],
      },
      {
        exfalso,
        have h16 : CFG_NonTerms g1 r.fst := by
        {
          unfold CFG_NonTerms,
          apply or.inr,
          use r,
          split,
          exact h3,
          unfold RuleNonTerms,
          simp,
        },
        rw [h12] at h16,
        exact h13 h16,
      },
    },
    simp [h13, h8],
  }

lemma StartCompleteness3 (g1 : CFG NT T) (g2 : CFG NT T) : (StartTransform g1 g2) →
(∀ α β: list (Symbol NT T),
(∀ A : NT, ((Symbol.NonTerminal A) ∈ α  → CFG_NonTerms g1 A)) → CFG_Derives g2 α β → (∀ A : NT, ((Symbol.NonTerminal A) ∈ β → CFG_NonTerms g1 A))
) := by
{
  intros hTrans α β h1 h2,
  unfold CFG_Derives at h2,
  induction h2 with γ δ hγ hδ,
  {
    exact h1,
  },
  {
    unfold CFG_Derives_1_Step at hδ,
    cases hδ with r,
    have h3 := and.elim_left hδ_h, have h4 := and.elim_right hδ_h,
    unfold StartTransform at hTrans,
    cases hTrans with SNew,
    have h5 := and.elim_right (and.elim_right hTrans_h),
    rw [h5] at h3,
    cases h3,
    {
      intros A h7,
      cases h4 with a h4,
      cases h4 with c h4,
      have h8 := and.elim_left h4, have h9 := and.elim_right h4,
      -- use h2_ih h3 h7 h8 h9
      simp [h9] at h7,
      cases h7,
      {
        have h10 : Symbol.NonTerminal A ∈ γ := by { rw [h8], refine list.mem_append.mpr _, apply or.inl, refine list.mem_append.mpr _, apply or.inl, exact h7, },
        exact h2_ih A h10,
      },
      {
        cases h7,
        {
          unfold CFG_NonTerms,
          apply or.inr,
          use r,
          unfold RuleNonTerms,
          split, { exact h3, }, { exact or.inr h7, },
        },
        {
          have h10 : Symbol.NonTerminal A ∈ γ := by { rw [h8], refine list.mem_append.mpr _, exact or.inr h7, },
          exact h2_ih A h10,
        },
      },
    },
    {
      simp at h3,
      cases h4 with a h4,
      cases h4 with c h4,
      have h8 := and.elim_left h4, have h9 := and.elim_right h4,
      -- use h8, h9, h3, h2_ih
      intros A h10,
      simp [h9] at h10,
      cases h10,
      {
        have h10 : Symbol.NonTerminal A ∈ γ := by { rw [h8], refine list.mem_append.mpr _, apply or.inl, refine list.mem_append.mpr _, apply or.inl, exact h10, },
        exact h2_ih A h10,
      },
      {
        cases h10,
        {
          simp [h3] at h10,
          simp [h10], unfold CFG_NonTerms, apply or.inl, refl,
        },
        {
          have h11 : Symbol.NonTerminal A ∈ γ := by { rw [h8], refine list.mem_append.mpr _, exact or.inr h10, },
          exact h2_ih A h11,
        },
      },
    },
  },
}

lemma StartCompleteness4 (g1 : CFG NT T) (g2 : CFG NT T) : (StartTransform g1 g2) →
(∀ α : list (Symbol NT T),
(∀ A : NT, ((Symbol.NonTerminal A) ∈ α  → CFG_NonTerms g1 A)) → (∀ β : list (Symbol NT T),
  CFG_Derives g2 α β → CFG_Derives g1 α β
)) := by
{
  intros hTrans α hNT β h1,
  unfold CFG_Derives at h1,
  induction h1 with γ δ h1_γ h1_δ,
  {
    unfold CFG_Derives,
  },
  {
    have h2 : (∀ A : NT, ((Symbol.NonTerminal A) ∈ γ → CFG_NonTerms g1 A)) := StartCompleteness3 g1 g2 hTrans α γ hNT h1_γ,
    have h3 : CFG_Derives_1_Step g1 γ δ := by
    {
      unfold CFG_Derives_1_Step at h1_δ,
      cases h1_δ with r,
      have h4 := and.elim_left h1_δ_h, have h5 := and.elim_right h1_δ_h,
      unfold StartTransform at hTrans,
      cases hTrans with SNew,
      have h6 := and.elim_right (and.elim_right hTrans_h),
      rw [h6] at h4,
      cases h4,
      {
        unfold CFG_Derives_1_Step,
        use r,
        exact and.intro h4 h5,
      },
      {
        exfalso,
        cases h5 with a h5,
        cases h5 with c h5,
        have h7 := and.elim_left h5,
        have h8 : r= (SNew, [Symbol.NonTerminal g1.start]) := by {
          exact set.mem_singleton_iff.mp h4,
        },
        simp [h8] at h7,
        have h9 := h2 SNew,
        simp [h7] at h9,
        have h10 := and.elim_left hTrans_h,
        exact h10 h9,
      },
    },
    exact relation.refl_trans_gen.tail h1_ih h3,
  },
}

theorem StartCompleteness (g1 : CFG NT T) (g2 : CFG NT T) : (StartTransform g1 g2) → ∀ w : list T, (CFG_Generates g2 w) → (CFG_Generates g1 w) := by
{
  intros hTrans w h1,
  unfold CFG_Generates at *,
  unfold CFG_Derives at h1,
  have h2 := relation.refl_trans_gen.cases_head h1,
  cases h2,
  {
    unfold liftWordToSf at h2,
    exfalso,
    apply_fun (λ l : list (Symbol NT T), ( Symbol.NonTerminal g2.start ) ∈ l) at h2,
    simp at h2,
    cases h2,
    have h3 := and.elim_right h2_h,
    unfold liftTermToSymbol at h3,
    simp at h3,
    exact h3,
  },
  {
    cases h2,
    have h3 := StartCompleteness2 g1 g2 h2_w hTrans (and.elim_left h2_h),
    have h4 : (∀ A : NT, ((Symbol.NonTerminal A) ∈ h2_w  → CFG_NonTerms g1 A)) := by
    {
      intro A,
      simp [h3],
      intro h4,
      unfold CFG_NonTerms,
      apply or.inl, exact h4,
    },
    have h5 := StartCompleteness4 g1 g2 hTrans h2_w h4 (liftWordToSf w NT) (and.elim_right h2_h),
    simp [h3] at h5,
    exact h5,
  },
}

-- noncomputable def StartTransform (g : CFG NT T) : CFG (NT ⊕ T ⊕
-- ( Σ r : NT × list (Symbol NT T), fin (r.snd.length) )
--  ) T :=
--   let
--     N := CFG_NonTerms g,
--     SNew := fresh N
--   in
--     (CFG.mk
--       ([ (SNew, [ Symbol.NonTerminal g.start ]) ] ++ g.rules)
--       SNew
--     )

-- def newNT (NT : Type) (T : Type) : Type :=
--   option ( (NT ⊕ T) ⊕
-- ( Σ r : NT × list (Symbol NT T), fin (r.snd.length) )
--  )

-- def WrapNonTerminal (A : NT) : newNT NT T := option.some (sum.inl(sum.inl(A)))

-- def WrapSymbol (X : Symbol NT T) : Symbol (newNT NT T) T :=
--   match X with
--     Symbol.Terminal a := Symbol.Terminal a
--     | Symbol.NonTerminal A := Symbol.NonTerminal (WrapNonTerminal A)
--   end

-- def WrapGrammar (g : CFG NT T) : CFG (newNT NT T) T :=
--     (CFG.mk
--       (
--         [(none, [Symbol.NonTerminal (WrapNonTerminal g.start)])]
--         ++
--         (list.map
--         (λ r : NT × list (Symbol NT T),
--           (WrapNonTerminal r.fst, list.map WrapSymbol r.snd)
--         )
--       g.rules)
--       )
--       (none)
--     )


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

! This file was ported from Lean 3 source module computability.halting
! leanprover-community/mathlib commit a50170a88a47570ed186b809ca754110590f9476
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Computability.PartrecCode

/-!
# 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) :=
  by
  obtain ⟨cf, rfl⟩ := code.exists_code.1 hf
  obtain ⟨cg, rfl⟩ := code.exists_code.1 hg
  have : Nat.Partrec fun n => Nat.rfindOpt fun k => cf.evaln k n <|> cg.evaln k n :=
    Partrec.nat_iff.1
      (Partrec.rfindOpt <|
        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, fun n => _⟩
  suffices; refine' ⟨this, ⟨fun h => (this _ ⟨h, rfl⟩).imp Exists.fst Exists.fst, _⟩⟩
  · intro h
    rw [Nat.rfindOpt_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]⟩
  intro x h
  obtain ⟨k, e⟩ := Nat.rfindOpt_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')
#align nat.partrec.merge' Nat.Partrec.merge'

end Nat.Partrec

namespace Partrec

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

variable [Primcodable α] [Primcodable β] [Primcodable γ] [Primcodable σ]

open Computable Part

open Nat.Partrec (code)

open 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) :=
  by
  let ⟨k, hk, H⟩ := Nat.Partrec.merge' (bind_decode₂_iff.1 hf) (bind_decode₂_iff.1 hg)
  let k' a := (k (encode a)).bind fun n => decode σ n
  refine'
    ⟨k', ((nat_iff.2 hk).comp Computable.encode).bind (computable.decode.of_option.comp snd).to₂,
      fun a => _⟩
  suffices; refine' ⟨this, ⟨fun 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)
    exists 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]
  intro 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
#align partrec.merge' Partrec.merge'

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
  ⟨k, hk, fun a x =>
    ⟨(K _).1 _, fun h =>
      by
      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⟩⟩
#align partrec.merge Partrec.merge

theorem cond {c : α → Bool} {f : α →. σ} {g : α →. σ} (hc : Computable c) (hf : Partrec f)
    (hg : Partrec g) : Partrec fun a => cond (c a) (f a) (g a) :=
  let ⟨cf, ef⟩ := exists_code.1 hf
  let ⟨cg, eg⟩ := exists_code.1 hg
  ((eval_part.comp (Computable.cond hc (const cf) (const cg)) Computable.id).bind
        ((@Computable.decode σ _).comp snd).ofOption.to₂).of_eq
    fun a => by cases c a <;> simp [ef, eg, encodek]
#align partrec.cond Partrec.cond

theorem sum_cases {f : α → Sum β γ} {g : α → β →. σ} {h : α → γ →. σ} (hf : Computable f)
    (hg : Partrec₂ g) (hh : Partrec₂ h) : @Partrec _ σ _ _ fun a => Sum.casesOn (f a) (g a) (h a) :=
  option_some_iff.1 <|
    (cond (sum_cases hf (const true).to₂ (const false).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
      fun a => by cases f a <;> simp only [Bool.cond_true, Bool.cond_false]
#align partrec.sum_cases Partrec.sum_cases

end Partrec

/-- A computable predicate is one whose indicator function is computable. -/
def ComputablePred {α} [Primcodable α] (p : α → Prop) :=
  ∃ D : DecidablePred p, Computable fun a => to_bool (p a)
#align computable_pred ComputablePred

/-- A recursively enumerable predicate is one which is the domain of a computable partial function.
 -/
def RePred {α} [Primcodable α] (p : α → Prop) :=
  Partrec fun a => Part.assert (p a) fun _ => Part.some ()
#align re_pred RePred

theorem RePred.of_eq {α} [Primcodable α] {p q : α → Prop} (hp : RePred p) (H : ∀ a, p a ↔ q a) :
    RePred q :=
  (funext fun a => propext (H a) : p = q) ▸ hp
#align re_pred.of_eq RePred.of_eq

theorem Partrec.dom_re {α β} [Primcodable α] [Primcodable β] {f : α →. β} (h : Partrec f) :
    RePred fun a => (f a).Dom :=
  (h.map (Computable.const ()).to₂).of_eq fun n => Part.ext fun _ => by simp [Part.dom_iff_mem]
#align partrec.dom_re Partrec.dom_re

theorem ComputablePred.of_eq {α} [Primcodable α] {p q : α → Prop} (hp : ComputablePred p)
    (H : ∀ a, p a ↔ q a) : ComputablePred q :=
  (funext fun a => propext (H a) : p = q) ▸ hp
#align computable_pred.of_eq ComputablePred.of_eq

namespace ComputablePred

variable {α : Type _} {σ : Type _}

variable [Primcodable α] [Primcodable σ]

open Nat.Partrec (code)

open Nat.Partrec.Code Computable

theorem computable_iff {p : α → Prop} :
    ComputablePred p ↔ ∃ f : α → Bool, Computable f ∧ p = fun a => f a :=
  ⟨fun ⟨D, h⟩ => ⟨_, h, funext fun a => propext (Bool.decide_iff _).symm⟩, by
    rintro ⟨f, h, rfl⟩ <;> exact ⟨by infer_instance, by simpa using h⟩⟩
#align computable_pred.computable_iff ComputablePred.computable_iff

protected theorem not {p : α → Prop} (hp : ComputablePred p) : ComputablePred fun a => ¬p a := by
  obtain ⟨f, hf, rfl⟩ := computable_iff.1 hp <;>
    exact
      ⟨by infer_instance,
        (cond hf (const ff) (const tt)).of_eq fun n =>
          by
          dsimp
          cases f n <;> rfl⟩
#align computable_pred.not ComputablePred.not

theorem to_re {p : α → Prop} (hp : ComputablePred p) : RePred p :=
  by
  obtain ⟨f, hf, rfl⟩ := computable_iff.1 hp
  unfold RePred
  refine'
    (Partrec.cond hf (Decidable.Partrec.const' (Part.some ())) Partrec.none).of_eq fun n =>
      Part.ext fun a => _
  cases a; cases f n <;> simp
#align computable_pred.to_re ComputablePred.to_re

theorem rice (C : Set (ℕ →. ℕ)) (h : ComputablePred fun c => eval c ∈ C) {f g} (hf : Nat.Partrec f)
    (hg : Nat.Partrec g) (fC : f ∈ C) : g ∈ C :=
  by
  cases' h with _ h; skip
  obtain ⟨c, e⟩ :=
    fixed_point₂
      (Partrec.cond (h.comp fst) ((Partrec.nat_iff.2 hg).comp snd).to₂
          ((Partrec.nat_iff.2 hf).comp snd).to₂).to₂
  simp at e
  by_cases H : eval c ∈ C
  · simp only [H, if_true] at e
    rwa [← e]
  · simp only [H, if_false] at e
    rw [e] at H
    contradiction
#align computable_pred.rice ComputablePred.rice

theorem rice₂ (C : Set Code) (H : ∀ cf cg, eval cf = eval cg → (cf ∈ C ↔ cg ∈ C)) :
    (ComputablePred fun c => c ∈ C) ↔ C = ∅ ∨ C = Set.univ := by
  classical exact
      have hC : ∀ f, f ∈ C ↔ eval f ∈ eval '' C := fun f =>
        ⟨Set.mem_image_of_mem _, fun ⟨g, hg, e⟩ => (H _ _ e).1 hg⟩
      ⟨fun h =>
        or_iff_not_imp_left.2 fun C0 =>
          Set.eq_univ_of_forall fun cg =>
            let ⟨cf, fC⟩ := Set.nonempty_iff_ne_empty.2 C0
            (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),
        fun h => by
        obtain rfl | rfl := h <;> simp [ComputablePred, Set.mem_empty_iff_false] <;>
          exact ⟨by infer_instance, Computable.const _⟩⟩
#align computable_pred.rice₂ ComputablePred.rice₂

theorem halting_problem_re (n) : RePred fun c => (eval c n).Dom :=
  (eval_part.comp Computable.id (Computable.const _)).dom_re
#align computable_pred.halting_problem_re ComputablePred.halting_problem_re

theorem halting_problem (n) : ¬ComputablePred fun c => (eval c n).Dom
  | h => rice { f | (f n).Dom } h Nat.Partrec.zero Nat.Partrec.none trivial
#align computable_pred.halting_problem ComputablePred.halting_problem

-- 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} [DecidablePred p] :
    ComputablePred p ↔ RePred p ∧ RePred fun a => ¬p a :=
  ⟨fun h => ⟨h.to_re, h.Not.to_re⟩, fun ⟨h₁, h₂⟩ =>
    ⟨‹_›,
      by
      obtain ⟨k, pk, hk⟩ :=
        Partrec.merge (h₁.map (Computable.const tt).to₂) (h₂.map (Computable.const ff).to₂) _
      · refine' Partrec.of_eq pk fun n => Part.eq_some_iff.2 _
        rw [hk]
        simp
        apply Decidable.em
      · intro a x hx y hy
        simp at hx hy
        cases hy.1 hx.1⟩⟩
#align computable_pred.computable_iff_re_compl_re ComputablePred.computable_iff_re_compl_re

theorem computable_iff_re_compl_re' {p : α → Prop} :
    ComputablePred p ↔ RePred p ∧ RePred fun a => ¬p a := by
  classical exact computable_iff_re_compl_re
#align computable_pred.computable_iff_re_compl_re' ComputablePred.computable_iff_re_compl_re'

theorem halting_problem_not_re (n) : ¬RePred fun c => ¬(eval c n).Dom
  | h => halting_problem _ <| computable_iff_re_compl_re'.2 ⟨halting_problem_re _, h⟩
#align computable_pred.halting_problem_not_re ComputablePred.halting_problem_not_re

end ComputablePred

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' fun v => (mOfFn fun i => g i v) >>= f
  |
  rfind {n} {f : Vector ℕ (n + 1) → ℕ} :
    @partrec' (n + 1) f → partrec' fun v => rfind fun n => some (f (n ::ᵥ v) = 0)
#align nat.partrec' Nat.Partrec'

end Nat

namespace Nat.Partrec'

open Vector Partrec Computable

open Nat (Partrec')

open Nat.Partrec'

theorem to_part {n f} (pf : @Partrec' n f) : Partrec f :=
  by
  induction pf
  case prim n f hf => exact hf.to_prim.to_comp
  case comp m n f g _ _ hf hg => exact (vector_m_of_fn fun i => hg i).bind (hf.comp snd)
  case
    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
#align nat.partrec'.to_part Nat.Partrec'.to_part

theorem of_eq {n} {f g : Vector ℕ n →. ℕ} (hf : Partrec' f) (H : ∀ i, f i = g i) : Partrec' g :=
  (funext H : f = g) ▸ hf
#align nat.partrec'.of_eq Nat.Partrec'.of_eq

theorem of_prim {n} {f : Vector ℕ n → ℕ} (hf : Primrec f) : @Partrec' n f :=
  prim (Nat.Primrec'.of_prim hf)
#align nat.partrec'.of_prim Nat.Partrec'.of_prim

theorem head {n : ℕ} : @Partrec' n.succ (@head ℕ n) :=
  prim Nat.Primrec'.head
#align nat.partrec'.head Nat.Partrec'.head

theorem tail {n f} (hf : @Partrec' n f) : @Partrec' n.succ fun v => f v.tail :=
  (hf.comp _ fun i => @prim _ _ <| Nat.Primrec'.get i.succ).of_eq fun v => by
    simp <;> rw [← of_fn_nth v.tail] <;> congr <;> funext i <;> simp
#align nat.partrec'.tail Nat.Partrec'.tail

protected theorem bind {n f g} (hf : @Partrec' n f) (hg : @Partrec' (n + 1) g) :
    @Partrec' n fun v => (f v).bind fun a => g (a ::ᵥ v) :=
  (@comp n (n + 1) g (fun i => Fin.cases f (fun i v => some (v.get? i)) i) hg fun i =>
        by
        refine' Fin.cases _ (fun i => _) i <;> simp [*]
        exact prim (Nat.Primrec'.get _)).of_eq
    fun v => by simp [m_of_fn, Part.bind_assoc, pure]
#align nat.partrec'.bind Nat.Partrec'.bind

protected theorem map {n f} {g : Vector ℕ (n + 1) → ℕ} (hf : @Partrec' n f)
    (hg : @Partrec' (n + 1) g) : @Partrec' n fun v => (f v).map fun a => g (a ::ᵥ v) := by
  simp [(Part.bind_some_eq_map _ _).symm] <;> exact hf.bind hg
#align nat.partrec'.map Nat.Partrec'.map

attribute [-instance] Part.hasZero

/-- 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' fun v => (f v).get? i
#align nat.partrec'.vec Nat.Partrec'.Vec

theorem Vec.prim {n m f} (hf : @Nat.Primrec'.Vec n m f) : Vec f := fun i => prim <| hf i
#align nat.partrec'.vec.prim Nat.Partrec'.Vec.prim

protected theorem nil {n} : @Vec n 0 fun _ => nil := fun i => i.elim0ₓ
#align nat.partrec'.nil Nat.Partrec'.nil

protected theorem cons {n m} {f : Vector ℕ n → ℕ} {g} (hf : @Partrec' n f) (hg : @Vec n m g) :
    Vec fun v => f v ::ᵥ g v := fun i =>
  Fin.cases (by simp [*]) (fun i => by simp only [hg i, nth_cons_succ]) i
#align nat.partrec'.cons Nat.Partrec'.cons

theorem idv {n} : @Vec n n id :=
  Vec.prim Nat.Primrec'.idv
#align nat.partrec'.idv Nat.Partrec'.idv

theorem comp' {n m f g} (hf : @Partrec' m f) (hg : @Vec n m g) : Partrec' fun v => f (g v) :=
  (hf.comp _ hg).of_eq fun v => by simp
#align nat.partrec'.comp' Nat.Partrec'.comp'

theorem comp₁ {n} (f : ℕ →. ℕ) {g : Vector ℕ n → ℕ} (hf : @Partrec' 1 fun v => f v.headI)
    (hg : @Partrec' n g) : @Partrec' n fun v => f (g v) := by
  simpa using hf.comp' (partrec'.cons hg partrec'.nil)
#align nat.partrec'.comp₁ Nat.Partrec'.comp₁

theorem rfindOpt {n} {f : Vector ℕ (n + 1) → ℕ} (hf : @Partrec' (n + 1) f) :
    @Partrec' n fun v => Nat.rfindOpt fun a => ofNat (Option ℕ) (f (a ::ᵥ v)) :=
  ((rfind <|
            (of_prim (Primrec.nat_sub.comp (Primrec.const 1) Primrec.vector_head)).comp₁
              (fun n => Part.some (1 - n)) hf).bind
        ((prim Nat.Primrec'.pred).comp₁ Nat.pred hf)).of_eq
    fun v =>
    Part.ext fun b =>
      by
      simp only [Nat.rfindOpt, 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 fun a => (and_congr (iff_of_eq _) Iff.rfl).trans (and_congr_right fun h => _)
      · congr
        funext n
        simp only [Part.some_inj, PFun.coe_val]
        cases f (n ::ᵥ v) <;> simp [Nat.succ_le_succ] <;> rfl
      · 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]
        rfl
#align nat.partrec'.rfind_opt Nat.Partrec'.rfindOpt

open Nat.Partrec.Code

theorem of_part : ∀ {n f}, Partrec f → @Partrec' n f :=
  suffices ∀ f, Nat.Partrec f → @Partrec' 1 fun v => f v.headI from fun n f hf =>
    by
    let g; swap
    exact
      (comp₁ g (this g hf) (prim Nat.Primrec'.encode)).of_eq fun i => by
        dsimp only [g] <;> simp [encodek, Part.map_id']
  fun f hf => by
  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
#align nat.partrec'.of_part Nat.Partrec'.of_part

theorem part_iff {n f} : @Partrec' n f ↔ Partrec f :=
  ⟨to_part, of_part⟩
#align nat.partrec'.part_iff Nat.Partrec'.part_iff

theorem part_iff₁ {f : ℕ →. ℕ} : (@Partrec' 1 fun v => f v.headI) ↔ Partrec f :=
  part_iff.trans
    ⟨fun h =>
      (h.comp <| (Primrec.vector_ofFn fun i => Primrec.id).to_comp).of_eq fun v => by
        simp only [id.def, head_of_fn],
      fun h => h.comp vector_head⟩
#align nat.partrec'.part_iff₁ Nat.Partrec'.part_iff₁

theorem part_iff₂ {f : ℕ → ℕ →. ℕ} : (@Partrec' 2 fun v => f v.headI v.tail.headI) ↔ Partrec₂ f :=
  part_iff.trans
    ⟨fun h =>
      (h.comp <| vector_cons.comp fst <| vector_cons.comp snd (const nil)).of_eq fun v => by
        simp only [cons_head, cons_tail],
      fun h => h.comp vector_head (vector_head.comp vector_tail)⟩
#align nat.partrec'.part_iff₂ Nat.Partrec'.part_iff₂

theorem vec_iff {m n f} : @Vec m n f ↔ Computable f :=
  ⟨fun h => by simpa only [of_fn_nth] using vector_of_fn fun i => to_part (h i), fun h i =>
    of_part <| vector_get.comp h (const i)⟩
#align nat.partrec'.vec_iff Nat.Partrec'.vec_iff

end Nat.Partrec'


import algebra.module.basic
import algebra.module.linear_map
import linear_algebra.basic
import linear_algebra.prod
import linear_algebra.projection
import order.bounded_lattice

theorem cpge_reduction_7_b (R : Type*) (M : Type*)
[semiring R] [add_comm_group M] [module R M]
 (u : linear_map R M M):

u^3 + u = 0 -> ∀ x ∈ ((⊤ : submodule R M).map u), u x = (- x) := sorry