/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Justus Springer

! This file was ported from Lean 3 source module category_theory.limits.lattice
! leanprover-community/mathlib commit 69c6a5a12d8a2b159f20933e60115a4f2de62b58
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Order.CompleteLattice
import Mathbin.Data.Fintype.Lattice
import Mathbin.CategoryTheory.Limits.Shapes.Pullbacks
import Mathbin.CategoryTheory.Category.Preorder
import Mathbin.CategoryTheory.Limits.Shapes.Products
import Mathbin.CategoryTheory.Limits.Shapes.FiniteLimits

/-!
# Limits in lattice categories are given by infimums and supremums.

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

universe w u

open CategoryTheory

open CategoryTheory.Limits

namespace CategoryTheory.Limits.CompleteLattice

section Semilattice

variable {α : Type u}

variable {J : Type w} [SmallCategory J] [FinCategory J]

#print CategoryTheory.Limits.CompleteLattice.finiteLimitCone /-
/-- The limit cone over any functor from a finite diagram into a `semilattice_inf` with `order_top`.
-/
def finiteLimitCone [SemilatticeInf α] [OrderTop α] (F : J ⥤ α) : LimitCone F
    where
  Cone :=
    { pt := Finset.univ.inf F.obj
      π := { app := fun j => homOfLE (Finset.inf_le (Fintype.complete _)) } }
  IsLimit := { lift := fun s => homOfLE (Finset.le_inf fun j _ => (s.π.app j).down.down) }
#align category_theory.limits.complete_lattice.finite_limit_cone CategoryTheory.Limits.CompleteLattice.finiteLimitCone
-/

#print CategoryTheory.Limits.CompleteLattice.finiteColimitCocone /-
/--
The colimit cocone over any functor from a finite diagram into a `semilattice_sup` with `order_bot`.
-/
def finiteColimitCocone [SemilatticeSup α] [OrderBot α] (F : J ⥤ α) : ColimitCocone F
    where
  Cocone :=
    { pt := Finset.univ.sup F.obj
      ι := { app := fun i => homOfLE (Finset.le_sup (Fintype.complete _)) } }
  IsColimit := { desc := fun s => homOfLE (Finset.sup_le fun j _ => (s.ι.app j).down.down) }
#align category_theory.limits.complete_lattice.finite_colimit_cocone CategoryTheory.Limits.CompleteLattice.finiteColimitCocone
-/

#print CategoryTheory.Limits.CompleteLattice.hasFiniteLimits_of_semilatticeInf_orderTop /-
-- see Note [lower instance priority]
instance (priority := 100) hasFiniteLimits_of_semilatticeInf_orderTop [SemilatticeInf α]
    [OrderTop α] : HasFiniteLimits α :=
  ⟨fun J 𝒥₁ 𝒥₂ => { HasLimit := fun F => has_limit.mk (finite_limit_cone F) }⟩
#align category_theory.limits.complete_lattice.has_finite_limits_of_semilattice_inf_order_top CategoryTheory.Limits.CompleteLattice.hasFiniteLimits_of_semilatticeInf_orderTop
-/

#print CategoryTheory.Limits.CompleteLattice.hasFiniteColimits_of_semilatticeSup_orderBot /-
-- see Note [lower instance priority]
instance (priority := 100) hasFiniteColimits_of_semilatticeSup_orderBot [SemilatticeSup α]
    [OrderBot α] : HasFiniteColimits α :=
  ⟨fun J 𝒥₁ 𝒥₂ => { HasColimit := fun F => has_colimit.mk (finite_colimit_cocone F) }⟩
#align category_theory.limits.complete_lattice.has_finite_colimits_of_semilattice_sup_order_bot CategoryTheory.Limits.CompleteLattice.hasFiniteColimits_of_semilatticeSup_orderBot
-/

/- warning: category_theory.limits.complete_lattice.finite_limit_eq_finset_univ_inf -> CategoryTheory.Limits.CompleteLattice.finite_limit_eq_finset_univ_inf is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u2}} {J : Type.{u1}} [_inst_1 : CategoryTheory.SmallCategory.{u1} J] [_inst_2 : CategoryTheory.FinCategory.{u1} J _inst_1] [_inst_3 : SemilatticeInf.{u2} α] [_inst_4 : OrderTop.{u2} α (Preorder.toLE.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α _inst_3)))] (F : CategoryTheory.Functor.{u1, u2, u1, u2} J _inst_1 α (Preorder.smallCategory.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α _inst_3)))), Eq.{succ u2} α (CategoryTheory.Limits.limit.{u1, u1, u2, u2} J _inst_1 α (Preorder.smallCategory.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α _inst_3))) F (CategoryTheory.Limits.hasLimitOfHasLimitsOfShape.{u1, u1, u2, u2} α (Preorder.smallCategory.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α _inst_3))) J _inst_1 (CategoryTheory.Limits.hasLimitsOfShape_of_hasFiniteLimits.{u1, u2, u2} α (Preorder.smallCategory.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α _inst_3))) J _inst_1 _inst_2 (CategoryTheory.Limits.CompleteLattice.hasFiniteLimits_of_semilatticeInf_orderTop.{u2} α _inst_3 _inst_4)) F)) (Finset.inf.{u2, u1} α J _inst_3 _inst_4 (Finset.univ.{u1} J (CategoryTheory.FinCategory.fintypeObj.{u1} J _inst_1 _inst_2)) (CategoryTheory.Functor.obj.{u1, u2, u1, u2} J _inst_1 α (Preorder.smallCategory.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α _inst_3))) F))
but is expected to have type
  forall {α : Type.{u2}} {J : Type.{u1}} [_inst_1 : CategoryTheory.SmallCategory.{u1} J] [_inst_2 : CategoryTheory.FinCategory.{u1} J _inst_1] [_inst_3 : SemilatticeInf.{u2} α] [_inst_4 : OrderTop.{u2} α (Preorder.toLE.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α _inst_3)))] (F : CategoryTheory.Functor.{u1, u2, u1, u2} J _inst_1 α (Preorder.smallCategory.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α _inst_3)))), Eq.{succ u2} α (CategoryTheory.Limits.limit.{u1, u1, u2, u2} J _inst_1 α (Preorder.smallCategory.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α _inst_3))) F (CategoryTheory.Limits.hasLimitOfHasLimitsOfShape.{u1, u1, u2, u2} α (Preorder.smallCategory.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α _inst_3))) J _inst_1 (CategoryTheory.Limits.hasLimitsOfShape_of_hasFiniteLimits.{u1, u2, u2} α (Preorder.smallCategory.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α _inst_3))) J _inst_1 _inst_2 (CategoryTheory.Limits.CompleteLattice.hasFiniteLimits_of_semilatticeInf_orderTop.{u2} α _inst_3 _inst_4)) F)) (Finset.inf.{u2, u1} α J _inst_3 _inst_4 (Finset.univ.{u1} J (CategoryTheory.FinCategory.fintypeObj.{u1} J _inst_1 _inst_2)) (Prefunctor.obj.{succ u1, succ u2, u1, u2} J (CategoryTheory.CategoryStruct.toQuiver.{u1, u1} J (CategoryTheory.Category.toCategoryStruct.{u1, u1} J _inst_1)) α (CategoryTheory.CategoryStruct.toQuiver.{u2, u2} α (CategoryTheory.Category.toCategoryStruct.{u2, u2} α (Preorder.smallCategory.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α _inst_3))))) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u1, u2} J _inst_1 α (Preorder.smallCategory.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α _inst_3))) F)))
Case conversion may be inaccurate. Consider using '#align category_theory.limits.complete_lattice.finite_limit_eq_finset_univ_inf CategoryTheory.Limits.CompleteLattice.finite_limit_eq_finset_univ_infₓ'. -/
/-- The limit of a functor from a finite diagram into a `semilattice_inf` with `order_top` is the
infimum of the objects in the image.
-/
theorem finite_limit_eq_finset_univ_inf [SemilatticeInf α] [OrderTop α] (F : J ⥤ α) :
    limit F = Finset.univ.inf F.obj :=
  (IsLimit.conePointUniqueUpToIso (limit.isLimit F) (finiteLimitCone F).IsLimit).to_eq
#align category_theory.limits.complete_lattice.finite_limit_eq_finset_univ_inf CategoryTheory.Limits.CompleteLattice.finite_limit_eq_finset_univ_inf

/- warning: category_theory.limits.complete_lattice.finite_colimit_eq_finset_univ_sup -> CategoryTheory.Limits.CompleteLattice.finite_colimit_eq_finset_univ_sup is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u2}} {J : Type.{u1}} [_inst_1 : CategoryTheory.SmallCategory.{u1} J] [_inst_2 : CategoryTheory.FinCategory.{u1} J _inst_1] [_inst_3 : SemilatticeSup.{u2} α] [_inst_4 : OrderBot.{u2} α (Preorder.toLE.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeSup.toPartialOrder.{u2} α _inst_3)))] (F : CategoryTheory.Functor.{u1, u2, u1, u2} J _inst_1 α (Preorder.smallCategory.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeSup.toPartialOrder.{u2} α _inst_3)))), Eq.{succ u2} α (CategoryTheory.Limits.colimit.{u1, u1, u2, u2} J _inst_1 α (Preorder.smallCategory.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeSup.toPartialOrder.{u2} α _inst_3))) F (CategoryTheory.Limits.hasColimitOfHasColimitsOfShape.{u1, u1, u2, u2} α (Preorder.smallCategory.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeSup.toPartialOrder.{u2} α _inst_3))) J _inst_1 (CategoryTheory.Limits.hasColimitsOfShape_of_hasFiniteColimits.{u1, u2, u2} α (Preorder.smallCategory.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeSup.toPartialOrder.{u2} α _inst_3))) J _inst_1 _inst_2 (CategoryTheory.Limits.CompleteLattice.hasFiniteColimits_of_semilatticeSup_orderBot.{u2} α _inst_3 _inst_4)) F)) (Finset.sup.{u2, u1} α J _inst_3 _inst_4 (Finset.univ.{u1} J (CategoryTheory.FinCategory.fintypeObj.{u1} J _inst_1 _inst_2)) (CategoryTheory.Functor.obj.{u1, u2, u1, u2} J _inst_1 α (Preorder.smallCategory.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeSup.toPartialOrder.{u2} α _inst_3))) F))
but is expected to have type
  forall {α : Type.{u2}} {J : Type.{u1}} [_inst_1 : CategoryTheory.SmallCategory.{u1} J] [_inst_2 : CategoryTheory.FinCategory.{u1} J _inst_1] [_inst_3 : SemilatticeSup.{u2} α] [_inst_4 : OrderBot.{u2} α (Preorder.toLE.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeSup.toPartialOrder.{u2} α _inst_3)))] (F : CategoryTheory.Functor.{u1, u2, u1, u2} J _inst_1 α (Preorder.smallCategory.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeSup.toPartialOrder.{u2} α _inst_3)))), Eq.{succ u2} α (CategoryTheory.Limits.colimit.{u1, u1, u2, u2} J _inst_1 α (Preorder.smallCategory.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeSup.toPartialOrder.{u2} α _inst_3))) F (CategoryTheory.Limits.hasColimitOfHasColimitsOfShape.{u1, u1, u2, u2} α (Preorder.smallCategory.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeSup.toPartialOrder.{u2} α _inst_3))) J _inst_1 (CategoryTheory.Limits.hasColimitsOfShape_of_hasFiniteColimits.{u1, u2, u2} α (Preorder.smallCategory.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeSup.toPartialOrder.{u2} α _inst_3))) J _inst_1 _inst_2 (CategoryTheory.Limits.CompleteLattice.hasFiniteColimits_of_semilatticeSup_orderBot.{u2} α _inst_3 _inst_4)) F)) (Finset.sup.{u2, u1} α J _inst_3 _inst_4 (Finset.univ.{u1} J (CategoryTheory.FinCategory.fintypeObj.{u1} J _inst_1 _inst_2)) (Prefunctor.obj.{succ u1, succ u2, u1, u2} J (CategoryTheory.CategoryStruct.toQuiver.{u1, u1} J (CategoryTheory.Category.toCategoryStruct.{u1, u1} J _inst_1)) α (CategoryTheory.CategoryStruct.toQuiver.{u2, u2} α (CategoryTheory.Category.toCategoryStruct.{u2, u2} α (Preorder.smallCategory.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeSup.toPartialOrder.{u2} α _inst_3))))) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u1, u2} J _inst_1 α (Preorder.smallCategory.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeSup.toPartialOrder.{u2} α _inst_3))) F)))
Case conversion may be inaccurate. Consider using '#align category_theory.limits.complete_lattice.finite_colimit_eq_finset_univ_sup CategoryTheory.Limits.CompleteLattice.finite_colimit_eq_finset_univ_supₓ'. -/
/-- The colimit of a functor from a finite diagram into a `semilattice_sup` with `order_bot`
is the supremum of the objects in the image.
-/
theorem finite_colimit_eq_finset_univ_sup [SemilatticeSup α] [OrderBot α] (F : J ⥤ α) :
    colimit F = Finset.univ.sup F.obj :=
  (IsColimit.coconePointUniqueUpToIso (colimit.isColimit F) (finiteColimitCocone F).IsColimit).to_eq
#align category_theory.limits.complete_lattice.finite_colimit_eq_finset_univ_sup CategoryTheory.Limits.CompleteLattice.finite_colimit_eq_finset_univ_sup

#print CategoryTheory.Limits.CompleteLattice.finite_product_eq_finset_inf /-
/--
A finite product in the category of a `semilattice_inf` with `order_top` is the same as the infimum.
-/
theorem finite_product_eq_finset_inf [SemilatticeInf α] [OrderTop α] {ι : Type u} [Fintype ι]
    (f : ι → α) : (∏ f) = (Fintype.elems ι).inf f :=
  by
  trans
  exact
    (is_limit.cone_point_unique_up_to_iso (limit.is_limit _)
        (finite_limit_cone (discrete.functor f)).IsLimit).to_eq
  change finset.univ.inf (f ∘ discrete_equiv.to_embedding) = (Fintype.elems ι).inf f
  simp only [← Finset.inf_map, Finset.univ_map_equiv_to_embedding]
  rfl
#align category_theory.limits.complete_lattice.finite_product_eq_finset_inf CategoryTheory.Limits.CompleteLattice.finite_product_eq_finset_inf
-/

#print CategoryTheory.Limits.CompleteLattice.finite_coproduct_eq_finset_sup /-
/-- A finite coproduct in the category of a `semilattice_sup` with `order_bot` is the same as the
supremum.
-/
theorem finite_coproduct_eq_finset_sup [SemilatticeSup α] [OrderBot α] {ι : Type u} [Fintype ι]
    (f : ι → α) : (∐ f) = (Fintype.elems ι).sup f :=
  by
  trans
  exact
    (is_colimit.cocone_point_unique_up_to_iso (colimit.is_colimit _)
        (finite_colimit_cocone (discrete.functor f)).IsColimit).to_eq
  change finset.univ.sup (f ∘ discrete_equiv.to_embedding) = (Fintype.elems ι).sup f
  simp only [← Finset.sup_map, Finset.univ_map_equiv_to_embedding]
  rfl
#align category_theory.limits.complete_lattice.finite_coproduct_eq_finset_sup CategoryTheory.Limits.CompleteLattice.finite_coproduct_eq_finset_sup
-/

-- see Note [lower instance priority]
instance (priority := 100) [SemilatticeInf α] [OrderTop α] : HasBinaryProducts α :=
  by
  have : ∀ x y : α, has_limit (pair x y) :=
    by
    letI := hasFiniteLimits_of_hasFiniteLimits_of_size.{u} α
    infer_instance
  apply has_binary_products_of_has_limit_pair

/- warning: category_theory.limits.complete_lattice.prod_eq_inf -> CategoryTheory.Limits.CompleteLattice.prod_eq_inf is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_3 : SemilatticeInf.{u1} α] [_inst_4 : OrderTop.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_3)))] (x : α) (y : α), Eq.{succ u1} α (CategoryTheory.Limits.prod.{u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_3))) x y (CategoryTheory.Limits.hasLimitOfHasLimitsOfShape.{0, 0, u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_3))) (CategoryTheory.Discrete.{0} CategoryTheory.Limits.WalkingPair) (CategoryTheory.discreteCategory.{0} CategoryTheory.Limits.WalkingPair) (CategoryTheory.Limits.CompleteLattice.CategoryTheory.Limits.hasBinaryProducts.{u1} α _inst_3 _inst_4) (CategoryTheory.Limits.pair.{u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_3))) x y))) (Inf.inf.{u1} α (SemilatticeInf.toHasInf.{u1} α _inst_3) x y)
but is expected to have type
  forall {α : Type.{u1}} [_inst_3 : SemilatticeInf.{u1} α] [_inst_4 : OrderTop.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_3)))] (x : α) (y : α), Eq.{succ u1} α (CategoryTheory.Limits.prod.{u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_3))) x y (CategoryTheory.Limits.hasLimitOfHasLimitsOfShape.{0, 0, u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_3))) (CategoryTheory.Discrete.{0} CategoryTheory.Limits.WalkingPair) (CategoryTheory.discreteCategory.{0} CategoryTheory.Limits.WalkingPair) (CategoryTheory.Limits.CompleteLattice.instHasBinaryProductsSmallCategoryToPreorderToPartialOrder.{u1} α _inst_3 _inst_4) (CategoryTheory.Limits.pair.{u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_3))) x y))) (Inf.inf.{u1} α (SemilatticeInf.toInf.{u1} α _inst_3) x y)
Case conversion may be inaccurate. Consider using '#align category_theory.limits.complete_lattice.prod_eq_inf CategoryTheory.Limits.CompleteLattice.prod_eq_infₓ'. -/
/-- The binary product in the category of a `semilattice_inf` with `order_top` is the same as the
infimum.
-/
@[simp]
theorem prod_eq_inf [SemilatticeInf α] [OrderTop α] (x y : α) : Limits.prod x y = x ⊓ y :=
  calc
    Limits.prod x y = limit (pair x y) := rfl
    _ = Finset.univ.inf (pair x y).obj := by rw [finite_limit_eq_finset_univ_inf (pair.{u} x y)]
    _ = x ⊓ (y ⊓ ⊤) := rfl
    -- Note: finset.inf is realized as a fold, hence the definitional equality
        _ =
        x ⊓ y :=
      by rw [inf_top_eq]

#align category_theory.limits.complete_lattice.prod_eq_inf CategoryTheory.Limits.CompleteLattice.prod_eq_inf

-- see Note [lower instance priority]
instance (priority := 100) [SemilatticeSup α] [OrderBot α] : HasBinaryCoproducts α :=
  by
  have : ∀ x y : α, has_colimit (pair x y) :=
    by
    letI := hasFiniteColimits_of_hasFiniteColimits_of_size.{u} α
    infer_instance
  apply has_binary_coproducts_of_has_colimit_pair

/- warning: category_theory.limits.complete_lattice.coprod_eq_sup -> CategoryTheory.Limits.CompleteLattice.coprod_eq_sup is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_3 : SemilatticeSup.{u1} α] [_inst_4 : OrderBot.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeSup.toPartialOrder.{u1} α _inst_3)))] (x : α) (y : α), Eq.{succ u1} α (CategoryTheory.Limits.coprod.{u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeSup.toPartialOrder.{u1} α _inst_3))) x y (CategoryTheory.Limits.hasColimitOfHasColimitsOfShape.{0, 0, u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeSup.toPartialOrder.{u1} α _inst_3))) (CategoryTheory.Discrete.{0} CategoryTheory.Limits.WalkingPair) (CategoryTheory.discreteCategory.{0} CategoryTheory.Limits.WalkingPair) (CategoryTheory.Limits.CompleteLattice.CategoryTheory.Limits.hasBinaryCoproducts.{u1} α _inst_3 _inst_4) (CategoryTheory.Limits.pair.{u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeSup.toPartialOrder.{u1} α _inst_3))) x y))) (Sup.sup.{u1} α (SemilatticeSup.toHasSup.{u1} α _inst_3) x y)
but is expected to have type
  forall {α : Type.{u1}} [_inst_3 : SemilatticeSup.{u1} α] [_inst_4 : OrderBot.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeSup.toPartialOrder.{u1} α _inst_3)))] (x : α) (y : α), Eq.{succ u1} α (CategoryTheory.Limits.coprod.{u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeSup.toPartialOrder.{u1} α _inst_3))) x y (CategoryTheory.Limits.hasColimitOfHasColimitsOfShape.{0, 0, u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeSup.toPartialOrder.{u1} α _inst_3))) (CategoryTheory.Discrete.{0} CategoryTheory.Limits.WalkingPair) (CategoryTheory.discreteCategory.{0} CategoryTheory.Limits.WalkingPair) (CategoryTheory.Limits.CompleteLattice.instHasBinaryCoproductsSmallCategoryToPreorderToPartialOrder.{u1} α _inst_3 _inst_4) (CategoryTheory.Limits.pair.{u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeSup.toPartialOrder.{u1} α _inst_3))) x y))) (Sup.sup.{u1} α (SemilatticeSup.toSup.{u1} α _inst_3) x y)
Case conversion may be inaccurate. Consider using '#align category_theory.limits.complete_lattice.coprod_eq_sup CategoryTheory.Limits.CompleteLattice.coprod_eq_supₓ'. -/
/-- The binary coproduct in the category of a `semilattice_sup` with `order_bot` is the same as the
supremum.
-/
@[simp]
theorem coprod_eq_sup [SemilatticeSup α] [OrderBot α] (x y : α) : Limits.coprod x y = x ⊔ y :=
  calc
    Limits.coprod x y = colimit (pair x y) := rfl
    _ = Finset.univ.sup (pair x y).obj := by rw [finite_colimit_eq_finset_univ_sup (pair x y)]
    _ = x ⊔ (y ⊔ ⊥) := rfl
    -- Note: finset.sup is realized as a fold, hence the definitional equality
        _ =
        x ⊔ y :=
      by rw [sup_bot_eq]

#align category_theory.limits.complete_lattice.coprod_eq_sup CategoryTheory.Limits.CompleteLattice.coprod_eq_sup

/- warning: category_theory.limits.complete_lattice.pullback_eq_inf -> CategoryTheory.Limits.CompleteLattice.pullback_eq_inf is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_3 : SemilatticeInf.{u1} α] [_inst_4 : OrderTop.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_3)))] {x : α} {y : α} {z : α} (f : Quiver.Hom.{succ u1, u1} α (CategoryTheory.CategoryStruct.toQuiver.{u1, u1} α (CategoryTheory.Category.toCategoryStruct.{u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_3))))) x z) (g : Quiver.Hom.{succ u1, u1} α (CategoryTheory.CategoryStruct.toQuiver.{u1, u1} α (CategoryTheory.Category.toCategoryStruct.{u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_3))))) y z), Eq.{succ u1} α (CategoryTheory.Limits.pullback.{u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_3))) x y z f g (CategoryTheory.Limits.hasLimitOfHasLimitsOfShape.{0, 0, u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_3))) CategoryTheory.Limits.WalkingCospan (CategoryTheory.Limits.WidePullbackShape.category.{0} CategoryTheory.Limits.WalkingPair) (CategoryTheory.Limits.hasLimitsOfShape_of_hasFiniteLimits.{0, u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_3))) CategoryTheory.Limits.WalkingCospan (CategoryTheory.Limits.WidePullbackShape.category.{0} CategoryTheory.Limits.WalkingPair) (CategoryTheory.Limits.finCategoryWidePullback.{0} CategoryTheory.Limits.WalkingPair CategoryTheory.Limits.fintypeWalkingPair) (CategoryTheory.Limits.CompleteLattice.hasFiniteLimits_of_semilatticeInf_orderTop.{u1} α _inst_3 _inst_4)) (CategoryTheory.Limits.cospan.{u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_3))) x y z f g))) (Inf.inf.{u1} α (SemilatticeInf.toHasInf.{u1} α _inst_3) x y)
but is expected to have type
  forall {α : Type.{u1}} [_inst_3 : SemilatticeInf.{u1} α] [_inst_4 : OrderTop.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_3)))] {x : α} {y : α} {z : α} (f : Quiver.Hom.{succ u1, u1} α (CategoryTheory.CategoryStruct.toQuiver.{u1, u1} α (CategoryTheory.Category.toCategoryStruct.{u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_3))))) x z) (g : Quiver.Hom.{succ u1, u1} α (CategoryTheory.CategoryStruct.toQuiver.{u1, u1} α (CategoryTheory.Category.toCategoryStruct.{u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_3))))) y z), Eq.{succ u1} α (CategoryTheory.Limits.pullback.{u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_3))) x y z f g (CategoryTheory.Limits.hasLimitOfHasLimitsOfShape.{0, 0, u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_3))) CategoryTheory.Limits.WalkingCospan (CategoryTheory.Limits.WidePullbackShape.category.{0} CategoryTheory.Limits.WalkingPair) (CategoryTheory.Limits.hasLimitsOfShape_of_hasFiniteLimits.{0, u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_3))) CategoryTheory.Limits.WalkingCospan (CategoryTheory.Limits.WidePullbackShape.category.{0} CategoryTheory.Limits.WalkingPair) (CategoryTheory.Limits.finCategoryWidePullback.{0} CategoryTheory.Limits.WalkingPair CategoryTheory.Limits.fintypeWalkingPair) (CategoryTheory.Limits.CompleteLattice.hasFiniteLimits_of_semilatticeInf_orderTop.{u1} α _inst_3 _inst_4)) (CategoryTheory.Limits.cospan.{u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_3))) x y z f g))) (Inf.inf.{u1} α (SemilatticeInf.toInf.{u1} α _inst_3) x y)
Case conversion may be inaccurate. Consider using '#align category_theory.limits.complete_lattice.pullback_eq_inf CategoryTheory.Limits.CompleteLattice.pullback_eq_infₓ'. -/
/-- The pullback in the category of a `semilattice_inf` with `order_top` is the same as the infimum
over the objects.
-/
@[simp]
theorem pullback_eq_inf [SemilatticeInf α] [OrderTop α] {x y z : α} (f : x ⟶ z) (g : y ⟶ z) :
    pullback f g = x ⊓ y :=
  calc
    pullback f g = limit (cospan f g) := rfl
    _ = Finset.univ.inf (cospan f g).obj := by rw [finite_limit_eq_finset_univ_inf]
    _ = z ⊓ (x ⊓ (y ⊓ ⊤)) := rfl
    _ = z ⊓ (x ⊓ y) := by rw [inf_top_eq]
    _ = x ⊓ y := inf_eq_right.mpr (inf_le_of_left_le f.le)

#align category_theory.limits.complete_lattice.pullback_eq_inf CategoryTheory.Limits.CompleteLattice.pullback_eq_inf

/- warning: category_theory.limits.complete_lattice.pushout_eq_sup -> CategoryTheory.Limits.CompleteLattice.pushout_eq_sup is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_3 : SemilatticeSup.{u1} α] [_inst_4 : OrderBot.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeSup.toPartialOrder.{u1} α _inst_3)))] (x : α) (y : α) (z : α) (f : Quiver.Hom.{succ u1, u1} α (CategoryTheory.CategoryStruct.toQuiver.{u1, u1} α (CategoryTheory.Category.toCategoryStruct.{u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeSup.toPartialOrder.{u1} α _inst_3))))) z x) (g : Quiver.Hom.{succ u1, u1} α (CategoryTheory.CategoryStruct.toQuiver.{u1, u1} α (CategoryTheory.Category.toCategoryStruct.{u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeSup.toPartialOrder.{u1} α _inst_3))))) z y), Eq.{succ u1} α (CategoryTheory.Limits.pushout.{u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeSup.toPartialOrder.{u1} α _inst_3))) z x y f g (CategoryTheory.Limits.hasColimitOfHasColimitsOfShape.{0, 0, u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeSup.toPartialOrder.{u1} α _inst_3))) CategoryTheory.Limits.WalkingSpan (CategoryTheory.Limits.WidePushoutShape.category.{0} CategoryTheory.Limits.WalkingPair) (CategoryTheory.Limits.hasColimitsOfShape_of_hasFiniteColimits.{0, u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeSup.toPartialOrder.{u1} α _inst_3))) CategoryTheory.Limits.WalkingSpan (CategoryTheory.Limits.WidePushoutShape.category.{0} CategoryTheory.Limits.WalkingPair) (CategoryTheory.Limits.finCategoryWidePushout.{0} CategoryTheory.Limits.WalkingPair CategoryTheory.Limits.fintypeWalkingPair) (CategoryTheory.Limits.CompleteLattice.hasFiniteColimits_of_semilatticeSup_orderBot.{u1} α _inst_3 _inst_4)) (CategoryTheory.Limits.span.{u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeSup.toPartialOrder.{u1} α _inst_3))) z x y f g))) (Sup.sup.{u1} α (SemilatticeSup.toHasSup.{u1} α _inst_3) x y)
but is expected to have type
  forall {α : Type.{u1}} [_inst_3 : SemilatticeSup.{u1} α] [_inst_4 : OrderBot.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeSup.toPartialOrder.{u1} α _inst_3)))] (x : α) (y : α) (z : α) (f : Quiver.Hom.{succ u1, u1} α (CategoryTheory.CategoryStruct.toQuiver.{u1, u1} α (CategoryTheory.Category.toCategoryStruct.{u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeSup.toPartialOrder.{u1} α _inst_3))))) z x) (g : Quiver.Hom.{succ u1, u1} α (CategoryTheory.CategoryStruct.toQuiver.{u1, u1} α (CategoryTheory.Category.toCategoryStruct.{u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeSup.toPartialOrder.{u1} α _inst_3))))) z y), Eq.{succ u1} α (CategoryTheory.Limits.pushout.{u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeSup.toPartialOrder.{u1} α _inst_3))) z x y f g (CategoryTheory.Limits.hasColimitOfHasColimitsOfShape.{0, 0, u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeSup.toPartialOrder.{u1} α _inst_3))) CategoryTheory.Limits.WalkingSpan (CategoryTheory.Limits.WidePushoutShape.category.{0} CategoryTheory.Limits.WalkingPair) (CategoryTheory.Limits.hasColimitsOfShape_of_hasFiniteColimits.{0, u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeSup.toPartialOrder.{u1} α _inst_3))) CategoryTheory.Limits.WalkingSpan (CategoryTheory.Limits.WidePushoutShape.category.{0} CategoryTheory.Limits.WalkingPair) (CategoryTheory.Limits.finCategoryWidePushout.{0} CategoryTheory.Limits.WalkingPair CategoryTheory.Limits.fintypeWalkingPair) (CategoryTheory.Limits.CompleteLattice.hasFiniteColimits_of_semilatticeSup_orderBot.{u1} α _inst_3 _inst_4)) (CategoryTheory.Limits.span.{u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeSup.toPartialOrder.{u1} α _inst_3))) z x y f g))) (Sup.sup.{u1} α (SemilatticeSup.toSup.{u1} α _inst_3) x y)
Case conversion may be inaccurate. Consider using '#align category_theory.limits.complete_lattice.pushout_eq_sup CategoryTheory.Limits.CompleteLattice.pushout_eq_supₓ'. -/
/-- The pushout in the category of a `semilattice_sup` with `order_bot` is the same as the supremum
over the objects.
-/
@[simp]
theorem pushout_eq_sup [SemilatticeSup α] [OrderBot α] (x y z : α) (f : z ⟶ x) (g : z ⟶ y) :
    pushout f g = x ⊔ y :=
  calc
    pushout f g = colimit (span f g) := rfl
    _ = Finset.univ.sup (span f g).obj := by rw [finite_colimit_eq_finset_univ_sup]
    _ = z ⊔ (x ⊔ (y ⊔ ⊥)) := rfl
    _ = z ⊔ (x ⊔ y) := by rw [sup_bot_eq]
    _ = x ⊔ y := sup_eq_right.mpr (le_sup_of_le_left f.le)

#align category_theory.limits.complete_lattice.pushout_eq_sup CategoryTheory.Limits.CompleteLattice.pushout_eq_sup

end Semilattice

variable {α : Type u} [CompleteLattice α]

variable {J : Type u} [SmallCategory J]

#print CategoryTheory.Limits.CompleteLattice.limitCone /-
/-- The limit cone over any functor into a complete lattice.
-/
def limitCone (F : J ⥤ α) : LimitCone F
    where
  Cone :=
    { pt := infᵢ F.obj
      π := { app := fun j => homOfLE (CompleteLattice.inf_le _ _ (Set.mem_range_self _)) } }
  IsLimit :=
    {
      lift := fun s =>
        homOfLE (CompleteLattice.le_inf _ _ (by rintro _ ⟨j, rfl⟩; exact (s.π.app j).le)) }
#align category_theory.limits.complete_lattice.limit_cone CategoryTheory.Limits.CompleteLattice.limitCone
-/

#print CategoryTheory.Limits.CompleteLattice.colimitCocone /-
/-- The colimit cocone over any functor into a complete lattice.
-/
def colimitCocone (F : J ⥤ α) : ColimitCocone F
    where
  Cocone :=
    { pt := supᵢ F.obj
      ι := { app := fun j => homOfLE (CompleteLattice.le_sup _ _ (Set.mem_range_self _)) } }
  IsColimit :=
    {
      desc := fun s =>
        homOfLE (CompleteLattice.sup_le _ _ (by rintro _ ⟨j, rfl⟩; exact (s.ι.app j).le)) }
#align category_theory.limits.complete_lattice.colimit_cocone CategoryTheory.Limits.CompleteLattice.colimitCocone
-/

#print CategoryTheory.Limits.CompleteLattice.hasLimits_of_completeLattice /-
-- It would be nice to only use the `Inf` half of the complete lattice, but
-- this seems not to have been described separately.
-- see Note [lower instance priority]
instance (priority := 100) hasLimits_of_completeLattice : HasLimits α
    where HasLimitsOfShape J 𝒥 := { HasLimit := fun F => has_limit.mk (limit_cone F) }
#align category_theory.limits.complete_lattice.has_limits_of_complete_lattice CategoryTheory.Limits.CompleteLattice.hasLimits_of_completeLattice
-/

#print CategoryTheory.Limits.CompleteLattice.hasColimits_of_completeLattice /-
-- see Note [lower instance priority]
instance (priority := 100) hasColimits_of_completeLattice : HasColimits α
    where HasColimitsOfShape J 𝒥 := { HasColimit := fun F => has_colimit.mk (colimit_cocone F) }
#align category_theory.limits.complete_lattice.has_colimits_of_complete_lattice CategoryTheory.Limits.CompleteLattice.hasColimits_of_completeLattice
-/

/- warning: category_theory.limits.complete_lattice.limit_eq_infi -> CategoryTheory.Limits.CompleteLattice.limit_eq_infᵢ is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : CompleteLattice.{u1} α] {J : Type.{u1}} [_inst_2 : CategoryTheory.SmallCategory.{u1} J] (F : CategoryTheory.Functor.{u1, u1, u1, u1} J _inst_2 α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (CompleteSemilatticeInf.toPartialOrder.{u1} α (CompleteLattice.toCompleteSemilatticeInf.{u1} α _inst_1))))), Eq.{succ u1} α (CategoryTheory.Limits.limit.{u1, u1, u1, u1} J _inst_2 α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (CompleteSemilatticeInf.toPartialOrder.{u1} α (CompleteLattice.toCompleteSemilatticeInf.{u1} α _inst_1)))) F (CategoryTheory.Limits.hasLimitOfHasLimitsOfShape.{u1, u1, u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (CompleteSemilatticeInf.toPartialOrder.{u1} α (CompleteLattice.toCompleteSemilatticeInf.{u1} α _inst_1)))) J _inst_2 (CategoryTheory.Limits.hasLimitsOfShapeOfHasLimits.{u1, u1, u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (CompleteSemilatticeInf.toPartialOrder.{u1} α (CompleteLattice.toCompleteSemilatticeInf.{u1} α _inst_1)))) J _inst_2 (CategoryTheory.Limits.CompleteLattice.hasLimits_of_completeLattice.{u1} α _inst_1)) F)) (infᵢ.{u1, succ u1} α (CompleteSemilatticeInf.toHasInf.{u1} α (CompleteLattice.toCompleteSemilatticeInf.{u1} α _inst_1)) J (CategoryTheory.Functor.obj.{u1, u1, u1, u1} J _inst_2 α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (CompleteSemilatticeInf.toPartialOrder.{u1} α (CompleteLattice.toCompleteSemilatticeInf.{u1} α _inst_1)))) F))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : CompleteLattice.{u1} α] {J : Type.{u1}} [_inst_2 : CategoryTheory.SmallCategory.{u1} J] (F : CategoryTheory.Functor.{u1, u1, u1, u1} J _inst_2 α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (CompleteSemilatticeInf.toPartialOrder.{u1} α (CompleteLattice.toCompleteSemilatticeInf.{u1} α _inst_1))))), Eq.{succ u1} α (CategoryTheory.Limits.limit.{u1, u1, u1, u1} J _inst_2 α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (CompleteSemilatticeInf.toPartialOrder.{u1} α (CompleteLattice.toCompleteSemilatticeInf.{u1} α _inst_1)))) F (CategoryTheory.Limits.hasLimitOfHasLimitsOfShape.{u1, u1, u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (CompleteSemilatticeInf.toPartialOrder.{u1} α (CompleteLattice.toCompleteSemilatticeInf.{u1} α _inst_1)))) J _inst_2 (CategoryTheory.Limits.hasLimitsOfShapeOfHasLimits.{u1, u1, u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (CompleteSemilatticeInf.toPartialOrder.{u1} α (CompleteLattice.toCompleteSemilatticeInf.{u1} α _inst_1)))) J _inst_2 (CategoryTheory.Limits.CompleteLattice.hasLimits_of_completeLattice.{u1} α _inst_1)) F)) (infᵢ.{u1, succ u1} α (CompleteLattice.toInfSet.{u1} α _inst_1) J (Prefunctor.obj.{succ u1, succ u1, u1, u1} J (CategoryTheory.CategoryStruct.toQuiver.{u1, u1} J (CategoryTheory.Category.toCategoryStruct.{u1, u1} J _inst_2)) α (CategoryTheory.CategoryStruct.toQuiver.{u1, u1} α (CategoryTheory.Category.toCategoryStruct.{u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (CompleteSemilatticeInf.toPartialOrder.{u1} α (CompleteLattice.toCompleteSemilatticeInf.{u1} α _inst_1)))))) (CategoryTheory.Functor.toPrefunctor.{u1, u1, u1, u1} J _inst_2 α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (CompleteSemilatticeInf.toPartialOrder.{u1} α (CompleteLattice.toCompleteSemilatticeInf.{u1} α _inst_1)))) F)))
Case conversion may be inaccurate. Consider using '#align category_theory.limits.complete_lattice.limit_eq_infi CategoryTheory.Limits.CompleteLattice.limit_eq_infᵢₓ'. -/
/-- The limit of a functor into a complete lattice is the infimum of the objects in the image.
-/
theorem limit_eq_infᵢ (F : J ⥤ α) : limit F = infᵢ F.obj :=
  (IsLimit.conePointUniqueUpToIso (limit.isLimit F) (limitCone F).IsLimit).to_eq
#align category_theory.limits.complete_lattice.limit_eq_infi CategoryTheory.Limits.CompleteLattice.limit_eq_infᵢ

/- warning: category_theory.limits.complete_lattice.colimit_eq_supr -> CategoryTheory.Limits.CompleteLattice.colimit_eq_supᵢ is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : CompleteLattice.{u1} α] {J : Type.{u1}} [_inst_2 : CategoryTheory.SmallCategory.{u1} J] (F : CategoryTheory.Functor.{u1, u1, u1, u1} J _inst_2 α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (CompleteSemilatticeInf.toPartialOrder.{u1} α (CompleteLattice.toCompleteSemilatticeInf.{u1} α _inst_1))))), Eq.{succ u1} α (CategoryTheory.Limits.colimit.{u1, u1, u1, u1} J _inst_2 α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (CompleteSemilatticeInf.toPartialOrder.{u1} α (CompleteLattice.toCompleteSemilatticeInf.{u1} α _inst_1)))) F (CategoryTheory.Limits.hasColimitOfHasColimitsOfShape.{u1, u1, u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (CompleteSemilatticeInf.toPartialOrder.{u1} α (CompleteLattice.toCompleteSemilatticeInf.{u1} α _inst_1)))) J _inst_2 (CategoryTheory.Limits.hasColimitsOfShapeOfHasColimitsOfSize.{u1, u1, u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (CompleteSemilatticeInf.toPartialOrder.{u1} α (CompleteLattice.toCompleteSemilatticeInf.{u1} α _inst_1)))) J _inst_2 (CategoryTheory.Limits.CompleteLattice.hasColimits_of_completeLattice.{u1} α _inst_1)) F)) (supᵢ.{u1, succ u1} α (CompleteSemilatticeSup.toHasSup.{u1} α (CompleteLattice.toCompleteSemilatticeSup.{u1} α _inst_1)) J (CategoryTheory.Functor.obj.{u1, u1, u1, u1} J _inst_2 α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (CompleteSemilatticeInf.toPartialOrder.{u1} α (CompleteLattice.toCompleteSemilatticeInf.{u1} α _inst_1)))) F))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : CompleteLattice.{u1} α] {J : Type.{u1}} [_inst_2 : CategoryTheory.SmallCategory.{u1} J] (F : CategoryTheory.Functor.{u1, u1, u1, u1} J _inst_2 α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (CompleteSemilatticeInf.toPartialOrder.{u1} α (CompleteLattice.toCompleteSemilatticeInf.{u1} α _inst_1))))), Eq.{succ u1} α (CategoryTheory.Limits.colimit.{u1, u1, u1, u1} J _inst_2 α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (CompleteSemilatticeInf.toPartialOrder.{u1} α (CompleteLattice.toCompleteSemilatticeInf.{u1} α _inst_1)))) F (CategoryTheory.Limits.hasColimitOfHasColimitsOfShape.{u1, u1, u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (CompleteSemilatticeInf.toPartialOrder.{u1} α (CompleteLattice.toCompleteSemilatticeInf.{u1} α _inst_1)))) J _inst_2 (CategoryTheory.Limits.hasColimitsOfShapeOfHasColimitsOfSize.{u1, u1, u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (CompleteSemilatticeInf.toPartialOrder.{u1} α (CompleteLattice.toCompleteSemilatticeInf.{u1} α _inst_1)))) J _inst_2 (CategoryTheory.Limits.CompleteLattice.hasColimits_of_completeLattice.{u1} α _inst_1)) F)) (supᵢ.{u1, succ u1} α (CompleteLattice.toSupSet.{u1} α _inst_1) J (Prefunctor.obj.{succ u1, succ u1, u1, u1} J (CategoryTheory.CategoryStruct.toQuiver.{u1, u1} J (CategoryTheory.Category.toCategoryStruct.{u1, u1} J _inst_2)) α (CategoryTheory.CategoryStruct.toQuiver.{u1, u1} α (CategoryTheory.Category.toCategoryStruct.{u1, u1} α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (CompleteSemilatticeInf.toPartialOrder.{u1} α (CompleteLattice.toCompleteSemilatticeInf.{u1} α _inst_1)))))) (CategoryTheory.Functor.toPrefunctor.{u1, u1, u1, u1} J _inst_2 α (Preorder.smallCategory.{u1} α (PartialOrder.toPreorder.{u1} α (CompleteSemilatticeInf.toPartialOrder.{u1} α (CompleteLattice.toCompleteSemilatticeInf.{u1} α _inst_1)))) F)))
Case conversion may be inaccurate. Consider using '#align category_theory.limits.complete_lattice.colimit_eq_supr CategoryTheory.Limits.CompleteLattice.colimit_eq_supᵢₓ'. -/
/-- The colimit of a functor into a complete lattice is the supremum of the objects in the image.
-/
theorem colimit_eq_supᵢ (F : J ⥤ α) : colimit F = supᵢ F.obj :=
  (IsColimit.coconePointUniqueUpToIso (colimit.isColimit F) (colimitCocone F).IsColimit).to_eq
#align category_theory.limits.complete_lattice.colimit_eq_supr CategoryTheory.Limits.CompleteLattice.colimit_eq_supᵢ

end CategoryTheory.Limits.CompleteLattice


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

import algebra.algebra.basic
import algebra.order.smul

/-!
# Ordered algebras

An ordered algebra is an ordered semiring, which is an algebra over an ordered commutative semiring,
for which scalar multiplication is "compatible" with the two orders.

The prototypical example is 2x2 matrices over the reals or complexes (or indeed any C^* algebra)
where the ordering the one determined by the positive cone of positive operators,
i.e. `A ≤ B` iff `B - A = star R * R` for some `R`.
(We don't yet have this example in mathlib.)

## Implementation

Because the axioms for an ordered algebra are exactly the same as those for the underlying
module being ordered, we don't actually introduce a new class, but just use the `ordered_smul`
mixin.

## Tags

ordered algebra
-/

section ordered_algebra

variables {R A : Type*} {a b : A} {r : R}

variables [ordered_comm_ring R] [ordered_ring A] [algebra R A] [ordered_smul R A]

lemma algebra_map_monotone : monotone (algebra_map R A) :=
λ a b h,
begin
  rw [algebra.algebra_map_eq_smul_one, algebra.algebra_map_eq_smul_one, ←sub_nonneg, ←sub_smul],
  transitivity (b - a) • (0 : A),
  { simp, },
  { exact smul_le_smul_of_nonneg zero_le_one (sub_nonneg.mpr h) }
end

end ordered_algebra

section instances

variables {R : Type*} [linear_ordered_comm_ring R]

instance linear_ordered_comm_ring.to_ordered_smul : ordered_smul R R :=
{ smul_lt_smul_of_pos       := ordered_semiring.mul_lt_mul_of_pos_left,
  lt_of_smul_lt_smul_of_pos := λ a b c w₁ w₂, (mul_lt_mul_left w₂).mp w₁ }

end instances


/-
Copyright (c) 2020 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.polynomial.erase_lead
import Mathlib.data.polynomial.degree.default
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Reverse of a univariate polynomial

The main definition is `reverse`.  Applying `reverse` to a polynomial `f : polynomial R` produces
the polynomial with a reversed list of coefficients, equivalent to `X^f.nat_degree * f(1/X)`.

The main result is that `reverse (f * g) = reverse (f) * reverse (g)`, provided the leading
coefficients of `f` and `g` do not multiply to zero.
-/

namespace polynomial

/-- If `i ≤ N`, then `rev_at_fun N i` returns `N - i`, otherwise it returns `i`.
This is the map used by the embedding `rev_at`.
-/
def rev_at_fun (N : ℕ) (i : ℕ) : ℕ :=
  ite (i ≤ N) (N - i) i

theorem rev_at_fun_invol {N : ℕ} {i : ℕ} : rev_at_fun N (rev_at_fun N i) = i := sorry

theorem rev_at_fun_inj {N : ℕ} : function.injective (rev_at_fun N) := sorry

/-- If `i ≤ N`, then `rev_at N i` returns `N - i`, otherwise it returns `i`.
Essentially, this embedding is only used for `i ≤ N`.
The advantage of `rev_at N i` over `N - i` is that `rev_at` is an involution.
-/
def rev_at (N : ℕ) : ℕ ↪ ℕ :=
  function.embedding.mk (fun (i : ℕ) => ite (i ≤ N) (N - i) i) rev_at_fun_inj

/-- We prefer to use the bundled `rev_at` over unbundled `rev_at_fun`. -/
@[simp] theorem rev_at_fun_eq (N : ℕ) (i : ℕ) : rev_at_fun N i = coe_fn (rev_at N) i :=
  rfl

@[simp] theorem rev_at_invol {N : ℕ} {i : ℕ} : coe_fn (rev_at N) (coe_fn (rev_at N) i) = i :=
  rev_at_fun_invol

@[simp] theorem rev_at_le {N : ℕ} {i : ℕ} (H : i ≤ N) : coe_fn (rev_at N) i = N - i :=
  if_pos H

theorem rev_at_add {N : ℕ} {O : ℕ} {n : ℕ} {o : ℕ} (hn : n ≤ N) (ho : o ≤ O) : coe_fn (rev_at (N + O)) (n + o) = coe_fn (rev_at N) n + coe_fn (rev_at O) o := sorry

/-- `reflect N f` is the polynomial such that `(reflect N f).coeff i = f.coeff (rev_at N i)`.
In other words, the terms with exponent `[0, ..., N]` now have exponent `[N, ..., 0]`.

In practice, `reflect` is only used when `N` is at least as large as the degree of `f`.

Eventually, it will be used with `N` exactly equal to the degree of `f`.  -/
def reflect {R : Type u_1} [semiring R] (N : ℕ) (f : polynomial R) : polynomial R :=
  finsupp.emb_domain (rev_at N) f

theorem reflect_support {R : Type u_1} [semiring R] (N : ℕ) (f : polynomial R) : finsupp.support (reflect N f) = finset.image (⇑(rev_at N)) (finsupp.support f) := sorry

@[simp] theorem coeff_reflect {R : Type u_1} [semiring R] (N : ℕ) (f : polynomial R) (i : ℕ) : coeff (reflect N f) i = coeff f (coe_fn (rev_at N) i) := sorry

@[simp] theorem reflect_zero {R : Type u_1} [semiring R] {N : ℕ} : reflect N 0 = 0 :=
  rfl

@[simp] theorem reflect_eq_zero_iff {R : Type u_1} [semiring R] {N : ℕ} {f : polynomial R} : reflect N f = 0 ↔ f = 0 := sorry

@[simp] theorem reflect_add {R : Type u_1} [semiring R] (f : polynomial R) (g : polynomial R) (N : ℕ) : reflect N (f + g) = reflect N f + reflect N g := sorry

@[simp] theorem reflect_C_mul {R : Type u_1} [semiring R] (f : polynomial R) (r : R) (N : ℕ) : reflect N (coe_fn C r * f) = coe_fn C r * reflect N f := sorry

@[simp] theorem reflect_C_mul_X_pow {R : Type u_1} [semiring R] (N : ℕ) (n : ℕ) {c : R} : reflect N (coe_fn C c * X ^ n) = coe_fn C c * X ^ coe_fn (rev_at N) n := sorry

@[simp] theorem reflect_monomial {R : Type u_1} [semiring R] (N : ℕ) (n : ℕ) : reflect N (X ^ n) = X ^ coe_fn (rev_at N) n := sorry

theorem reflect_mul_induction {R : Type u_1} [semiring R] (cf : ℕ) (cg : ℕ) (N : ℕ) (O : ℕ) (f : polynomial R) (g : polynomial R) : finset.card (finsupp.support f) ≤ Nat.succ cf →
  finset.card (finsupp.support g) ≤ Nat.succ cg →
    nat_degree f ≤ N → nat_degree g ≤ O → reflect (N + O) (f * g) = reflect N f * reflect O g := sorry

@[simp] theorem reflect_mul {R : Type u_1} [semiring R] (f : polynomial R) (g : polynomial R) {F : ℕ} {G : ℕ} (Ff : nat_degree f ≤ F) (Gg : nat_degree g ≤ G) : reflect (F + G) (f * g) = reflect F f * reflect G g :=
  reflect_mul_induction (finset.card (finsupp.support f)) (finset.card (finsupp.support g)) F G f g
    (nat.le_succ (finset.card (finsupp.support f))) (nat.le_succ (finset.card (finsupp.support g))) Ff Gg

/-- The reverse of a polynomial f is the polynomial obtained by "reading f backwards".
Even though this is not the actual definition, reverse f = f (1/X) * X ^ f.nat_degree. -/
def reverse {R : Type u_1} [semiring R] (f : polynomial R) : polynomial R :=
  reflect (nat_degree f) f

@[simp] theorem reverse_zero {R : Type u_1} [semiring R] : reverse 0 = 0 :=
  rfl

theorem reverse_mul {R : Type u_1} [semiring R] {f : polynomial R} {g : polynomial R} (fg : leading_coeff f * leading_coeff g ≠ 0) : reverse (f * g) = reverse f * reverse g := sorry

@[simp] theorem reverse_mul_of_domain {R : Type u_1} [domain R] (f : polynomial R) (g : polynomial R) : reverse (f * g) = reverse f * reverse g := sorry

@[simp] theorem coeff_zero_reverse {R : Type u_1} [semiring R] (f : polynomial R) : coeff (reverse f) 0 = leading_coeff f := sorry

@[simp] theorem coeff_one_reverse {R : Type u_1} [semiring R] (f : polynomial R) : coeff (reverse f) 1 = next_coeff f := sorry


/-
Copyright (c) 2019 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen
-/
import algebra.regular.basic
import linear_algebra.matrix.mv_polynomial
import linear_algebra.matrix.polynomial
import ring_theory.polynomial.basic

/-!
# Cramer's rule and adjugate matrices

The adjugate matrix is the transpose of the cofactor matrix.
It is calculated with Cramer's rule, which we introduce first.
The vectors returned by Cramer's rule are given by the linear map `cramer`,
which sends a matrix `A` and vector `b` to the vector consisting of the
determinant of replacing the `i`th column of `A` with `b` at index `i`
(written as `(A.update_column i b).det`).
Using Cramer's rule, we can compute for each matrix `A` the matrix `adjugate A`.
The entries of the adjugate are the minors of `A`.
Instead of defining a minor by deleting row `i` and column `j` of `A`, we
replace the `i`th row of `A` with the `j`th basis vector; the resulting matrix
has the same determinant but more importantly equals Cramer's rule applied
to `A` and the `j`th basis vector, simplifying the subsequent proofs.
We prove the adjugate behaves like `det A • A⁻¹`.

## Main definitions

 * `matrix.cramer A b`: the vector output by Cramer's rule on `A` and `b`.
 * `matrix.adjugate A`: the adjugate (or classical adjoint) of the matrix `A`.

## References

  * https://en.wikipedia.org/wiki/Cramer's_rule#Finding_inverse_matrix

## Tags

cramer, cramer's rule, adjugate
-/

namespace matrix
universes u v
variables {n : Type u} [decidable_eq n] [fintype n] {α : Type v} [comm_ring α]
open_locale matrix big_operators polynomial
open equiv equiv.perm finset

section cramer
/-!
  ### `cramer` section

  Introduce the linear map `cramer` with values defined by `cramer_map`.
  After defining `cramer_map` and showing it is linear,
  we will restrict our proofs to using `cramer`.
-/
variables (A : matrix n n α) (b : n → α)

/--
  `cramer_map A b i` is the determinant of the matrix `A` with column `i` replaced with `b`,
  and thus `cramer_map A b` is the vector output by Cramer's rule on `A` and `b`.

  If `A ⬝ x = b` has a unique solution in `x`, `cramer_map A` sends the vector `b` to `A.det • x`.
  Otherwise, the outcome of `cramer_map` is well-defined but not necessarily useful.
-/
def cramer_map (i : n) : α := (A.update_column i b).det

lemma cramer_map_is_linear (i : n) : is_linear_map α (λ b, cramer_map A b i) :=
{ map_add := det_update_column_add _ _,
  map_smul := det_update_column_smul _ _ }

lemma cramer_is_linear : is_linear_map α (cramer_map A) :=
begin
  split; intros; ext i,
  { apply (cramer_map_is_linear A i).1 },
  { apply (cramer_map_is_linear A i).2 }
end

/--
  `cramer A b i` is the determinant of the matrix `A` with column `i` replaced with `b`,
  and thus `cramer A b` is the vector output by Cramer's rule on `A` and `b`.

  If `A ⬝ x = b` has a unique solution in `x`, `cramer A` sends the vector `b` to `A.det • x`.
  Otherwise, the outcome of `cramer` is well-defined but not necessarily useful.
 -/
def cramer (A : matrix n n α) : (n → α) →ₗ[α] (n → α) :=
is_linear_map.mk' (cramer_map A) (cramer_is_linear A)

lemma cramer_apply (i : n) : cramer A b i = (A.update_column i b).det := rfl

lemma cramer_transpose_apply (i : n) : cramer Aᵀ b i = (A.update_row i b).det :=
by rw [cramer_apply, update_column_transpose, det_transpose]

lemma cramer_transpose_row_self (i : n) :
  Aᵀ.cramer (A i) = pi.single i A.det :=
begin
  ext j,
  rw [cramer_apply, pi.single_apply],
  split_ifs with h,
  { -- i = j: this entry should be `A.det`
    subst h,
    simp only [update_column_transpose, det_transpose, update_row, function.update_eq_self] },
  { -- i ≠ j: this entry should be 0
    rw [update_column_transpose, det_transpose],
    apply det_zero_of_row_eq h,
    rw [update_row_self, update_row_ne (ne.symm h)] }
end

lemma cramer_row_self (i : n) (h : ∀ j, b j = A j i) :
  A.cramer b = pi.single i A.det :=
begin
  rw [← transpose_transpose A, det_transpose],
  convert cramer_transpose_row_self Aᵀ i,
  exact funext h
end

@[simp] lemma cramer_one : cramer (1 : matrix n n α) = 1 :=
begin
  ext i j,
  convert congr_fun (cramer_row_self (1 : matrix n n α) (pi.single i 1) i _) j,
  { simp },
  { intros j, rw [matrix.one_eq_pi_single, pi.single_comm] }
end

lemma cramer_smul (r : α) (A : matrix n n α) :
  cramer (r • A) = r ^ (fintype.card n - 1) • cramer A :=
linear_map.ext $ λ b, funext $ λ _, det_update_column_smul' _ _ _ _

@[simp] lemma cramer_subsingleton_apply [subsingleton n] (A : matrix n n α) (b : n → α) (i : n) :
  cramer A b i = b i :=
by rw [cramer_apply, det_eq_elem_of_subsingleton _ i, update_column_self]

lemma cramer_zero [nontrivial n] : cramer (0 : matrix n n α) = 0 :=
begin
  ext i j,
  obtain ⟨j', hj'⟩ : ∃ j', j' ≠ j := exists_ne j,
  apply det_eq_zero_of_column_eq_zero j',
  intro j'',
  simp [update_column_ne hj'],
end

/-- Use linearity of `cramer` to take it out of a summation. -/
lemma sum_cramer {β} (s : finset β) (f : β → n → α) :
  ∑ x in s, cramer A (f x) = cramer A (∑ x in s, f x) :=
(linear_map.map_sum (cramer A)).symm

/-- Use linearity of `cramer` and vector evaluation to take `cramer A _ i` out of a summation. -/
lemma sum_cramer_apply {β} (s : finset β) (f : n → β → α) (i : n) :
∑ x in s, cramer A (λ j, f j x) i = cramer A (λ (j : n), ∑ x in s, f j x) i :=
calc ∑ x in s, cramer A (λ j, f j x) i
    = (∑ x in s, cramer A (λ j, f j x)) i : (finset.sum_apply i s _).symm
... = cramer A (λ (j : n), ∑ x in s, f j x) i :
  by { rw [sum_cramer, cramer_apply], congr' with j, apply finset.sum_apply }

end cramer

section adjugate
/-!
### `adjugate` section

Define the `adjugate` matrix and a few equations.
These will hold for any matrix over a commutative ring.
-/

/-- The adjugate matrix is the transpose of the cofactor matrix.

  Typically, the cofactor matrix is defined by taking minors,
  i.e. the determinant of the matrix with a row and column removed.
  However, the proof of `mul_adjugate` becomes a lot easier if we use the
  matrix replacing a column with a basis vector, since it allows us to use
  facts about the `cramer` map.
-/
def adjugate (A : matrix n n α) : matrix n n α := λ i, cramer Aᵀ (pi.single i 1)

lemma adjugate_def (A : matrix n n α) :
  adjugate A = λ i, cramer Aᵀ (pi.single i 1) := rfl

lemma adjugate_apply (A : matrix n n α) (i j : n) :
  adjugate A i j = (A.update_row j (pi.single i 1)).det :=
by { rw adjugate_def, simp only, rw [cramer_apply, update_column_transpose, det_transpose], }

lemma adjugate_transpose (A : matrix n n α) : (adjugate A)ᵀ = adjugate (Aᵀ) :=
begin
  ext i j,
  rw [transpose_apply, adjugate_apply, adjugate_apply, update_row_transpose, det_transpose],
  rw [det_apply', det_apply'],
  apply finset.sum_congr rfl,
  intros σ _,
  congr' 1,

  by_cases i = σ j,
  { -- Everything except `(i , j)` (= `(σ j , j)`) is given by A, and the rest is a single `1`.
    congr; ext j',
    subst h,
    have : σ j' = σ j ↔ j' = j := σ.injective.eq_iff,
    rw [update_row_apply, update_column_apply],
    simp_rw this,
    rw [←dite_eq_ite, ←dite_eq_ite],
    congr' 1 with rfl,
    rw [pi.single_eq_same, pi.single_eq_same], },
  { -- Otherwise, we need to show that there is a `0` somewhere in the product.
    have : (∏ j' : n, update_column A j (pi.single i 1) (σ j') j') = 0,
    { apply prod_eq_zero (mem_univ j),
      rw [update_column_self, pi.single_eq_of_ne' h], },
    rw this,
    apply prod_eq_zero (mem_univ (σ⁻¹ i)),
    erw [apply_symm_apply σ i, update_row_self],
    apply pi.single_eq_of_ne,
    intro h',
    exact h ((symm_apply_eq σ).mp h') }
end

/-- Since the map `b ↦ cramer A b` is linear in `b`, it must be multiplication by some matrix. This
matrix is `A.adjugate`. -/
lemma cramer_eq_adjugate_mul_vec (A : matrix n n α) (b : n → α) :
  cramer A b = A.adjugate.mul_vec b :=
begin
  nth_rewrite 1 ← A.transpose_transpose,
  rw [← adjugate_transpose, adjugate_def],
  have : b = ∑ i, (b i) • (pi.single i 1),
  { refine (pi_eq_sum_univ b).trans _, congr' with j, simp [pi.single_apply, eq_comm] },
  nth_rewrite 0 this, ext k,
  simp [mul_vec, dot_product, mul_comm],
end

lemma mul_adjugate_apply (A : matrix n n α) (i j k) :
  A i k * adjugate A k j = cramer Aᵀ (pi.single k (A i k)) j :=
begin
  erw [←smul_eq_mul, ←pi.smul_apply, ←linear_map.map_smul, ←pi.single_smul', smul_eq_mul, mul_one],
end

lemma mul_adjugate (A : matrix n n α) : A ⬝ adjugate A = A.det • 1 :=
begin
  ext i j,
  rw [mul_apply, pi.smul_apply, pi.smul_apply, one_apply, smul_eq_mul, mul_boole],
  simp [mul_adjugate_apply, sum_cramer_apply, cramer_transpose_row_self, pi.single_apply, eq_comm]
end

lemma adjugate_mul (A : matrix n n α) : adjugate A ⬝ A = A.det • 1 :=
calc adjugate A ⬝ A = (Aᵀ ⬝ (adjugate Aᵀ))ᵀ :
  by rw [←adjugate_transpose, ←transpose_mul, transpose_transpose]
... = A.det • 1 : by rw [mul_adjugate (Aᵀ), det_transpose, transpose_smul, transpose_one]

lemma adjugate_smul (r : α) (A : matrix n n α) :
  adjugate (r • A) = r ^ (fintype.card n - 1) • adjugate A :=
begin
  rw [adjugate, adjugate, transpose_smul, cramer_smul],
  refl,
end

/-- A stronger form of **Cramer's rule** that allows us to solve some instances of `A ⬝ x = b` even
if the determinant is not a unit. A sufficient (but still not necessary) condition is that `A.det`
divides `b`. -/
@[simp] lemma mul_vec_cramer (A : matrix n n α) (b : n → α) :
  A.mul_vec (cramer A b) = A.det • b :=
by rw [cramer_eq_adjugate_mul_vec, mul_vec_mul_vec, mul_adjugate, smul_mul_vec_assoc, one_mul_vec]

lemma adjugate_subsingleton [subsingleton n] (A : matrix n n α) : adjugate A = 1 :=
begin
  ext i j,
  simp [subsingleton.elim i j, adjugate_apply, det_eq_elem_of_subsingleton _ i]
end

lemma adjugate_eq_one_of_card_eq_one {A : matrix n n α} (h : fintype.card n = 1) : adjugate A = 1 :=
begin
  haveI : subsingleton n := fintype.card_le_one_iff_subsingleton.mp h.le,
  exact adjugate_subsingleton _
end

@[simp] lemma adjugate_zero [nontrivial n] : adjugate (0 : matrix n n α) = 0 :=
begin
  ext i j,
  obtain ⟨j', hj'⟩ : ∃ j', j' ≠ j := exists_ne j,
  apply det_eq_zero_of_column_eq_zero j',
  intro j'',
  simp [update_column_ne hj'],
end

@[simp] lemma adjugate_one : adjugate (1 : matrix n n α) = 1 :=
by { ext, simp [adjugate_def, matrix.one_apply, pi.single_apply, eq_comm] }

@[simp] lemma adjugate_diagonal (v : n → α) :
  adjugate (diagonal v) = diagonal (λ i, ∏ j in finset.univ.erase i, v j) :=
begin
  ext,
  simp only [adjugate_def, cramer_apply, diagonal_transpose],
  obtain rfl | hij := eq_or_ne i j,
  { rw [diagonal_apply_eq, diagonal_update_column_single, det_diagonal,
      prod_update_of_mem (finset.mem_univ _), sdiff_singleton_eq_erase, one_mul] },
  { rw diagonal_apply_ne _ hij,
    refine det_eq_zero_of_row_eq_zero j (λ k, _),
    obtain rfl | hjk := eq_or_ne k j,
    { rw [update_column_self, pi.single_eq_of_ne' hij] },
    { rw [update_column_ne hjk, diagonal_apply_ne' _ hjk]} },
end

lemma _root_.ring_hom.map_adjugate {R S : Type*} [comm_ring R] [comm_ring S] (f : R →+* S)
  (M : matrix n n R) : f.map_matrix M.adjugate = matrix.adjugate (f.map_matrix M) :=
begin
  ext i k,
  have : pi.single i (1 : S) = f ∘ pi.single i 1,
  { rw ←f.map_one,
    exact pi.single_op (λ i, f) (λ i, f.map_zero) i (1 : R) },
  rw [adjugate_apply, ring_hom.map_matrix_apply, map_apply, ring_hom.map_matrix_apply,
      this, ←map_update_row, ←ring_hom.map_matrix_apply, ←ring_hom.map_det, ←adjugate_apply]
end

lemma _root_.alg_hom.map_adjugate {R A B : Type*} [comm_semiring R] [comm_ring A] [comm_ring B]
  [algebra R A] [algebra R B] (f : A →ₐ[R] B)
  (M : matrix n n A) : f.map_matrix M.adjugate = matrix.adjugate (f.map_matrix M) :=
f.to_ring_hom.map_adjugate _

lemma det_adjugate (A : matrix n n α) : (adjugate A).det = A.det ^ (fintype.card n - 1) :=
begin
  -- get rid of the `- 1`
  cases (fintype.card n).eq_zero_or_pos with h_card h_card,
  { haveI : is_empty n := fintype.card_eq_zero_iff.mp h_card,
    rw [h_card, nat.zero_sub, pow_zero, adjugate_subsingleton, det_one] },
  replace h_card := tsub_add_cancel_of_le h_card.nat_succ_le,

  -- express `A` as an evaluation of a polynomial in n^2 variables, and solve in the polynomial ring
  -- where `A'.det` is non-zero.
  let A' := mv_polynomial_X n n ℤ,
  suffices : A'.adjugate.det = A'.det ^ (fintype.card n - 1),
  { rw [←mv_polynomial_X_map_matrix_aeval ℤ A, ←alg_hom.map_adjugate, ←alg_hom.map_det,
      ←alg_hom.map_det, ←alg_hom.map_pow, this] },

  apply mul_left_cancel₀ (show A'.det ≠ 0, from det_mv_polynomial_X_ne_zero n ℤ),
  calc  A'.det * A'.adjugate.det
      = (A' ⬝ adjugate A').det                 : (det_mul _ _).symm
  ... = A'.det ^ fintype.card n                : by rw [mul_adjugate, det_smul, det_one, mul_one]
  ... = A'.det * A'.det ^ (fintype.card n - 1) : by rw [←pow_succ, h_card],
end

@[simp] lemma adjugate_fin_zero (A : matrix (fin 0) (fin 0) α) : adjugate A = 0 :=
subsingleton.elim _ _

@[simp] lemma adjugate_fin_one (A : matrix (fin 1) (fin 1) α) : adjugate A = 1 :=
adjugate_subsingleton A

lemma adjugate_fin_two (A : matrix (fin 2) (fin 2) α) :
  adjugate A = !![A 1 1, -A 0 1; -A 1 0, A 0 0] :=
begin
  ext i j,
  rw [adjugate_apply, det_fin_two],
  fin_cases i; fin_cases j;
  simp only [one_mul, fin.one_eq_zero_iff, pi.single_eq_same, mul_zero, sub_zero,
    pi.single_eq_of_ne, ne.def, not_false_iff, update_row_self, update_row_ne, cons_val_zero,
    of_apply, nat.succ_succ_ne_one, pi.single_eq_of_ne, update_row_self, pi.single_eq_of_ne, ne.def,
    fin.zero_eq_one_iff, nat.succ_succ_ne_one, not_false_iff, update_row_ne, fin.one_eq_zero_iff,
    zero_mul, pi.single_eq_same, one_mul, zero_sub, of_apply, cons_val', cons_val_fin_one,
    cons_val_one, head_fin_const, neg_inj, eq_self_iff_true, cons_val_zero, head_cons, mul_one]
end

@[simp] lemma adjugate_fin_two_of (a b c d : α) :
  adjugate !![a, b; c, d] = !![d, -b; -c, a] :=
adjugate_fin_two _

lemma adjugate_conj_transpose [star_ring α] (A : matrix n n α) : A.adjugateᴴ = adjugate (Aᴴ) :=
begin
  dsimp only [conj_transpose],
  have : Aᵀ.adjugate.map star = adjugate (Aᵀ.map star) := ((star_ring_end α).map_adjugate Aᵀ),
  rw [A.adjugate_transpose, this],
end

lemma is_regular_of_is_left_regular_det {A : matrix n n α} (hA : is_left_regular A.det) :
  is_regular A :=
begin
  split,
  { intros B C h,
    refine hA.matrix _,
    rw [←matrix.one_mul B, ←matrix.one_mul C, ←matrix.smul_mul, ←matrix.smul_mul, ←adjugate_mul,
        matrix.mul_assoc, matrix.mul_assoc, ←mul_eq_mul A, h, mul_eq_mul] },
  { intros B C h,
    simp only [mul_eq_mul] at h,
    refine hA.matrix _,
    rw [←matrix.mul_one B, ←matrix.mul_one C, ←matrix.mul_smul, ←matrix.mul_smul, ←mul_adjugate,
        ←matrix.mul_assoc, ←matrix.mul_assoc, h] }
end

lemma adjugate_mul_distrib_aux (A B : matrix n n α)
  (hA : is_left_regular A.det)
  (hB : is_left_regular B.det) :
  adjugate (A ⬝ B) = adjugate B ⬝ adjugate A :=
begin
  have hAB : is_left_regular (A ⬝ B).det,
  { rw [det_mul],
    exact hA.mul hB },
  refine (is_regular_of_is_left_regular_det hAB).left _,
  rw [mul_eq_mul, mul_adjugate, mul_eq_mul, matrix.mul_assoc, ←matrix.mul_assoc B, mul_adjugate,
      smul_mul, matrix.one_mul, mul_smul, mul_adjugate, smul_smul, mul_comm, ←det_mul]
end

/--
Proof follows from "The trace Cayley-Hamilton theorem" by Darij Grinberg, Section 5.3
-/
lemma adjugate_mul_distrib (A B : matrix n n α) : adjugate (A ⬝ B) = adjugate B ⬝ adjugate A :=
begin
  let g : matrix n n α → matrix n n α[X] :=
    λ M, M.map polynomial.C + (polynomial.X : α[X]) • 1,
  let f' : matrix n n α[X] →+* matrix n n α := (polynomial.eval_ring_hom 0).map_matrix,
  have f'_inv : ∀ M, f' (g M) = M,
  { intro,
    ext,
    simp [f', g], },
  have f'_adj : ∀ (M : matrix n n α), f' (adjugate (g M)) = adjugate M,
  { intro,
    rw [ring_hom.map_adjugate, f'_inv] },
  have f'_g_mul : ∀ (M N : matrix n n α), f' (g M ⬝ g N) = M ⬝ N,
  { intros,
    rw [←mul_eq_mul, ring_hom.map_mul, f'_inv, f'_inv, mul_eq_mul] },
  have hu : ∀ (M : matrix n n α), is_regular (g M).det,
  { intros M,
    refine polynomial.monic.is_regular _,
    simp only [g, polynomial.monic.def, ←polynomial.leading_coeff_det_X_one_add_C M, add_comm] },
  rw [←f'_adj, ←f'_adj, ←f'_adj, ←mul_eq_mul (f' (adjugate (g B))), ←f'.map_mul, mul_eq_mul,
      ←adjugate_mul_distrib_aux _ _ (hu A).left (hu B).left, ring_hom.map_adjugate,
      ring_hom.map_adjugate, f'_inv, f'_g_mul]
end

@[simp] lemma adjugate_pow (A : matrix n n α) (k : ℕ) :
  adjugate (A ^ k) = (adjugate A) ^ k :=
begin
  induction k with k IH,
  { simp },
  { rw [pow_succ', mul_eq_mul, adjugate_mul_distrib, IH, ←mul_eq_mul, pow_succ] }
end

lemma det_smul_adjugate_adjugate (A : matrix n n α) :
  det A • adjugate (adjugate A) = det A ^ (fintype.card n - 1) • A :=
begin
  have : A ⬝ (A.adjugate ⬝ A.adjugate.adjugate) = A ⬝ (A.det ^ (fintype.card n - 1) • 1),
  { rw [←adjugate_mul_distrib, adjugate_mul, adjugate_smul, adjugate_one], },
  rwa [←matrix.mul_assoc, mul_adjugate, matrix.mul_smul, matrix.mul_one, matrix.smul_mul,
    matrix.one_mul] at this,
end

/-- Note that this is not true for `fintype.card n = 1` since `1 - 2 = 0` and not `-1`. -/

  -- express `A` as an evaluation of a polynomial in n^2 variables, and solve in the polynomial ring
  -- where `A'.det` is non-zero.
  let A' := mv_polynomial_X n n ℤ,
  suffices : adjugate (adjugate A') = det A' ^ (fintype.card n - 2) • A',
  { rw [←mv_polynomial_X_map_matrix_aeval ℤ A, ←alg_hom.map_adjugate, ←alg_hom.map_adjugate, this,
      ←alg_hom.map_det, ← alg_hom.map_pow, alg_hom.map_matrix_apply, alg_hom.map_matrix_apply,
      matrix.map_smul' _ _ _ (_root_.map_mul _)] },
  have h_card' : fintype.card n - 2 + 1 = fintype.card n - 1,
  { simp [h_card] },

  have is_reg : is_smul_regular (mv_polynomial (n × n) ℤ) (det A') :=
    λ x y, mul_left_cancel₀ (det_mv_polynomial_X_ne_zero n ℤ),
  apply is_reg.matrix,
  rw [smul_smul, ←pow_succ, h_card', det_smul_adjugate_adjugate],
end

/-- A weaker version of `matrix.adjugate_adjugate` that uses `nontrivial`. -/
lemma adjugate_adjugate' (A : matrix n n α) [nontrivial n] :
  adjugate (adjugate A) = det A ^ (fintype.card n - 2) • A :=
adjugate_adjugate _ $ fintype.one_lt_card.ne'

end adjugate

end matrix


/-
The intersection of algebraic sets is an algebraic set.

Kevin Buzzard
-/

import affine_algebraic_set.basic -- the basic theory of affine algebraic sets.

/-
# The intersection of (any number of) affine algebraic sets is affine.

Let k be a field and let n be a natural number. We prove the following
theorem in this file:

Theorem. If I is an index set, and for each i ∈ I we have an
affine algebraic subset Vᵢ of kⁿ, then the intersection ⋂_{i ∈ I} Vᵢ
is also an affine algebraic subset of kⁿ.

Lean version:

** TODO

Maths proof: if Vᵢ is cut out by the set Sᵢ ⊆ k[X_1,X_2,…,X_n]
and we consider the set S = ⋃_{i ∈ I} Sᵢ then it is straightforward
to check that this works.

## References

Martin Orr's lecture notes at
https://homepages.warwick.ac.uk/staff/Martin.Orr/2017-8/alg-geom/

## Tags

algebraic geometry, algebraic variety
-/

-- end of docstring; code starts here.

-- We're proving theorems about affine algebraic sets so the names of the theorems
-- should start with "affine_algebraic_set".
namespace affine_algebraic_set

-- let k be a field
variables {k : Type*} [discrete_field k]

-- and let σ be a set of indexes for our polynomial variables e.g. σ = {1,2,...,n}
variable {σ : Type*}

-- We're working with multivariable polynomials, so let's get access to their notation
open mv_polynomial

-- this should be proved by general nonsense really.

/-- An arbitrary intersection of affine algebraic subsets of kⁿ
  is an affine algebraic subset of kⁿ -/
def Inter (I : Type*) (V : I → affine_algebraic_set k σ) :
  affine_algebraic_set k σ :=
{ carrier := ⋂ (i : I), (V i : set (σ → k)), -- the underlying set is the union of the two sets defining V and W
  is_algebraic' :=
  -- We now need to prove that the union is cut out by some set of polynomials.
  begin
    use ⋃ (i : I), (classical.some (V i).is_algebraic),
    ext x,
    rw 𝕍_Union,
    congr',
    funext i,
    exact classical.some_spec (V i).is_algebraic,
  end
}

end affine_algebraic_set


/-
Copyright (c) 2022 Jiale Miao. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jiale Miao, Kevin Buzzard, Alexander Bentkamp

! This file was ported from Lean 3 source module analysis.inner_product_space.gram_schmidt_ortho
! leanprover-community/mathlib commit 46b633fd842bef9469441c0209906f6dddd2b4f5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.InnerProductSpace.PiL2
import Mathbin.LinearAlgebra.Matrix.Block

/-!
# Gram-Schmidt Orthogonalization and Orthonormalization

In this file we introduce Gram-Schmidt Orthogonalization and Orthonormalization.

The Gram-Schmidt process takes a set of vectors as input
and outputs a set of orthogonal vectors which have the same span.

## Main results

- `gram_schmidt` : the Gram-Schmidt process
- `gram_schmidt_orthogonal` :
  `gram_schmidt` produces an orthogonal system of vectors.
- `span_gram_schmidt` :
  `gram_schmidt` preserves span of vectors.
- `gram_schmidt_ne_zero` :
  If the input vectors of `gram_schmidt` are linearly independent,
  then the output vectors are non-zero.
- `gram_schmidt_basis` :
  The basis produced by the Gram-Schmidt process when given a basis as input.
- `gram_schmidt_normed` :
  the normalized `gram_schmidt` (i.e each vector in `gram_schmidt_normed` has unit length.)
- `gram_schmidt_orthornormal` :
  `gram_schmidt_normed` produces an orthornormal system of vectors.
- `gram_schmidt_orthonormal_basis`: orthonormal basis constructed by the Gram-Schmidt process from
  an indexed set of vectors of the right size
-/

open BigOperators

open Finset Submodule FiniteDimensional

variable (𝕜 : Type _) {E : Type _} [IsROrC 𝕜] [NormedAddCommGroup E] [InnerProductSpace 𝕜 E]

variable {ι : Type _} [LinearOrder ι] [LocallyFiniteOrderBot ι] [IsWellOrder ι (· < ·)]

attribute [local instance] IsWellOrder.toHasWellFounded

-- mathport name: «expr⟪ , ⟫»
local notation "⟪" x ", " y "⟫" => @inner 𝕜 _ _ x y

/-- The Gram-Schmidt process takes a set of vectors as input
and outputs a set of orthogonal vectors which have the same span. -/
noncomputable def gramSchmidt (f : ι → E) : ι → E
  | n => f n - ∑ i : Iio n, orthogonalProjection (𝕜 ∙ gramSchmidt i) (f n)decreasing_by
  exact mem_Iio.1 i.2
#align gram_schmidt gramSchmidt

/-- This lemma uses `∑ i in` instead of `∑ i :`.-/
theorem gramSchmidt_def (f : ι → E) (n : ι) :
    gramSchmidt 𝕜 f n = f n - ∑ i in Iio n, orthogonalProjection (𝕜 ∙ gramSchmidt 𝕜 f i) (f n) :=
  by
  rw [← sum_attach, attach_eq_univ, gramSchmidt]
  rfl
#align gram_schmidt_def gramSchmidt_def

theorem gramSchmidt_def' (f : ι → E) (n : ι) :
    f n = gramSchmidt 𝕜 f n + ∑ i in Iio n, orthogonalProjection (𝕜 ∙ gramSchmidt 𝕜 f i) (f n) := by
  rw [gramSchmidt_def, sub_add_cancel]
#align gram_schmidt_def' gramSchmidt_def'

theorem gramSchmidt_def'' (f : ι → E) (n : ι) :
    f n =
      gramSchmidt 𝕜 f n +
        ∑ i in Iio n, (⟪gramSchmidt 𝕜 f i, f n⟫ / ‖gramSchmidt 𝕜 f i‖ ^ 2) • gramSchmidt 𝕜 f i :=
  by
  convert gramSchmidt_def' 𝕜 f n
  ext i
  rw [orthogonalProjection_singleton]
#align gram_schmidt_def'' gramSchmidt_def''

@[simp]
theorem gramSchmidt_zero {ι : Type _} [LinearOrder ι] [LocallyFiniteOrder ι] [OrderBot ι]
    [IsWellOrder ι (· < ·)] (f : ι → E) : gramSchmidt 𝕜 f ⊥ = f ⊥ := by
  rw [gramSchmidt_def, Iio_eq_Ico, Finset.Ico_self, Finset.sum_empty, sub_zero]
#align gram_schmidt_zero gramSchmidt_zero

/-- **Gram-Schmidt Orthogonalisation**:
`gram_schmidt` produces an orthogonal system of vectors. -/
theorem gramSchmidt_orthogonal (f : ι → E) {a b : ι} (h₀ : a ≠ b) :
    ⟪gramSchmidt 𝕜 f a, gramSchmidt 𝕜 f b⟫ = 0 :=
  by
  suffices ∀ a b : ι, a < b → ⟪gramSchmidt 𝕜 f a, gramSchmidt 𝕜 f b⟫ = 0
    by
    cases' h₀.lt_or_lt with ha hb
    · exact this _ _ ha
    · rw [inner_eq_zero_symm]
      exact this _ _ hb
  clear h₀ a b
  intro a b h₀
  revert a
  apply WellFounded.induction (@IsWellFounded.wf ι (· < ·) _) b
  intro b ih a h₀
  simp only [gramSchmidt_def 𝕜 f b, inner_sub_right, inner_sum, orthogonalProjection_singleton,
    inner_smul_right]
  rw [Finset.sum_eq_single_of_mem a (finset.mem_Iio.mpr h₀)]
  · by_cases h : gramSchmidt 𝕜 f a = 0
    · simp only [h, inner_zero_left, zero_div, MulZeroClass.zero_mul, sub_zero]
    · rw [← inner_self_eq_norm_sq_to_K, div_mul_cancel, sub_self]
      rwa [inner_self_ne_zero]
  simp_intro i hi hia only [Finset.mem_range]
  simp only [mul_eq_zero, div_eq_zero_iff, inner_self_eq_zero]
  right
  cases' hia.lt_or_lt with hia₁ hia₂
  · rw [inner_eq_zero_symm]
    exact ih a h₀ i hia₁
  · exact ih i (mem_Iio.1 hi) a hia₂
#align gram_schmidt_orthogonal gramSchmidt_orthogonal

/-- This is another version of `gram_schmidt_orthogonal` using `pairwise` instead. -/
theorem gramSchmidt_pairwise_orthogonal (f : ι → E) :
    Pairwise fun a b => ⟪gramSchmidt 𝕜 f a, gramSchmidt 𝕜 f b⟫ = 0 := fun a b =>
  gramSchmidt_orthogonal 𝕜 f
#align gram_schmidt_pairwise_orthogonal gramSchmidt_pairwise_orthogonal

theorem gramSchmidt_inv_triangular (v : ι → E) {i j : ι} (hij : i < j) :
    ⟪gramSchmidt 𝕜 v j, v i⟫ = 0 := by
  rw [gramSchmidt_def'' 𝕜 v]
  simp only [inner_add_right, inner_sum, inner_smul_right]
  set b : ι → E := gramSchmidt 𝕜 v
  convert zero_add (0 : 𝕜)
  · exact gramSchmidt_orthogonal 𝕜 v hij.ne'
  apply Finset.sum_eq_zero
  rintro k hki'
  have hki : k < i := by simpa using hki'
  have : ⟪b j, b k⟫ = 0 := gramSchmidt_orthogonal 𝕜 v (hki.trans hij).ne'
  simp [this]
#align gram_schmidt_inv_triangular gramSchmidt_inv_triangular

open Submodule Set Order

theorem mem_span_gramSchmidt (f : ι → E) {i j : ι} (hij : i ≤ j) :
    f i ∈ span 𝕜 (gramSchmidt 𝕜 f '' Iic j) :=
  by
  rw [gramSchmidt_def' 𝕜 f i]
  simp_rw [orthogonalProjection_singleton]
  exact
    Submodule.add_mem _ (subset_span <| mem_image_of_mem _ hij)
      (Submodule.sum_mem _ fun k hk =>
        smul_mem (span 𝕜 (gramSchmidt 𝕜 f '' Iic j)) _ <|
          subset_span <| mem_image_of_mem (gramSchmidt 𝕜 f) <| (Finset.mem_Iio.1 hk).le.trans hij)
#align mem_span_gram_schmidt mem_span_gramSchmidt

theorem gramSchmidt_mem_span (f : ι → E) : ∀ {j i}, i ≤ j → gramSchmidt 𝕜 f i ∈ span 𝕜 (f '' Iic j)
  | j => fun i hij => by
    rw [gramSchmidt_def 𝕜 f i]
    simp_rw [orthogonalProjection_singleton]
    refine'
      Submodule.sub_mem _ (subset_span (mem_image_of_mem _ hij)) (Submodule.sum_mem _ fun k hk => _)
    let hkj : k < j := (Finset.mem_Iio.1 hk).trans_le hij
    exact
      smul_mem _ _
        (span_mono (image_subset f <| Iic_subset_Iic.2 hkj.le) <| gramSchmidt_mem_span le_rfl)
#align gram_schmidt_mem_span gramSchmidt_mem_span

theorem span_gramSchmidt_Iic (f : ι → E) (c : ι) :
    span 𝕜 (gramSchmidt 𝕜 f '' Iic c) = span 𝕜 (f '' Iic c) :=
  span_eq_span (Set.image_subset_iff.2 fun i => gramSchmidt_mem_span _ _) <|
    Set.image_subset_iff.2 fun i => mem_span_gramSchmidt _ _
#align span_gram_schmidt_Iic span_gramSchmidt_Iic

theorem span_gramSchmidt_Iio (f : ι → E) (c : ι) :
    span 𝕜 (gramSchmidt 𝕜 f '' Iio c) = span 𝕜 (f '' Iio c) :=
  span_eq_span
      (Set.image_subset_iff.2 fun i hi =>
        span_mono (image_subset _ <| Iic_subset_Iio.2 hi) <| gramSchmidt_mem_span _ _ le_rfl) <|
    Set.image_subset_iff.2 fun i hi =>
      span_mono (image_subset _ <| Iic_subset_Iio.2 hi) <| mem_span_gramSchmidt _ _ le_rfl
#align span_gram_schmidt_Iio span_gramSchmidt_Iio

/-- `gram_schmidt` preserves span of vectors. -/
theorem span_gramSchmidt (f : ι → E) : span 𝕜 (range (gramSchmidt 𝕜 f)) = span 𝕜 (range f) :=
  span_eq_span
      (range_subset_iff.2 fun i =>
        span_mono (image_subset_range _ _) <| gramSchmidt_mem_span _ _ le_rfl) <|
    range_subset_iff.2 fun i =>
      span_mono (image_subset_range _ _) <| mem_span_gramSchmidt _ _ le_rfl
#align span_gram_schmidt span_gramSchmidt

theorem gramSchmidt_of_orthogonal {f : ι → E} (hf : Pairwise fun i j => ⟪f i, f j⟫ = 0) :
    gramSchmidt 𝕜 f = f := by
  ext i
  rw [gramSchmidt_def]
  trans f i - 0
  · congr
    apply Finset.sum_eq_zero
    intro j hj
    rw [coe_eq_zero]
    suffices span 𝕜 (f '' Set.Iic j) ≤ (𝕜 ∙ f i)ᗮ
      by
      apply orthogonalProjection_mem_subspace_orthogonal_complement_eq_zero
      rw [mem_orthogonal_singleton_iff_inner_left]
      rw [← mem_orthogonal_singleton_iff_inner_right]
      exact this (gramSchmidt_mem_span 𝕜 f (le_refl j))
    rw [span_le]
    rintro - ⟨k, hk, rfl⟩
    rw [SetLike.mem_coe, mem_orthogonal_singleton_iff_inner_left]
    apply hf
    refine' (lt_of_le_of_lt hk _).Ne
    simpa using hj
  · simp
#align gram_schmidt_of_orthogonal gramSchmidt_of_orthogonal

variable {𝕜}

theorem gramSchmidt_ne_zero_coe {f : ι → E} (n : ι)
    (h₀ : LinearIndependent 𝕜 (f ∘ (coe : Set.Iic n → ι))) : gramSchmidt 𝕜 f n ≠ 0 :=
  by
  by_contra h
  have h₁ : f n ∈ span 𝕜 (f '' Iio n) :=
    by
    rw [← span_gramSchmidt_Iio 𝕜 f n, gramSchmidt_def' _ f, h, zero_add]
    apply Submodule.sum_mem _ _
    simp_intro a ha only [Finset.mem_Ico]
    simp only [Set.mem_image, Set.mem_Iio, orthogonalProjection_singleton]
    apply Submodule.smul_mem _ _ _
    rw [Finset.mem_Iio] at ha
    refine' subset_span ⟨a, ha, by rfl⟩
  have h₂ :
    (f ∘ (coe : Set.Iic n → ι)) ⟨n, le_refl n⟩ ∈
      span 𝕜 (f ∘ (coe : Set.Iic n → ι) '' Iio ⟨n, le_refl n⟩) :=
    by
    rw [image_comp]
    convert h₁ using 3
    ext i
    simpa using @le_of_lt _ _ i n
  apply LinearIndependent.not_mem_span_image h₀ _ h₂
  simp only [Set.mem_Iio, lt_self_iff_false, not_false_iff]
#align gram_schmidt_ne_zero_coe gramSchmidt_ne_zero_coe

/-- If the input vectors of `gram_schmidt` are linearly independent,
then the output vectors are non-zero. -/
theorem gramSchmidt_ne_zero {f : ι → E} (n : ι) (h₀ : LinearIndependent 𝕜 f) :
    gramSchmidt 𝕜 f n ≠ 0 :=
  gramSchmidt_ne_zero_coe _ (LinearIndependent.comp h₀ _ Subtype.coe_injective)
#align gram_schmidt_ne_zero gramSchmidt_ne_zero

/-- `gram_schmidt` produces a triangular matrix of vectors when given a basis. -/
theorem gramSchmidt_triangular {i j : ι} (hij : i < j) (b : Basis ι 𝕜 E) :
    b.repr (gramSchmidt 𝕜 b i) j = 0 :=
  by
  have : gramSchmidt 𝕜 b i ∈ span 𝕜 (gramSchmidt 𝕜 b '' Set.Iio j) :=
    subset_span ((Set.mem_image _ _ _).2 ⟨i, hij, rfl⟩)
  have : gramSchmidt 𝕜 b i ∈ span 𝕜 (b '' Set.Iio j) := by rwa [← span_gramSchmidt_Iio 𝕜 b j]
  have : ↑(b.repr (gramSchmidt 𝕜 b i)).support ⊆ Set.Iio j :=
    Basis.repr_support_subset_of_mem_span b (Set.Iio j) this
  exact (Finsupp.mem_supported' _ _).1 ((Finsupp.mem_supported 𝕜 _).2 this) j Set.not_mem_Iio_self
#align gram_schmidt_triangular gramSchmidt_triangular

/-- `gram_schmidt` produces linearly independent vectors when given linearly independent vectors. -/
theorem gramSchmidt_linearIndependent {f : ι → E} (h₀ : LinearIndependent 𝕜 f) :
    LinearIndependent 𝕜 (gramSchmidt 𝕜 f) :=
  linearIndependent_of_ne_zero_of_inner_eq_zero (fun i => gramSchmidt_ne_zero _ h₀) fun i j =>
    gramSchmidt_orthogonal 𝕜 f
#align gram_schmidt_linear_independent gramSchmidt_linearIndependent

/-- When given a basis, `gram_schmidt` produces a basis. -/
noncomputable def gramSchmidtBasis (b : Basis ι 𝕜 E) : Basis ι 𝕜 E :=
  Basis.mk (gramSchmidt_linearIndependent b.LinearIndependent)
    ((span_gramSchmidt 𝕜 b).trans b.span_eq).ge
#align gram_schmidt_basis gramSchmidtBasis

theorem coe_gramSchmidtBasis (b : Basis ι 𝕜 E) : (gramSchmidtBasis b : ι → E) = gramSchmidt 𝕜 b :=
  Basis.coe_mk _ _
#align coe_gram_schmidt_basis coe_gramSchmidtBasis

variable (𝕜)

/-- the normalized `gram_schmidt`
(i.e each vector in `gram_schmidt_normed` has unit length.) -/
noncomputable def gramSchmidtNormed (f : ι → E) (n : ι) : E :=
  (‖gramSchmidt 𝕜 f n‖ : 𝕜)⁻¹ • gramSchmidt 𝕜 f n
#align gram_schmidt_normed gramSchmidtNormed

variable {𝕜}

theorem gramSchmidtNormed_unit_length_coe {f : ι → E} (n : ι)
    (h₀ : LinearIndependent 𝕜 (f ∘ (coe : Set.Iic n → ι))) : ‖gramSchmidtNormed 𝕜 f n‖ = 1 := by
  simp only [gramSchmidt_ne_zero_coe n h₀, gramSchmidtNormed, norm_smul_inv_norm, Ne.def,
    not_false_iff]
#align gram_schmidt_normed_unit_length_coe gramSchmidtNormed_unit_length_coe

theorem gramSchmidtNormed_unit_length {f : ι → E} (n : ι) (h₀ : LinearIndependent 𝕜 f) :
    ‖gramSchmidtNormed 𝕜 f n‖ = 1 :=
  gramSchmidtNormed_unit_length_coe _ (LinearIndependent.comp h₀ _ Subtype.coe_injective)
#align gram_schmidt_normed_unit_length gramSchmidtNormed_unit_length

theorem gramSchmidtNormed_unit_length' {f : ι → E} {n : ι} (hn : gramSchmidtNormed 𝕜 f n ≠ 0) :
    ‖gramSchmidtNormed 𝕜 f n‖ = 1 :=
  by
  rw [gramSchmidtNormed] at *
  rw [norm_smul_inv_norm]
  simpa using hn
#align gram_schmidt_normed_unit_length' gramSchmidtNormed_unit_length'

/-- **Gram-Schmidt Orthonormalization**:
`gram_schmidt_normed` applied to a linearly independent set of vectors produces an orthornormal
system of vectors. -/
theorem gram_schmidt_orthonormal {f : ι → E} (h₀ : LinearIndependent 𝕜 f) :
    Orthonormal 𝕜 (gramSchmidtNormed 𝕜 f) :=
  by
  unfold Orthonormal
  constructor
  · simp only [gramSchmidtNormed_unit_length, h₀, eq_self_iff_true, imp_true_iff]
  · intro i j hij
    simp only [gramSchmidtNormed, inner_smul_left, inner_smul_right, IsROrC.conj_inv,
      IsROrC.conj_of_real, mul_eq_zero, inv_eq_zero, IsROrC.of_real_eq_zero, norm_eq_zero]
    repeat' right
    exact gramSchmidt_orthogonal 𝕜 f hij
#align gram_schmidt_orthonormal gram_schmidt_orthonormal

/-- **Gram-Schmidt Orthonormalization**:
`gram_schmidt_normed` produces an orthornormal system of vectors after removing the vectors which
become zero in the process. -/
theorem gram_schmidt_orthonormal' (f : ι → E) :
    Orthonormal 𝕜 fun i : { i | gramSchmidtNormed 𝕜 f i ≠ 0 } => gramSchmidtNormed 𝕜 f i :=
  by
  refine' ⟨fun i => gramSchmidtNormed_unit_length' i.Prop, _⟩
  rintro i j (hij : ¬_)
  rw [Subtype.ext_iff] at hij
  simp [gramSchmidtNormed, inner_smul_left, inner_smul_right, gramSchmidt_orthogonal 𝕜 f hij]
#align gram_schmidt_orthonormal' gram_schmidt_orthonormal'

theorem span_gramSchmidtNormed (f : ι → E) (s : Set ι) :
    span 𝕜 (gramSchmidtNormed 𝕜 f '' s) = span 𝕜 (gramSchmidt 𝕜 f '' s) :=
  by
  refine'
    span_eq_span
      (Set.image_subset_iff.2 fun i hi => smul_mem _ _ <| subset_span <| mem_image_of_mem _ hi)
      (Set.image_subset_iff.2 fun i hi =>
        span_mono (image_subset _ <| singleton_subset_set_iff.2 hi) _)
  simp only [coe_singleton, Set.image_singleton]
  by_cases h : gramSchmidt 𝕜 f i = 0
  · simp [h]
  · refine' mem_span_singleton.2 ⟨‖gramSchmidt 𝕜 f i‖, smul_inv_smul₀ _ _⟩
    exact_mod_cast norm_ne_zero_iff.2 h
#align span_gram_schmidt_normed span_gramSchmidtNormed

theorem span_gramSchmidtNormed_range (f : ι → E) :
    span 𝕜 (range (gramSchmidtNormed 𝕜 f)) = span 𝕜 (range (gramSchmidt 𝕜 f)) := by
  simpa only [image_univ.symm] using span_gramSchmidtNormed f univ
#align span_gram_schmidt_normed_range span_gramSchmidtNormed_range

section OrthonormalBasis

variable [Fintype ι] [FiniteDimensional 𝕜 E] (h : finrank 𝕜 E = Fintype.card ι) (f : ι → E)

include h

/-- Given an indexed family `f : ι → E` of vectors in an inner product space `E`, for which the
size of the index set is the dimension of `E`, produce an orthonormal basis for `E` which agrees
with the orthonormal set produced by the Gram-Schmidt orthonormalization process on the elements of
`ι` for which this process gives a nonzero number. -/
noncomputable def gramSchmidtOrthonormalBasis : OrthonormalBasis ι 𝕜 E :=
  ((gram_schmidt_orthonormal' f).exists_orthonormalBasis_extension_of_card_eq h).some
#align gram_schmidt_orthonormal_basis gramSchmidtOrthonormalBasis

theorem gramSchmidtOrthonormalBasis_apply {f : ι → E} {i : ι} (hi : gramSchmidtNormed 𝕜 f i ≠ 0) :
    gramSchmidtOrthonormalBasis h f i = gramSchmidtNormed 𝕜 f i :=
  ((gram_schmidt_orthonormal' f).exists_orthonormalBasis_extension_of_card_eq h).choose_spec i hi
#align gram_schmidt_orthonormal_basis_apply gramSchmidtOrthonormalBasis_apply

theorem gramSchmidtOrthonormalBasis_apply_of_orthogonal {f : ι → E}
    (hf : Pairwise fun i j => ⟪f i, f j⟫ = 0) {i : ι} (hi : f i ≠ 0) :
    gramSchmidtOrthonormalBasis h f i = (‖f i‖⁻¹ : 𝕜) • f i :=
  by
  have H : gramSchmidtNormed 𝕜 f i = (‖f i‖⁻¹ : 𝕜) • f i := by
    rw [gramSchmidtNormed, gramSchmidt_of_orthogonal 𝕜 hf]
  rw [gramSchmidtOrthonormalBasis_apply h, H]
  simpa [H] using hi
#align gram_schmidt_orthonormal_basis_apply_of_orthogonal gramSchmidtOrthonormalBasis_apply_of_orthogonal

theorem inner_gramSchmidtOrthonormalBasis_eq_zero {f : ι → E} {i : ι}
    (hi : gramSchmidtNormed 𝕜 f i = 0) (j : ι) : ⟪gramSchmidtOrthonormalBasis h f i, f j⟫ = 0 :=
  by
  rw [← mem_orthogonal_singleton_iff_inner_right]
  suffices span 𝕜 (gramSchmidtNormed 𝕜 f '' Iic j) ≤ (𝕜 ∙ gramSchmidtOrthonormalBasis h f i)ᗮ
    by
    apply this
    rw [span_gramSchmidtNormed]
    simpa using mem_span_gramSchmidt 𝕜 f (le_refl j)
  rw [span_le]
  rintro - ⟨k, -, rfl⟩
  rw [SetLike.mem_coe, mem_orthogonal_singleton_iff_inner_left]
  by_cases hk : gramSchmidtNormed 𝕜 f k = 0
  · simp [hk]
  rw [← gramSchmidtOrthonormalBasis_apply h hk]
  have : k ≠ i := by
    rintro rfl
    exact hk hi
  exact (gramSchmidtOrthonormalBasis h f).Orthonormal.2 this
#align inner_gram_schmidt_orthonormal_basis_eq_zero inner_gramSchmidtOrthonormalBasis_eq_zero

theorem gramSchmidtOrthonormalBasis_inv_triangular {i j : ι} (hij : i < j) :
    ⟪gramSchmidtOrthonormalBasis h f j, f i⟫ = 0 :=
  by
  by_cases hi : gramSchmidtNormed 𝕜 f j = 0
  · rw [inner_gramSchmidtOrthonormalBasis_eq_zero h hi]
  ·
    simp [gramSchmidtOrthonormalBasis_apply h hi, gramSchmidtNormed, inner_smul_left,
      gramSchmidt_inv_triangular 𝕜 f hij]
#align gram_schmidt_orthonormal_basis_inv_triangular gramSchmidtOrthonormalBasis_inv_triangular

theorem gramSchmidtOrthonormalBasis_inv_triangular' {i j : ι} (hij : i < j) :
    (gramSchmidtOrthonormalBasis h f).repr (f i) j = 0 := by
  simpa [OrthonormalBasis.repr_apply_apply] using gramSchmidtOrthonormalBasis_inv_triangular h f hij
#align gram_schmidt_orthonormal_basis_inv_triangular' gramSchmidtOrthonormalBasis_inv_triangular'

/-- Given an indexed family `f : ι → E` of vectors in an inner product space `E`, for which the
size of the index set is the dimension of `E`, the matrix of coefficients of `f` with respect to the
orthonormal basis `gram_schmidt_orthonormal_basis` constructed from `f` is upper-triangular. -/
theorem gramSchmidtOrthonormalBasis_inv_blockTriangular :
    ((gramSchmidtOrthonormalBasis h f).toBasis.toMatrix f).BlockTriangular id := fun i j =>
  gramSchmidtOrthonormalBasis_inv_triangular' h f
#align gram_schmidt_orthonormal_basis_inv_block_triangular gramSchmidtOrthonormalBasis_inv_blockTriangular

theorem gramSchmidtOrthonormalBasis_det :
    (gramSchmidtOrthonormalBasis h f).toBasis.det f =
      ∏ i, ⟪gramSchmidtOrthonormalBasis h f i, f i⟫ :=
  by
  convert Matrix.det_of_upper_triangular (gramSchmidtOrthonormalBasis_inv_blockTriangular h f)
  ext i
  exact ((gramSchmidtOrthonormalBasis h f).repr_apply_apply (f i) i).symm
#align gram_schmidt_orthonormal_basis_det gramSchmidtOrthonormalBasis_det

end OrthonormalBasis


import solutions.world1_addition -- addition lemmas

import mynat.mul
/- Here's what you get from the import:

1) The following data:
  * a function called mynat.mul, and notation a * b for this function

2) The following axioms:

  * `mul_zero : ∀ a : mynat, a * 0 = 0`
  * `mul_succ : ∀ a b : mynat, a * succ(b) = a * b + a`

These axiom between them tell you how to work out a * x for every x; use induction on x to
reduce to the case either `x = 0` or `x = succ b`, and then use `mul_zero` or `mul_succ` appropriately.
-/

namespace mynat

--MULTIPLICATION WORLD

--Level 1 :
lemma zero_mul (m : mynat) : 0 * m = 0 :=
begin [nat_num_game]
  -- On fait une induction sur m :
  induction m with d hd,

  -- Le cas de base :
  rw mul_zero,
  refl,

  -- Le cas d'induction :
  rw mul_succ,
  rw add_zero,
  rw hd,
  refl,
end

--Level 2 :
lemma mul_one (m : mynat) : m * 1 = m :=
begin [nat_num_game]
  -- On fait une induction sur m :
  induction m with d hd,

  -- Le cas de base :
  rw zero_mul,
  refl,

  -- Le cas d'induction :
  rw one_eq_succ_zero,
  rw mul_succ,
  rw mul_zero,
  rw zero_add,
  refl,
end

--Level 3 :
lemma one_mul (m : mynat) : 1 * m = m :=
begin [nat_num_game]
  -- On fait une induction sur m :
  induction m with d hd,

  -- Le cas de base :
  rw mul_zero,
  refl,

  -- Le cas d'induction :
  rw mul_succ,
  rw hd,
  rw succ_eq_add_one,
  refl,
end

-- mul_assoc immediately, leads to this:
-- ⊢ a * (b * d) + a * b = a * (b * d + b)

-- so let's prove mul_add first.

--Level 4 :
lemma mul_add (a b c : mynat) : a * (b + c) = a * b + a * c :=
begin [nat_num_game]
  -- On fait une induction sur b :
  induction c with d hd,

  -- Le cas de base :
  refl,

  -- Le cas d'induction :
  rw mul_succ,
  rw ← add_assoc,
  rw ← hd,
  rw add_succ,
  rw mul_succ,
  refl,
end

-- just ignore this
def left_distrib := mul_add -- stupid field name,
-- I just don't instinctively know what left_distrib means

--Level 5 :
lemma mul_assoc (a b c : mynat) : (a * b) * c = a * (b * c) :=
begin [nat_num_game]
  -- On fait une induction sur c :
  induction c with d hd,

  -- Le cas de base :
  repeat {rw mul_zero},

  -- Le cas d'induction :
  repeat {rw mul_succ},
  rw mul_add,
  rw hd,
  refl,
end

-- goal : mul_comm.
-- mul_comm leads to ⊢ a * d + a = succ d * a
-- so perhaps we need add_mul
-- but add_mul leads to either a+b+c=a+c+b or (a+b)+(c+d)=(a+c)+(b+d)
-- (depending on whether we do induction on b or c)

-- I need this for mul_comm
--Level 6 :
lemma succ_mul (a b : mynat) : succ a * b = a * b + b :=
begin [nat_num_game]
-- Attention, ne pas oublier de taper 'espace' après les '\l' !!!
  -- On fait une induction sur b :
  induction b with d hd,

  -- Le cas de base :
  refl,

  -- Le cas d'induction :
  rw succ_eq_add_one d,
  rw mul_add,
  rw hd,
  rw succ_eq_add_one,
  rw mul_add,
  repeat {rw mul_one},
  repeat {rw ← add_assoc},
  rw add_assoc,
  rw add_assoc  (a * d) (d) (a + 1),
  rw add_comm d _,
  rw add_right_comm,
  rw ← add_assoc (a*d) (a+d) 1,
  rw ← add_assoc (a*d) a d,
  refl,
end

--Level 7 :
lemma add_mul (a b c : mynat) : (a + b) * c = a * c + b * c :=
begin [nat_num_game]
  -- On fait une induction sur t :
  induction c with d hd,

  -- Le cas de base :
  refl,

  -- Le cas d'induction :
  repeat {rw mul_succ},
  rw hd,
  rw ← add_assoc,
  rw ← add_assoc (a*d +a) _ _,
  rw add_assoc (a*d) a _,
  rw add_comm a (b*d),
  rw ← add_assoc,
  refl,
end

-- ignore this
def right_distrib := add_mul -- stupid field name,

--Level 8 :
lemma mul_comm (a b : mynat) : a * b = b * a :=
begin [nat_num_game]
  -- On fait une induction sur b :
  induction b with d hd,

  -- Le cas de base :
  rw zero_mul,
  rw mul_zero,
  refl,

  -- Le cas d'induction :
  rw mul_succ,
  rw succ_mul,
  rw hd,
  refl,
end

--Level 9 :
lemma mul_left_comm (a b c : mynat) : a * (b * c) = b * (a * c) :=
begin [nat_num_game]
  -- On met tout dans le bon ordre
  rw ← mul_assoc,
  rw mul_comm a b,
  rw mul_assoc,
  refl,
end

--ADVANCED MULTIPLICATION WORLD

--Level 1 :
theorem mul_pos (a b : mynat) : a ≠ 0 → b ≠ 0 → a * b ≠ 0 :=
begin [nat_num_game]
  intros ha hb hab,
  apply ha,

  --On divise le goal en 2 cas :
  cases b with n,

  --Le cas 'b = 0' :
  exfalso,
  apply hb,
  refl,

  --Le cas 'b = succ n' :
  rw mul_succ at hab,
  rw add_left_eq_zero hab,
  refl,
end

--Level 2 :
theorem eq_zero_or_eq_zero_of_mul_eq_zero ⦃a b : mynat⦄ (h : a * b = 0) : a = 0 ∨ b = 0 :=
begin [nat_num_game]
  --On fait une distintion de cas sur b :
  cases b with n,

  --Cas 'b = 0' :
  right,
  refl,

  --Cas 'b = succ n' :
  rw mul_succ at h,   --Pas strictement nécessaire car les notations sont égales par définition.
  left,
  apply add_left_eq_zero h,
end

--Level 3 :
theorem mul_eq_zero_iff : ∀ (a b : mynat), a * b = 0 ↔ a = 0 ∨ b = 0 :=
begin [nat_num_game]
  intros a b,
  --On divise le goal en 2 implications :
  split,

  --Sens →
  intro h,
  exact eq_zero_or_eq_zero_of_mul_eq_zero h,

  --Sens ←
  intro h,
  cases h with g h,
  rw g,
  rw zero_mul,
  refl,
  rw h,
  rw mul_zero,
  refl,
end

instance : comm_semiring mynat := by structure_helper

--Level 4 :
theorem mul_left_cancel ⦃a b c : mynat⦄ (ha : a ≠ 0) : a * b = a * c → b = c :=
begin [nat_num_game]
-- Attention, ne pas oublier de taper 'espace' après les '\or' et '\ne'!!!
  revert b,
  -- On fait une induction sur c :
  induction c with n hn,

  --Le cas de base :
  rw mul_zero,
  intros b h,
  rw mul_eq_zero_iff a b at h,
  --On casse le ∨ :
  cases h with hha hhb,
  --Si 'a = 0' :
  exfalso,
  apply ha,
  exact hha,
  --Si 'b = 0' :
  exact hhb,

  --Le cas d'induction :
  intros b h,
  --On fait une distinction de cas sur b :
  cases b with c,

  --Cas 'b = 0' :
  rw mul_zero at h,
  exfalso,
  apply mul_pos a (succ n), --On a besoin de démontrer les hypothèses de mul_pos :
  --Hypothèse 'a ≠ 0' :
  exact ha,
  --Hypothèse 'succ n ≠ 0' :
  intro hnn,
  exact succ_ne_zero hnn,
  --Retour à la preuve par l'absurde :
  symmetry,
  exact h,

  --Cas 'b = succ c' :
  repeat {rw succ_eq_add_one},
  rw add_right_cancel_iff,
  apply hn,
  repeat {rw mul_succ at h},
  rw add_right_cancel_iff at h,
  exact h,
end

end mynat


def fib : Nat → Nat
| 0   => 1
| 1   => 1
| n+2 => fib n + fib (n+1)

example : fib 0 = 1 := rfl
example : fib 1 = 1 := rfl
example (n : Nat) : fib (n+2) = fib n + fib (n+1) := rfl