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

! This file was ported from Lean 3 source module category_theory.functor.basic
! leanprover-community/mathlib commit 448144f7ae193a8990cb7473c9e9a01990f64ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.ReassocAxiom
import Mathbin.CategoryTheory.Category.Basic

/-!
# Functors

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

Defines a functor between categories, extending a `prefunctor` between quivers.

Introduces notation `C ⥤ D` for the type of all functors from `C` to `D`.
(Unfortunately the `⇒` arrow (`\functor`) is taken by core,
but in mathlib4 we should switch to this.)
-/

namespace CategoryTheory

-- declare the `v`'s first; see `category_theory.category` for an explanation
universe v v₁ v₂ v₃ u u₁ u₂ u₃

section

#print CategoryTheory.Functor /-
/-- `functor C D` represents a functor between categories `C` and `D`.

To apply a functor `F` to an object use `F.obj X`, and to a morphism use `F.map f`.

The axiom `map_id` expresses preservation of identities, and
`map_comp` expresses functoriality.

See <https://stacks.math.columbia.edu/tag/001B>.
-/
structure Functor (C : Type u₁) [Category.{v₁} C] (D : Type u₂) [Category.{v₂} D] extends
  Prefunctor C D : Type max v₁ v₂ u₁ u₂ where
  map_id' : ∀ X : C, map (𝟙 X) = 𝟙 (obj X) := by obviously
  map_comp' : ∀ {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z), map (f ≫ g) = map f ≫ map g := by obviously
#align category_theory.functor CategoryTheory.Functor
-/

/-- The prefunctor between the underlying quivers. -/
add_decl_doc functor.to_prefunctor

end

-- mathport name: «expr ⥤ »
infixr:26
  " ⥤ " =>-- A functor is basically a function, so give ⥤ a similar precedence to → (25).
  -- For example, `C × D ⥤ E` should parse as `(C × D) ⥤ E` not `C × (D ⥤ E)`.
  Functor

-- type as \func --
restate_axiom functor.map_id'

attribute [simp] Functor.map_id

restate_axiom functor.map_comp'

attribute [reassoc.1, simp] functor.map_comp

namespace Functor

section

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

#print CategoryTheory.Functor.id /-
-- We don't use `@[simps]` here because we want `C` implicit for the simp lemmas.
/-- `𝟭 C` is the identity functor on a category `C`. -/
protected def id : C ⥤ C where
  obj X := X
  map _ _ f := f
#align category_theory.functor.id CategoryTheory.Functor.id
-/

-- mathport name: «expr𝟭»
notation "𝟭" => Functor.id

-- Type this as `\sb1`
instance : Inhabited (C ⥤ C) :=
  ⟨Functor.id C⟩

variable {C}

/- warning: category_theory.functor.id_obj -> CategoryTheory.Functor.id_obj is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C] (X : C), Eq.{succ u2} C (CategoryTheory.Functor.obj.{u1, u1, u2, u2} C _inst_1 C _inst_1 (CategoryTheory.Functor.id.{u1, u2} C _inst_1) X) X
but is expected to have type
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C] (X : C), Eq.{succ u2} C (Prefunctor.obj.{succ u1, succ u1, u2, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{u1, u1, u2, u2} C _inst_1 C _inst_1 (CategoryTheory.Functor.id.{u1, u2} C _inst_1)) X) X
Case conversion may be inaccurate. Consider using '#align category_theory.functor.id_obj CategoryTheory.Functor.id_objₓ'. -/
@[simp]
theorem id_obj (X : C) : (𝟭 C).obj X = X :=
  rfl
#align category_theory.functor.id_obj CategoryTheory.Functor.id_obj

/- warning: category_theory.functor.id_map -> CategoryTheory.Functor.id_map is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C] {X : C} {Y : C} (f : Quiver.Hom.{succ u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) X Y), Eq.{succ u1} (Quiver.Hom.{succ u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.obj.{u1, u1, u2, u2} C _inst_1 C _inst_1 (CategoryTheory.Functor.id.{u1, u2} C _inst_1) X) (CategoryTheory.Functor.obj.{u1, u1, u2, u2} C _inst_1 C _inst_1 (CategoryTheory.Functor.id.{u1, u2} C _inst_1) Y)) (CategoryTheory.Functor.map.{u1, u1, u2, u2} C _inst_1 C _inst_1 (CategoryTheory.Functor.id.{u1, u2} C _inst_1) X Y f) f
but is expected to have type
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C] {X : C} {Y : C} (f : Quiver.Hom.{succ u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) X Y), Eq.{succ u1} (Quiver.Hom.{succ u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (Prefunctor.obj.{succ u1, succ u1, u2, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{u1, u1, u2, u2} C _inst_1 C _inst_1 (CategoryTheory.Functor.id.{u1, u2} C _inst_1)) X) (Prefunctor.obj.{succ u1, succ u1, u2, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{u1, u1, u2, u2} C _inst_1 C _inst_1 (CategoryTheory.Functor.id.{u1, u2} C _inst_1)) Y)) (Prefunctor.map.{succ u1, succ u1, u2, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{u1, u1, u2, u2} C _inst_1 C _inst_1 (CategoryTheory.Functor.id.{u1, u2} C _inst_1)) X Y f) f
Case conversion may be inaccurate. Consider using '#align category_theory.functor.id_map CategoryTheory.Functor.id_mapₓ'. -/
@[simp]
theorem id_map {X Y : C} (f : X ⟶ Y) : (𝟭 C).map f = f :=
  rfl
#align category_theory.functor.id_map CategoryTheory.Functor.id_map

end

section

variable {C : Type u₁} [Category.{v₁} C] {D : Type u₂} [Category.{v₂} D] {E : Type u₃}
  [Category.{v₃} E]

#print CategoryTheory.Functor.comp /-
/-- `F ⋙ G` is the composition of a functor `F` and a functor `G` (`F` first, then `G`).
-/
@[simps obj]
def comp (F : C ⥤ D) (G : D ⥤ E) : C ⥤ E
    where
  obj X := G.obj (F.obj X)
  map _ _ f := G.map (F.map f)
#align category_theory.functor.comp CategoryTheory.Functor.comp
-/

-- mathport name: «expr ⋙ »
infixr:80 " ⋙ " => comp

/- warning: category_theory.functor.comp_map -> CategoryTheory.Functor.comp_map is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u4}} [_inst_1 : CategoryTheory.Category.{u1, u4} C] {D : Type.{u5}} [_inst_2 : CategoryTheory.Category.{u2, u5} D] {E : Type.{u6}} [_inst_3 : CategoryTheory.Category.{u3, u6} E] (F : CategoryTheory.Functor.{u1, u2, u4, u5} C _inst_1 D _inst_2) (G : CategoryTheory.Functor.{u2, u3, u5, u6} D _inst_2 E _inst_3) {X : C} {Y : C} (f : Quiver.Hom.{succ u1, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u4} C (CategoryTheory.Category.toCategoryStruct.{u1, u4} C _inst_1)) X Y), Eq.{succ u3} (Quiver.Hom.{succ u3, u6} E (CategoryTheory.CategoryStruct.toQuiver.{u3, u6} E (CategoryTheory.Category.toCategoryStruct.{u3, u6} E _inst_3)) (CategoryTheory.Functor.obj.{u1, u3, u4, u6} C _inst_1 E _inst_3 (CategoryTheory.Functor.comp.{u1, u2, u3, u4, u5, u6} C _inst_1 D _inst_2 E _inst_3 F G) X) (CategoryTheory.Functor.obj.{u1, u3, u4, u6} C _inst_1 E _inst_3 (CategoryTheory.Functor.comp.{u1, u2, u3, u4, u5, u6} C _inst_1 D _inst_2 E _inst_3 F G) Y)) (CategoryTheory.Functor.map.{u1, u3, u4, u6} C _inst_1 E _inst_3 (CategoryTheory.Functor.comp.{u1, u2, u3, u4, u5, u6} C _inst_1 D _inst_2 E _inst_3 F G) X Y f) (CategoryTheory.Functor.map.{u2, u3, u5, u6} D _inst_2 E _inst_3 G (CategoryTheory.Functor.obj.{u1, u2, u4, u5} C _inst_1 D _inst_2 F X) (CategoryTheory.Functor.obj.{u1, u2, u4, u5} C _inst_1 D _inst_2 F Y) (CategoryTheory.Functor.map.{u1, u2, u4, u5} C _inst_1 D _inst_2 F X Y f))
but is expected to have type
  forall {C : Type.{u4}} [_inst_1 : CategoryTheory.Category.{u1, u4} C] {D : Type.{u5}} [_inst_2 : CategoryTheory.Category.{u2, u5} D] {E : Type.{u6}} [_inst_3 : CategoryTheory.Category.{u3, u6} E] (F : CategoryTheory.Functor.{u1, u2, u4, u5} C _inst_1 D _inst_2) (G : CategoryTheory.Functor.{u2, u3, u5, u6} D _inst_2 E _inst_3) {X : C} {Y : C} (f : Quiver.Hom.{succ u1, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u4} C (CategoryTheory.Category.toCategoryStruct.{u1, u4} C _inst_1)) X Y), Eq.{succ u3} (Quiver.Hom.{succ u3, u6} E (CategoryTheory.CategoryStruct.toQuiver.{u3, u6} E (CategoryTheory.Category.toCategoryStruct.{u3, u6} E _inst_3)) (Prefunctor.obj.{succ u1, succ u3, u4, u6} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u4} C (CategoryTheory.Category.toCategoryStruct.{u1, u4} C _inst_1)) E (CategoryTheory.CategoryStruct.toQuiver.{u3, u6} E (CategoryTheory.Category.toCategoryStruct.{u3, u6} E _inst_3)) (CategoryTheory.Functor.toPrefunctor.{u1, u3, u4, u6} C _inst_1 E _inst_3 (CategoryTheory.Functor.comp.{u1, u2, u3, u4, u5, u6} C _inst_1 D _inst_2 E _inst_3 F G)) X) (Prefunctor.obj.{succ u1, succ u3, u4, u6} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u4} C (CategoryTheory.Category.toCategoryStruct.{u1, u4} C _inst_1)) E (CategoryTheory.CategoryStruct.toQuiver.{u3, u6} E (CategoryTheory.Category.toCategoryStruct.{u3, u6} E _inst_3)) (CategoryTheory.Functor.toPrefunctor.{u1, u3, u4, u6} C _inst_1 E _inst_3 (CategoryTheory.Functor.comp.{u1, u2, u3, u4, u5, u6} C _inst_1 D _inst_2 E _inst_3 F G)) Y)) (Prefunctor.map.{succ u1, succ u3, u4, u6} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u4} C (CategoryTheory.Category.toCategoryStruct.{u1, u4} C _inst_1)) E (CategoryTheory.CategoryStruct.toQuiver.{u3, u6} E (CategoryTheory.Category.toCategoryStruct.{u3, u6} E _inst_3)) (CategoryTheory.Functor.toPrefunctor.{u1, u3, u4, u6} C _inst_1 E _inst_3 (CategoryTheory.Functor.comp.{u1, u2, u3, u4, u5, u6} C _inst_1 D _inst_2 E _inst_3 F G)) X Y f) (Prefunctor.map.{succ u2, succ u3, u5, u6} D (CategoryTheory.CategoryStruct.toQuiver.{u2, u5} D (CategoryTheory.Category.toCategoryStruct.{u2, u5} D _inst_2)) E (CategoryTheory.CategoryStruct.toQuiver.{u3, u6} E (CategoryTheory.Category.toCategoryStruct.{u3, u6} E _inst_3)) (CategoryTheory.Functor.toPrefunctor.{u2, u3, u5, u6} D _inst_2 E _inst_3 G) (Prefunctor.obj.{succ u1, succ u2, u4, u5} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u4} C (CategoryTheory.Category.toCategoryStruct.{u1, u4} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u5} D (CategoryTheory.Category.toCategoryStruct.{u2, u5} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u4, u5} C _inst_1 D _inst_2 F) X) (Prefunctor.obj.{succ u1, succ u2, u4, u5} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u4} C (CategoryTheory.Category.toCategoryStruct.{u1, u4} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u5} D (CategoryTheory.Category.toCategoryStruct.{u2, u5} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u4, u5} C _inst_1 D _inst_2 F) Y) (Prefunctor.map.{succ u1, succ u2, u4, u5} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u4} C (CategoryTheory.Category.toCategoryStruct.{u1, u4} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u5} D (CategoryTheory.Category.toCategoryStruct.{u2, u5} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u4, u5} C _inst_1 D _inst_2 F) X Y f))
Case conversion may be inaccurate. Consider using '#align category_theory.functor.comp_map CategoryTheory.Functor.comp_mapₓ'. -/
@[simp]
theorem comp_map (F : C ⥤ D) (G : D ⥤ E) {X Y : C} (f : X ⟶ Y) : (F ⋙ G).map f = G.map (F.map f) :=
  rfl
#align category_theory.functor.comp_map CategoryTheory.Functor.comp_map

#print CategoryTheory.Functor.comp_id /-
-- These are not simp lemmas because rewriting along equalities between functors
-- is not necessarily a good idea.
-- Natural isomorphisms are also provided in `whiskering.lean`.
protected theorem comp_id (F : C ⥤ D) : F ⋙ 𝟭 D = F := by cases F <;> rfl
#align category_theory.functor.comp_id CategoryTheory.Functor.comp_id
-/

#print CategoryTheory.Functor.id_comp /-
protected theorem id_comp (F : C ⥤ D) : 𝟭 C ⋙ F = F := by cases F <;> rfl
#align category_theory.functor.id_comp CategoryTheory.Functor.id_comp
-/

/- warning: category_theory.functor.map_dite -> CategoryTheory.Functor.map_dite is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] {D : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u2, u4} D] (F : CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) {X : C} {Y : C} {P : Prop} [_inst_4 : Decidable P] (f : P -> (Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) X Y)) (g : (Not P) -> (Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) X Y)), Eq.{succ u2} (Quiver.Hom.{succ u2, u4} D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.obj.{u1, u2, u3, u4} C _inst_1 D _inst_2 F X) (CategoryTheory.Functor.obj.{u1, u2, u3, u4} C _inst_1 D _inst_2 F Y)) (CategoryTheory.Functor.map.{u1, u2, u3, u4} C _inst_1 D _inst_2 F X Y (dite.{succ u1} (Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) X Y) P _inst_4 (fun (h : P) => f h) (fun (h : Not P) => g h))) (dite.{succ u2} (Quiver.Hom.{succ u2, u4} D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.obj.{u1, u2, u3, u4} C _inst_1 D _inst_2 F X) (CategoryTheory.Functor.obj.{u1, u2, u3, u4} C _inst_1 D _inst_2 F Y)) P _inst_4 (fun (h : P) => CategoryTheory.Functor.map.{u1, u2, u3, u4} C _inst_1 D _inst_2 F X Y (f h)) (fun (h : Not P) => CategoryTheory.Functor.map.{u1, u2, u3, u4} C _inst_1 D _inst_2 F X Y (g h)))
but is expected to have type
  forall {C : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] {D : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u2, u4} D] (F : CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) {X : C} {Y : C} {P : Prop} [_inst_4 : Decidable P] (f : P -> (Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) X Y)) (g : (Not P) -> (Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) X Y)), Eq.{succ u2} (Quiver.Hom.{succ u2, u4} D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (Prefunctor.obj.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 F) X) (Prefunctor.obj.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 F) Y)) (Prefunctor.map.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 F) X Y (dite.{succ u1} (Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) X Y) P _inst_4 (fun (h : P) => f h) (fun (h : Not P) => g h))) (dite.{succ u2} (Quiver.Hom.{succ u2, u4} D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (Prefunctor.obj.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 F) X) (Prefunctor.obj.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 F) Y)) P _inst_4 (fun (h : P) => Prefunctor.map.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 F) X Y (f h)) (fun (h : Not P) => Prefunctor.map.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 F) X Y (g h)))
Case conversion may be inaccurate. Consider using '#align category_theory.functor.map_dite CategoryTheory.Functor.map_diteₓ'. -/
@[simp]
theorem map_dite (F : C ⥤ D) {X Y : C} {P : Prop} [Decidable P] (f : P → (X ⟶ Y))
    (g : ¬P → (X ⟶ Y)) :
    F.map (if h : P then f h else g h) = if h : P then F.map (f h) else F.map (g h) := by
  split_ifs <;> rfl
#align category_theory.functor.map_dite CategoryTheory.Functor.map_dite

@[simp]
theorem toPrefunctor_obj (F : C ⥤ D) (X : C) : F.toPrefunctor.obj X = F.obj X :=
  rfl
#align category_theory.functor.to_prefunctor_obj CategoryTheory.Functor.toPrefunctor_obj

@[simp]
theorem toPrefunctor_map (F : C ⥤ D) {X Y : C} (f : X ⟶ Y) : F.toPrefunctor.map f = F.map f :=
  rfl
#align category_theory.functor.to_prefunctor_map CategoryTheory.Functor.toPrefunctor_map

#print CategoryTheory.Functor.toPrefunctor_comp /-
@[simp]
theorem toPrefunctor_comp (F : C ⥤ D) (G : D ⥤ E) :
    F.toPrefunctor.comp G.toPrefunctor = (F ⋙ G).toPrefunctor :=
  rfl
#align category_theory.functor.to_prefunctor_comp CategoryTheory.Functor.toPrefunctor_comp
-/

end

end Functor

end CategoryTheory


/-
Copyright (c) 2022 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn

! This file was ported from Lean 3 source module measure_theory.function.locally_integrable
! leanprover-community/mathlib commit a75898643b2d774cced9ae7c0b28c21663b99666
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Integral.IntegrableOn

/-!
# Locally integrable functions

A function is called *locally integrable* (`measure_theory.locally_integrable`) if it is integrable
on a neighborhood of every point.

This file contains properties of locally integrable functions and integrability results
on compact sets.

## Main statements

* `continuous.locally_integrable`: A continuous function is locally integrable.

-/

open MeasureTheory MeasureTheory.Measure Set Function TopologicalSpace

open Topology Interval

variable {X Y E R : Type _} [MeasurableSpace X] [TopologicalSpace X]

variable [MeasurableSpace Y] [TopologicalSpace Y]

variable [NormedAddCommGroup E] {f : X → E} {μ : Measure X}

namespace MeasureTheory

/-- A function `f : X → E` is locally integrable if it is integrable on a neighborhood of every
point. In particular, it is integrable on all compact sets,
see `locally_integrable.integrable_on_is_compact`. -/
def LocallyIntegrable (f : X → E) (μ : Measure X := by exact MeasureTheory.MeasureSpace.volume) :
    Prop :=
  ∀ x : X, IntegrableAtFilter f (𝓝 x) μ
#align measure_theory.locally_integrable MeasureTheory.LocallyIntegrable

theorem Integrable.locallyIntegrable (hf : Integrable f μ) : LocallyIntegrable f μ := fun x =>
  hf.IntegrableAtFilter _
#align measure_theory.integrable.locally_integrable MeasureTheory.Integrable.locallyIntegrable

/-- If a function is locally integrable, then it is integrable on an open neighborhood of any
compact set. -/
theorem LocallyIntegrable.integrableOn_nhds_isCompact (hf : LocallyIntegrable f μ) {k : Set X}
    (hk : IsCompact k) : ∃ u, IsOpen u ∧ k ⊆ u ∧ IntegrableOn f u μ :=
  by
  refine' IsCompact.induction_on hk _ _ _ _
  · refine' ⟨∅, isOpen_empty, subset.rfl, integrable_on_empty⟩
  · rintro s t hst ⟨u, u_open, tu, hu⟩
    exact ⟨u, u_open, hst.trans tu, hu⟩
  · rintro s t ⟨u, u_open, su, hu⟩ ⟨v, v_open, tv, hv⟩
    exact ⟨u ∪ v, u_open.union v_open, union_subset_union su tv, hu.union hv⟩
  · intro x hx
    rcases hf x with ⟨u, ux, hu⟩
    rcases mem_nhds_iff.1 ux with ⟨v, vu, v_open, xv⟩
    exact ⟨v, nhdsWithin_le_nhds (v_open.mem_nhds xv), v, v_open, subset.rfl, hu.mono_set vu⟩
#align measure_theory.locally_integrable.integrable_on_nhds_is_compact MeasureTheory.LocallyIntegrable.integrableOn_nhds_isCompact

/-- If a function is locally integrable, then it is integrable on any compact set. -/
theorem LocallyIntegrable.integrableOnIsCompact {k : Set X} (hf : LocallyIntegrable f μ)
    (hk : IsCompact k) : IntegrableOn f k μ :=
  by
  rcases hf.integrable_on_nhds_is_compact hk with ⟨u, u_open, ku, hu⟩
  exact hu.mono_set ku
#align measure_theory.locally_integrable.integrable_on_is_compact MeasureTheory.LocallyIntegrable.integrableOnIsCompact

theorem locallyIntegrable_iff [LocallyCompactSpace X] :
    LocallyIntegrable f μ ↔ ∀ k : Set X, IsCompact k → IntegrableOn f k μ :=
  by
  refine' ⟨fun hf k hk => hf.integrableOnIsCompact hk, fun hf x => _⟩
  obtain ⟨K, hK, h2K⟩ := exists_compact_mem_nhds x
  exact ⟨K, h2K, hf K hK⟩
#align measure_theory.locally_integrable_iff MeasureTheory.locallyIntegrable_iff

theorem LocallyIntegrable.aeStronglyMeasurable [SecondCountableTopology X]
    (hf : LocallyIntegrable f μ) : AeStronglyMeasurable f μ :=
  by
  have : ∀ x, ∃ u, IsOpen u ∧ x ∈ u ∧ integrable_on f u μ :=
    by
    intro x
    rcases hf x with ⟨s, hs, h's⟩
    rcases mem_nhds_iff.1 hs with ⟨u, us, u_open, xu⟩
    exact ⟨u, u_open, xu, h's.mono_set us⟩
  choose u u_open xu hu using this
  obtain ⟨T, T_count, hT⟩ : ∃ T : Set X, T.Countable ∧ (⋃ i : T, u i) = univ :=
    by
    have : (⋃ x, u x) = univ := eq_univ_of_forall fun x => mem_Union_of_mem x (xu x)
    rw [← this]
    simp only [Union_coe_set, Subtype.coe_mk]
    exact is_open_Union_countable u u_open
  have : Countable T := countable_coe_iff.mpr T_count
  rw [← @restrict_univ _ _ μ, ← hT, aeStronglyMeasurable_unionᵢ_iff]
  exact fun i => (hu i).AeStronglyMeasurable
#align measure_theory.locally_integrable.ae_strongly_measurable MeasureTheory.LocallyIntegrable.aeStronglyMeasurable

theorem locallyIntegrableConst [IsLocallyFiniteMeasure μ] (c : E) :
    LocallyIntegrable (fun x => c) μ := by
  intro x
  rcases μ.finite_at_nhds x with ⟨U, hU, h'U⟩
  refine' ⟨U, hU, _⟩
  simp only [h'U, integrable_on_const, or_true_iff]
#align measure_theory.locally_integrable_const MeasureTheory.locallyIntegrableConst

theorem LocallyIntegrable.indicator (hf : LocallyIntegrable f μ) {s : Set X}
    (hs : MeasurableSet s) : LocallyIntegrable (s.indicator f) μ :=
  by
  intro x
  rcases hf x with ⟨U, hU, h'U⟩
  exact ⟨U, hU, h'U.indicator hs⟩
#align measure_theory.locally_integrable.indicator MeasureTheory.LocallyIntegrable.indicator

theorem locallyIntegrable_map_homeomorph [BorelSpace X] [BorelSpace Y] (e : X ≃ₜ Y) {f : Y → E}
    {μ : Measure X} : LocallyIntegrable f (Measure.map e μ) ↔ LocallyIntegrable (f ∘ e) μ :=
  by
  refine' ⟨fun h x => _, fun h x => _⟩
  · rcases h (e x) with ⟨U, hU, h'U⟩
    refine' ⟨e ⁻¹' U, e.continuous.continuous_at.preimage_mem_nhds hU, _⟩
    exact (integrable_on_map_equiv e.to_measurable_equiv).1 h'U
  · rcases h (e.symm x) with ⟨U, hU, h'U⟩
    refine' ⟨e.symm ⁻¹' U, e.symm.continuous.continuous_at.preimage_mem_nhds hU, _⟩
    apply (integrable_on_map_equiv e.to_measurable_equiv).2
    simp only [Homeomorph.toMeasurableEquiv_coe]
    convert h'U
    ext x
    simp only [mem_preimage, Homeomorph.symm_apply_apply]
#align measure_theory.locally_integrable_map_homeomorph MeasureTheory.locallyIntegrable_map_homeomorph

section Mul

variable [OpensMeasurableSpace X] [NormedRing R] [SecondCountableTopologyEither X R] {A K : Set X}
  {g g' : X → R}

theorem IntegrableOn.mulContinuousOnOfSubset (hg : IntegrableOn g A μ) (hg' : ContinuousOn g' K)
    (hA : MeasurableSet A) (hK : IsCompact K) (hAK : A ⊆ K) :
    IntegrableOn (fun x => g x * g' x) A μ :=
  by
  rcases IsCompact.exists_bound_of_continuousOn hK hg' with ⟨C, hC⟩
  rw [integrable_on, ← mem_ℒp_one_iff_integrable] at hg⊢
  have : ∀ᵐ x ∂μ.restrict A, ‖g x * g' x‖ ≤ C * ‖g x‖ :=
    by
    filter_upwards [ae_restrict_mem hA]with x hx
    refine' (norm_mul_le _ _).trans _
    rw [mul_comm]
    apply mul_le_mul_of_nonneg_right (hC x (hAK hx)) (norm_nonneg _)
  exact
    mem_ℒp.of_le_mul hg (hg.ae_strongly_measurable.mul <| (hg'.mono hAK).AeStronglyMeasurable hA)
      this
#align measure_theory.integrable_on.mul_continuous_on_of_subset MeasureTheory.IntegrableOn.mulContinuousOnOfSubset

theorem IntegrableOn.mulContinuousOn [T2Space X] (hg : IntegrableOn g K μ) (hg' : ContinuousOn g' K)
    (hK : IsCompact K) : IntegrableOn (fun x => g x * g' x) K μ :=
  hg.mulContinuousOnOfSubset hg' hK.MeasurableSet hK (Subset.refl _)
#align measure_theory.integrable_on.mul_continuous_on MeasureTheory.IntegrableOn.mulContinuousOn

theorem IntegrableOn.continuousOnMulOfSubset (hg : ContinuousOn g K) (hg' : IntegrableOn g' A μ)
    (hK : IsCompact K) (hA : MeasurableSet A) (hAK : A ⊆ K) :
    IntegrableOn (fun x => g x * g' x) A μ :=
  by
  rcases IsCompact.exists_bound_of_continuousOn hK hg with ⟨C, hC⟩
  rw [integrable_on, ← mem_ℒp_one_iff_integrable] at hg'⊢
  have : ∀ᵐ x ∂μ.restrict A, ‖g x * g' x‖ ≤ C * ‖g' x‖ :=
    by
    filter_upwards [ae_restrict_mem hA]with x hx
    refine' (norm_mul_le _ _).trans _
    apply mul_le_mul_of_nonneg_right (hC x (hAK hx)) (norm_nonneg _)
  exact
    mem_ℒp.of_le_mul hg' (((hg.mono hAK).AeStronglyMeasurable hA).mul hg'.ae_strongly_measurable)
      this
#align measure_theory.integrable_on.continuous_on_mul_of_subset MeasureTheory.IntegrableOn.continuousOnMulOfSubset

theorem IntegrableOn.continuousOnMul [T2Space X] (hg : ContinuousOn g K) (hg' : IntegrableOn g' K μ)
    (hK : IsCompact K) : IntegrableOn (fun x => g x * g' x) K μ :=
  hg'.continuousOnMulOfSubset hg hK hK.MeasurableSet Subset.rfl
#align measure_theory.integrable_on.continuous_on_mul MeasureTheory.IntegrableOn.continuousOnMul

end Mul

end MeasureTheory

open MeasureTheory

/-- If a function is integrable at `𝓝[s] x` for each point `x` of a compact set `s`, then it is
integrable on `s`. -/
theorem IsCompact.integrableOnOfNhdsWithin {K : Set X} (hK : IsCompact K)
    (hf : ∀ x ∈ K, IntegrableAtFilter f (𝓝[K] x) μ) : IntegrableOn f K μ :=
  IsCompact.induction_on hK integrableOnEmpty (fun s t hst ht => ht.monoSet hst)
    (fun s t hs ht => hs.union ht) hf
#align is_compact.integrable_on_of_nhds_within IsCompact.integrableOnOfNhdsWithin

section borel

variable [OpensMeasurableSpace X] [IsLocallyFiniteMeasure μ]

variable {K : Set X} {a b : X}

/-- A continuous function `f` is locally integrable with respect to any locally finite measure. -/
theorem Continuous.locallyIntegrable [SecondCountableTopologyEither X E] (hf : Continuous f) :
    LocallyIntegrable f μ :=
  hf.integrableAtNhds
#align continuous.locally_integrable Continuous.locallyIntegrable

variable [MetrizableSpace X]

/-- A function `f` continuous on a compact set `K` is integrable on this set with respect to any
locally finite measure. -/
theorem ContinuousOn.integrableOnCompact (hK : IsCompact K) (hf : ContinuousOn f K) :
    IntegrableOn f K μ := by
  letI := metrizable_space_metric X
  apply hK.integrable_on_of_nhds_within fun x hx => _
  exact hf.integrable_at_nhds_within_of_is_separable hK.measurable_set hK.is_separable hx
#align continuous_on.integrable_on_compact ContinuousOn.integrableOnCompact

theorem ContinuousOn.integrableOnIcc [Preorder X] [CompactIccSpace X]
    (hf : ContinuousOn f (Icc a b)) : IntegrableOn f (Icc a b) μ :=
  hf.integrableOnCompact isCompact_Icc
#align continuous_on.integrable_on_Icc ContinuousOn.integrableOnIcc

theorem Continuous.integrableOnIcc [Preorder X] [CompactIccSpace X] (hf : Continuous f) :
    IntegrableOn f (Icc a b) μ :=
  hf.ContinuousOn.integrableOnIcc
#align continuous.integrable_on_Icc Continuous.integrableOnIcc

theorem Continuous.integrableOnIoc [Preorder X] [CompactIccSpace X] (hf : Continuous f) :
    IntegrableOn f (Ioc a b) μ :=
  hf.integrableOnIcc.monoSet Ioc_subset_Icc_self
#align continuous.integrable_on_Ioc Continuous.integrableOnIoc

theorem ContinuousOn.integrableOnUIcc [LinearOrder X] [CompactIccSpace X]
    (hf : ContinuousOn f [a, b]) : IntegrableOn f [a, b] μ :=
  hf.integrableOnIcc
#align continuous_on.integrable_on_uIcc ContinuousOn.integrableOnUIcc

theorem Continuous.integrableOnUIcc [LinearOrder X] [CompactIccSpace X] (hf : Continuous f) :
    IntegrableOn f [a, b] μ :=
  hf.integrableOnIcc
#align continuous.integrable_on_uIcc Continuous.integrableOnUIcc

theorem Continuous.integrableOnUIoc [LinearOrder X] [CompactIccSpace X] (hf : Continuous f) :
    IntegrableOn f (Ι a b) μ :=
  hf.integrableOnIoc
#align continuous.integrable_on_uIoc Continuous.integrableOnUIoc

/-- A continuous function with compact support is integrable on the whole space. -/
theorem Continuous.integrableOfHasCompactSupport (hf : Continuous f) (hcf : HasCompactSupport f) :
    Integrable f μ :=
  (integrableOn_iff_integrable_of_support_subset (subset_tsupport f)).mp <|
    hf.ContinuousOn.integrableOnCompact hcf
#align continuous.integrable_of_has_compact_support Continuous.integrableOfHasCompactSupport

end borel

open ENNReal

section Monotone

variable [BorelSpace X] [ConditionallyCompleteLinearOrder X] [ConditionallyCompleteLinearOrder E]
  [OrderTopology X] [OrderTopology E] [SecondCountableTopology E] {s : Set X}

theorem MonotoneOn.integrableOnOfMeasureNeTop (hmono : MonotoneOn f s) {a b : X} (ha : IsLeast s a)
    (hb : IsGreatest s b) (hs : μ s ≠ ∞) (h's : MeasurableSet s) : IntegrableOn f s μ :=
  by
  borelize E
  obtain rfl | h := s.eq_empty_or_nonempty
  · exact integrable_on_empty
  have hbelow : BddBelow (f '' s) := ⟨f a, fun x ⟨y, hy, hyx⟩ => hyx ▸ hmono ha.1 hy (ha.2 hy)⟩
  have habove : BddAbove (f '' s) := ⟨f b, fun x ⟨y, hy, hyx⟩ => hyx ▸ hmono hy hb.1 (hb.2 hy)⟩
  have : Metric.Bounded (f '' s) := Metric.bounded_of_bddAbove_of_bddBelow habove hbelow
  rcases bounded_iff_forall_norm_le.mp this with ⟨C, hC⟩
  have A : integrable_on (fun x => C) s μ := by
    simp only [hs.lt_top, integrable_on_const, or_true_iff]
  refine'
    integrable.mono' A (aeMeasurableRestrictOfMonotoneOn h's hmono).AeStronglyMeasurable
      ((ae_restrict_iff' h's).mpr <| ae_of_all _ fun y hy => hC (f y) (mem_image_of_mem f hy))
#align monotone_on.integrable_on_of_measure_ne_top MonotoneOn.integrableOnOfMeasureNeTop

theorem MonotoneOn.integrableOnIsCompact [IsFiniteMeasureOnCompacts μ] (hs : IsCompact s)
    (hmono : MonotoneOn f s) : IntegrableOn f s μ :=
  by
  obtain rfl | h := s.eq_empty_or_nonempty
  · exact integrable_on_empty
  ·
    exact
      hmono.integrable_on_of_measure_ne_top (hs.is_least_Inf h) (hs.is_greatest_Sup h)
        hs.measure_lt_top.ne hs.measurable_set
#align monotone_on.integrable_on_is_compact MonotoneOn.integrableOnIsCompact

theorem AntitoneOn.integrableOnOfMeasureNeTop (hanti : AntitoneOn f s) {a b : X} (ha : IsLeast s a)
    (hb : IsGreatest s b) (hs : μ s ≠ ∞) (h's : MeasurableSet s) : IntegrableOn f s μ :=
  hanti.dual_right.integrableOnOfMeasureNeTop ha hb hs h's
#align antitone_on.integrable_on_of_measure_ne_top AntitoneOn.integrableOnOfMeasureNeTop

theorem AntioneOn.integrableOnIsCompact [IsFiniteMeasureOnCompacts μ] (hs : IsCompact s)
    (hanti : AntitoneOn f s) : IntegrableOn f s μ :=
  hanti.dual_right.integrableOnIsCompact hs
#align antione_on.integrable_on_is_compact AntioneOn.integrableOnIsCompact

theorem Monotone.locallyIntegrable [IsLocallyFiniteMeasure μ] (hmono : Monotone f) :
    LocallyIntegrable f μ := by
  intro x
  rcases μ.finite_at_nhds x with ⟨U, hU, h'U⟩
  obtain ⟨a, b, xab, hab, abU⟩ : ∃ a b : X, x ∈ Icc a b ∧ Icc a b ∈ 𝓝 x ∧ Icc a b ⊆ U
  exact exists_Icc_mem_subset_of_mem_nhds hU
  have ab : a ≤ b := xab.1.trans xab.2
  refine' ⟨Icc a b, hab, _⟩
  exact
    (hmono.monotone_on _).integrableOnOfMeasureNeTop (isLeast_Icc ab) (isGreatest_Icc ab)
      ((measure_mono abU).trans_lt h'U).Ne measurableSet_Icc
#align monotone.locally_integrable Monotone.locallyIntegrable

theorem Antitone.locallyIntegrable [IsLocallyFiniteMeasure μ] (hanti : Antitone f) :
    LocallyIntegrable f μ :=
  hanti.dual_right.LocallyIntegrable
#align antitone.locally_integrable Antitone.locallyIntegrable

end Monotone


example (x : Nat) : x + 0 = x + 0 := by
  generalize x + 0 = y
  rfl

example (x : Nat) : x + 0 = x + 0 := by
  generalize h : x + 0 = y
  rfl

example (x y w : Nat) (h : y = w) : (x + x) + w = (x + x) + y := by
  generalize h' : x + x = z
  subst y
  rfl

example (x y w : Nat) (h : x + x = y) : (x + x) + (x+x) = (x + x) + y := by
  generalize h' : x + x = z
  subst z
  subst y
  rfl

example (x y w : Nat) (h : y = w) : (x + x) + w = (x + x) + y := by
  generalize h' : x + y = z -- just add equality
  subst h
  rfl

example (x y w : Nat) (h : y = w) (H : (x + x) + w = (x + x) + y) :
    (x + x) + w = (x + x) + y := by
  generalize h' : x + x = z at H
  exact H


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import data.mv_polynomial.supported
import ring_theory.derivation

/-!
# Derivations of multivariate polynomials

In this file we prove that a derivation of `mv_polynomial σ R` is determined by its values on all
monomials `mv_polynomial.X i`. We also provide a constructor `mv_polynomial.mk_derivation` that
builds a derivation from its values on `X i`s and a linear equivalence
`mv_polynomial.equiv_derivation` between `σ → A` and `derivation (mv_polynomial σ R) A`.
-/

namespace mv_polynomial

open_locale big_operators

noncomputable theory

variables {σ R A : Type*} [comm_semiring R] [add_comm_monoid A]
  [module R A] [module (mv_polynomial σ R) A]

section

variable (R)

/-- The derivation on `mv_polynomial σ R` that takes value `f i` on `X i`, as a linear map.
Use `mv_polynomial.mk_derivation` instead. -/
def mk_derivationₗ (f : σ → A) : mv_polynomial σ R →ₗ[R] A :=
finsupp.lsum R $ λ xs : σ →₀ ℕ, (linear_map.ring_lmap_equiv_self R R A).symm $
  xs.sum $ λ i k, monomial (xs - finsupp.single i 1) (k : R) • f i

end

lemma mk_derivationₗ_monomial (f : σ → A) (s : σ →₀ ℕ) (r : R) :
  mk_derivationₗ R f (monomial s r) =
    r • (s.sum $ λ i k, monomial (s - finsupp.single i 1) (k : R) • f i) :=
sum_monomial_eq $ linear_map.map_zero _

lemma mk_derivationₗ_C (f : σ → A) (r : R) : mk_derivationₗ R f (C r) = 0 :=
(mk_derivationₗ_monomial f _ _).trans (smul_zero _)

lemma mk_derivationₗ_X (f : σ → A) (i : σ) : mk_derivationₗ R f (X i) = f i :=
(mk_derivationₗ_monomial f _ _).trans $ by simp

@[simp] lemma derivation_C (D : derivation R (mv_polynomial σ R) A) (a : R) : D (C a) = 0 :=
D.map_algebra_map a

@[simp] lemma derivation_C_mul (D : derivation R (mv_polynomial σ R) A) (a : R)
  (f : mv_polynomial σ R) : D (C a * f) = a • D f :=
by rw [C_mul', D.map_smul]

/-- If two derivations agree on `X i`, `i ∈ s`, then they agree on all polynomials from
`mv_polynomial.supported R s`. -/
lemma derivation_eq_on_supported {D₁ D₂ : derivation R (mv_polynomial σ R) A} {s : set σ}
  (h : set.eq_on (D₁ ∘ X) (D₂ ∘ X) s) {f : mv_polynomial σ R} (hf : f ∈ supported R s) :
  D₁ f = D₂ f :=
derivation.eq_on_adjoin (set.ball_image_iff.2 h) hf

lemma derivation_eq_of_forall_mem_vars {D₁ D₂ : derivation R (mv_polynomial σ R) A}
  {f : mv_polynomial σ R} (h : ∀ i ∈ f.vars, D₁ (X i) = D₂ (X i)) :
  D₁ f = D₂ f :=
derivation_eq_on_supported h f.mem_supported_vars

@[ext] lemma derivation_ext {D₁ D₂ : derivation R (mv_polynomial σ R) A}
  (h : ∀ i, D₁ (X i) = D₂ (X i)) :
  D₁ = D₂ :=
derivation.ext $ λ f, derivation_eq_of_forall_mem_vars (λ i _, h i)

variables [is_scalar_tower R (mv_polynomial σ R) A]

lemma leibniz_iff_X (D : mv_polynomial σ R →ₗ[R] A) (h₁ : D 1 = 0) :
  (∀ p q, D (p * q) = p • D q + q • D p) ↔
    (∀ s i, D (monomial s 1 * X i) = (monomial s 1 : mv_polynomial σ R) • D (X i) +
      (X i : mv_polynomial σ R) • D (monomial s 1)) :=
begin
  refine ⟨λ H p i, H _ _, λ H, _⟩,
  have hC : ∀ r, D (C r) = 0,
  { intro r, rw [C_eq_smul_one, D.map_smul, h₁, smul_zero] },
  have : ∀ p i, D (p * X i) = p • D (X i) + (X i : mv_polynomial σ R) • D p,
  { intros p i,
    induction p using mv_polynomial.induction_on' with s r p q hp hq,
    { rw [← mul_one r, ← C_mul_monomial, mul_assoc, C_mul', D.map_smul, H, C_mul', smul_assoc,
        smul_add, D.map_smul, smul_comm r (X i)], apply_instance },
    { rw [add_mul, map_add, map_add, hp, hq, add_smul, smul_add, add_add_add_comm] } },
  intros p q,
  induction q using mv_polynomial.induction_on,
  case h_C : c { rw [mul_comm, C_mul', hC, smul_zero, zero_add, D.map_smul,
    C_eq_smul_one, smul_one_smul] },
  case h_add : q₁ q₂ h₁ h₂ { simp only [mul_add, map_add, h₁, h₂, smul_add, add_smul], abel },
  case h_X : q i hq { simp only [this, ← mul_assoc, hq, mul_smul, smul_add, smul_comm (X i),
      add_assoc] }
end

variables (R)

/-- The derivation on `mv_polynomial σ R` that takes value `f i` on `X i`. -/
def mk_derivation (f : σ → A) : derivation R (mv_polynomial σ R) A :=
{ to_linear_map := mk_derivationₗ R f,
  map_one_eq_zero' := mk_derivationₗ_C _ 1,
  leibniz' := (leibniz_iff_X (mk_derivationₗ R f) (mk_derivationₗ_C _ 1)).2 $ λ s i,
    begin
      simp only [mk_derivationₗ_monomial, X, monomial_mul, one_smul, one_mul],
      rw [finsupp.sum_add_index'];
        [skip, by simp, by { intros, simp only [nat.cast_add, (monomial _).map_add, add_smul] }],
      rw [finsupp.sum_single_index, finsupp.sum_single_index]; [skip, by simp, by simp],
      rw [tsub_self, add_tsub_cancel_right, nat.cast_one, ← C_apply, C_1, one_smul,
        add_comm, finsupp.smul_sum],
      refine congr_arg2 (+) rfl (finset.sum_congr rfl (λ j hj, _)), dsimp only,
      rw [smul_smul, monomial_mul, one_mul, add_comm s, add_tsub_assoc_of_le],
      rwa [finsupp.single_le_iff, nat.succ_le_iff, pos_iff_ne_zero, ← finsupp.mem_support_iff]
    end }

@[simp] lemma mk_derivation_X (f : σ → A) (i : σ) : mk_derivation R f (X i) = f i :=
mk_derivationₗ_X f i

lemma mk_derivation_monomial (f : σ → A) (s : σ →₀ ℕ) (r : R) :
  mk_derivation R f (monomial s r) =
    r • (s.sum $ λ i k, monomial (s - finsupp.single i 1) (k : R) • f i) :=
mk_derivationₗ_monomial f s r

/-- `mv_polynomial.mk_derivation` as a linear equivalence. -/
def mk_derivation_equiv : (σ → A) ≃ₗ[R] derivation R (mv_polynomial σ R) A :=
linear_equiv.symm $
{ inv_fun := mk_derivation R,
  to_fun := λ D i, D (X i),
  map_add' := λ D₁ D₂, rfl,
  map_smul' := λ c D, rfl,
  left_inv := λ D, derivation_ext $ mk_derivation_X _ _,
  right_inv := λ f, funext $ mk_derivation_X _ _ }

end mv_polynomial


/-
Copyright (c) 2021 Andrew Yang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andrew Yang

! This file was ported from Lean 3 source module algebra.category.Ring.constructions
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Limits.Shapes.Pullbacks
import Mathbin.RingTheory.TensorProduct
import Mathbin.Algebra.Category.Ring.Limits
import Mathbin.Algebra.Category.Ring.Instances
import Mathbin.CategoryTheory.Limits.Shapes.StrictInitial
import Mathbin.RingTheory.Subring.Basic

/-!
# Constructions of (co)limits in CommRing

In this file we provide the explicit (co)cones for various (co)limits in `CommRing`, including
* tensor product is the pushout
* `Z` is the initial object
* `0` is the strict terminal object
* cartesian product is the product
* `ring_hom.eq_locus` is the equalizer

-/

universe u u'

open CategoryTheory CategoryTheory.Limits

open TensorProduct

namespace CommRingCat

section Pushout

variable {R A B : CommRingCat.{u}} (f : R ⟶ A) (g : R ⟶ B)

/-- The explicit cocone with tensor products as the fibered product in `CommRing`. -/
def pushoutCocone : Limits.PushoutCocone f g :=
  by
  letI := RingHom.toAlgebra f
  letI := RingHom.toAlgebra g
  apply limits.pushout_cocone.mk
  show CommRingCat; exact CommRingCat.of (A ⊗[R] B)
  show A ⟶ _; exact algebra.tensor_product.include_left.to_ring_hom
  show B ⟶ _; exact algebra.tensor_product.include_right.to_ring_hom
  ext r
  trans algebraMap R (A ⊗[R] B) r
  · exact algebra.tensor_product.include_left.commutes r
  · exact (algebra.tensor_product.include_right.commutes r).symm
#align CommRing.pushout_cocone CommRingCat.pushoutCocone

@[simp]
theorem pushoutCocone_inl :
    (pushoutCocone f g).inl = by
      letI := f.to_algebra
      letI := g.to_algebra
      exact algebra.tensor_product.include_left.to_ring_hom :=
  rfl
#align CommRing.pushout_cocone_inl CommRingCat.pushoutCocone_inl

@[simp]
theorem pushoutCocone_inr :
    (pushoutCocone f g).inr = by
      letI := f.to_algebra
      letI := g.to_algebra
      exact algebra.tensor_product.include_right.to_ring_hom :=
  rfl
#align CommRing.pushout_cocone_inr CommRingCat.pushoutCocone_inr

@[simp]
theorem pushoutCocone_pt :
    (pushoutCocone f g).pt = by
      letI := f.to_algebra
      letI := g.to_algebra
      exact CommRingCat.of (A ⊗[R] B) :=
  rfl
#align CommRing.pushout_cocone_X CommRingCat.pushoutCocone_pt

/-- Verify that the `pushout_cocone` is indeed the colimit. -/
def pushoutCoconeIsColimit : Limits.IsColimit (pushoutCocone f g) :=
  Limits.PushoutCocone.isColimitAux' _ fun s =>
    by
    letI := RingHom.toAlgebra f
    letI := RingHom.toAlgebra g
    letI := RingHom.toAlgebra (f ≫ s.inl)
    let f' : A →ₐ[R] s.X :=
      { s.inl with
        commutes' := fun r => by
          change s.inl.to_fun (f r) = (f ≫ s.inl) r
          rfl }
    let g' : B →ₐ[R] s.X :=
      { s.inr with
        commutes' := fun r => by
          change (g ≫ s.inr) r = (f ≫ s.inl) r
          congr 1
          exact
            (s.ι.naturality limits.walking_span.hom.snd).trans
              (s.ι.naturality limits.walking_span.hom.fst).symm }
    -- The factor map is a ⊗ b ↦ f(a) * g(b).
    use AlgHom.toRingHom (Algebra.TensorProduct.productMap f' g')
    simp only [pushout_cocone_inl, pushout_cocone_inr]
    constructor
    · ext x
      exact Algebra.TensorProduct.productMap_left_apply _ _ x
    constructor
    · ext x
      exact Algebra.TensorProduct.productMap_right_apply _ _ x
    intro h eq1 eq2
    let h' : A ⊗[R] B →ₐ[R] s.X :=
      { h with
        commutes' := fun r => by
          change h (f r ⊗ₜ[R] 1) = s.inl (f r)
          rw [← eq1]
          simp }
    suffices h' = Algebra.TensorProduct.productMap f' g'
      by
      ext x
      change h' x = Algebra.TensorProduct.productMap f' g' x
      rw [this]
    apply Algebra.TensorProduct.ext
    intro a b
    simp [← eq1, ← eq2, ← h.map_mul]
#align CommRing.pushout_cocone_is_colimit CommRingCat.pushoutCoconeIsColimit

end Pushout

section Terminal

/-- The trivial ring is the (strict) terminal object of `CommRing`. -/
def punitIsTerminal : IsTerminal (CommRingCat.of.{u} PUnit) :=
  by
  apply (config := { instances := false }) is_terminal.of_unique
  tidy
#align CommRing.punit_is_terminal CommRingCat.punitIsTerminal

instance commRingCat_hasStrictTerminalObjects : HasStrictTerminalObjects CommRingCat.{u} :=
  by
  apply has_strict_terminal_objects_of_terminal_is_strict (CommRingCat.of PUnit)
  intro X f
  refine' ⟨⟨by tidy, by ext, _⟩⟩
  ext
  have e : (0 : X) = 1 := by
    rw [← f.map_one, ← f.map_zero]
    congr
  replace e : 0 * x = 1 * x := congr_arg (fun a => a * x) e
  rw [one_mul, MulZeroClass.zero_mul, ← f.map_zero] at e
  exact e
#align CommRing.CommRing_has_strict_terminal_objects CommRingCat.commRingCat_hasStrictTerminalObjects

theorem subsingleton_of_isTerminal {X : CommRingCat} (hX : IsTerminal X) : Subsingleton X :=
  (hX.uniqueUpToIso punitIsTerminal).commRingIsoToRingEquiv.toEquiv.subsingleton_congr.mpr
    (show Subsingleton PUnit by infer_instance)
#align CommRing.subsingleton_of_is_terminal CommRingCat.subsingleton_of_isTerminal

/-- `ℤ` is the initial object of `CommRing`. -/
def zIsInitial : IsInitial (CommRingCat.of ℤ) :=
  by
  apply (config := { instances := false }) is_initial.of_unique
  exact fun R => ⟨⟨Int.castRingHom R⟩, fun a => a.ext_int _⟩
#align CommRing.Z_is_initial CommRingCat.zIsInitial

end Terminal

section Product

variable (A B : CommRingCat.{u})

/-- The product in `CommRing` is the cartesian product. This is the binary fan. -/
@[simps pt]
def prodFan : BinaryFan A B :=
  BinaryFan.mk (CommRingCat.ofHom <| RingHom.fst A B) (CommRingCat.ofHom <| RingHom.snd A B)
#align CommRing.prod_fan CommRingCat.prodFan

/-- The product in `CommRing` is the cartesian product. -/
def prodFanIsLimit : IsLimit (prodFan A B)
    where
  lift c := RingHom.prod (c.π.app ⟨WalkingPair.left⟩) (c.π.app ⟨WalkingPair.right⟩)
  fac c j := by
    ext
    rcases j with ⟨⟨⟩⟩ <;>
      simpa only [binary_fan.π_app_left, binary_fan.π_app_right, comp_apply, RingHom.prod_apply]
  uniq s m h := by
    ext
    · simpa using congr_hom (h ⟨walking_pair.left⟩) x
    · simpa using congr_hom (h ⟨walking_pair.right⟩) x
#align CommRing.prod_fan_is_limit CommRingCat.prodFanIsLimit

end Product

section Equalizer

variable {A B : CommRingCat.{u}} (f g : A ⟶ B)

/-- The equalizer in `CommRing` is the equalizer as sets. This is the equalizer fork. -/
def equalizerFork : Fork f g :=
  Fork.ofι (CommRingCat.ofHom (RingHom.eqLocus f g).Subtype)
    (by
      ext ⟨x, e⟩
      simpa using e)
#align CommRing.equalizer_fork CommRingCat.equalizerFork

/-- The equalizer in `CommRing` is the equalizer as sets. -/
def equalizerForkIsLimit : IsLimit (equalizerFork f g) :=
  by
  fapply fork.is_limit.mk'
  intro s
  use s.ι.cod_restrict _ fun x => (concrete_category.congr_hom s.condition x : _)
  constructor
  · ext
    rfl
  · intro m hm
    ext x
    exact concrete_category.congr_hom hm x
#align CommRing.equalizer_fork_is_limit CommRingCat.equalizerForkIsLimit

instance : IsLocalRingHom (equalizerFork f g).ι :=
  by
  constructor
  rintro ⟨a, h₁ : _ = _⟩ (⟨⟨x, y, h₃, h₄⟩, rfl : x = _⟩ : IsUnit a)
  have : y ∈ RingHom.eqLocus f g :=
    by
    apply (f.is_unit_map ⟨⟨x, y, h₃, h₄⟩, rfl⟩ : IsUnit (f x)).mul_left_inj.mp
    conv_rhs => rw [h₁]
    rw [← f.map_mul, ← g.map_mul, h₄, f.map_one, g.map_one]
  rw [isUnit_iff_exists_inv]
  exact ⟨⟨y, this⟩, Subtype.eq h₃⟩

instance equalizer_ι_isLocalRingHom (F : WalkingParallelPair ⥤ CommRingCat.{u}) :
    IsLocalRingHom (limit.π F WalkingParallelPair.zero) :=
  by
  have := lim_map_π (diagram_iso_parallel_pair F).Hom walking_parallel_pair.zero
  rw [← is_iso.comp_inv_eq] at this
  rw [← this]
  rw [←
    limit.iso_limit_cone_hom_π
      ⟨_,
        equalizer_fork_is_limit (F.map walking_parallel_pair_hom.left)
          (F.map walking_parallel_pair_hom.right)⟩
      walking_parallel_pair.zero]
  change IsLocalRingHom ((lim.map _ ≫ _ ≫ (equalizer_fork _ _).ι) ≫ _)
  infer_instance
#align CommRing.equalizer_ι_is_local_ring_hom CommRingCat.equalizer_ι_isLocalRingHom

open CategoryTheory.Limits.WalkingParallelPair Opposite

open CategoryTheory.Limits.WalkingParallelPairHom

instance equalizer_ι_is_local_ring_hom' (F : WalkingParallelPairᵒᵖ ⥤ CommRingCat.{u}) :
    IsLocalRingHom (limit.π F (Opposite.op WalkingParallelPair.one)) :=
  by
  have : _ = limit.π F (walking_parallel_pair_op_equiv.functor.obj _) :=
    (limit.iso_limit_cone_inv_π
        ⟨_, is_limit.whisker_equivalence (limit.is_limit F) walking_parallel_pair_op_equiv⟩
        walking_parallel_pair.zero :
      _)
  erw [← this]
  infer_instance
#align CommRing.equalizer_ι_is_local_ring_hom' CommRingCat.equalizer_ι_is_local_ring_hom'

end Equalizer

section Pullback

/-- In the category of `CommRing`, the pullback of `f : A ⟶ C` and `g : B ⟶ C` is the `eq_locus` of
the two maps `A × B ⟶ C`. This is the constructed pullback cone.
-/
def pullbackCone {A B C : CommRingCat.{u}} (f : A ⟶ C) (g : B ⟶ C) : PullbackCone f g :=
  PullbackCone.mk
    (CommRingCat.ofHom <|
      (RingHom.fst A B).comp
        (RingHom.eqLocus (f.comp (RingHom.fst A B)) (g.comp (RingHom.snd A B))).Subtype)
    (CommRingCat.ofHom <|
      (RingHom.snd A B).comp
        (RingHom.eqLocus (f.comp (RingHom.fst A B)) (g.comp (RingHom.snd A B))).Subtype)
    (by
      ext ⟨x, e⟩
      simpa [CommRingCat.ofHom] using e)
#align CommRing.pullback_cone CommRingCat.pullbackCone

/-- The constructed pullback cone is indeed the limit. -/
def pullbackConeIsLimit {A B C : CommRingCat.{u}} (f : A ⟶ C) (g : B ⟶ C) :
    IsLimit (pullbackCone f g) :=
  by
  fapply pullback_cone.is_limit.mk
  · intro s
    apply (s.fst.prod s.snd).codRestrict
    intro x
    exact congr_arg (fun f : s.X →+* C => f x) s.condition
  · intro s
    ext x
    rfl
  · intro s
    ext x
    rfl
  · intro s m e₁ e₂
    ext
    · exact (congr_arg (fun f : s.X →+* A => f x) e₁ : _)
    · exact (congr_arg (fun f : s.X →+* B => f x) e₂ : _)
#align CommRing.pullback_cone_is_limit CommRingCat.pullbackConeIsLimit

end Pullback

end CommRingCat


import definitions rotations forall_keys tactic.linarith tactic.omega
set_option pp.generalized_field_notation false

universe u

namespace insertion_balanced_lemmas
open btree rotation_lemmas forall_keys_lemmas

variables {α : Type u}

/- Auxilary lemma to show that a previously existing key has the same relation to the tree after insertion -/
lemma forall_insert (k x : nat) (t : btree α) (a : α) (p : nat → nat → Prop) (h : p x k) :
  forall_keys p x t → forall_keys p x (insert k a t) :=
begin
  intro h₁,
  induction t,
  case empty {
    unfold forall_keys,
    intros k' h₂,
    simp [btree.insert, bound] at h₂,
    subst h₂,
    exact h,
  },
  case node : tl tk ta tr ihl ihr {
    unfold forall_keys at ihl ihr h₁,
    simp only [btree.insert],
    by_cases c₁ : (k < tk),
    { simp only [if_pos c₁],
      by_cases c₂ : (height (insert k a tl) > height tr + 1),
      { simp only [if_pos c₂],
        apply forall_rotate_right,
        rw ← forall_keys_char,
        unfold forall_keys,
        repeat { split },
        { apply ihl,
          intros k' h₂,
          apply h₁,
          simp [bound],
          tauto,
        },
        { apply h₁,
          simp [bound],
        },
        { intros k' h₂,
          apply h₁,
          simp [bound],
          tauto,
        },
      },
      { simp only [if_neg c₂],
        rw ← forall_keys_char,
        repeat { split },
        { apply ihl,
          intros k' h₂,
          apply h₁,
          simp [bound],
          tauto,
        },
        { apply h₁,
          simp [bound],
        },
        { intros k' h₂,
          apply h₁,
          simp [bound],
          tauto,
        },
      },
    },
    { simp only [if_neg c₁],
      by_cases c₂ : (k > tk),
      { simp only [if_pos c₂],
        by_cases c₃ : (height (insert k a tr) > height tl + 1),
        { simp only [if_pos c₃],
          apply forall_rotate_left,
          rw ← forall_keys_char,
          unfold forall_keys,
          repeat { split },
          { intros k' h₂,
            apply h₁,
            simp [bound],
            tauto,
          },
          { apply h₁,
            simp [bound],
          },
          { apply ihr,
            intros k' h₂,
            apply h₁,
            simp [bound],
            tauto,
          },
        },
        { simp only [if_neg c₃],
          rw ← forall_keys_char,
          unfold forall_keys,
          repeat { split },
          { intros k' h₂,
            apply h₁,
            simp [bound],
            tauto,
          },
          { apply h₁,
            simp [bound],
          },
          { apply ihr,
            intros k' h₂,
            apply h₁,
            simp [bound],
            tauto,
          },
        },
      },
      { simp only [if_neg c₂],
        have h : k = tk := by linarith,
        subst h,
        exact h₁,
      },
    },
  },
end

-- /- Insertion preserves tree order -/
lemma insert_ordered (t : btree α) (k : nat) (v : α) :
  ordered t → ordered (insert k v t) :=
begin
  intro h₁,
  induction t,
  case empty {
    simp [btree.insert, ordered, forall_keys],
    split,
    repeat { intros k' h₂,
      simp [bound] at h₂,
      contradiction,
    },
  },
  case node : tl tk ta tr ihl ihr {
    simp only [btree.insert],
    by_cases c₁ : (k < tk),
    { simp only [if_pos c₁],
      by_cases c₂ : (height (insert k v tl) > height tr + 1),
      { simp only [if_pos c₂],
        apply rotate_right_ordered,
        simp only [ordered] at h₁ ⊢,
        cases_matching* (_ ∧ _),
        repeat { split }; try { assumption },
        { apply ihl, exact h₁_left, },
        { apply forall_insert; assumption, },
      },
      { simp only [if_neg c₂],
        simp only [ordered] at h₁ ⊢,
        cases_matching* (_ ∧ _),
        repeat { split }; try { assumption },
        { apply ihl, exact h₁_left, },
        { apply forall_insert; assumption, },
      },
    },
    { simp only [if_neg c₁],
      by_cases c₂ : (k > tk),
      { simp only [if_pos c₂],
        by_cases c₃ : (height (insert k v tr) > height tl + 1),
        { simp only [if_pos c₃],
          apply rotate_left_ordered,
          simp only [ordered] at h₁ ⊢,
          cases_matching* (_ ∧ _),
          repeat { split }; try { assumption },
          { apply ihr, exact h₁_right_left, },
          { apply forall_insert; assumption, }
        },
        { simp only [if_neg c₃],
          simp only [ordered] at h₁ ⊢,
          cases_matching* (_ ∧ _),
          repeat { split }; try { assumption },
          { apply ihr, exact h₁_right_left, },
          { apply forall_insert; assumption, },
        },
      },
      { simp only [if_neg c₂],
        have h : k = tk := by linarith,
        subst h,
        exact h₁,
      },
    },
  },
end

/- A key is bound to the tree immediately after insertion -/
lemma insert_bound (t : btree α) (k : nat) (v : α) :
  bound k (insert k v t) = tt :=
begin
  induction t,
  case empty {
    simp [btree.insert, bound],
  },
  case node : tl tk ta tr ihl ihr {
    simp [btree.insert],
    by_cases c₁ : (k < tk),
    { simp only [if_pos c₁],
      by_cases c₂ : (height tr + 1 < height (insert k v tl)),
      { simp only [if_pos c₂],
        rw ← rotate_right_keys,
        simp [bound],
        tauto,
      },
      { simp only [if_neg c₂],
        simp [bound],
        tauto,
      },
    },
    { simp only [if_neg c₁],
      by_cases c₂ : (tk < k),
      { simp only [if_pos c₂],
        by_cases c₃ : (height tl + 1 < height (insert k v tr)),
        { simp only [if_pos c₃],
          rw ← rotate_left_keys,
          simp [bound],
          tauto,
        },
        { simp only [if_neg c₃],
          simp [bound],
          tauto,
        },
      },
      { simp [if_neg c₂, bound], },
    },
  },
end

/- Insertion does not lose any other keys after insertion -/
lemma insert_diff_bound (t : btree α) (k x : nat) (v : α) :
  bound x t = tt → bound x (insert k v t) = tt :=
begin
  intro h₁,
  induction t,
  case empty {
    simp [btree.insert, bound],
    simp [bound] at h₁,
    contradiction,
  },
  case node : tl tk ta tr ihl ihr {
    simp only [btree.insert],
    by_cases c₁ : (k < tk),
    { simp only [if_pos c₁],
      by_cases c₂ : (height (insert k v tl) > height tr + 1),
      { simp only [if_pos c₂],
        rw ← rotate_right_keys,
        simp [bound],
        simp [bound] at h₁,
        tauto,
      },
      { simp only [if_neg c₂],
        simp [bound],
        simp [bound] at h₁,
        tauto,
      },
    },
    { simp only [if_neg c₁],
      by_cases c₂ : (k > tk),
      { simp only [if_pos c₂],
        by_cases c₃ : (height (insert k v tr) > height tl + 1),
        { simp only [if_pos c₃],
          rw ← rotate_left_keys,
          simp [bound],
          simp [bound] at h₁,
          tauto,
        },
        { simp only [if_neg c₃],
          simp [bound],
          simp [bound] at h₁,
          tauto,
        },
      },
      { simp only [if_neg c₂],
        simp [bound],
        simp [bound] at h₁,
        have h : k = tk := by linarith,
        subst h,
        exact h₁,
      },
    },
  },
end

/- Insertion doesn't create any new keys except the ones specified -/
lemma insert_nbound (t : btree α) (k x : nat) (v : α) :
  (bound x t = ff ∧ x ≠ k) → bound x (insert k v t) = ff :=
begin
  intro h₁,
  induction t,
  case empty {
    simp [btree.insert, bound],
    finish,
  },
  case node : tl tk ta tr ihl ihr {
    simp only [btree.insert],
    by_cases c₁ : (k < tk),
    { simp only [if_pos c₁],
      by_cases c₂ : (height (insert k v tl) > height tr + 1),
      { simp only [if_pos c₂],
        rw ← rotate_right_keys,
        simp [bound] at *,
        tauto,
      },
      { simp only [if_neg c₂],
        simp [bound] at *,
        tauto,
      },
    },
    { simp only [if_neg c₁],
      by_cases c₂ : (tk < k),
      { simp only [if_pos c₂],
        by_cases c₃ : (height (insert k v tr) > height tl + 1),
        { simp only [if_pos c₃],
          rw ← rotate_left_keys,
          simp [bound] at *,
          tauto,
        },
        { simp only [if_neg c₃],
          simp [bound] at *,
          tauto,
        },
      },
      { simp only [if_neg c₂],
        simp [bound] at *,
        tauto,
      },
    },
  },
end

/- Insertion preserves balance -/
lemma insert_balanced (t : btree α) (k : nat) (v : α) :
  balanced t = tt → balanced (insert k v t) = tt :=
begin
  intro h₁,
  cases t,
  case empty {
    simp [btree.insert, balanced],
  },
  case node : tl tk ta tr {
    simp only [btree.insert],
    by_cases c₁ : (k < tk),
    { simp only [if_pos c₁],
      by_cases c₂ : (height (insert k v tl) > height tr + 1),
      { simp only [if_pos c₂],
        apply rotate_right_balanced,
        sorry,
      },
      { simp only [if_neg c₂],
        simp [balanced, height] at h₁ ⊢,
        sorry,
      },
    },
    { simp only [if_neg c₁],
      by_cases c₂ : (k > tk),
      { simp only [if_pos c₂],
        by_cases c₃ : (height (insert k v tr) > height tl + 1),
        { simp only [if_pos c₃],
          apply rotate_left_balanced,
          sorry,
        },
        { simp only [if_neg c₃],
          simp [balanced],
          sorry,
        },
      },
      { simp only [if_neg c₂],
        have h : k = tk := by linarith,
        subst h,
        exact h₁,
      },
    },
  },
end

end insertion_balanced_lemmas