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

! This file was ported from Lean 3 source module category_theory.limits.constructions.equalizers
! 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.CategoryTheory.Limits.Shapes.Equalizers
import Mathbin.CategoryTheory.Limits.Shapes.BinaryProducts
import Mathbin.CategoryTheory.Limits.Shapes.Pullbacks
import Mathbin.CategoryTheory.Limits.Preserves.Shapes.Pullbacks
import Mathbin.CategoryTheory.Limits.Preserves.Shapes.BinaryProducts

/-!
# Constructing equalizers from pullbacks and binary products.

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

If a category has pullbacks and binary products, then it has equalizers.

TODO: generalize universe
-/

noncomputable section

universe v v' u u'

open CategoryTheory CategoryTheory.Category

namespace CategoryTheory.Limits

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

variable {D : Type u'} [Category.{v'} D] (G : C ⥤ D)

-- We hide the "implementation details" inside a namespace
namespace HasEqualizersOfHasPullbacksAndBinaryProducts

variable [HasBinaryProducts C] [HasPullbacks C]

#print CategoryTheory.Limits.HasEqualizersOfHasPullbacksAndBinaryProducts.constructEqualizer /-
/-- Define the equalizing object -/
@[reducible]
def constructEqualizer (F : WalkingParallelPair ⥤ C) : C :=
  pullback (prod.lift (𝟙 _) (F.map WalkingParallelPairHom.left))
    (prod.lift (𝟙 _) (F.map WalkingParallelPairHom.right))
#align category_theory.limits.has_equalizers_of_has_pullbacks_and_binary_products.construct_equalizer CategoryTheory.Limits.HasEqualizersOfHasPullbacksAndBinaryProducts.constructEqualizer
-/

/- warning: category_theory.limits.has_equalizers_of_has_pullbacks_and_binary_products.pullback_fst -> CategoryTheory.Limits.HasEqualizersOfHasPullbacksAndBinaryProducts.pullbackFst is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C] [_inst_3 : CategoryTheory.Limits.HasBinaryProducts.{u1, u2} C _inst_1] [_inst_4 : CategoryTheory.Limits.HasPullbacks.{u1, u2} C _inst_1] (F : CategoryTheory.Functor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1), Quiver.Hom.{succ u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Limits.HasEqualizersOfHasPullbacksAndBinaryProducts.constructEqualizer.{u1, u2} C _inst_1 _inst_3 _inst_4 F) (CategoryTheory.Functor.obj.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F CategoryTheory.Limits.WalkingParallelPair.zero)
but is expected to have type
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C] [_inst_3 : CategoryTheory.Limits.HasBinaryProducts.{u1, u2} C _inst_1] [_inst_4 : CategoryTheory.Limits.HasPullbacks.{u1, u2} C _inst_1] (F : CategoryTheory.Functor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1), Quiver.Hom.{succ u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Limits.HasEqualizersOfHasPullbacksAndBinaryProducts.constructEqualizer.{u1, u2} C _inst_1 _inst_3 _inst_4 F) (Prefunctor.obj.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F) CategoryTheory.Limits.WalkingParallelPair.zero)
Case conversion may be inaccurate. Consider using '#align category_theory.limits.has_equalizers_of_has_pullbacks_and_binary_products.pullback_fst CategoryTheory.Limits.HasEqualizersOfHasPullbacksAndBinaryProducts.pullbackFstₓ'. -/
/-- Define the equalizing morphism -/
abbrev pullbackFst (F : WalkingParallelPair ⥤ C) :
    constructEqualizer F ⟶ F.obj WalkingParallelPair.zero :=
  pullback.fst
#align category_theory.limits.has_equalizers_of_has_pullbacks_and_binary_products.pullback_fst CategoryTheory.Limits.HasEqualizersOfHasPullbacksAndBinaryProducts.pullbackFst

/- warning: category_theory.limits.has_equalizers_of_has_pullbacks_and_binary_products.pullback_fst_eq_pullback_snd -> CategoryTheory.Limits.HasEqualizersOfHasPullbacksAndBinaryProducts.pullbackFst_eq_pullback_snd is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C] [_inst_3 : CategoryTheory.Limits.HasBinaryProducts.{u1, u2} C _inst_1] [_inst_4 : CategoryTheory.Limits.HasPullbacks.{u1, u2} C _inst_1] (F : CategoryTheory.Functor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1), Eq.{succ u1} (Quiver.Hom.{succ u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Limits.HasEqualizersOfHasPullbacksAndBinaryProducts.constructEqualizer.{u1, u2} C _inst_1 _inst_3 _inst_4 F) (CategoryTheory.Functor.obj.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F CategoryTheory.Limits.WalkingParallelPair.zero)) (CategoryTheory.Limits.HasEqualizersOfHasPullbacksAndBinaryProducts.pullbackFst.{u1, u2} C _inst_1 _inst_3 _inst_4 F) (CategoryTheory.Limits.pullback.snd.{u1, u2} C _inst_1 (CategoryTheory.Functor.obj.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F CategoryTheory.Limits.WalkingParallelPair.zero) (CategoryTheory.Functor.obj.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F CategoryTheory.Limits.WalkingParallelPair.zero) (CategoryTheory.Limits.prod.{u1, u2} C _inst_1 (CategoryTheory.Functor.obj.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F CategoryTheory.Limits.WalkingParallelPair.zero) (CategoryTheory.Functor.obj.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F CategoryTheory.Limits.WalkingParallelPair.one) (CategoryTheory.Limits.HasEqualizersOfHasPullbacksAndBinaryProducts.constructEqualizer._proof_1.{u2, u1} C _inst_1 _inst_3 F)) (CategoryTheory.Limits.prod.lift.{u1, u2} C _inst_1 (CategoryTheory.Functor.obj.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F CategoryTheory.Limits.WalkingParallelPair.zero) (CategoryTheory.Functor.obj.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F CategoryTheory.Limits.WalkingParallelPair.zero) (CategoryTheory.Functor.obj.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F CategoryTheory.Limits.WalkingParallelPair.one) (CategoryTheory.Limits.HasEqualizersOfHasPullbacksAndBinaryProducts.constructEqualizer._proof_2.{u2, u1} C _inst_1 _inst_3 F) (CategoryTheory.CategoryStruct.id.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1) (CategoryTheory.Functor.obj.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F CategoryTheory.Limits.WalkingParallelPair.zero)) (CategoryTheory.Functor.map.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F CategoryTheory.Limits.WalkingParallelPair.zero CategoryTheory.Limits.WalkingParallelPair.one CategoryTheory.Limits.WalkingParallelPairHom.left)) (CategoryTheory.Limits.prod.lift.{u1, u2} C _inst_1 (CategoryTheory.Functor.obj.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F CategoryTheory.Limits.WalkingParallelPair.zero) (CategoryTheory.Functor.obj.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F CategoryTheory.Limits.WalkingParallelPair.zero) (CategoryTheory.Functor.obj.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F CategoryTheory.Limits.WalkingParallelPair.one) (CategoryTheory.Limits.HasEqualizersOfHasPullbacksAndBinaryProducts.constructEqualizer._proof_3.{u2, u1} C _inst_1 _inst_3 F) (CategoryTheory.CategoryStruct.id.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1) (CategoryTheory.Functor.obj.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F CategoryTheory.Limits.WalkingParallelPair.zero)) (CategoryTheory.Functor.map.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F CategoryTheory.Limits.WalkingParallelPair.zero CategoryTheory.Limits.WalkingParallelPair.one CategoryTheory.Limits.WalkingParallelPairHom.right)) (CategoryTheory.Limits.HasEqualizersOfHasPullbacksAndBinaryProducts.constructEqualizer._proof_4.{u2, u1} C _inst_1 _inst_3 _inst_4 F))
but is expected to have type
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C] [_inst_3 : CategoryTheory.Limits.HasBinaryProducts.{u1, u2} C _inst_1] [_inst_4 : CategoryTheory.Limits.HasPullbacks.{u1, u2} C _inst_1] (F : CategoryTheory.Functor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1), Eq.{succ u1} (Quiver.Hom.{succ u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Limits.HasEqualizersOfHasPullbacksAndBinaryProducts.constructEqualizer.{u1, u2} C _inst_1 _inst_3 _inst_4 F) (Prefunctor.obj.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F) CategoryTheory.Limits.WalkingParallelPair.zero)) (CategoryTheory.Limits.HasEqualizersOfHasPullbacksAndBinaryProducts.pullbackFst.{u1, u2} C _inst_1 _inst_3 _inst_4 F) (CategoryTheory.Limits.pullback.snd.{u1, u2} C _inst_1 (Prefunctor.obj.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F) CategoryTheory.Limits.WalkingParallelPair.zero) (Prefunctor.obj.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F) CategoryTheory.Limits.WalkingParallelPair.zero) (CategoryTheory.Limits.prod.{u1, u2} C _inst_1 (Prefunctor.obj.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F) CategoryTheory.Limits.WalkingParallelPair.zero) (Prefunctor.obj.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F) CategoryTheory.Limits.WalkingParallelPair.one) (CategoryTheory.Limits.HasEqualizersOfHasPullbacksAndBinaryProducts.constructEqualizer.proof_1.{u1, u2} C _inst_1 _inst_3 F)) (CategoryTheory.Limits.prod.lift.{u1, u2} C _inst_1 (Prefunctor.obj.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F) CategoryTheory.Limits.WalkingParallelPair.zero) (Prefunctor.obj.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F) CategoryTheory.Limits.WalkingParallelPair.zero) (Prefunctor.obj.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F) CategoryTheory.Limits.WalkingParallelPair.one) (CategoryTheory.Limits.HasEqualizersOfHasPullbacksAndBinaryProducts.constructEqualizer.proof_1.{u1, u2} C _inst_1 _inst_3 F) (CategoryTheory.CategoryStruct.id.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1) (Prefunctor.obj.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F) CategoryTheory.Limits.WalkingParallelPair.zero)) (Prefunctor.map.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F) CategoryTheory.Limits.WalkingParallelPair.zero CategoryTheory.Limits.WalkingParallelPair.one CategoryTheory.Limits.WalkingParallelPairHom.left)) (CategoryTheory.Limits.prod.lift.{u1, u2} C _inst_1 (Prefunctor.obj.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F) CategoryTheory.Limits.WalkingParallelPair.zero) (Prefunctor.obj.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F) CategoryTheory.Limits.WalkingParallelPair.zero) (Prefunctor.obj.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F) CategoryTheory.Limits.WalkingParallelPair.one) (CategoryTheory.Limits.HasEqualizersOfHasPullbacksAndBinaryProducts.constructEqualizer.proof_1.{u1, u2} C _inst_1 _inst_3 F) (CategoryTheory.CategoryStruct.id.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1) (Prefunctor.obj.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F) CategoryTheory.Limits.WalkingParallelPair.zero)) (Prefunctor.map.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F) CategoryTheory.Limits.WalkingParallelPair.zero CategoryTheory.Limits.WalkingParallelPair.one CategoryTheory.Limits.WalkingParallelPairHom.right)) (CategoryTheory.Limits.HasEqualizersOfHasPullbacksAndBinaryProducts.constructEqualizer.proof_2.{u1, u2} C _inst_1 _inst_3 _inst_4 F))
Case conversion may be inaccurate. Consider using '#align category_theory.limits.has_equalizers_of_has_pullbacks_and_binary_products.pullback_fst_eq_pullback_snd CategoryTheory.Limits.HasEqualizersOfHasPullbacksAndBinaryProducts.pullbackFst_eq_pullback_sndₓ'. -/
theorem pullbackFst_eq_pullback_snd (F : WalkingParallelPair ⥤ C) : pullbackFst F = pullback.snd :=
  by convert pullback.condition =≫ limits.prod.fst <;> simp
#align category_theory.limits.has_equalizers_of_has_pullbacks_and_binary_products.pullback_fst_eq_pullback_snd CategoryTheory.Limits.HasEqualizersOfHasPullbacksAndBinaryProducts.pullbackFst_eq_pullback_snd

#print CategoryTheory.Limits.HasEqualizersOfHasPullbacksAndBinaryProducts.equalizerCone /-
/-- Define the equalizing cone -/
@[reducible]
def equalizerCone (F : WalkingParallelPair ⥤ C) : Cone F :=
  Cone.ofFork
    (Fork.ofι (pullbackFst F)
      (by
        conv_rhs => rw [pullback_fst_eq_pullback_snd]
        convert pullback.condition =≫ limits.prod.snd using 1 <;> simp))
#align category_theory.limits.has_equalizers_of_has_pullbacks_and_binary_products.equalizer_cone CategoryTheory.Limits.HasEqualizersOfHasPullbacksAndBinaryProducts.equalizerCone
-/

#print CategoryTheory.Limits.HasEqualizersOfHasPullbacksAndBinaryProducts.equalizerConeIsLimit /-
/-- Show the equalizing cone is a limit -/
def equalizerConeIsLimit (F : WalkingParallelPair ⥤ C) : IsLimit (equalizerCone F)
    where
  lift := by
    intro c; apply pullback.lift (c.π.app _) (c.π.app _)
    apply limit.hom_ext
    rintro (_ | _) <;> simp
  fac := by rintro c (_ | _) <;> simp
  uniq := by
    intro c _ J
    have J0 := J walking_parallel_pair.zero; simp at J0
    apply pullback.hom_ext
    · rwa [limit.lift_π]
    · erw [limit.lift_π, ← J0, pullback_fst_eq_pullback_snd]
#align category_theory.limits.has_equalizers_of_has_pullbacks_and_binary_products.equalizer_cone_is_limit CategoryTheory.Limits.HasEqualizersOfHasPullbacksAndBinaryProducts.equalizerConeIsLimit
-/

end HasEqualizersOfHasPullbacksAndBinaryProducts

open HasEqualizersOfHasPullbacksAndBinaryProducts

#print CategoryTheory.Limits.hasEqualizers_of_hasPullbacks_and_binary_products /-
-- This is not an instance, as it is not always how one wants to construct equalizers!
/-- Any category with pullbacks and binary products, has equalizers. -/
theorem hasEqualizers_of_hasPullbacks_and_binary_products [HasBinaryProducts C] [HasPullbacks C] :
    HasEqualizers C :=
  {
    HasLimit := fun F =>
      HasLimit.mk
        { Cone := equalizerCone F
          IsLimit := equalizerConeIsLimit F } }
#align category_theory.limits.has_equalizers_of_has_pullbacks_and_binary_products CategoryTheory.Limits.hasEqualizers_of_hasPullbacks_and_binary_products
-/

attribute [local instance] has_pullback_of_preserves_pullback

#print CategoryTheory.Limits.preservesEqualizersOfPreservesPullbacksAndBinaryProducts /-
/-- A functor that preserves pullbacks and binary products also presrves equalizers. -/
def preservesEqualizersOfPreservesPullbacksAndBinaryProducts [HasBinaryProducts C] [HasPullbacks C]
    [PreservesLimitsOfShape (Discrete WalkingPair) G] [PreservesLimitsOfShape WalkingCospan G] :
    PreservesLimitsOfShape WalkingParallelPair G :=
  ⟨fun K =>
    preservesLimitOfPreservesLimitCone (equalizerConeIsLimit K) <|
      { lift := fun c =>
          by
          refine' pullback.lift _ _ _ ≫ (@preserves_pullback.iso _ _ _ _ _ _ _ _).inv
          · exact c.π.app walking_parallel_pair.zero
          · exact c.π.app walking_parallel_pair.zero
          apply (map_is_limit_of_preserves_of_is_limit G _ _ (prod_is_prod _ _)).hom_ext
          swap; infer_instance
          rintro (_ | _)
          ·
            simp only [category.assoc, ← G.map_comp, prod.lift_fst, binary_fan.π_app_left,
              binary_fan.mk_fst]
          · simp only [binary_fan.π_app_right, binary_fan.mk_snd, category.assoc, ← G.map_comp,
              prod.lift_snd]
            exact
              (c.π.naturality walking_parallel_pair_hom.left).symm.trans
                (c.π.naturality walking_parallel_pair_hom.right)
        fac := fun c j =>
          by
          rcases j with (_ | _) <;>
            simp only [category.comp_id, preserves_pullback.iso_inv_fst, cone.of_fork_π, G.map_comp,
              preserves_pullback.iso_inv_fst_assoc, functor.map_cone_π_app, eq_to_hom_refl,
              category.assoc, fork.of_ι_π_app, pullback.lift_fst, pullback.lift_fst_assoc]
          exact (c.π.naturality walking_parallel_pair_hom.left).symm.trans (category.id_comp _)
        uniq := fun s m h => by
          rw [iso.eq_comp_inv]
          have := h walking_parallel_pair.zero
          dsimp [equalizer_cone] at this
          ext <;>
            simp only [preserves_pullback.iso_hom_snd, category.assoc,
              preserves_pullback.iso_hom_fst, pullback.lift_fst, pullback.lift_snd,
              category.comp_id, ← pullback_fst_eq_pullback_snd, ← this] }⟩
#align category_theory.limits.preserves_equalizers_of_preserves_pullbacks_and_binary_products CategoryTheory.Limits.preservesEqualizersOfPreservesPullbacksAndBinaryProducts
-/

-- We hide the "implementation details" inside a namespace
namespace HasCoequalizersOfHasPushoutsAndBinaryCoproducts

variable [HasBinaryCoproducts C] [HasPushouts C]

#print CategoryTheory.Limits.HasCoequalizersOfHasPushoutsAndBinaryCoproducts.constructCoequalizer /-
/-- Define the equalizing object -/
@[reducible]
def constructCoequalizer (F : WalkingParallelPair ⥤ C) : C :=
  pushout (coprod.desc (𝟙 _) (F.map WalkingParallelPairHom.left))
    (coprod.desc (𝟙 _) (F.map WalkingParallelPairHom.right))
#align category_theory.limits.has_coequalizers_of_has_pushouts_and_binary_coproducts.construct_coequalizer CategoryTheory.Limits.HasCoequalizersOfHasPushoutsAndBinaryCoproducts.constructCoequalizer
-/

/- warning: category_theory.limits.has_coequalizers_of_has_pushouts_and_binary_coproducts.pushout_inl -> CategoryTheory.Limits.HasCoequalizersOfHasPushoutsAndBinaryCoproducts.pushoutInl is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C] [_inst_3 : CategoryTheory.Limits.HasBinaryCoproducts.{u1, u2} C _inst_1] [_inst_4 : CategoryTheory.Limits.HasPushouts.{u1, u2} C _inst_1] (F : CategoryTheory.Functor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1), Quiver.Hom.{succ u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.obj.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F CategoryTheory.Limits.WalkingParallelPair.one) (CategoryTheory.Limits.HasCoequalizersOfHasPushoutsAndBinaryCoproducts.constructCoequalizer.{u1, u2} C _inst_1 _inst_3 _inst_4 F)
but is expected to have type
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C] [_inst_3 : CategoryTheory.Limits.HasBinaryCoproducts.{u1, u2} C _inst_1] [_inst_4 : CategoryTheory.Limits.HasPushouts.{u1, u2} C _inst_1] (F : CategoryTheory.Functor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1), Quiver.Hom.{succ u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (Prefunctor.obj.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F) CategoryTheory.Limits.WalkingParallelPair.one) (CategoryTheory.Limits.HasCoequalizersOfHasPushoutsAndBinaryCoproducts.constructCoequalizer.{u1, u2} C _inst_1 _inst_3 _inst_4 F)
Case conversion may be inaccurate. Consider using '#align category_theory.limits.has_coequalizers_of_has_pushouts_and_binary_coproducts.pushout_inl CategoryTheory.Limits.HasCoequalizersOfHasPushoutsAndBinaryCoproducts.pushoutInlₓ'. -/
/-- Define the equalizing morphism -/
abbrev pushoutInl (F : WalkingParallelPair ⥤ C) :
    F.obj WalkingParallelPair.one ⟶ constructCoequalizer F :=
  pushout.inl
#align category_theory.limits.has_coequalizers_of_has_pushouts_and_binary_coproducts.pushout_inl CategoryTheory.Limits.HasCoequalizersOfHasPushoutsAndBinaryCoproducts.pushoutInl

/- warning: category_theory.limits.has_coequalizers_of_has_pushouts_and_binary_coproducts.pushout_inl_eq_pushout_inr -> CategoryTheory.Limits.HasCoequalizersOfHasPushoutsAndBinaryCoproducts.pushoutInl_eq_pushout_inr is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C] [_inst_3 : CategoryTheory.Limits.HasBinaryCoproducts.{u1, u2} C _inst_1] [_inst_4 : CategoryTheory.Limits.HasPushouts.{u1, u2} C _inst_1] (F : CategoryTheory.Functor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1), Eq.{succ u1} (Quiver.Hom.{succ u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.obj.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F CategoryTheory.Limits.WalkingParallelPair.one) (CategoryTheory.Limits.HasCoequalizersOfHasPushoutsAndBinaryCoproducts.constructCoequalizer.{u1, u2} C _inst_1 _inst_3 _inst_4 F)) (CategoryTheory.Limits.HasCoequalizersOfHasPushoutsAndBinaryCoproducts.pushoutInl.{u1, u2} C _inst_1 _inst_3 _inst_4 F) (CategoryTheory.Limits.pushout.inr.{u1, u2} C _inst_1 (CategoryTheory.Limits.coprod.{u1, u2} C _inst_1 (CategoryTheory.Functor.obj.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F CategoryTheory.Limits.WalkingParallelPair.one) (CategoryTheory.Functor.obj.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F CategoryTheory.Limits.WalkingParallelPair.zero) (CategoryTheory.Limits.HasCoequalizersOfHasPushoutsAndBinaryCoproducts.constructCoequalizer._proof_1.{u2, u1} C _inst_1 _inst_3 F)) (CategoryTheory.Functor.obj.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F CategoryTheory.Limits.WalkingParallelPair.one) (CategoryTheory.Functor.obj.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F CategoryTheory.Limits.WalkingParallelPair.one) (CategoryTheory.Limits.coprod.desc.{u1, u2} C _inst_1 (CategoryTheory.Functor.obj.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F CategoryTheory.Limits.WalkingParallelPair.one) (CategoryTheory.Functor.obj.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F CategoryTheory.Limits.WalkingParallelPair.one) (CategoryTheory.Functor.obj.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F CategoryTheory.Limits.WalkingParallelPair.zero) (CategoryTheory.Limits.HasCoequalizersOfHasPushoutsAndBinaryCoproducts.constructCoequalizer._proof_2.{u2, u1} C _inst_1 _inst_3 F) (CategoryTheory.CategoryStruct.id.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1) (CategoryTheory.Functor.obj.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F CategoryTheory.Limits.WalkingParallelPair.one)) (CategoryTheory.Functor.map.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F CategoryTheory.Limits.WalkingParallelPair.zero CategoryTheory.Limits.WalkingParallelPair.one CategoryTheory.Limits.WalkingParallelPairHom.left)) (CategoryTheory.Limits.coprod.desc.{u1, u2} C _inst_1 (CategoryTheory.Functor.obj.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F CategoryTheory.Limits.WalkingParallelPair.one) (CategoryTheory.Functor.obj.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F CategoryTheory.Limits.WalkingParallelPair.one) (CategoryTheory.Functor.obj.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F CategoryTheory.Limits.WalkingParallelPair.zero) (CategoryTheory.Limits.HasCoequalizersOfHasPushoutsAndBinaryCoproducts.constructCoequalizer._proof_3.{u2, u1} C _inst_1 _inst_3 F) (CategoryTheory.CategoryStruct.id.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1) (CategoryTheory.Functor.obj.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F CategoryTheory.Limits.WalkingParallelPair.one)) (CategoryTheory.Functor.map.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F CategoryTheory.Limits.WalkingParallelPair.zero CategoryTheory.Limits.WalkingParallelPair.one CategoryTheory.Limits.WalkingParallelPairHom.right)) (CategoryTheory.Limits.HasCoequalizersOfHasPushoutsAndBinaryCoproducts.constructCoequalizer._proof_4.{u2, u1} C _inst_1 _inst_3 _inst_4 F))
but is expected to have type
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C] [_inst_3 : CategoryTheory.Limits.HasBinaryCoproducts.{u1, u2} C _inst_1] [_inst_4 : CategoryTheory.Limits.HasPushouts.{u1, u2} C _inst_1] (F : CategoryTheory.Functor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1), Eq.{succ u1} (Quiver.Hom.{succ u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (Prefunctor.obj.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F) CategoryTheory.Limits.WalkingParallelPair.one) (CategoryTheory.Limits.HasCoequalizersOfHasPushoutsAndBinaryCoproducts.constructCoequalizer.{u1, u2} C _inst_1 _inst_3 _inst_4 F)) (CategoryTheory.Limits.HasCoequalizersOfHasPushoutsAndBinaryCoproducts.pushoutInl.{u1, u2} C _inst_1 _inst_3 _inst_4 F) (CategoryTheory.Limits.pushout.inr.{u1, u2} C _inst_1 (CategoryTheory.Limits.coprod.{u1, u2} C _inst_1 (Prefunctor.obj.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F) CategoryTheory.Limits.WalkingParallelPair.one) (Prefunctor.obj.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F) CategoryTheory.Limits.WalkingParallelPair.zero) (CategoryTheory.Limits.HasCoequalizersOfHasPushoutsAndBinaryCoproducts.constructCoequalizer.proof_1.{u1, u2} C _inst_1 _inst_3 F)) (Prefunctor.obj.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F) CategoryTheory.Limits.WalkingParallelPair.one) (Prefunctor.obj.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F) CategoryTheory.Limits.WalkingParallelPair.one) (CategoryTheory.Limits.coprod.desc.{u1, u2} C _inst_1 (Prefunctor.obj.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F) CategoryTheory.Limits.WalkingParallelPair.one) (Prefunctor.obj.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F) CategoryTheory.Limits.WalkingParallelPair.one) (Prefunctor.obj.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F) CategoryTheory.Limits.WalkingParallelPair.zero) (CategoryTheory.Limits.HasCoequalizersOfHasPushoutsAndBinaryCoproducts.constructCoequalizer.proof_1.{u1, u2} C _inst_1 _inst_3 F) (CategoryTheory.CategoryStruct.id.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1) (Prefunctor.obj.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F) CategoryTheory.Limits.WalkingParallelPair.one)) (Prefunctor.map.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F) CategoryTheory.Limits.WalkingParallelPair.zero CategoryTheory.Limits.WalkingParallelPair.one CategoryTheory.Limits.WalkingParallelPairHom.left)) (CategoryTheory.Limits.coprod.desc.{u1, u2} C _inst_1 (Prefunctor.obj.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F) CategoryTheory.Limits.WalkingParallelPair.one) (Prefunctor.obj.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F) CategoryTheory.Limits.WalkingParallelPair.one) (Prefunctor.obj.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F) CategoryTheory.Limits.WalkingParallelPair.zero) (CategoryTheory.Limits.HasCoequalizersOfHasPushoutsAndBinaryCoproducts.constructCoequalizer.proof_1.{u1, u2} C _inst_1 _inst_3 F) (CategoryTheory.CategoryStruct.id.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1) (Prefunctor.obj.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F) CategoryTheory.Limits.WalkingParallelPair.one)) (Prefunctor.map.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 F) CategoryTheory.Limits.WalkingParallelPair.zero CategoryTheory.Limits.WalkingParallelPair.one CategoryTheory.Limits.WalkingParallelPairHom.right)) (CategoryTheory.Limits.HasCoequalizersOfHasPushoutsAndBinaryCoproducts.constructCoequalizer.proof_2.{u1, u2} C _inst_1 _inst_3 _inst_4 F))
Case conversion may be inaccurate. Consider using '#align category_theory.limits.has_coequalizers_of_has_pushouts_and_binary_coproducts.pushout_inl_eq_pushout_inr CategoryTheory.Limits.HasCoequalizersOfHasPushoutsAndBinaryCoproducts.pushoutInl_eq_pushout_inrₓ'. -/
theorem pushoutInl_eq_pushout_inr (F : WalkingParallelPair ⥤ C) : pushoutInl F = pushout.inr := by
  convert limits.coprod.inl ≫= pushout.condition <;> simp
#align category_theory.limits.has_coequalizers_of_has_pushouts_and_binary_coproducts.pushout_inl_eq_pushout_inr CategoryTheory.Limits.HasCoequalizersOfHasPushoutsAndBinaryCoproducts.pushoutInl_eq_pushout_inr

#print CategoryTheory.Limits.HasCoequalizersOfHasPushoutsAndBinaryCoproducts.coequalizerCocone /-
/-- Define the equalizing cocone -/
@[reducible]
def coequalizerCocone (F : WalkingParallelPair ⥤ C) : Cocone F :=
  Cocone.ofCofork
    (Cofork.ofπ (pushoutInl F)
      (by
        conv_rhs => rw [pushout_inl_eq_pushout_inr]
        convert limits.coprod.inr ≫= pushout.condition using 1 <;> simp))
#align category_theory.limits.has_coequalizers_of_has_pushouts_and_binary_coproducts.coequalizer_cocone CategoryTheory.Limits.HasCoequalizersOfHasPushoutsAndBinaryCoproducts.coequalizerCocone
-/

#print CategoryTheory.Limits.HasCoequalizersOfHasPushoutsAndBinaryCoproducts.coequalizerCoconeIsColimit /-
/-- Show the equalizing cocone is a colimit -/
def coequalizerCoconeIsColimit (F : WalkingParallelPair ⥤ C) : IsColimit (coequalizerCocone F)
    where
  desc := by
    intro c; apply pushout.desc (c.ι.app _) (c.ι.app _)
    apply colimit.hom_ext
    rintro (_ | _) <;> simp
  fac := by rintro c (_ | _) <;> simp
  uniq := by
    intro c _ J
    have J1 : pushout_inl F ≫ m = c.ι.app walking_parallel_pair.one := by
      simpa using J walking_parallel_pair.one
    apply pushout.hom_ext
    · rw [colimit.ι_desc]
      exact J1
    · rw [colimit.ι_desc, ← pushout_inl_eq_pushout_inr]
      exact J1
#align category_theory.limits.has_coequalizers_of_has_pushouts_and_binary_coproducts.coequalizer_cocone_is_colimit CategoryTheory.Limits.HasCoequalizersOfHasPushoutsAndBinaryCoproducts.coequalizerCoconeIsColimit
-/

end HasCoequalizersOfHasPushoutsAndBinaryCoproducts

open HasCoequalizersOfHasPushoutsAndBinaryCoproducts

#print CategoryTheory.Limits.hasCoequalizers_of_hasPushouts_and_binary_coproducts /-
-- This is not an instance, as it is not always how one wants to construct equalizers!
/-- Any category with pullbacks and binary products, has equalizers. -/
theorem hasCoequalizers_of_hasPushouts_and_binary_coproducts [HasBinaryCoproducts C]
    [HasPushouts C] : HasCoequalizers C :=
  {
    HasColimit := fun F =>
      HasColimit.mk
        { Cocone := coequalizerCocone F
          IsColimit := coequalizerCoconeIsColimit F } }
#align category_theory.limits.has_coequalizers_of_has_pushouts_and_binary_coproducts CategoryTheory.Limits.hasCoequalizers_of_hasPushouts_and_binary_coproducts
-/

attribute [local instance] has_pushout_of_preserves_pushout

#print CategoryTheory.Limits.preservesCoequalizersOfPreservesPushoutsAndBinaryCoproducts /-
/-- A functor that preserves pushouts and binary coproducts also presrves coequalizers. -/
def preservesCoequalizersOfPreservesPushoutsAndBinaryCoproducts [HasBinaryCoproducts C]
    [HasPushouts C] [PreservesColimitsOfShape (Discrete WalkingPair) G]
    [PreservesColimitsOfShape WalkingSpan G] : PreservesColimitsOfShape WalkingParallelPair G :=
  ⟨fun K =>
    preservesColimitOfPreservesColimitCocone (coequalizerCoconeIsColimit K) <|
      { desc := fun c =>
          by
          refine' (@preserves_pushout.iso _ _ _ _ _ _ _ _).inv ≫ pushout.desc _ _ _
          · exact c.ι.app walking_parallel_pair.one
          · exact c.ι.app walking_parallel_pair.one
          apply (map_is_colimit_of_preserves_of_is_colimit G _ _ (coprod_is_coprod _ _)).hom_ext
          swap; infer_instance
          rintro (_ | _)
          ·
            simp only [binary_cofan.ι_app_left, binary_cofan.mk_inl, category.assoc, ←
              G.map_comp_assoc, coprod.inl_desc]
          · simp only [binary_cofan.ι_app_right, binary_cofan.mk_inr, category.assoc, ←
              G.map_comp_assoc, coprod.inr_desc]
            exact
              (c.ι.naturality walking_parallel_pair_hom.left).trans
                (c.ι.naturality walking_parallel_pair_hom.right).symm
        fac := fun c j =>
          by
          rcases j with (_ | _) <;>
            simp only [functor.map_cocone_ι_app, cocone.of_cofork_ι, category.id_comp,
              eq_to_hom_refl, category.assoc, functor.map_comp, cofork.of_π_ι_app, pushout.inl_desc,
              preserves_pushout.inl_iso_inv_assoc]
          exact (c.ι.naturality walking_parallel_pair_hom.left).trans (category.comp_id _)
        uniq := fun s m h => by
          rw [iso.eq_inv_comp]
          have := h walking_parallel_pair.one
          dsimp [coequalizer_cocone] at this
          ext <;>
            simp only [preserves_pushout.inl_iso_hom_assoc, category.id_comp, pushout.inl_desc,
              pushout.inr_desc, preserves_pushout.inr_iso_hom_assoc, ← pushout_inl_eq_pushout_inr, ←
              this] }⟩
#align category_theory.limits.preserves_coequalizers_of_preserves_pushouts_and_binary_coproducts CategoryTheory.Limits.preservesCoequalizersOfPreservesPushoutsAndBinaryCoproducts
-/

end CategoryTheory.Limits


import tactic
import data.polynomial.basic
import data.polynomial.div
import data.nat.parity
open polynomial
open nat

noncomputable theory
open_locale classical

meta def ring_poly := `[
  apply polynomial.eq_of_subs,
  intro r,
  try {simp},
  try {ring}
]

variables {R : Type*} [field R] -- should work with comm_ring but some lemmas used for simp won't work

-- This lemma is false in general, we will fix this later
lemma polynomial.eq_of_subs (p q : polynomial R) : (∀ (r : R), p.eval r = q.eval r) → p = q :=
begin
  sorry
end

lemma induction_ppl_bit {P : ℕ → Prop} (m : ℕ) (h0 : P 0)
  (hbit0 : ∀ n, P n → P (2 * n)) (hbit1 : ∀ n, P n → P (2 * n + 1))
  : P m :=
begin
  apply nat.strong_induction_on m,
  have nat_is_pos : 0 ≤ m, exact nat.zero_le m,
  intros m hm,
  by_cases hz : m = 0,
  { rw hz, exact h0 },
  by_cases he : even m,
  {
    obtain ⟨k, rfl⟩ := he,
    rw ← two_mul,
    apply hbit0,
    apply hm k,
    have hk' : 0 < k,
    {apply nat.pos_of_ne_zero,
    intro hc, subst hc, contradiction},
    linarith,
  },
  {
    replace he : odd m := odd_iff_not_even.mpr he,
    obtain ⟨k, rfl⟩ := he,
    apply hbit1,
    apply hm k,
    linarith,
  }
end

variables (A B : R)

lemma nat_sub_add (n m k : ℕ) (h : m ≤ n) : n - m + (m + k) = n + k :=
by linarith

lemma nhalves {n m r : ℕ} :  n / 2 + m < n + m + r + 1 :=
begin
  have nhalf : n / 2 ≤ n := nat.div_le_self n 2,
  linarith,
end

lemma nhalves' {n m r : ℕ} : (n+1)/2 + m < n + m + r + 1:=
begin
  have nhalf : (n+1)/2 < n + 1 := div_lt_self' n 0,
  linarith,
end

/--
Define the "depleted" psi polynomials. They are Ψ as in Wikipedia,
but for even n we remove a factor of 2*y, thus making them one-variable.
-/
noncomputable def psi' : ℕ → (polynomial R)
| 0 := (0 : polynomial R)
| 1 := (1 : polynomial R)
| 2 := (1 : polynomial R)
| 3 := (3 : R)•X^4 + (6*A)•X^2 + (12*B)•X - A^2•1
| 4 := (2 : R)•X^6 + (10*A)•X^4 + (40*B)•X^3-(10*A^2)•X^2-(8*A*B)•X- (2*A^3+16*B^2)•1
| (n+5) :=
  have n/2+4 < n+4+0+1 := nhalves,
  have n/2+3 < n+3+1+1 := nhalves,
  have n/2+2 < n+2+2+1 := nhalves,
  have n/2+1 < n+1+3+1 := nhalves,
  have (n+1)/2 < n+0+4+1 := @nhalves' _ 0 _,
  have (n+1)/2+1 < n+1+3+1 := nhalves',
  have (n+1)/2+2 < n+2+2+1 := nhalves',
  have (n+1)/2+3 < n+3+1+1 := nhalves',
  have (n+1)/2+4 < n+4+0+1 := nhalves',
  if even n then
    if even (n / 2) then
      ((4:R)•X^3+(4*A)•X+(4*B)•1)^2 * psi' (n/2+4) * (psi' (n/2+2))^3 - psi' (n/2+1) * (psi' (n/2+3))^3
    else
      psi' (n/2+4) * (psi' (n/2+2))^3 - ((4:R)•X^3+(4*A)•X+(4*B)•1)^2 * psi' (n/2+1) * (psi' (n/2+3))^3
  else
      (psi' ((n+1)/2+2)) * ((psi' ((n+1)/2+4)) * (psi' ((n+1)/2+1))^2 -
        psi' ((n+1)/2) * (psi' ((n+1)/2+3))^2)

local notation `ψ'` := psi' A B

example : ψ' 3 = (3:R)•X^4 + (6*A)•X^2 + (12*B)•X - (A^2)•1 := by simp [psi']

example : ψ' 4 =
(2:R)•X^6 + (10*A)•X^4 + (40*B)•X^3 - (10*A^2)•X^2 - (8*A*B)•X +(-2*A^3 - 16*B^2)•1
:=
begin
  unfold psi',
  ring_poly,
end

example : ψ' 5 =
5*X^12 + 62*A•X^10 + 380*B•X^9 - 105*A^2•X^8 + (240*A*B)•X^7 +
(-300*A^3 - 240*B^2)•X^6 - (696*A^2*B)•X^5 + (-125*A^4 - 1920*A*B^2)•X^4 +
(-80*A^3*B - 1600*B^3)•X^3 +
(-50*A^5 - 240*A^2*B^2)•X^2 +
(-100*A^4*B - 640*A*B^3)•X + (A^6 - 32*A^3*B^2 - 256*B^4)•1
:=
begin
  simp [psi'],
  ring_poly,
end

/-
example : ψ' 6 =
3*X^16 + 72*A•X^14 + 672*B•X^13 - 364*A^2•X^12 + (-1288*A^3 - 2688*B^2)•X^10 - (4576*A^2*B)•X^9 +
(-942*A^4 - 19872*A*B^2)•X^8 + (768*A^3*B - 22272*B^3)•X^7 + (-1288*A^5 - 2688*A^2*B^2)•X^6 +
(-3360*A^4*B - 16128*A*B^3)•X^5 + (-364*A^6 - 4032*A^3*B^2 - 5376*B^4)•X^4 +
(-1792*A^5*B - 12544*A^2*B^3)•X^3 + (72*A^7 - 1536*A^4*B^2 - 13824*A*B^4)•X^2 +
(96*A^6*B - 256*A^3*B^3 - 6144*B^5)•X + (3*A^8 + 96*A^5*B^2 + 512*A^2*B^4)•1
:=
begin
  simp [psi'],
  ring_poly,
end
 -/

lemma le_succ_of_le_and_ne {k m : ℕ} (h : m ≤ k) (h' : m ≠ k) : m+1 ≤ k :=
begin
  rw le_iff_lt_or_eq at h,
  cases h,
  { exact succ_le_iff.mpr h },
  { contradiction }
end

lemma add_two_div_two {k : ℕ} : (k + 2) / 2 = k / 2 + 1 := by simp

lemma even_odd_succ {k : ℕ} (h : even k) :¬ even (k+1) := by simp [even_add, h]

lemma odd_even_succ {k : ℕ} (h : odd k) :¬ odd (k+1) := by simp [odd_add, h]

@[simp]
lemma even_odd_succ_iff {k : ℕ} : even (k+1) ↔ odd k :=
  by simp [even_odd_succ, odd_even_succ, even_add]

@[simp]
lemma odd_even_succ_iff {k : ℕ} : odd (k+1) ↔ even k :=
  by simp [even_odd_succ, odd_even_succ, even_add]

/-- Duplication formula for Ψ' -/
lemma psi_bit0 {n : ℕ}  (h : 2 ≤ n) :
 ψ'(2*n) = ψ' n * ( ψ'(n+2) * ψ'(n-1)^2 - ψ'(n-2) * ψ'(n+1)^2 ) :=
begin
  have twopos : 0 < 2, by linarith,
  by_cases hedge : n = 2,
  {
    subst hedge,
    unfold psi',
    have : 2*2 = 4, by refl,
    simp [psi', this],
  },
  replace h : 3 ≤ n := le_succ_of_le_and_ne h (ne.symm hedge),
  by_cases he : even n,
  {
    let k := 2*n - 5,
    have hk : 2 * n = k + 5, by {rw nat.sub_add_cancel, linarith},
    have hkodd : ¬ even k,
    {
      rw ←nat.odd_iff_not_even,
      use (n-3),
      rw [nat.mul_sub_left_distrib, hk],
      norm_num,
      rw ←nat.sub_eq_iff_eq_add,
      linarith,
    },
    rw hk,
    have hn : n = (k+1)/2 + 2,
    {
      rw ←nat.sub_eq_iff_eq_add,
      {
        have hk' : 2*n-5 = k, by simp [hk],
        rw ←hk',
        suffices : 2*(n-2) = (2 * n - 5 + 1), by {rw [←@nat.mul_div_cancel (n-2) 2 twopos,←this], simp},
        rw nat.mul_sub_left_distrib,
        norm_num,
        simp [hk],
      },
      exact le_of_succ_le h,
    },
    simp [psi', hkodd, hn],
  },
  {
    let k := 2*n - 6,
    have hk : 2 * n = k + 6, by { rw nat.sub_add_cancel, linarith },
    rw hk,
    have hkeven : even k,
    {
      use (n-3),
      rw [nat.mul_sub_left_distrib, hk],
      norm_num,
    },
    have hn : n = (k+2)/2 + 2,
    {
      suffices : n = k / 2 + 3, by simp [this],
      rw ←nat.sub_eq_iff_eq_add h,
      {
        have hk' : 2*n-6 = k, by simp [hk],
        rw ←hk',
        suffices : 2*(n-3) = (2 * n - 6),
        {
          rw [←@nat.mul_div_cancel (n-3) 2 twopos, ←this],
          simp,
        },
        rw nat.mul_sub_left_distrib,
        norm_num,
      },
    },
    have hke : even (k/2),
    {
      obtain ⟨r, hr⟩ := odd_iff_not_even.mpr he,
      have : k/2 = n - 3, by simp [←nat.sub_add_cancel h, hr, hn],
      rw this,
      exact odd.sub_odd (odd_iff_not_even.mpr he) (odd_bit1 1),
    },
    change n = (k+1+1)/2 + 2 at hn,
    simp [psi', hkeven, hn],
  },
end

lemma even_nat_iff_coe  (a : ℕ) : even a ↔ even (a : ℤ) :=
begin
  split,
  {
    intro h,
    obtain ⟨k, hk⟩ := h,
    exact ⟨k, by linarith⟩,
  },
  {
    intro h,
    obtain ⟨k, hk⟩ := h,
    have hpos : 0 ≤ k, by linarith,
    rw ←(int.nat_abs_of_nonneg hpos) at hk,
    exact ⟨k.nat_abs, by {zify, exact hk}⟩,
  }
end

/-- Duplic-add-tion formula for Ψ' -/
lemma psi_bit1 {n : ℕ} (h : 1 ≤ n) :
 ψ'(2*n+1) = ψ' (n+2) * (ψ' n)^3 * (ite (even n) (16*(X^3 + A•X + B•1)^2) 1) - ψ' (n-1) * (ψ' (n+1))^3 * (ite (even n) 1 (16*(X^3 + A•X + B•1)^2)) :=
begin
  by_cases h0 : n = 1,
  {
    subst h0,
    have hone: odd 1 := odd_bit1 0,
    simp [psi', hone],
  },
  replace h : 2 ≤ n := le_succ_of_le_and_ne h (ne.symm h0),
  have twopos : 0 < 2, by linarith,
  by_cases hedge : n = 2,
  {
    subst hedge,
    unfold psi',
    have : 2*2 + 1 = 5, by refl,
    simp [psi', this],
    ring_poly,
  },
  replace h : 3 ≤ n := le_succ_of_le_and_ne h (ne.symm hedge),
  by_cases he : even n,
  {
    let k := 2 * n - 5,
    have hk : 2 * n = k + 5,
    {
      rw nat.sub_add_cancel,
      linarith,
    },
    rw hk,
    have hkodd : ¬ even k,
    {
      rw ←nat.odd_iff_not_even,
      use (n-3),
      rw [nat.mul_sub_left_distrib, hk],
      norm_num,
      rw ←nat.sub_eq_iff_eq_add,
      linarith,
    },
    have hn : n = (k+1)/2 + 2,
    {
      rw ←nat.sub_eq_iff_eq_add,
      {
        have hk' : 2*n-5 = k, by simp [hk],
        rw ←hk',
        suffices : 2*(n-2) = (2 * n - 5 + 1),
        {
          rw [←@nat.mul_div_cancel (n-2) 2 twopos,←this],
          simp,
        },
        rw nat.mul_sub_left_distrib,
        norm_num,
        simp [hk],
      },
      linarith,
    },
    rw hn,
    have hs1 : (k + 1) / 2 + 2 + 2 = (k + 1) / 2 + 4 := by linarith,
    have hs2 : (k + 1) / 2 + 2 - 1 = (k + 1) / 2 + 1 := by {zify, simp},
    have hk' : even ((k+1) / 2),
    {
      obtain ⟨r, hr⟩ := he,
      zify at hr,
      rw even_nat_iff_coe,
      have : even ((k + 1)/2 : ℤ) := ⟨r-1, by linarith⟩,
      exact this,
    },
    simp [psi', hkodd, hk', he, hs1, hs2],
    ring_poly,
  },
  {
    have twon_ge_six : 6 ≤ 2 * n, by linarith [h],
    simp [he],
    let k := 2 * n - 6,
    have hk : 2 * n + 1 = k + 7,
    {
      rw ←nat_sub_add,
      exact twon_ge_six,
    },
    rw hk,
    have hkeven : even k,
    {
      use (n-3),
      zify at hk ⊢,
      replace hk : (k : ℤ) = 2 * n + 1 - 7, by linarith,
      rw hk,
      have : (((n-3) : ℕ) : ℤ) = (n : ℤ) - 3 := int.of_nat_sub h,
      rw this,
      ring,
    },
    have hn : n = (k+2)/2 + 2,
    {
      suffices : n = k / 2 + 3, by simp [this],
      rw ←nat.sub_eq_iff_eq_add h,
      {
        have : 2*n-6+6+1 = k + 6+1, by rw [nat.sub_add_cancel twon_ge_six, hk],
        have hk' : 2*n-6 = k, by linarith [this],
        rw ←hk',
        suffices : 2*(n-3) = (2 * n - 6),
        {
          rw [←@nat.mul_div_cancel (n-3) 2 twopos, ←this],
          simp,
        },
        rw nat.mul_sub_left_distrib,
        norm_num,
      },
    },
    have hke : even (k/2),
    {
      obtain ⟨r, hr⟩ := odd_iff_not_even.mpr he,
      have : k/2 = n - 3, by simp [←nat.sub_add_cancel h, hr, hn],
      rw this,
      exact odd.sub_odd (odd_iff_not_even.mpr he) (odd_bit1 1),
    },
    have hs1 : (k / 2).succ + 1 = (k / 2) + 2, by refl,
    have hs2 : (k / 2).succ + 2 + 1 = (k / 2).succ + 3, by refl,
    simp [psi', hke, hn, hkeven, hs1, hs2],
    ring_poly,
  },
end

/-- Duplic-sub-tion formula for Ψ' -/
lemma psi_bit1' {n : ℕ}  (h : 2 ≤ n) :
 ψ'(2*n-1) = ψ' (n+1) * (ψ' (n-1))^3 * (ite (even n) 1 (16*(X^3 + A•X + B•1)^2)) - ψ' (n-2) * (ψ' (n))^3 * (ite (even n) (16*(X^3 + A•X + B•1)^2) 1) :=
begin
  have H : ∃ m, (1≤ m) ∧ n = m+1,
  {
    use n-1,
    split,
    { exact le_tsub_of_add_le_left h },
    { have h' : 1 ≤ n := le_of_succ_le h,
      rw nat_sub_add _ _ 0 h',
      refl }
  },
  obtain ⟨m, ⟨hm, rfl⟩⟩ := H,
  have h1 : 2 * (m + 1) - 1 = 2*m +1, by omega,
  rw [h1,psi_bit1 _ _ hm],
  simp,
end

-- This is really ψ^2 from the Wikipedia definition.
def psisq (n : ℕ) :=
  (psi' A B n)^2 * (ite (even n) (4 * (X^3 + A•X + B•1)) 1)

local notation `ψ2` := psisq A B

lemma psisq_def {n : ℕ} (he : even n) : ψ2 n = (psi' A B n)^2 * (4 * (X^3 + A•X + B•1)) :=
by simp [he, psisq]

lemma psisq_def' {n : ℕ} (he : ¬ even n) : ψ2 n = (psi' A B n)^2 :=
by simp [he, psisq]

/-- Duplication formula for Ψ2 -/
lemma psisq_bit0 {n : ℕ} (h : 2 ≤ n) (he : even n) :
 ψ2 (2*n) = ψ2 n * ( ψ'(n+2) * ψ2 (n-1) - ψ'(n-2) * ψ2 (n+1) )^2 :=
begin
  have het : even (2*n) := even_two_mul n,
  unfold psisq,
  have hen' : ¬ even (n+1) := even_odd_succ he,
  have hen'' : ¬ even (n-1) :=
  begin
    rw ←odd_iff_not_even at hen' ⊢,
    suffices : odd (n + 1 - 2), by exact this,
    rw odd_sub (le_add_right h),
    have even_two := even_two_mul 1,
    tauto,
  end,
  rw psi_bit0 A B h,
  simp [he, het, hen', hen''],
  ring,
end

/-- Duplic-add-tion formula for Ψ2 -/
lemma psisq_bit1 {n : ℕ} (h : 1 ≤ n) (he : even n) :
ψ2 (2*n+1) = (ψ' (n+2) * (ψ' n)^3 * (16*(X^3 + A•X + B•1)^2) - ψ' (n-1) * ψ' (n+1)^3 )^2 :=
begin
  unfold psisq,
  have het : even (2*n) := even.mul_left he _,
  simp [he, het],
  congr' 1,
  rw psi_bit1 _ _ h,
  simp [he, het],
end

-- This is φ n from the Wikipedia
noncomputable def phi (n : ℕ) : polynomial R
:= X * ψ2 n - ψ'(n+1) * ψ'(n-1) * (ite (even n) 1 (4 * (X^3 + A•X + B•1)))

local notation `φ` := phi A B

-- This is 2ω when n is even, and y⁻¹ω when n is odd (ω as in Wikipedia)
noncomputable def omega' (n : ℕ) : polynomial R
:= ψ'(n+2) * ψ' (n-1)^2 - ψ'(n-2) * ψ' (n+1)^2

local notation `ω'` := omega' A B

lemma omega'_def (n : ℕ): ω' n = ψ'(n+2) * ψ' (n-1)^2 - ψ'(n-2) * ψ' (n+1)^2 := rfl

lemma omega'_def' (n : ℕ): ω' n * (4 * (X^3 + A•X + B•1)) =
ψ'(n+2) * (ψ' (n-1)^2 * (4 * (X^3 + A•X + B•1))) - ψ'(n-2) * (ψ' (n+1)^2 * (4 * (X^3 + A•X + B•1))):=
begin
  rw omega'_def,
  ring,
end

/-- Duplication formula for Ψ2, second version -/
lemma psisq_bit0' {n : ℕ}  (h : 2 ≤ n) (he : ¬ even n) :
 ψ2 (2*n) * (4 * (X^3 + A•X + B•1)) =  ψ2 n * ( ψ'(n+2) * ψ2 (n-1) - ψ'(n-2) * ψ2 (n+1) )^2 :=
begin
  have het : even (2*n) := even_two_mul n,
  unfold psisq,
  have hen' : even (n+1) := even_succ.mpr he,
  have hen'' : even (n-1) := odd.sub_odd (even_odd_succ_iff.mp hen') (odd_bit1 0),
  simp [he, het, hen', hen''],
  rw psi_bit0 A B h,
  ring,
end

/-- Duplic-add-tion formula for ψ2, second version -/
lemma psisq_bit1' {n : ℕ} (h : 1 ≤ n) (he : ¬ even n) :
ψ2 (2*n+1) = (ψ' (n+2) * (ψ' n)^3 - ψ' (n-1) * ψ' (n+1)^3 * (16*(X^3 + A•X + B•1)^2))^2 :=
begin
  unfold psisq,
  have het : even (2*n) := even.mul_left (nat.even_bit0 1) _,
  simp [he, het],
  congr' 1,
  rw psi_bit1 _ _ h,
  simp [he, het],
end

lemma psi_double {n : ℕ} (h : 2 ≤ n) : ψ' (2*n) = ψ' n * ω' n :=
begin
  rw psi_bit0 _ _ h,
  unfold omega',
end

/-- Useful unification of statements -/
def omega_sq (n : ℕ) : polynomial R :=
  (omega' A B n)^2 * (ite (even n) 1 (4 * (X ^ 3 + A • X + B • 1)))

local notation `ω2` := omega_sq A B

lemma omega_sq_def {n : ℕ} : ω2 n =
(omega' A B n)^2 * (ite (even n) 1 (4 * (X ^ 3 + A • X + B • 1))) := rfl

lemma psisq_bit0_omegasq {n : ℕ} (h : 2 ≤ n) : ψ2 (2*n) = ψ2 n * ω2 n :=
begin
  unfold psisq,
  unfold omega_sq,
  have ht : even (2 * n) := even.mul_left (nat.even_bit0 1) _,
  by_cases he : even n;
  {
    simp [he, ht],
    rw psi_double _ _  h,
    ring,
  },
end

lemma psi_simp (n : ℕ) : psi' A B (2 * (n + 1) - 1) = psi' A B (2*n+1) := by congr
lemma psi_simp' (n : ℕ) : psi' A B (n + 1 + 2) = psi' A B (n + 3) := by congr
lemma psi_simp'' (n : ℕ) : psi' A B (n + 1 + 1) = psi' A B (n + 2) := by congr

-- duplication formula is: if P=(x,y), then
-- x(2P) = (9*x^4 + 6*A*x^2 - 8*x*y^2 + A^2)/(4*y^2) = (x^4 - 2*A*x^2 - 8 * B * x + A^2) / (4*y^2)
-- y(2P) = (-27*x^6 - 27*A*x^4 + 36*x^3*y^2 - 9*A^2*x^2 + 12*A*x*y^2 - 8*y^4 - A^3)/(8*y^3)
-- This gives a certain identity between polynomials in x of degree 12.
example {n : ℕ} (h : n < 2) : n = 0 ∨ n = 1 := by omega

lemma psisq_bit0_even {n : ℕ} (hn : 2 ≤ n) (he : even n)
(hc : ω2 n = φ n^3 + A • φ n * ψ2 n ^ 2 + B • ψ2 n ^ 3 ) :
ψ2 (2*n)  = ψ2 n * ((φ n)^3 + A • φ n * (ψ2 n)^2 + B • (ψ2 n)^3) :=
begin
  simp [he, psisq_bit0 A B hn he],
  have he' : ¬ even (n - 1),
  { rw ←odd_iff_not_even,
    apply even.sub_odd (le_of_succ_le hn) he (odd_bit1 0) },
  simp [psisq, he, he'],
  rw ←omega'_def,
  rw ←psisq_def _ _ he,
  suffices :  omega' A B n ^ 2 = phi A B n^ 3 + A • phi A B n * psisq A B n^2 + B • psisq A B n^3,
  by rw this,
  rw ←hc,
  simp [omega_sq_def, he],
end

lemma psisq_bit0_odd {n : ℕ} (hn : 2 ≤ n) (he : ¬ even n)
(hc : ω2 n * (4 * (X^3 + A•X + B•1))  = φ n^3 + A • φ n * ψ2 n ^ 2 + B • ψ2 n ^ 3 ) :
ψ2 (2*n) * (4 * (X^3 + A•X + B•1)) = ψ2 n * ((φ n)^3 + A • φ n * (ψ2 n)^2 + B • (ψ2 n)^3) :=
begin
  simp [he, psisq_bit0' A B hn he],
  have he' : even (n - 1) :=
    odd.sub_odd (odd_iff_not_even.mpr he) (odd_bit1 0),
  simp [psisq, he, he'],
  rw ←omega'_def',
  rw ←psisq_def' _ _ he,
  suffices :  (omega' A B n * (4 * (X ^ 3 + A • X + B • 1))) ^ 2
  = phi A B n^ 3 + A • phi A B n * psisq A B n^2 + B • psisq A B n^3,
    by rw this,
  rw ←hc,
  simp [omega_sq_def, he],
  ring,
end

/-- A formula for relating ψ2(2*n) / ψ2^4 to φ / ψ2 involving φ. Valid for all n ≥ 2 -/
theorem psisq_bit0_inductive {n : ℕ} (hn : 2 ≤ n)
(hc : (ω2 n * (ite (even n) 1 (4 * (X ^ 3 + A • X + B • 1)))) = φ n^3 + A • φ n * ψ2 n ^ 2 + B • ψ2 n ^ 3 ) :
ψ2 (2*n) * (ite (even n) 1  (4 * (X^3 + A•X + B•1))) = ψ2 n * ((φ n)^3 + A • φ n * (ψ2 n)^2 + B • (ψ2 n)^3) :=
begin
  by_cases he : even n,
  { simp [he] at hc ⊢,
    apply psisq_bit0_even _ _ hn he hc },
  { simp [he] at hc ⊢,
    apply psisq_bit0_odd _ _ hn he hc }
end

/-
Now we will study the degrees and leading terms.
-/

example : (X : polynomial R).degree = 1 := degree_X

example (n : ℕ) : ((X : polynomial R)^n).degree = n :=
begin
  finish,
end

lemma deg_psip {n : ℕ} :
(ψ' n).nat_degree = ite (even n) ((n^2-4) / 2) ((n^2-1) / 2) :=
begin
  apply @nat.strong_induction_on (λ n, (ψ' n).nat_degree = ite (even n) ((n^2-4) / 2) ((n^2-1) / 2)),
  rintros m hm,
  clear n,
  simp at hm,
  by_cases h0 : m = 0,
  {
    subst h0,
    simp [psi'],
  },
  by_cases h1 : m = 1,
  {
    subst h1,
    simp [psi'],
  },
  by_cases h2 : m = 2,
  {
    subst h2,
    simp [psi'],
    ring,
  },
  by_cases h3 : m = 3,
  {
    subst h3,
    simp [psi'],
    have htmp : (3^2 -1)/2 = 4, by sorry,
    rw htmp,
    sorry,
  },
  have hm : 4 ≤ m,
  {
    sorry
  },
  clear h0 h1,
  by_cases he : even m,
  {
    simp [he],
    obtain ⟨k, hk⟩ := he,
    subst hk,
    replace hm : 2 ≤ k, by linarith,
    rw psi_bit0 _ _ hm,
    sorry
  },
  {
    sorry
  }
end


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

! This file was ported from Lean 3 source module data.multiset.finset_ops
! leanprover-community/mathlib commit c227d107bbada5d0d9d20287e3282c0a7f1651a0
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Multiset.Dedup

/-!
# Preparations for defining operations on `Finset`.

The operations here ignore multiplicities,
and preparatory for defining the corresponding operations on `Finset`.
-/

namespace Multiset

open List

variable {α : Type _} [DecidableEq α] {s : Multiset α}

/-! ### finset insert -/

/-- `ndinsert a s` is the lift of the list `insert` operation. This operation
  does not respect multiplicities, unlike `cons`, but it is suitable as
  an insert operation on `Finset`. -/
def ndinsert (a : α) (s : Multiset α) : Multiset α :=
  Quot.liftOn s (fun l => (l.insert a : Multiset α)) fun _ _ p => Quot.sound (p.insert a)
#align multiset.ndinsert Multiset.ndinsert

@[simp]
theorem coe_ndinsert (a : α) (l : List α) : ndinsert a l = (insert a l : List α) :=
  rfl
#align multiset.coe_ndinsert Multiset.coe_ndinsert

@[simp, nolint simpNF] -- Porting note: dsimp can not prove this
theorem ndinsert_zero (a : α) : ndinsert a 0 = {a} :=
  rfl
#align multiset.ndinsert_zero Multiset.ndinsert_zero

@[simp]
theorem ndinsert_of_mem {a : α} {s : Multiset α} : a ∈ s → ndinsert a s = s :=
  Quot.inductionOn s fun _ h => congr_arg ((↑) : List α → Multiset α) <| insert_of_mem h
#align multiset.ndinsert_of_mem Multiset.ndinsert_of_mem

@[simp]
theorem ndinsert_of_not_mem {a : α} {s : Multiset α} : a ∉ s → ndinsert a s = a ::ₘ s :=
  Quot.inductionOn s fun _ h => congr_arg ((↑) : List α → Multiset α) <| insert_of_not_mem h
#align multiset.ndinsert_of_not_mem Multiset.ndinsert_of_not_mem

@[simp]
theorem mem_ndinsert {a b : α} {s : Multiset α} : a ∈ ndinsert b s ↔ a = b ∨ a ∈ s :=
  Quot.inductionOn s fun _ => mem_insert_iff
#align multiset.mem_ndinsert Multiset.mem_ndinsert

@[simp]
theorem le_ndinsert_self (a : α) (s : Multiset α) : s ≤ ndinsert a s :=
  Quot.inductionOn s fun _ => (sublist_insert _ _).subperm
#align multiset.le_ndinsert_self Multiset.le_ndinsert_self

--Porting note: removing @[simp], simp can prove it
theorem mem_ndinsert_self (a : α) (s : Multiset α) : a ∈ ndinsert a s :=
  mem_ndinsert.2 (Or.inl rfl)
#align multiset.mem_ndinsert_self Multiset.mem_ndinsert_self

theorem mem_ndinsert_of_mem {a b : α} {s : Multiset α} (h : a ∈ s) : a ∈ ndinsert b s :=
  mem_ndinsert.2 (Or.inr h)
#align multiset.mem_ndinsert_of_mem Multiset.mem_ndinsert_of_mem

@[simp]
theorem length_ndinsert_of_mem {a : α} {s : Multiset α} (h : a ∈ s) :
    card (ndinsert a s) = card s := by simp [h]
#align multiset.length_ndinsert_of_mem Multiset.length_ndinsert_of_mem

@[simp]
theorem length_ndinsert_of_not_mem {a : α} {s : Multiset α} (h : a ∉ s) :
    card (ndinsert a s) = card s + 1 := by simp [h]
#align multiset.length_ndinsert_of_not_mem Multiset.length_ndinsert_of_not_mem

theorem dedup_cons {a : α} {s : Multiset α} : dedup (a ::ₘ s) = ndinsert a (dedup s) := by
  by_cases h : a ∈ s <;> simp [h]
#align multiset.dedup_cons Multiset.dedup_cons

theorem Nodup.ndinsert (a : α) : Nodup s → Nodup (ndinsert a s) :=
  Quot.inductionOn s fun _ => Nodup.insert
#align multiset.nodup.ndinsert Multiset.Nodup.ndinsert

theorem ndinsert_le {a : α} {s t : Multiset α} : ndinsert a s ≤ t ↔ s ≤ t ∧ a ∈ t :=
  ⟨fun h => ⟨le_trans (le_ndinsert_self _ _) h, mem_of_le h (mem_ndinsert_self _ _)⟩, fun ⟨l, m⟩ =>
    if h : a ∈ s then by simp [h, l]
    else by
      rw [ndinsert_of_not_mem h, ← cons_erase m, cons_le_cons_iff, ← le_cons_of_not_mem h,
          cons_erase m];
        exact l⟩
#align multiset.ndinsert_le Multiset.ndinsert_le

theorem attach_ndinsert (a : α) (s : Multiset α) :
    (s.ndinsert a).attach =
      ndinsert ⟨a, mem_ndinsert_self a s⟩ (s.attach.map fun p => ⟨p.1, mem_ndinsert_of_mem p.2⟩) :=
  have eq :
    ∀ h : ∀ p : { x // x ∈ s }, p.1 ∈ s,
      (fun p : { x // x ∈ s } => ⟨p.val, h p⟩ : { x // x ∈ s } → { x // x ∈ s }) = id :=
    fun h => funext fun p => Subtype.eq rfl
  have :
    ∀ (t) (eq : s.ndinsert a = t),
      t.attach =
        ndinsert ⟨a, eq ▸ mem_ndinsert_self a s⟩
          (s.attach.map fun p => ⟨p.1, eq ▸ mem_ndinsert_of_mem p.2⟩) :=
    by
    intro t ht
    by_cases h : a ∈ s
    · rw [ndinsert_of_mem h] at ht
      subst ht
      rw [eq, map_id, ndinsert_of_mem (mem_attach _ _)]
    · rw [ndinsert_of_not_mem h] at ht
      subst ht
      simp [attach_cons, h]
  this _ rfl
#align multiset.attach_ndinsert Multiset.attach_ndinsert

@[simp]
theorem disjoint_ndinsert_left {a : α} {s t : Multiset α} :
    Disjoint (ndinsert a s) t ↔ a ∉ t ∧ Disjoint s t :=
  Iff.trans (by simp [Disjoint]) disjoint_cons_left
#align multiset.disjoint_ndinsert_left Multiset.disjoint_ndinsert_left

@[simp]
theorem disjoint_ndinsert_right {a : α} {s t : Multiset α} :
    Disjoint s (ndinsert a t) ↔ a ∉ s ∧ Disjoint s t := by
  rw [disjoint_comm, disjoint_ndinsert_left]; tauto
#align multiset.disjoint_ndinsert_right Multiset.disjoint_ndinsert_right

/-! ### finset union -/

/-- `ndunion s t` is the lift of the list `union` operation. This operation
  does not respect multiplicities, unlike `s ∪ t`, but it is suitable as
  a union operation on `Finset`. (`s ∪ t` would also work as a union operation
  on finset, but this is more efficient.) -/
def ndunion (s t : Multiset α) : Multiset α :=
  (Quotient.liftOn₂ s t fun l₁ l₂ => (l₁.union l₂ : Multiset α)) fun _ _ _ _ p₁ p₂ =>
    Quot.sound <| p₁.union p₂
#align multiset.ndunion Multiset.ndunion

@[simp]
theorem coe_ndunion (l₁ l₂ : List α) : @ndunion α _ l₁ l₂ = (l₁ ∪ l₂ : List α) :=
  rfl
#align multiset.coe_ndunion Multiset.coe_ndunion

--Porting note: removing @[simp], simp can prove it
theorem zero_ndunion (s : Multiset α) : ndunion 0 s = s :=
  Quot.inductionOn s fun _ => rfl
#align multiset.zero_ndunion Multiset.zero_ndunion

@[simp]
theorem cons_ndunion (s t : Multiset α) (a : α) : ndunion (a ::ₘ s) t = ndinsert a (ndunion s t) :=
  Quot.induction_on₂ s t fun _ _ => rfl
#align multiset.cons_ndunion Multiset.cons_ndunion

@[simp]
theorem mem_ndunion {s t : Multiset α} {a : α} : a ∈ ndunion s t ↔ a ∈ s ∨ a ∈ t :=
  Quot.induction_on₂ s t fun _ _ => List.mem_union
#align multiset.mem_ndunion Multiset.mem_ndunion

theorem le_ndunion_right (s t : Multiset α) : t ≤ ndunion s t :=
  Quot.induction_on₂ s t fun _ _ => (suffix_union_right _ _).sublist.subperm
#align multiset.le_ndunion_right Multiset.le_ndunion_right

theorem subset_ndunion_right (s t : Multiset α) : t ⊆ ndunion s t :=
  subset_of_le (le_ndunion_right s t)
#align multiset.subset_ndunion_right Multiset.subset_ndunion_right

theorem ndunion_le_add (s t : Multiset α) : ndunion s t ≤ s + t :=
  Quot.induction_on₂ s t fun _ _ => (union_sublist_append _ _).subperm
#align multiset.ndunion_le_add Multiset.ndunion_le_add

theorem ndunion_le {s t u : Multiset α} : ndunion s t ≤ u ↔ s ⊆ u ∧ t ≤ u :=
  Multiset.induction_on s (by simp [zero_ndunion])
    (fun _ _ h =>
      by simp only [cons_ndunion, mem_ndunion, ndinsert_le, and_comm, cons_subset, and_left_comm, h,
        and_assoc])
#align multiset.ndunion_le Multiset.ndunion_le

theorem subset_ndunion_left (s t : Multiset α) : s ⊆ ndunion s t := fun _ h =>
  mem_ndunion.2 <| Or.inl h
#align multiset.subset_ndunion_left Multiset.subset_ndunion_left

theorem le_ndunion_left {s} (t : Multiset α) (d : Nodup s) : s ≤ ndunion s t :=
  (le_iff_subset d).2 <| subset_ndunion_left _ _
#align multiset.le_ndunion_left Multiset.le_ndunion_left

theorem ndunion_le_union (s t : Multiset α) : ndunion s t ≤ s ∪ t :=
  ndunion_le.2 ⟨subset_of_le (le_union_left _ _), le_union_right _ _⟩
#align multiset.ndunion_le_union Multiset.ndunion_le_union

theorem Nodup.ndunion (s : Multiset α) {t : Multiset α} : Nodup t → Nodup (ndunion s t) :=
  Quot.induction_on₂ s t fun _ _ => List.Nodup.union _
#align multiset.nodup.ndunion Multiset.Nodup.ndunion

@[simp]
theorem ndunion_eq_union {s t : Multiset α} (d : Nodup s) : ndunion s t = s ∪ t :=
  le_antisymm (ndunion_le_union _ _) <| union_le (le_ndunion_left _ d) (le_ndunion_right _ _)
#align multiset.ndunion_eq_union Multiset.ndunion_eq_union

theorem dedup_add (s t : Multiset α) : dedup (s + t) = ndunion s (dedup t) :=
  Quot.induction_on₂ s t fun _ _ => congr_arg ((↑) : List α → Multiset α) <| dedup_append _ _
#align multiset.dedup_add Multiset.dedup_add

/-! ### finset inter -/

/-- `ndinter s t` is the lift of the list `∩` operation. This operation
  does not respect multiplicities, unlike `s ∩ t`, but it is suitable as
  an intersection operation on `Finset`. (`s ∩ t` would also work as a union operation
  on finset, but this is more efficient.) -/
def ndinter (s t : Multiset α) : Multiset α :=
  filter (· ∈ t) s
#align multiset.ndinter Multiset.ndinter

@[simp]
theorem coe_ndinter (l₁ l₂ : List α) : @ndinter α _ l₁ l₂ = (l₁ ∩ l₂ : List α) :=
  rfl
#align multiset.coe_ndinter Multiset.coe_ndinter

@[simp, nolint simpNF] -- Porting note: dsimp can not prove this
theorem zero_ndinter (s : Multiset α) : ndinter 0 s = 0 :=
  rfl
#align multiset.zero_ndinter Multiset.zero_ndinter

@[simp]
theorem cons_ndinter_of_mem {a : α} (s : Multiset α) {t : Multiset α} (h : a ∈ t) :
    ndinter (a ::ₘ s) t = a ::ₘ ndinter s t := by simp [ndinter, h]
#align multiset.cons_ndinter_of_mem Multiset.cons_ndinter_of_mem

@[simp]
theorem ndinter_cons_of_not_mem {a : α} (s : Multiset α) {t : Multiset α} (h : a ∉ t) :
    ndinter (a ::ₘ s) t = ndinter s t := by simp [ndinter, h]
#align multiset.ndinter_cons_of_not_mem Multiset.ndinter_cons_of_not_mem

@[simp]
theorem mem_ndinter {s t : Multiset α} {a : α} : a ∈ ndinter s t ↔ a ∈ s ∧ a ∈ t := by
  simp [ndinter, mem_filter]
#align multiset.mem_ndinter Multiset.mem_ndinter

@[simp]

theorem le_ndinter {s t u : Multiset α} : s ≤ ndinter t u ↔ s ≤ t ∧ s ⊆ u := by
  simp [ndinter, le_filter, subset_iff]
#align multiset.le_ndinter Multiset.le_ndinter

theorem ndinter_le_left (s t : Multiset α) : ndinter s t ≤ s :=
  (le_ndinter.1 le_rfl).1
#align multiset.ndinter_le_left Multiset.ndinter_le_left

theorem ndinter_subset_left (s t : Multiset α) : ndinter s t ⊆ s :=
  subset_of_le (ndinter_le_left s t)
#align multiset.ndinter_subset_left Multiset.ndinter_subset_left

theorem ndinter_subset_right (s t : Multiset α) : ndinter s t ⊆ t :=
  (le_ndinter.1 le_rfl).2
#align multiset.ndinter_subset_right Multiset.ndinter_subset_right

theorem ndinter_le_right {s} (t : Multiset α) (d : Nodup s) : ndinter s t ≤ t :=
  (le_iff_subset <| d.ndinter _).2 <| ndinter_subset_right _ _
#align multiset.ndinter_le_right Multiset.ndinter_le_right

theorem inter_le_ndinter (s t : Multiset α) : s ∩ t ≤ ndinter s t :=
  le_ndinter.2 ⟨inter_le_left _ _, subset_of_le <| inter_le_right _ _⟩
#align multiset.inter_le_ndinter Multiset.inter_le_ndinter

@[simp]
theorem ndinter_eq_inter {s t : Multiset α} (d : Nodup s) : ndinter s t = s ∩ t :=
  le_antisymm (le_inter (ndinter_le_left _ _) (ndinter_le_right _ d)) (inter_le_ndinter _ _)
#align multiset.ndinter_eq_inter Multiset.ndinter_eq_inter

theorem ndinter_eq_zero_iff_disjoint {s t : Multiset α} : ndinter s t = 0 ↔ Disjoint s t := by
  rw [← subset_zero]; simp [subset_iff, Disjoint]
#align multiset.ndinter_eq_zero_iff_disjoint Multiset.ndinter_eq_zero_iff_disjoint

end Multiset

-- Porting note: `assert_not_exists` has not been ported yet.
-- -- Assert that we define `finset` without the material on the set lattice.
-- -- Note that we cannot put this in `data.finset.basic` because we proved relevant lemmas there.
-- assert_not_exists set.sInter


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl
-/
import order.hom.basic
import order.min_max
import algebra.group.units

/-!
# Units in ordered monoids

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

variables {α : Type*}

namespace units

@[to_additive]
instance [monoid α] [preorder α] : preorder αˣ :=
preorder.lift (coe : αˣ → α)

@[simp, norm_cast, to_additive]
theorem coe_le_coe [monoid α] [preorder α] {a b : αˣ} :
  (a : α) ≤ b ↔ a ≤ b := iff.rfl

@[simp, norm_cast, to_additive]
theorem coe_lt_coe [monoid α] [preorder α] {a b : αˣ} :
  (a : α) < b ↔ a < b := iff.rfl

@[to_additive]
instance [monoid α] [partial_order α] : partial_order αˣ :=
partial_order.lift coe units.ext

@[to_additive]
instance [monoid α] [linear_order α] : linear_order αˣ :=
linear_order.lift' coe units.ext

/-- `coe : αˣ → α` as an order embedding. -/
@[to_additive "`coe : add_units α → α` as an order embedding.", simps { fully_applied := ff }]
def order_embedding_coe [monoid α] [linear_order α] : αˣ ↪o α := ⟨⟨coe, ext⟩, λ _ _, iff.rfl⟩

@[simp, norm_cast, to_additive]
theorem max_coe [monoid α] [linear_order α] {a b : αˣ} :
  (↑(max a b) : α) = max a b :=
monotone.map_max order_embedding_coe.monotone

@[simp, norm_cast, to_additive]
theorem min_coe [monoid α] [linear_order α] {a b : αˣ} :
  (↑(min a b) : α) = min a b :=
monotone.map_min order_embedding_coe.monotone

end units


/-
Copyright (c) 2021 Aaron Anderson, Jesse Michael Han, Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson, Jesse Michael Han, Floris van Doorn
-/
import model_theory.basic
/-!
# Language Maps
Maps between first-order languages in the style of the
[Flypitch project](https://flypitch.github.io/), as well as several important maps between
structures.

## Main Definitions
* A `first_order.language.Lhom`, denoted `L →ᴸ L'`, is a map between languages, sending the symbols
  of one to symbols of the same kind and arity in the other.
* A `first_order.language.Lequiv`, denoted `L ≃ᴸ L'`, is an invertible language homomorphism.
* `first_order.language.with_constants` is defined so that if `M` is an `L.Structure` and
  `A : set M`, `L.with_constants A`, denoted `L[[A]]`, is a language which adds constant symbols for
  elements of `A` to `L`.

## References
For the Flypitch project:
- [J. Han, F. van Doorn, *A formal proof of the independence of the continuum hypothesis*]
[flypitch_cpp]
- [J. Han, F. van Doorn, *A formalization of forcing and the unprovability of
the continuum hypothesis*][flypitch_itp]

-/

universes u v u' v' w

namespace first_order
namespace language
open Structure cardinal
open_locale cardinal

variables (L : language.{u v}) (L' : language.{u' v'}) {M : Type w} [L.Structure M]

/-- A language homomorphism maps the symbols of one language to symbols of another. -/
structure Lhom :=
(on_function : ∀{n}, L.functions n → L'.functions n)
(on_relation : ∀{n}, L.relations n → L'.relations n)

infix ` →ᴸ `:10 := Lhom -- \^L

variables {L L'}

namespace Lhom

/-- Defines a map between languages defined with `language.mk₂`. -/
protected def mk₂ {c f₁ f₂ : Type u} {r₁ r₂ : Type v}
  (φ₀ : c → L'.constants) (φ₁ : f₁ → L'.functions 1) (φ₂ : f₂ → L'.functions 2)
  (φ₁' : r₁ → L'.relations 1) (φ₂' : r₂ → L'.relations 2) :
  language.mk₂ c f₁ f₂ r₁ r₂ →ᴸ L' :=
⟨λ n, nat.cases_on n φ₀ (λ n, nat.cases_on n φ₁ (λ n, nat.cases_on n φ₂ (λ _, pempty.elim))),
  λ n, nat.cases_on n pempty.elim
    (λ n, nat.cases_on n φ₁' (λ n, nat.cases_on n φ₂' (λ _, pempty.elim)))⟩

variables (ϕ : L →ᴸ L')

/-- Pulls a structure back along a language map. -/
def reduct (M : Type*) [L'.Structure M] : L.Structure M :=
{ fun_map := λ n f xs, fun_map (ϕ.on_function f) xs,
  rel_map := λ n r xs, rel_map (ϕ.on_relation r) xs }

/-- The identity language homomorphism. -/
@[simps] protected def id (L : language) : L →ᴸ L :=
⟨λn, id, λ n, id⟩

instance : inhabited (L →ᴸ L) := ⟨Lhom.id L⟩

/-- The inclusion of the left factor into the sum of two languages. -/
@[simps] protected def sum_inl : L →ᴸ L.sum L' :=
⟨λn, sum.inl, λ n, sum.inl⟩

/-- The inclusion of the right factor into the sum of two languages. -/
@[simps] protected def sum_inr : L' →ᴸ L.sum L' :=
⟨λn, sum.inr, λ n, sum.inr⟩

variables (L L')

/-- The inclusion of an empty language into any other language. -/
@[simps] protected def of_is_empty [L.is_algebraic] [L.is_relational] : L →ᴸ L' :=
⟨λ n, (is_relational.empty_functions n).elim, λ n, (is_algebraic.empty_relations n).elim⟩

variables {L L'} {L'' : language}

@[ext] protected lemma funext {F G : L →ᴸ L'} (h_fun : F.on_function = G.on_function )
  (h_rel : F.on_relation = G.on_relation ) : F = G :=
by {cases F with Ff Fr, cases G with Gf Gr, simp only *, exact and.intro h_fun h_rel}

instance [L.is_algebraic] [L.is_relational] : unique (L →ᴸ L') :=
⟨⟨Lhom.of_is_empty L L'⟩, λ _, Lhom.funext (subsingleton.elim _ _) (subsingleton.elim _ _)⟩

lemma mk₂_funext {c f₁ f₂ : Type u} {r₁ r₂ : Type v} {F G : language.mk₂ c f₁ f₂ r₁ r₂ →ᴸ L'}
  (h0 : ∀ (c : (language.mk₂ c f₁ f₂ r₁ r₂).constants), F.on_function c = G.on_function c)
  (h1 : ∀ (f : (language.mk₂ c f₁ f₂ r₁ r₂).functions 1), F.on_function f = G.on_function f)
  (h2 : ∀ (f : (language.mk₂ c f₁ f₂ r₁ r₂).functions 2), F.on_function f = G.on_function f)
  (h1' : ∀ (r : (language.mk₂ c f₁ f₂ r₁ r₂).relations 1), F.on_relation r = G.on_relation r)
  (h2' : ∀ (r : (language.mk₂ c f₁ f₂ r₁ r₂).relations 2), F.on_relation r = G.on_relation r) :
  F = G :=
Lhom.funext (funext (λ n, nat.cases_on n (funext h0) (λ n, nat.cases_on n (funext h1)
      (λ n, nat.cases_on n (funext h2) (λ n, funext (λ f, pempty.elim f))))))
      (funext (λ n, nat.cases_on n (funext (λ r, pempty.elim r)) (λ n, nat.cases_on n (funext h1')
      (λ n, nat.cases_on n (funext h2') (λ n, funext (λ r, pempty.elim r))))))

/-- The composition of two language homomorphisms. -/
@[simps] def comp (g : L' →ᴸ L'') (f : L →ᴸ L') : L →ᴸ L'' :=
⟨λ n F, g.1 (f.1 F), λ _ R, g.2 (f.2 R)⟩

local infix ` ∘ `:60 := Lhom.comp

@[simp] lemma id_comp (F : L →ᴸ L') : (Lhom.id L') ∘ F = F :=
by {cases F, refl}

@[simp] lemma comp_id (F : L →ᴸ L') : F ∘ (Lhom.id L) = F :=
by {cases F, refl}

lemma comp_assoc {L3 : language} (F: L'' →ᴸ L3) (G : L' →ᴸ L'') (H : L →ᴸ L') :
  (F ∘ G) ∘ H = F ∘ (G ∘ H) :=
rfl

section sum_elim

variables (ψ : L'' →ᴸ L')

/-- A language map defined on two factors of a sum. -/
@[simps] protected def sum_elim : L.sum L'' →ᴸ L' :=
{ on_function := λ n, sum.elim (λ f, ϕ.on_function f) (λ f, ψ.on_function f),
  on_relation := λ n, sum.elim (λ f, ϕ.on_relation f) (λ f, ψ.on_relation f) }

lemma sum_elim_comp_inl (ψ : L'' →ᴸ L') :
  (ϕ.sum_elim ψ) ∘ Lhom.sum_inl = ϕ :=
Lhom.funext (funext (λ _, rfl)) (funext (λ _, rfl))

lemma sum_elim_comp_inr (ψ : L'' →ᴸ L') :
  (ϕ.sum_elim ψ) ∘ Lhom.sum_inr = ψ :=
Lhom.funext (funext (λ _, rfl)) (funext (λ _, rfl))

theorem sum_elim_inl_inr :
  (Lhom.sum_inl).sum_elim (Lhom.sum_inr) = Lhom.id (L.sum L') :=
Lhom.funext (funext (λ _, sum.elim_inl_inr)) (funext (λ _, sum.elim_inl_inr))

theorem comp_sum_elim {L3 : language} (θ : L' →ᴸ L3) :
  θ ∘ (ϕ.sum_elim ψ) = (θ ∘ ϕ).sum_elim (θ ∘ ψ) :=
Lhom.funext (funext (λ n, sum.comp_elim _ _ _)) (funext (λ n, sum.comp_elim _ _ _))

end sum_elim

section sum_map

variables {L₁ L₂ : language} (ψ : L₁ →ᴸ L₂)

/-- The map between two sum-languages induced by maps on the two factors. -/
@[simps] def sum_map : L.sum L₁ →ᴸ L'.sum L₂ :=
{ on_function := λ n, sum.map (λ f, ϕ.on_function f) (λ f, ψ.on_function f),
  on_relation := λ n, sum.map (λ f, ϕ.on_relation f) (λ f, ψ.on_relation f) }

@[simp] lemma sum_map_comp_inl :
  (ϕ.sum_map ψ) ∘ Lhom.sum_inl = Lhom.sum_inl ∘ ϕ :=
Lhom.funext (funext (λ _, rfl)) (funext (λ _, rfl))

@[simp] lemma sum_map_comp_inr :
  (ϕ.sum_map ψ) ∘ Lhom.sum_inr = Lhom.sum_inr ∘ ψ :=
Lhom.funext (funext (λ _, rfl)) (funext (λ _, rfl))

end sum_map

/-- A language homomorphism is injective when all the maps between symbol types are. -/
protected structure injective : Prop :=
(on_function {n} : function.injective (on_function ϕ : L.functions n → L'.functions n))
(on_relation {n} : function.injective (on_relation ϕ : L.relations n → L'.relations n))

/-- A language homomorphism is an expansion on a structure if it commutes with the interpretation of
all symbols on that structure. -/
class is_expansion_on (M : Type*) [L.Structure M] [L'.Structure M] : Prop :=
(map_on_function : ∀ {n} (f : L.functions n) (x : fin n → M),
  fun_map (ϕ.on_function f) x = fun_map f x)
(map_on_relation : ∀ {n} (R : L.relations n) (x : fin n → M),
  rel_map (ϕ.on_relation R) x = rel_map R x)

attribute [simp] is_expansion_on.map_on_function is_expansion_on.map_on_relation

instance id_is_expansion_on (M : Type*) [L.Structure M] : is_expansion_on (Lhom.id L) M :=
⟨λ _ _ _, rfl, λ _ _ _, rfl⟩

instance of_is_empty_is_expansion_on (M : Type*) [L.Structure M] [L'.Structure M]
  [L.is_algebraic] [L.is_relational] :
  is_expansion_on (Lhom.of_is_empty L L') M :=
⟨λ n, (is_relational.empty_functions n).elim, λ n, (is_algebraic.empty_relations n).elim⟩

instance sum_elim_is_expansion_on {L'' : language} (ψ : L'' →ᴸ L') (M : Type*)
  [L.Structure M] [L'.Structure M] [L''.Structure M]
  [ϕ.is_expansion_on M] [ψ.is_expansion_on M] :
  (ϕ.sum_elim ψ).is_expansion_on M :=
⟨λ _ f _, sum.cases_on f (by simp) (by simp), λ _ R _, sum.cases_on R (by simp) (by simp)⟩

instance sum_map_is_expansion_on {L₁ L₂ : language} (ψ : L₁ →ᴸ L₂) (M : Type*)
  [L.Structure M] [L'.Structure M] [L₁.Structure M] [L₂.Structure M]
  [ϕ.is_expansion_on M] [ψ.is_expansion_on M] :
  (ϕ.sum_map ψ).is_expansion_on M :=
⟨λ _ f _, sum.cases_on f (by simp) (by simp), λ _ R _, sum.cases_on R (by simp) (by simp)⟩

instance sum_inl_is_expansion_on (M : Type*)
  [L.Structure M] [L'.Structure M] :
  (Lhom.sum_inl : L →ᴸ L.sum L').is_expansion_on M :=
⟨λ _ f _, rfl, λ _ R _, rfl⟩

instance sum_inr_is_expansion_on (M : Type*)
  [L.Structure M] [L'.Structure M] :
  (Lhom.sum_inr : L' →ᴸ L.sum L').is_expansion_on M :=
⟨λ _ f _, rfl, λ _ R _, rfl⟩

@[priority 100] instance is_expansion_on_reduct (ϕ : L →ᴸ L') (M : Type*) [L'.Structure M] :
  @is_expansion_on L L' ϕ M (ϕ.reduct M) _ :=
begin
  letI := ϕ.reduct M,
  exact ⟨λ _ f _, rfl, λ _ R _, rfl⟩,
end

end Lhom

/-- A language equivalence maps the symbols of one language to symbols of another bijectively. -/
structure Lequiv (L L' : language) :=
(to_Lhom : L →ᴸ L')
(inv_Lhom : L' →ᴸ L)
(left_inv : inv_Lhom.comp to_Lhom = Lhom.id L)
(right_inv : to_Lhom.comp inv_Lhom = Lhom.id L')

infix ` ≃ᴸ `:10 := Lequiv -- \^L

namespace Lequiv

variable (L)

/-- The identity equivalence from a first-order language to itself. -/
@[simps] protected def refl : L ≃ᴸ L :=
⟨Lhom.id L, Lhom.id L, Lhom.id_comp _, Lhom.id_comp _⟩

variable {L}

instance : inhabited (L ≃ᴸ L) := ⟨Lequiv.refl L⟩

variables {L'' : language} (e' : L' ≃ᴸ L'') (e : L ≃ᴸ L')

/-- The inverse of an equivalence of first-order languages. -/
@[simps] protected def symm : L' ≃ᴸ L :=
⟨e.inv_Lhom, e.to_Lhom, e.right_inv, e.left_inv⟩

/-- The composition of equivalences of first-order languages. -/
@[simps, trans] protected def trans (e : L ≃ᴸ L') (e' : L' ≃ᴸ L'') : L ≃ᴸ L'' :=
⟨e'.to_Lhom.comp e.to_Lhom, e.inv_Lhom.comp e'.inv_Lhom,
  by rw [Lhom.comp_assoc, ← Lhom.comp_assoc e'.inv_Lhom, e'.left_inv, Lhom.id_comp, e.left_inv],
  by rw [Lhom.comp_assoc, ← Lhom.comp_assoc e.to_Lhom, e.right_inv, Lhom.id_comp, e'.right_inv]⟩

end Lequiv

section constants_on
variables (α : Type u')

/-- A language with constants indexed by a type. -/
@[simp] def constants_on : language.{u' 0} :=
  language.mk₂ α pempty pempty pempty pempty

variables {α}

lemma constants_on_constants : (constants_on α).constants = α := rfl

instance is_algebraic_constants_on : is_algebraic (constants_on α) :=
language.is_algebraic_mk₂

instance is_relational_constants_on [ie : is_empty α] : is_relational (constants_on α) :=
language.is_relational_mk₂

instance is_empty_functions_constants_on_succ {n : ℕ} :
  is_empty ((constants_on α).functions (n + 1)) :=
nat.cases_on n pempty.is_empty (λ n, nat.cases_on n pempty.is_empty (λ _, pempty.is_empty))

lemma card_constants_on : (constants_on α).card = # α :=
by simp

/-- Gives a `constants_on α` structure to a type by assigning each constant a value. -/
def constants_on.Structure (f : α → M) : (constants_on α).Structure M :=
Structure.mk₂ f pempty.elim pempty.elim pempty.elim pempty.elim

variables {β : Type v'}

/-- A map between index types induces a map between constant languages. -/
def Lhom.constants_on_map (f : α → β) : (constants_on α) →ᴸ (constants_on β) :=
Lhom.mk₂ f pempty.elim pempty.elim pempty.elim pempty.elim

lemma constants_on_map_is_expansion_on {f : α → β} {fα : α → M} {fβ : β → M}
  (h : fβ ∘ f = fα) :
  @Lhom.is_expansion_on _ _ (Lhom.constants_on_map f) M
    (constants_on.Structure fα) (constants_on.Structure fβ) :=
begin
  letI := constants_on.Structure fα,
  letI := constants_on.Structure fβ,
  exact ⟨λ n, nat.cases_on n (λ F x, (congr_fun h F : _)) (λ n F, is_empty_elim F),
    λ _ R, is_empty_elim R⟩
end

end constants_on

section with_constants

variable (L)

section
variables (α : Type w)

/-- Extends a language with a constant for each element of a parameter set in `M`. -/
def with_constants : language.{(max u w) v} := L.sum (constants_on α)

localized "notation L`[[`:95 α`]]`:90 := L.with_constants α" in first_order

@[simp] lemma card_with_constants :
  (L[[α]]).card = cardinal.lift.{w} L.card + cardinal.lift.{max u v} (# α) :=
by rw [with_constants, card_sum, card_constants_on]

/-- The language map adding constants.  -/
@[simps] def Lhom_with_constants : L →ᴸ L[[α]] := Lhom.sum_inl

variables {α}

/-- The constant symbol indexed by a particular element. -/
protected def con (a : α) : L[[α]].constants := sum.inr a

variables {L} (α)

/-- Adds constants to a language map.  -/
def Lhom.add_constants {L' : language} (φ : L →ᴸ L') :
  L[[α]] →ᴸ L'[[α]] := φ.sum_map (Lhom.id _)

instance params_Structure (A : set α) : (constants_on A).Structure α := constants_on.Structure coe

variables (L) (α)

/-- The language map removing an empty constant set.  -/
@[simps] def Lequiv.add_empty_constants [ie : is_empty α] : L ≃ᴸ L[[α]] :=
{ to_Lhom := Lhom_with_constants L α,
  inv_Lhom := Lhom.sum_elim (Lhom.id L) (Lhom.of_is_empty (constants_on α) L),
  left_inv := by rw [Lhom_with_constants, Lhom.sum_elim_comp_inl],
  right_inv := by { simp only [Lhom.comp_sum_elim, Lhom_with_constants, Lhom.comp_id],
    exact trans (congr rfl (subsingleton.elim _ _)) Lhom.sum_elim_inl_inr } }

variables {α} {β : Type*}

/-- The language map extending the constant set.  -/
def Lhom_with_constants_map (f : α → β) : L[[α]] →ᴸ L[[β]] :=
Lhom.sum_map (Lhom.id L) (Lhom.constants_on_map f)

@[simp] lemma Lhom.map_constants_comp_sum_inl {f : α → β} :
  (L.Lhom_with_constants_map f).comp (Lhom.sum_inl) = L.Lhom_with_constants β :=
by ext n f R; refl

end

open_locale first_order

instance constants_on_self_Structure : (constants_on M).Structure M :=
constants_on.Structure id

instance with_constants_self_Structure : L[[M]].Structure M :=
language.sum_Structure _ _ M

instance with_constants_self_expansion : (Lhom_with_constants L M).is_expansion_on M :=
⟨λ _ _ _, rfl, λ _ _ _, rfl⟩

variables (α : Type*) [(constants_on α).Structure M]

instance with_constants_Structure : L[[α]].Structure M :=
language.sum_Structure _ _ _

instance with_constants_expansion : (L.Lhom_with_constants α).is_expansion_on M :=
⟨λ _ _ _, rfl, λ _ _ _, rfl⟩

instance add_empty_constants_is_expansion_on' :
  (Lequiv.add_empty_constants L (∅ : set M)).to_Lhom.is_expansion_on M :=
L.with_constants_expansion _

instance add_empty_constants_symm_is_expansion_on :
  (Lequiv.add_empty_constants L (∅ : set M)).symm.to_Lhom.is_expansion_on M :=
Lhom.sum_elim_is_expansion_on _ _ _

instance add_constants_expansion {L' : language} [L'.Structure M] (φ : L →ᴸ L')
  [φ.is_expansion_on M] :
  (φ.add_constants α).is_expansion_on M :=
Lhom.sum_map_is_expansion_on _ _ M

variables {α} (A : set M)

@[simp] lemma coe_con {a : A} : ((L.con a) : M) = a := rfl

variables {A} {B : set M} (h : A ⊆ B)

instance constants_on_map_inclusion_is_expansion_on :
  (Lhom.constants_on_map (set.inclusion h)).is_expansion_on M :=
constants_on_map_is_expansion_on rfl

instance map_constants_inclusion_is_expansion_on :
  (L.Lhom_with_constants_map (set.inclusion h)).is_expansion_on M :=
Lhom.sum_map_is_expansion_on _ _ _

end with_constants
end language
end first_order