/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Patrick Massot

! This file was ported from Lean 3 source module topology.algebra.order.proj_Icc
! leanprover-community/mathlib commit 50832daea47b195a48b5b33b1c8b2162c48c3afc
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Set.Intervals.ProjIcc
import Mathbin.Topology.Order.Basic

/-!
# Projection onto a closed interval

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

In this file we prove that the projection `set.proj_Icc f a b h` is a quotient map, and use it
to show that `Icc_extend h f` is continuous if and only if `f` is continuous.
-/

open Set Filter

open Filter Topology

variable {α β γ : Type _} [LinearOrder α] [TopologicalSpace γ] {a b c : α} {h : a ≤ b}

/- warning: filter.tendsto.Icc_extend -> Filter.Tendsto.IccExtend' is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {γ : Type.{u3}} [_inst_1 : LinearOrder.{u1} α] [_inst_2 : TopologicalSpace.{u3} γ] {a : α} {b : α} {h : LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1))))) a b} (f : γ -> (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b)) -> β) {z : γ} {l : Filter.{u1} α} {l' : Filter.{u2} β}, (Filter.Tendsto.{max u3 u1, u2} (Prod.{u3, u1} γ (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b))) β (Function.HasUncurry.uncurry.{max u3 u1 u2, max u3 u1, u2} (γ -> (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b)) -> β) (Prod.{u3, u1} γ (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b))) β (Function.hasUncurryInduction.{u3, max u1 u2, u1, u2} γ ((coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b)) -> β) (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b)) β (Function.hasUncurryBase.{u1, u2} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b)) β)) f) (Filter.prod.{u3, u1} γ (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b)) (nhds.{u3} γ _inst_2 z) (Filter.map.{u1, u1} α (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b)) (Set.projIcc.{u1} α _inst_1 a b h) l)) l') -> (Filter.Tendsto.{max u3 u1, u2} (Prod.{u3, u1} γ α) β (Function.HasUncurry.uncurry.{max u3 u1 u2, max u3 u1, u2} (γ -> α -> β) (Prod.{u3, u1} γ α) β (Function.hasUncurryInduction.{u3, max u1 u2, u1, u2} γ (α -> β) α β (Function.hasUncurryBase.{u1, u2} α β)) (Function.comp.{succ u3, max (succ u1) (succ u2), max (succ u1) (succ u2)} γ ((coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b)) -> β) (α -> β) (Set.IccExtend.{u1, u2} α β _inst_1 a b h) f)) (Filter.prod.{u3, u1} γ α (nhds.{u3} γ _inst_2 z) l) l')
but is expected to have type
  forall {α : Type.{u3}} {β : Type.{u2}} {γ : Type.{u1}} [_inst_1 : LinearOrder.{u3} α] [_inst_2 : TopologicalSpace.{u1} γ] {a : α} {b : α} {h : LE.le.{u3} α (Preorder.toLE.{u3} α (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1)))))) a b} (f : γ -> (Set.Elem.{u3} α (Set.Icc.{u3} α (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1))))) a b)) -> β) {z : γ} {l : Filter.{u3} α} {l' : Filter.{u2} β}, (Filter.Tendsto.{max u3 u1, u2} (Prod.{u1, u3} γ (Set.Elem.{u3} α (Set.Icc.{u3} α (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1))))) a b))) β (Function.HasUncurry.uncurry.{max (max u3 u2) u1, max u3 u1, u2} (γ -> (Set.Elem.{u3} α (Set.Icc.{u3} α (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1))))) a b)) -> β) (Prod.{u1, u3} γ (Set.Elem.{u3} α (Set.Icc.{u3} α (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1))))) a b))) β (Function.hasUncurryInduction.{u1, max u3 u2, u3, u2} γ ((Set.Elem.{u3} α (Set.Icc.{u3} α (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1))))) a b)) -> β) (Set.Elem.{u3} α (Set.Icc.{u3} α (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1))))) a b)) β (Function.hasUncurryBase.{u3, u2} (Set.Elem.{u3} α (Set.Icc.{u3} α (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1))))) a b)) β)) f) (Filter.prod.{u1, u3} γ (Set.Elem.{u3} α (Set.Icc.{u3} α (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1))))) a b)) (nhds.{u1} γ _inst_2 z) (Filter.map.{u3, u3} α (Set.Elem.{u3} α (Set.Icc.{u3} α (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1))))) a b)) (Set.projIcc.{u3} α _inst_1 a b h) l)) l') -> (Filter.Tendsto.{max u3 u1, u2} (Prod.{u1, u3} γ α) β (Function.HasUncurry.uncurry.{max (max u3 u2) u1, max u3 u1, u2} (γ -> α -> β) (Prod.{u1, u3} γ α) β (Function.hasUncurryInduction.{u1, max u3 u2, u3, u2} γ (α -> β) α β (Function.hasUncurryBase.{u3, u2} α β)) (Function.comp.{succ u1, max (succ u2) (succ u3), max (succ u2) (succ u3)} γ ((Set.Elem.{u3} α (Set.Icc.{u3} α (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1))))) a b)) -> β) (α -> β) (Set.IccExtend.{u3, u2} α β _inst_1 a b h) f)) (Filter.prod.{u1, u3} γ α (nhds.{u1} γ _inst_2 z) l) l')
Case conversion may be inaccurate. Consider using '#align filter.tendsto.Icc_extend Filter.Tendsto.IccExtend'ₓ'. -/
theorem Filter.Tendsto.IccExtend' (f : γ → Icc a b → β) {z : γ} {l : Filter α} {l' : Filter β}
    (hf : Tendsto (↿f) (𝓝 z ×ᶠ l.map (projIcc a b h)) l') :
    Tendsto (↿(IccExtend h ∘ f)) (𝓝 z ×ᶠ l) l' :=
  show Tendsto (↿f ∘ Prod.map id (projIcc a b h)) (𝓝 z ×ᶠ l) l' from
    hf.comp <| tendsto_id.Prod_map tendsto_map
#align filter.tendsto.Icc_extend Filter.Tendsto.IccExtend'

variable [TopologicalSpace α] [OrderTopology α] [TopologicalSpace β]

#print continuous_projIcc /-
@[continuity]
theorem continuous_projIcc : Continuous (projIcc a b h) :=
  (continuous_const.max <| continuous_const.min continuous_id).subtype_mk _
#align continuous_proj_Icc continuous_projIcc
-/

#print quotientMap_projIcc /-
theorem quotientMap_projIcc : QuotientMap (projIcc a b h) :=
  quotientMap_iff.2
    ⟨projIcc_surjective h, fun s =>
      ⟨fun hs => hs.Preimage continuous_projIcc, fun hs =>
        ⟨_, hs, by
          ext
          simp⟩⟩⟩
#align quotient_map_proj_Icc quotientMap_projIcc
-/

/- warning: continuous_Icc_extend_iff -> continuous_IccExtend_iff is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : LinearOrder.{u1} α] {a : α} {b : α} {h : LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1))))) a b} [_inst_3 : TopologicalSpace.{u1} α] [_inst_4 : OrderTopology.{u1} α _inst_3 (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1))))] [_inst_5 : TopologicalSpace.{u2} β] {f : (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b)) -> β}, Iff (Continuous.{u1, u2} α β _inst_3 _inst_5 (Set.IccExtend.{u1, u2} α β _inst_1 a b h f)) (Continuous.{u1, u2} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b)) β (Subtype.topologicalSpace.{u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b)) _inst_3) _inst_5 f)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : LinearOrder.{u2} α] {a : α} {b : α} {h : LE.le.{u2} α (Preorder.toLE.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1)))))) a b} [_inst_3 : TopologicalSpace.{u2} α] [_inst_4 : OrderTopology.{u2} α _inst_3 (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1)))))] [_inst_5 : TopologicalSpace.{u1} β] {f : (Set.Elem.{u2} α (Set.Icc.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) a b)) -> β}, Iff (Continuous.{u2, u1} α β _inst_3 _inst_5 (Set.IccExtend.{u2, u1} α β _inst_1 a b h f)) (Continuous.{u2, u1} (Set.Elem.{u2} α (Set.Icc.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) a b)) β (instTopologicalSpaceSubtype.{u2} α (fun (x : α) => Membership.mem.{u2, u2} α (Set.{u2} α) (Set.instMembershipSet.{u2} α) x (Set.Icc.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) a b)) _inst_3) _inst_5 f)
Case conversion may be inaccurate. Consider using '#align continuous_Icc_extend_iff continuous_IccExtend_iffₓ'. -/
@[simp]
theorem continuous_IccExtend_iff {f : Icc a b → β} : Continuous (IccExtend h f) ↔ Continuous f :=
  quotientMap_projIcc.continuous_iff.symm
#align continuous_Icc_extend_iff continuous_IccExtend_iff

/- warning: continuous.Icc_extend -> Continuous.IccExtend is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {γ : Type.{u3}} [_inst_1 : LinearOrder.{u1} α] [_inst_2 : TopologicalSpace.{u3} γ] {a : α} {b : α} {h : LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1))))) a b} [_inst_3 : TopologicalSpace.{u1} α] [_inst_4 : OrderTopology.{u1} α _inst_3 (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1))))] [_inst_5 : TopologicalSpace.{u2} β] {f : γ -> (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b)) -> β} {g : γ -> α}, (Continuous.{max u3 u1, u2} (Prod.{u3, u1} γ (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b))) β (Prod.topologicalSpace.{u3, u1} γ (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b)) _inst_2 (Subtype.topologicalSpace.{u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b)) _inst_3)) _inst_5 (Function.HasUncurry.uncurry.{max u3 u1 u2, max u3 u1, u2} (γ -> (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b)) -> β) (Prod.{u3, u1} γ (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b))) β (Function.hasUncurryInduction.{u3, max u1 u2, u1, u2} γ ((coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b)) -> β) (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b)) β (Function.hasUncurryBase.{u1, u2} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b)) β)) f)) -> (Continuous.{u3, u1} γ α _inst_2 _inst_3 g) -> (Continuous.{u3, u2} γ β _inst_2 _inst_5 (fun (a_1 : γ) => Set.IccExtend.{u1, u2} α β _inst_1 a b h (f a_1) (g a_1)))
but is expected to have type
  forall {α : Type.{u3}} {β : Type.{u1}} {γ : Type.{u2}} [_inst_1 : LinearOrder.{u3} α] [_inst_2 : TopologicalSpace.{u2} γ] {a : α} {b : α} {h : LE.le.{u3} α (Preorder.toLE.{u3} α (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1)))))) a b} [_inst_3 : TopologicalSpace.{u3} α] [_inst_4 : OrderTopology.{u3} α _inst_3 (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1)))))] [_inst_5 : TopologicalSpace.{u1} β] {f : γ -> (Set.Elem.{u3} α (Set.Icc.{u3} α (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1))))) a b)) -> β} {g : γ -> α}, (Continuous.{max u3 u2, u1} (Prod.{u2, u3} γ (Set.Elem.{u3} α (Set.Icc.{u3} α (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1))))) a b))) β (instTopologicalSpaceProd.{u2, u3} γ (Set.Elem.{u3} α (Set.Icc.{u3} α (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1))))) a b)) _inst_2 (instTopologicalSpaceSubtype.{u3} α (fun (x : α) => Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (Set.Icc.{u3} α (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1))))) a b)) _inst_3)) _inst_5 (Function.HasUncurry.uncurry.{max (max u3 u1) u2, max u3 u2, u1} (γ -> (Set.Elem.{u3} α (Set.Icc.{u3} α (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1))))) a b)) -> β) (Prod.{u2, u3} γ (Set.Elem.{u3} α (Set.Icc.{u3} α (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1))))) a b))) β (Function.hasUncurryInduction.{u2, max u3 u1, u3, u1} γ ((Set.Elem.{u3} α (Set.Icc.{u3} α (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1))))) a b)) -> β) (Set.Elem.{u3} α (Set.Icc.{u3} α (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1))))) a b)) β (Function.hasUncurryBase.{u3, u1} (Set.Elem.{u3} α (Set.Icc.{u3} α (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1))))) a b)) β)) f)) -> (Continuous.{u2, u3} γ α _inst_2 _inst_3 g) -> (Continuous.{u2, u1} γ β _inst_2 _inst_5 (fun (a_1 : γ) => Set.IccExtend.{u3, u1} α β _inst_1 a b h (f a_1) (g a_1)))
Case conversion may be inaccurate. Consider using '#align continuous.Icc_extend Continuous.IccExtendₓ'. -/
/-- See Note [continuity lemma statement]. -/
theorem Continuous.IccExtend {f : γ → Icc a b → β} {g : γ → α} (hf : Continuous ↿f)
    (hg : Continuous g) : Continuous fun a => IccExtend h (f a) (g a) :=
  hf.comp <| continuous_id.prod_mk <| continuous_projIcc.comp hg
#align continuous.Icc_extend Continuous.IccExtend

/- warning: continuous.Icc_extend' -> Continuous.Icc_extend' is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : LinearOrder.{u1} α] {a : α} {b : α} {h : LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1))))) a b} [_inst_3 : TopologicalSpace.{u1} α] [_inst_4 : OrderTopology.{u1} α _inst_3 (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1))))] [_inst_5 : TopologicalSpace.{u2} β] {f : (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b)) -> β}, (Continuous.{u1, u2} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b)) β (Subtype.topologicalSpace.{u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b)) _inst_3) _inst_5 f) -> (Continuous.{u1, u2} α β _inst_3 _inst_5 (Set.IccExtend.{u1, u2} α β _inst_1 a b h f))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : LinearOrder.{u2} α] {a : α} {b : α} {h : LE.le.{u2} α (Preorder.toLE.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1)))))) a b} [_inst_3 : TopologicalSpace.{u2} α] [_inst_4 : OrderTopology.{u2} α _inst_3 (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1)))))] [_inst_5 : TopologicalSpace.{u1} β] {f : (Set.Elem.{u2} α (Set.Icc.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) a b)) -> β}, (Continuous.{u2, u1} (Set.Elem.{u2} α (Set.Icc.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) a b)) β (instTopologicalSpaceSubtype.{u2} α (fun (x : α) => Membership.mem.{u2, u2} α (Set.{u2} α) (Set.instMembershipSet.{u2} α) x (Set.Icc.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) a b)) _inst_3) _inst_5 f) -> (Continuous.{u2, u1} α β _inst_3 _inst_5 (Set.IccExtend.{u2, u1} α β _inst_1 a b h f))
Case conversion may be inaccurate. Consider using '#align continuous.Icc_extend' Continuous.Icc_extend'ₓ'. -/
/-- A useful special case of `continuous.Icc_extend`. -/
@[continuity]
theorem Continuous.Icc_extend' {f : Icc a b → β} (hf : Continuous f) : Continuous (IccExtend h f) :=
  hf.comp continuous_projIcc
#align continuous.Icc_extend' Continuous.Icc_extend'

/- warning: continuous_at.Icc_extend -> ContinuousAt.IccExtend is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {γ : Type.{u3}} [_inst_1 : LinearOrder.{u1} α] [_inst_2 : TopologicalSpace.{u3} γ] {a : α} {b : α} {h : LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1))))) a b} [_inst_3 : TopologicalSpace.{u1} α] [_inst_4 : OrderTopology.{u1} α _inst_3 (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1))))] [_inst_5 : TopologicalSpace.{u2} β] {x : γ} (f : γ -> (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b)) -> β) {g : γ -> α}, (ContinuousAt.{max u3 u1, u2} (Prod.{u3, u1} γ (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b))) β (Prod.topologicalSpace.{u3, u1} γ (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b)) _inst_2 (Subtype.topologicalSpace.{u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b)) _inst_3)) _inst_5 (Function.HasUncurry.uncurry.{max u3 u1 u2, max u3 u1, u2} (γ -> (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b)) -> β) (Prod.{u3, u1} γ (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b))) β (Function.hasUncurryInduction.{u3, max u1 u2, u1, u2} γ ((coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b)) -> β) (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b)) β (Function.hasUncurryBase.{u1, u2} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b)) β)) f) (Prod.mk.{u3, u1} γ (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (Set.Icc.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) a b)) x (Set.projIcc.{u1} α _inst_1 a b h (g x)))) -> (ContinuousAt.{u3, u1} γ α _inst_2 _inst_3 g x) -> (ContinuousAt.{u3, u2} γ β _inst_2 _inst_5 (fun (a_1 : γ) => Set.IccExtend.{u1, u2} α β _inst_1 a b h (f a_1) (g a_1)) x)
but is expected to have type
  forall {α : Type.{u3}} {β : Type.{u1}} {γ : Type.{u2}} [_inst_1 : LinearOrder.{u3} α] [_inst_2 : TopologicalSpace.{u2} γ] {a : α} {b : α} {h : LE.le.{u3} α (Preorder.toLE.{u3} α (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1)))))) a b} [_inst_3 : TopologicalSpace.{u3} α] [_inst_4 : OrderTopology.{u3} α _inst_3 (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1)))))] [_inst_5 : TopologicalSpace.{u1} β] {x : γ} (f : γ -> (Set.Elem.{u3} α (Set.Icc.{u3} α (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1))))) a b)) -> β) {g : γ -> α}, (ContinuousAt.{max u3 u2, u1} (Prod.{u2, u3} γ (Set.Elem.{u3} α (Set.Icc.{u3} α (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1))))) a b))) β (instTopologicalSpaceProd.{u2, u3} γ (Set.Elem.{u3} α (Set.Icc.{u3} α (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1))))) a b)) _inst_2 (instTopologicalSpaceSubtype.{u3} α (fun (x : α) => Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (Set.Icc.{u3} α (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1))))) a b)) _inst_3)) _inst_5 (Function.HasUncurry.uncurry.{max (max u3 u1) u2, max u3 u2, u1} (γ -> (Set.Elem.{u3} α (Set.Icc.{u3} α (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1))))) a b)) -> β) (Prod.{u2, u3} γ (Set.Elem.{u3} α (Set.Icc.{u3} α (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1))))) a b))) β (Function.hasUncurryInduction.{u2, max u3 u1, u3, u1} γ ((Set.Elem.{u3} α (Set.Icc.{u3} α (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1))))) a b)) -> β) (Set.Elem.{u3} α (Set.Icc.{u3} α (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1))))) a b)) β (Function.hasUncurryBase.{u3, u1} (Set.Elem.{u3} α (Set.Icc.{u3} α (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1))))) a b)) β)) f) (Prod.mk.{u2, u3} γ (Set.Elem.{u3} α (Set.Icc.{u3} α (PartialOrder.toPreorder.{u3} α (SemilatticeInf.toPartialOrder.{u3} α (Lattice.toSemilatticeInf.{u3} α (DistribLattice.toLattice.{u3} α (instDistribLattice.{u3} α _inst_1))))) a b)) x (Set.projIcc.{u3} α _inst_1 a b h (g x)))) -> (ContinuousAt.{u2, u3} γ α _inst_2 _inst_3 g x) -> (ContinuousAt.{u2, u1} γ β _inst_2 _inst_5 (fun (a_1 : γ) => Set.IccExtend.{u3, u1} α β _inst_1 a b h (f a_1) (g a_1)) x)
Case conversion may be inaccurate. Consider using '#align continuous_at.Icc_extend ContinuousAt.IccExtendₓ'. -/
theorem ContinuousAt.IccExtend {x : γ} (f : γ → Icc a b → β) {g : γ → α}
    (hf : ContinuousAt (↿f) (x, projIcc a b h (g x))) (hg : ContinuousAt g x) :
    ContinuousAt (fun a => IccExtend h (f a) (g a)) x :=
  show ContinuousAt (↿f ∘ fun x => (x, projIcc a b h (g x))) x from
    ContinuousAt.comp hf <| continuousAt_id.Prod <| continuous_projIcc.ContinuousAt.comp hg
#align continuous_at.Icc_extend ContinuousAt.IccExtend


import Playground.Category.Instances.Set
import Playground.Category.Instances.Product
import Playground.Category.Functor.Category

namespace Category.Functor

section
  open Natural_Transformation

  section
    abbrev Bi (C D E) [Category C] [Category D] [Category E] := (C × D) ⥤ E
  end

  namespace Bi
  section

    def swap {C D E} [Category C] [Category D] [Category E]
      (F : Bi C D E) : Bi D C E where
      obj_map := λ ⟨Y, X⟩ => F ⟨X, Y⟩
      hom_map := λ ⟨g, f⟩ => F.hom_map ⟨f, g⟩
      hom_map_comp := λ ⟨g₁, f₁⟩ ⟨g₂, f₂⟩ => by
        show F.hom_map (_, _ ≫ _) = F.hom_map _ ≫ F.hom_map _
        rw [←hom_map_comp]
        show F.hom_map (_, _ ≫ _) = F.hom_map ((_ ≫ _), (_ ≫ _))
        simp
      hom_map_id := λ Y => by
        show F.hom_map (𝟙 _) = 𝟙 _
        simp

    def fixLeft {C D E} [Category C] [Category D] [Category E]
      (F : Bi C D E) (X : C) : D ⥤ E where
      obj_map := λ Y => F ⟨X, Y⟩
      hom_map := @λ Y₁ Y₂ g =>
        show F ⟨X, Y₁⟩ ⟶ F ⟨X, Y₂⟩ from
        F.hom_map ⟨𝟙 _, g⟩
      hom_map_comp := λ {Y₁ Y₂ Y₃} g₁ g₂ => by
        show F.hom_map (_, _ ≫ _) = F.hom_map _ ≫ F.hom_map _
        rw [←hom_map_comp]
        show F.hom_map (_, _ ≫ _) = F.hom_map ((_ ≫ _), (_ ≫ _))
        simp
      hom_map_id := λ Y => by
        show F.hom_map (𝟙 _) = 𝟙 _
        simp

    def fixRight {C D E} [Category C] [Category D] [Category E]
      (F : Bi C D E) (Y : D) : C ⥤ E := F.swap.fixLeft Y

    def curry {C D E} [Category C] [Category D] [Category E]
      (F : Bi C D E) : C ⥤ D ⥤ E where
      obj_map := F.fixLeft
      hom_map {X₁ X₂} f := {
        component := λ Y => F.hom_map (f, 𝟙 Y)
        naturality := λ {Y₁ Y₂} g => by
          show F.hom_map _ ≫ F.hom_map _ = F.hom_map _ ≫ F.hom_map _
          rw [←hom_map_comp, ←hom_map_comp]
          apply congrArg F.hom_map
          show (_ ≫ _, _ ≫ _) = (_ ≫ _, _ ≫ _)
          simp
      }
      hom_map_comp {X₁ X₂ X₃} f₁ f₂ := by
        apply eq_of_component_eq
        funext Y
        show F.hom_map _ = F.hom_map _ ≫ F.hom_map _
        rw [←hom_map_comp]
        apply congrArg F.hom_map
        show _ = (_ ≫ _, _ ≫ _)
        simp
      hom_map_id X := by
        apply eq_of_component_eq
        funext Y
        show F.hom_map (𝟙 _) = 𝟙 _
        simp
  end
  end Bi

  section
    def asLHSofBi {C D E} [Category C] [Category D] [Category E]
      (F : C ⥤ E) : Bi C D E where
      obj_map := λ ⟨X, _⟩ => F X
      hom_map := λ ⟨f, _⟩ => F.hom_map f
      hom_map_comp _ _ := by simp
      hom_map_id _ := by simp

    def asRHSofBi {C D E} [Category C] [Category D] [Category E]
      (F : D ⥤ E) : Bi C D E where
      obj_map := λ ⟨_, Y⟩ => F Y
      hom_map := λ ⟨_, f⟩ => F.hom_map f
      hom_map_comp _ _ := by simp
      hom_map_id _ := by simp

    def pack {C D₁ D₂} [Category C] [Category D₁] [Category D₂]
      (F₁ : C ⥤ D₁) (F₂ : C ⥤ D₂) : C ⥤ D₁ × D₂ where
      obj_map X := ⟨F₁ X, F₂ X⟩
      hom_map f := ⟨F₁.hom_map f, F₂.hom_map f⟩
      hom_map_comp f g := by simp; rfl
      hom_map_id X := by simp; rfl

    def prod {C D E₁ E₂} [Category C] [Category D] [Category E₁] [Category E₂]
      (F₁ : C ⥤ E₁) (F₂ : D ⥤ E₂) : Bi C D (E₁ × E₂) :=
      F₁.asLHSofBi.pack F₂.asRHSofBi
  end

  section
    def fixLeft {C D E} [Category C] [Category D] [Category E]
      (F : C ⥤ D ⥤ E) (X : C) : D ⥤ E := F X

    def fixRight {C D E} [Category C] [Category D] [Category E]
      (F : C ⥤ D ⥤ E) (Y : D) : C ⥤ E where
      obj_map := λ X => F X Y
      hom_map := λ {X₁ X₂} f => (F.hom_map f).component Y
      hom_map_comp := by simp
      hom_map_id X := by simp; rfl

    def uncurry {C D E} [Category C] [Category D] [Category E]
      (F : C ⥤ D ⥤ E) : Bi C D E where
      obj_map := λ ⟨X, Y⟩ => F X Y
      hom_map := @λ ⟨X₁, Y₁⟩ ⟨X₂, Y₂⟩ ⟨f, g⟩ =>
        show F X₁ Y₁ ⟶ F X₂ Y₂ from
        (F X₁).hom_map g ≫ (F.fixRight Y₂).hom_map f
      hom_map_comp := @λ ⟨X₁, Y₁⟩ ⟨X₂, Y₂⟩ ⟨X₃, Y₃⟩ ⟨f₁, g₁⟩ ⟨f₂, g₂⟩ => by
        simp [fixRight]
        rw [assoc ((F X₁).hom_map g₁), ←assoc ((F X₁).hom_map g₂)]
        rw [naturality, assoc, assoc]
      hom_map_id _ := by simp; rfl

    def swap {C D E} [Category C] [Category D] [Category E]
      (F : C ⥤ D ⥤ E) : D ⥤ C ⥤ E := F.uncurry.swap.curry
  end

  section
    namespace Bi
    -- define the evaluation bifunctor : X, F ↦ F X
    def evaluation (C D) [Category C] [Category D] : Bi C (C ⥤ D) D :=
      (𝟭 (C ⥤ D)).uncurry.swap

    --
    -- def ofLeftAndRightFunctors {C D E} [Category C] [Category D] [Category E]
    --   (F : C ⥤ E)
    --   : Bi C D E := sorry

    end Bi
  end

  section
    def isom_images_of_isom_functors {C D} [Category C] [Category D] {F G : C ⥤ D} (α : F ≅ G) (X : C)
      : F X ≅ G X :=
      ((Bi.evaluation C D).fixLeft X).isom_images_of_isom_objects α

    -- example {C D} [Category C] [Category D] {F G : C ⥤ D} (h : ∀ X, F X ≅ G X) : F ≅ G :=
    --   sorry

  end
end

end Category.Functor


variable {α : Type*}

def is_prefix (l₁ : list α) (l₂ : list α) : Prop :=
∃ t, l₁ ++ t = l₂

infix ` <+: `:50 := is_prefix

section
local attribute [simp]
theorem list.is_prefix_refl (l : list α) : l <+: l :=
⟨[], by simp⟩

example : [1, 2, 3] <+: [1, 2, 3] := by simp
end

-- example : [1, 2, 3] <+: [1, 2, 3] := by simp


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

! This file was ported from Lean 3 source module init.control.lawful
! leanprover-community/mathlib commit 9af482290ef68e8aaa5ead01aa7b09b7be7019fd
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
prelude
import Leanbin.Init.Control.Monad
import Leanbin.Init.Meta.Interactive
import Leanbin.Init.Control.State
import Leanbin.Init.Control.Except
import Leanbin.Init.Control.Reader
import Leanbin.Init.Control.Option

universe u v

open Function

open Tactic

unsafe def control_laws_tac :=
  (whnf_target >> intros) >> to_expr ``(rfl) >>= exact
#align control_laws_tac control_laws_tac

#print LawfulFunctor /-
class LawfulFunctor (f : Type u → Type v) [Functor f] : Prop where
  mapConst_eq :
    ∀ {α β : Type u},
      ((· <$ ·) : α → f β → f α) =
        (· <$> ·) ∘ const β := by
    intros
    rfl
  -- `functor` is indeed a categorical functor
  id_map : ∀ {α : Type u} (x : f α), id <$> x = x
  comp_map : ∀ {α β γ : Type u} (g : α → β) (h : β → γ) (x : f α), (h ∘ g) <$> x = h <$> g <$> x
#align is_lawful_functor LawfulFunctor
-/

export LawfulFunctor (mapConst_eq id_map comp_map)

attribute [simp] id_map

#print LawfulApplicative /-
-- `comp_map` does not make a good simp lemma
class LawfulApplicative (f : Type u → Type v) [Applicative f] extends LawfulFunctor f : Prop where
  seqLeft_eq :
    ∀ {α β : Type u} (a : f α) (b : f β),
      a <* b = const β <$> a <*> b := by
    intros
    rfl
  seqRight_eq :
    ∀ {α β : Type u} (a : f α) (b : f β),
      a *> b = const α id <$> a <*> b := by
    intros
    rfl
  -- applicative laws
  pure_seq : ∀ {α β : Type u} (g : α → β) (x : f α), pure g <*> x = g <$> x
  map_pure : ∀ {α β : Type u} (g : α → β) (x : α), g <$> (pure x : f α) = pure (g x)
  seq_pure : ∀ {α β : Type u} (g : f (α → β)) (x : α), g <*> pure x = (fun g : α → β => g x) <$> g
  seq_assoc :
    ∀ {α β γ : Type u} (x : f α) (g : f (α → β)) (h : f (β → γ)),
      h <*> (g <*> x) = @comp α β γ <$> h <*> g <*> x
  -- default functor law
  comp_map := (by intros <;> simp [(pure_seq_eq_map _ _).symm, seq_assoc, map_pure, seq_pure])
#align is_lawful_applicative LawfulApplicative
-/

export LawfulApplicative (seqLeft_eq seqRight_eq pure_seq map_pure seq_pure seq_assoc)

attribute [simp] map_pure seq_pure

/- warning: pure_id_seq -> pure_id_seq is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {f : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} f] [_inst_2 : LawfulApplicative.{u1, u2} f _inst_1] (x : f α), Eq.{succ u2} (f α) (Seq.seq.{u1, u2} f (Applicative.toHasSeq.{u1, u2} f _inst_1) α α (Pure.pure.{u1, u2} f (Applicative.toHasPure.{u1, u2} f _inst_1) (α -> α) (id.{succ u1} α)) x) x
but is expected to have type
  forall {α : Type.{u2} -> Type.{u1}} {f : Type.{u2}} [_inst_1 : Applicative.{u2, u1} α] [_inst_2 : LawfulApplicative.{u2, u1} α _inst_1] (x : α f), Eq.{succ u1} (α f) (Seq.seq.{u2, u1} α (Applicative.toSeq.{u2, u1} α _inst_1) f f (Pure.pure.{u2, u1} α (Applicative.toPure.{u2, u1} α _inst_1) (f -> f) (id.{succ u2} f)) (fun (x._@.Init.Control.Lawful._hyg.566 : Unit) => x)) x
Case conversion may be inaccurate. Consider using '#align pure_id_seq pure_id_seqₓ'. -/
-- applicative "law" derivable from other laws
@[simp]
theorem pure_id_seq {α : Type u} {f : Type u → Type v} [Applicative f] [LawfulApplicative f]
    (x : f α) : pure id <*> x = x := by simp [pure_seq_eq_map]
#align pure_id_seq pure_id_seq

#print LawfulMonad /-
class LawfulMonad (m : Type u → Type v) [Monad m] extends LawfulApplicative m : Prop where
  bind_pure_comp_eq_map :
    ∀ {α β : Type u} (f : α → β) (x : m α),
      x >>= pure ∘ f = f <$> x := by
    intros
    rfl
  bind_map_eq_seq :
    ∀ {α β : Type u} (f : m (α → β)) (x : m α),
      f >>= (· <$> x) = f <*> x := by
    intros
    rfl
  -- monad laws
  pure_bind : ∀ {α β : Type u} (x : α) (f : α → m β), pure x >>= f = f x
  bind_assoc :
    ∀ {α β γ : Type u} (x : m α) (f : α → m β) (g : β → m γ),
      x >>= f >>= g = x >>= fun x => f x >>= g
  pure_seq := (by intros <;> rw [← bind_map_eq_seq] <;> simp [pure_bind])
  map_pure := (by intros <;> rw [← bind_pure_comp_eq_map] <;> simp [pure_bind])
  seq_pure := (by intros <;> rw [← bind_map_eq_seq] <;> simp [map_pure, bind_pure_comp_eq_map])
  seq_assoc :=
    (by
      intros <;>
        simp [(bind_pure_comp_eq_map _ _).symm, (bind_map_eq_seq _ _).symm, bind_assoc, pure_bind])
#align is_lawful_monad LawfulMonad
-/

export LawfulMonad (bind_pure_comp_eq_map bind_map_eq_seq pure_bind bind_assoc)

attribute [simp] pure_bind

/- warning: bind_pure -> bind_pure is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {m : Type.{u1} -> Type.{u2}} [_inst_1 : Monad.{u1, u2} m] [_inst_2 : LawfulMonad.{u1, u2} m _inst_1] (x : m α), Eq.{succ u2} (m α) (Bind.bind.{u1, u2} m (Monad.toHasBind.{u1, u2} m _inst_1) α α x (Pure.pure.{u1, u2} m (Applicative.toHasPure.{u1, u2} m (Monad.toApplicative.{u1, u2} m _inst_1)) α)) x
but is expected to have type
  forall {α : Type.{u2} -> Type.{u1}} {m : Type.{u2}} [_inst_1 : Monad.{u2, u1} α] [_inst_2 : LawfulMonad.{u2, u1} α _inst_1] (x : α m), Eq.{succ u1} (α m) (Bind.bind.{u2, u1} α (Monad.toBind.{u2, u1} α _inst_1) m m x (Pure.pure.{u2, u1} α (Applicative.toPure.{u2, u1} α (Monad.toApplicative.{u2, u1} α _inst_1)) m)) x
Case conversion may be inaccurate. Consider using '#align bind_pure bind_pureₓ'. -/
-- monad "law" derivable from other laws
@[simp]
theorem bind_pure {α : Type u} {m : Type u → Type v} [Monad m] [LawfulMonad m] (x : m α) :
    x >>= pure = x :=
  show x >>= pure ∘ id = x by rw [bind_pure_comp_eq_map] <;> simp [id_map]
#align bind_pure bind_pure

theorem bind_ext_congr {α β} {m : Type u → Type v} [Bind m] {x : m α} {f g : α → m β} :
    (∀ a, f a = g a) → x >>= f = x >>= g := fun h => by simp [show f = g from funext h]
#align bind_ext_congr bind_ext_congr

theorem map_ext_congr {α β} {m : Type u → Type v} [Functor m] {x : m α} {f g : α → β} :
    (∀ a, f a = g a) → (f <$> x : m β) = g <$> x := fun h => by simp [show f = g from funext h]
#align map_ext_congr map_ext_congr

-- instances of previously defined monads
namespace id

variable {α β : Type}

@[simp]
theorem map_eq (x : id α) (f : α → β) : f <$> x = f x :=
  rfl
#align id.map_eq id.map_eq

@[simp]
theorem bind_eq (x : id α) (f : α → id β) : x >>= f = f x :=
  rfl
#align id.bind_eq id.bind_eq

@[simp]
theorem pure_eq (a : α) : (pure a : id α) = a :=
  rfl
#align id.pure_eq id.pure_eq

end id

instance : LawfulMonad id := by refine' { .. } <;> intros <;> rfl

namespace StateT

section

variable {σ : Type u}

variable {m : Type u → Type v}

variable {α β : Type u}

variable (x : StateT σ m α) (st : σ)

theorem ext {x x' : StateT σ m α} (h : ∀ st, x.run st = x'.run st) : x = x' := by
  cases x <;> cases x' <;> simp [show x = x' from funext h]
#align state_t.ext StateTₓ.ext

variable [Monad m]

@[simp]
theorem run_pure (a) : (pure a : StateT σ m α).run st = pure (a, st) :=
  rfl
#align state_t.run_pure StateTₓ.run_pure

@[simp]
theorem run_bind (f : α → StateT σ m β) :
    (x >>= f).run st = x.run st >>= fun p => (f p.1).run p.2 := by
  apply bind_ext_congr <;> intro a <;> cases a <;> simp [StateT.bind, StateT.run]
#align state_t.run_bind StateTₓ.run_bind

@[simp]
theorem run_map (f : α → β) [LawfulMonad m] :
    (f <$> x).run st = (fun p : α × σ => (f (Prod.fst p), Prod.snd p)) <$> x.run st :=
  by
  rw [← bind_pure_comp_eq_map _ (x.run st)]
  change (x >>= pure ∘ f).run st = _
  simp
#align state_t.run_map StateTₓ.run_map

@[simp]
theorem run_monadLift {n} [HasMonadLiftT n m] (x : n α) :
    (monadLift x : StateT σ m α).run st = do
      let a ← (monadLift x : m α)
      pure (a, st) :=
  rfl
#align state_t.run_monad_lift StateTₓ.run_monadLift

@[simp]
theorem run_monadMap {m' n n'} [Monad m'] [MonadFunctorT n n' m m'] (f : ∀ {α}, n α → n' α) :
    (monadMap (@f) x : StateT σ m' α).run st = monadMap (@f) (x.run st) :=
  rfl
#align state_t.run_monad_map StateTₓ.run_monadMap

@[simp]
theorem run_adapt {σ' σ''} (st : σ) (split : σ → σ' × σ'') (join : σ' → σ'' → σ)
    (x : StateT σ' m α) :
    (StateT.adapt split join x : StateT σ m α).run st = do
      let (st, ctx) := split st
      let (a, st') ← x.run st
      pure (a, join st' ctx) :=
  by delta StateT.adapt <;> rfl
#align state_t.run_adapt StateTₓ.run_adapt

@[simp]
theorem run_get : (StateT.get : StateT σ m σ).run st = pure (st, st) :=
  rfl
#align state_t.run_get StateTₓ.run_get

@[simp]
theorem run_put (st') : (StateT.put st' : StateT σ m _).run st = pure (PUnit.unit, st') :=
  rfl
#align state_t.run_put StateTₓ.run_put

end

end StateT

instance (m : Type u → Type v) [Monad m] [LawfulMonad m] (σ : Type u) : LawfulMonad (StateT σ m)
    where
  id_map := by intros <;> apply StateT.ext <;> intro <;> simp <;> erw [id_map]
  pure_bind := by
    intros
    apply StateT.ext
    simp
  bind_assoc := by
    intros
    apply StateT.ext
    simp [bind_assoc]

namespace ExceptT

variable {α β ε : Type u} {m : Type u → Type v} (x : ExceptT ε m α)

theorem ext {x x' : ExceptT ε m α} (h : x.run = x'.run) : x = x' := by
  cases x <;> cases x' <;> simp_all
#align except_t.ext ExceptTₓ.ext

variable [Monad m]

@[simp]
theorem run_pure (a) : (pure a : ExceptT ε m α).run = pure (@Except.ok ε α a) :=
  rfl
#align except_t.run_pure ExceptTₓ.run_pure

@[simp]
theorem run_bind (f : α → ExceptT ε m β) : (x >>= f).run = x.run >>= ExceptT.bindCont f :=
  rfl
#align except_t.run_bind ExceptTₓ.run_bind

@[simp]
theorem run_map (f : α → β) [LawfulMonad m] : (f <$> x).run = Except.map f <$> x.run :=
  by
  rw [← bind_pure_comp_eq_map _ x.run]
  change x.run >>= ExceptT.bindCont (pure ∘ f) = _
  apply bind_ext_congr
  intro a <;> cases a <;> simp [ExceptT.bindCont, Except.map]
#align except_t.run_map ExceptTₓ.run_map

@[simp]
theorem run_monadLift {n} [HasMonadLiftT n m] (x : n α) :
    (monadLift x : ExceptT ε m α).run = Except.ok <$> (monadLift x : m α) :=
  rfl
#align except_t.run_monad_lift ExceptTₓ.run_monadLift

@[simp]
theorem run_monadMap {m' n n'} [Monad m'] [MonadFunctorT n n' m m'] (f : ∀ {α}, n α → n' α) :
    (monadMap (@f) x : ExceptT ε m' α).run = monadMap (@f) x.run :=
  rfl
#align except_t.run_monad_map ExceptTₓ.run_monadMap

end ExceptT

instance (m : Type u → Type v) [Monad m] [LawfulMonad m] (ε : Type u) : LawfulMonad (ExceptT ε m)
    where
  id_map := by
    intros ; apply ExceptT.ext; simp only [ExceptT.run_map]
    rw [map_ext_congr, id_map]
    intro a; cases a <;> rfl
  bind_pure_comp_eq_map := by
    intros ; apply ExceptT.ext; simp only [ExceptT.run_map, ExceptT.run_bind]
    rw [bind_ext_congr, bind_pure_comp_eq_map]
    intro a; cases a <;> rfl
  bind_assoc := by
    intros ; apply ExceptT.ext; simp only [ExceptT.run_bind, bind_assoc]
    rw [bind_ext_congr]
    intro a; cases a <;> simp [ExceptT.bindCont]
  pure_bind := by intros <;> apply ExceptT.ext <;> simp [ExceptT.bindCont]

namespace ReaderT

section

variable {ρ : Type u}

variable {m : Type u → Type v}

variable {α β : Type u}

variable (x : ReaderT ρ m α) (r : ρ)

theorem ext {x x' : ReaderT ρ m α} (h : ∀ r, x.run r = x'.run r) : x = x' := by
  cases x <;> cases x' <;> simp [show x = x' from funext h]
#align reader_t.ext ReaderTₓ.ext

variable [Monad m]

@[simp]
theorem run_pure (a) : (pure a : ReaderT ρ m α).run r = pure a :=
  rfl
#align reader_t.run_pure ReaderTₓ.run_pure

@[simp]
theorem run_bind (f : α → ReaderT ρ m β) : (x >>= f).run r = x.run r >>= fun a => (f a).run r :=
  rfl
#align reader_t.run_bind ReaderTₓ.run_bind

@[simp]
theorem run_map (f : α → β) [LawfulMonad m] : (f <$> x).run r = f <$> x.run r := by
  rw [← bind_pure_comp_eq_map _ (x.run r)] <;> rfl
#align reader_t.run_map ReaderTₓ.run_map

@[simp]
theorem run_monadLift {n} [HasMonadLiftT n m] (x : n α) :
    (monadLift x : ReaderT ρ m α).run r = (monadLift x : m α) :=
  rfl
#align reader_t.run_monad_lift ReaderTₓ.run_monadLift

@[simp]
theorem run_monadMap {m' n n'} [Monad m'] [MonadFunctorT n n' m m'] (f : ∀ {α}, n α → n' α) :
    (monadMap (@f) x : ReaderT ρ m' α).run r = monadMap (@f) (x.run r) :=
  rfl
#align reader_t.run_monad_map ReaderTₓ.run_monadMap

@[simp]
theorem run_read : (ReaderT.read : ReaderT ρ m ρ).run r = pure r :=
  rfl
#align reader_t.run_read ReaderTₓ.run_read

end

end ReaderT

instance (ρ : Type u) (m : Type u → Type v) [Monad m] [LawfulMonad m] : LawfulMonad (ReaderT ρ m)
    where
  id_map := by intros <;> apply ReaderT.ext <;> intro <;> simp
  pure_bind := by intros <;> apply ReaderT.ext <;> intro <;> simp
  bind_assoc := by intros <;> apply ReaderT.ext <;> intro <;> simp [bind_assoc]

namespace OptionT

variable {α β : Type u} {m : Type u → Type v} (x : OptionT m α)

theorem ext {x x' : OptionT m α} (h : x.run = x'.run) : x = x' := by
  cases x <;> cases x' <;> simp_all
#align option_t.ext OptionTₓ.ext

variable [Monad m]

@[simp]
theorem run_pure (a) : (pure a : OptionT m α).run = pure (some a) :=
  rfl
#align option_t.run_pure OptionTₓ.run_pure

@[simp]
theorem run_bind (f : α → OptionT m β) : (x >>= f).run = x.run >>= OptionT.bindCont f :=
  rfl
#align option_t.run_bind OptionTₓ.run_bind

@[simp]
theorem run_map (f : α → β) [LawfulMonad m] : (f <$> x).run = Option.map f <$> x.run :=
  by
  rw [← bind_pure_comp_eq_map _ x.run]
  change x.run >>= OptionT.bindCont (pure ∘ f) = _
  apply bind_ext_congr
  intro a <;> cases a <;> simp [OptionT.bindCont, Option.map, Option.bind]
#align option_t.run_map OptionTₓ.run_map

@[simp]
theorem run_monadLift {n} [HasMonadLiftT n m] (x : n α) :
    (monadLift x : OptionT m α).run = some <$> (monadLift x : m α) :=
  rfl
#align option_t.run_monad_lift OptionTₓ.run_monadLift

@[simp]
theorem run_monadMap {m' n n'} [Monad m'] [MonadFunctorT n n' m m'] (f : ∀ {α}, n α → n' α) :
    (monadMap (@f) x : OptionT m' α).run = monadMap (@f) x.run :=
  rfl
#align option_t.run_monad_map OptionTₓ.run_monadMap

end OptionT

instance (m : Type u → Type v) [Monad m] [LawfulMonad m] : LawfulMonad (OptionT m)
    where
  id_map := by
    intros ; apply OptionT.ext; simp only [OptionT.run_map]
    rw [map_ext_congr, id_map]
    intro a; cases a <;> rfl
  bind_assoc := by
    intros ; apply OptionT.ext; simp only [OptionT.run_bind, bind_assoc]
    rw [bind_ext_congr]
    intro a; cases a <;> simp [OptionT.bindCont]
  pure_bind := by intros <;> apply OptionT.ext <;> simp [OptionT.bindCont]


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

open category_theory category_theory.category

namespace category_theory.limits

universes v v₂ u -- morphism levels before object levels. See note [category_theory universes].

variables {C : Type u} [category.{v} C]

variables {J K : Type v} [small_category J] [category.{v₂} K]

@[simp, reassoc]
lemma limit.lift_π_app (H : J ⥤ K ⥤ C) [has_limit H] (c : cone H) (j : J) (k : K) :
  (limit.lift H c).app k ≫ (limit.π H j).app k = (c.π.app j).app k :=
congr_app (limit.lift_π c j) k

@[simp, reassoc]
lemma colimit.ι_desc_app (H : J ⥤ K ⥤ C) [has_colimit H] (c : cocone H) (j : J) (k : K) :
  (colimit.ι H j).app k ≫ (colimit.desc H c).app k = (c.ι.app j).app k :=
congr_app (colimit.ι_desc c j) k

/--
The evaluation functors jointly reflect limits: that is, to show a cone is a limit of `F`
it suffices to show that each evaluation cone is a limit. In other words, to prove a cone is
limiting you can show it's pointwise limiting.
-/
def evaluation_jointly_reflects_limits {F : J ⥤ K ⥤ C} (c : cone F)
  (t : Π (k : K), is_limit (((evaluation K C).obj k).map_cone c)) : is_limit c :=
{ lift := λ s,
  { app := λ k, (t k).lift ⟨s.X.obj k, whisker_right s.π ((evaluation K C).obj k)⟩,
    naturality' := λ X Y f, (t Y).hom_ext $ λ j,
    begin
      rw [assoc, (t Y).fac _ j],
      simpa using
        ((t X).fac_assoc ⟨s.X.obj X, whisker_right s.π ((evaluation K C).obj X)⟩ j _).symm,
    end },
  fac' := λ s j, nat_trans.ext _ _ $ funext $ λ k, (t k).fac _ j,
  uniq' := λ s m w, nat_trans.ext _ _ $ funext $ λ x, (t x).hom_ext $ λ j,
      (congr_app (w j) x).trans
        ((t x).fac ⟨s.X.obj _, whisker_right s.π ((evaluation K C).obj _)⟩ j).symm }

/--
Given a functor `F` and a collection of limit cones for each diagram `X ↦ F X k`, we can stitch
them together to give a cone for the diagram `F`.
`combined_is_limit` shows that the new cone is limiting, and `eval_combined` shows it is
(essentially) made up of the original cones.
-/
@[simps] def combine_cones (F : J ⥤ K ⥤ C) (c : Π (k : K), limit_cone (F.flip.obj k)) :
  cone F :=
{ X :=
  { obj := λ k, (c k).cone.X,
    map := λ k₁ k₂ f, (c k₂).is_limit.lift ⟨_, (c k₁).cone.π ≫ F.flip.map f⟩,
    map_id' := λ k, (c k).is_limit.hom_ext (λ j, by { dsimp, simp }),
    map_comp' := λ k₁ k₂ k₃ f₁ f₂, (c k₃).is_limit.hom_ext (λ j, by simp) },
  π :=
  { app := λ j, { app := λ k, (c k).cone.π.app j },
    naturality' := λ j₁ j₂ g, nat_trans.ext _ _ $ funext $ λ k, (c k).cone.π.naturality g } }

/-- The stitched together cones each project down to the original given cones (up to iso). -/
def evaluate_combined_cones (F : J ⥤ K ⥤ C) (c : Π (k : K), limit_cone (F.flip.obj k)) (k : K) :
  ((evaluation K C).obj k).map_cone (combine_cones F c) ≅ (c k).cone :=
cones.ext (iso.refl _) (by tidy)

/-- Stitching together limiting cones gives a limiting cone. -/
def combined_is_limit (F : J ⥤ K ⥤ C) (c : Π (k : K), limit_cone (F.flip.obj k)) :
  is_limit (combine_cones F c) :=
evaluation_jointly_reflects_limits _
  (λ k, (c k).is_limit.of_iso_limit (evaluate_combined_cones F c k).symm)

/--
The evaluation functors jointly reflect colimits: that is, to show a cocone is a colimit of `F`
it suffices to show that each evaluation cocone is a colimit. In other words, to prove a cocone is
colimiting you can show it's pointwise colimiting.
-/
def evaluation_jointly_reflects_colimits {F : J ⥤ K ⥤ C} (c : cocone F)
  (t : Π (k : K), is_colimit (((evaluation K C).obj k).map_cocone c)) : is_colimit c :=
{ desc := λ s,
  { app := λ k, (t k).desc ⟨s.X.obj k, whisker_right s.ι ((evaluation K C).obj k)⟩,
    naturality' := λ X Y f, (t X).hom_ext $ λ j,
    begin
      rw [(t X).fac_assoc _ j],
      erw ← (c.ι.app j).naturality_assoc f,
      erw (t Y).fac ⟨s.X.obj _, whisker_right s.ι _⟩ j,
      dsimp,
      simp,
    end },
  fac' := λ s j, nat_trans.ext _ _ $ funext $ λ k, (t k).fac _ j,
  uniq' := λ s m w, nat_trans.ext _ _ $ funext $ λ x, (t x).hom_ext $ λ j,
      (congr_app (w j) x).trans
        ((t x).fac ⟨s.X.obj _, whisker_right s.ι ((evaluation K C).obj _)⟩ j).symm }

/--
Given a functor `F` and a collection of colimit cocones for each diagram `X ↦ F X k`, we can stitch
them together to give a cocone for the diagram `F`.
`combined_is_colimit` shows that the new cocone is colimiting, and `eval_combined` shows it is
(essentially) made up of the original cocones.
-/
@[simps] def combine_cocones (F : J ⥤ K ⥤ C) (c : Π (k : K), colimit_cocone (F.flip.obj k)) :
  cocone F :=
{ X :=
  { obj := λ k, (c k).cocone.X,
    map := λ k₁ k₂ f, (c k₁).is_colimit.desc ⟨_, F.flip.map f ≫ (c k₂).cocone.ι⟩,
    map_id' := λ k, (c k).is_colimit.hom_ext (λ j, by { dsimp, simp }),
    map_comp' := λ k₁ k₂ k₃ f₁ f₂, (c k₁).is_colimit.hom_ext (λ j, by simp) },
  ι :=
  { app := λ j, { app := λ k, (c k).cocone.ι.app j },
    naturality' := λ j₁ j₂ g, nat_trans.ext _ _ $ funext $ λ k, (c k).cocone.ι.naturality g } }

/-- The stitched together cocones each project down to the original given cocones (up to iso). -/
def evaluate_combined_cocones
  (F : J ⥤ K ⥤ C) (c : Π (k : K), colimit_cocone (F.flip.obj k)) (k : K) :
  ((evaluation K C).obj k).map_cocone (combine_cocones F c) ≅ (c k).cocone :=
cocones.ext (iso.refl _) (by tidy)

/-- Stitching together colimiting cocones gives a colimiting cocone. -/
def combined_is_colimit (F : J ⥤ K ⥤ C) (c : Π (k : K), colimit_cocone (F.flip.obj k)) :
  is_colimit (combine_cocones F c) :=
evaluation_jointly_reflects_colimits _
  (λ k, (c k).is_colimit.of_iso_colimit (evaluate_combined_cocones F c k).symm)

noncomputable theory

instance functor_category_has_limits_of_shape
  [has_limits_of_shape J C] : has_limits_of_shape J (K ⥤ C) :=
{ has_limit := λ F, has_limit.mk
  { cone := combine_cones F (λ k, get_limit_cone _),
    is_limit := combined_is_limit _ _ } }

instance functor_category_has_colimits_of_shape
  [has_colimits_of_shape J C] : has_colimits_of_shape J (K ⥤ C) :=
{ has_colimit := λ F, has_colimit.mk
  { cocone := combine_cocones _ (λ k, get_colimit_cocone _),
    is_colimit := combined_is_colimit _ _ } }

instance functor_category_has_limits [has_limits C] : has_limits (K ⥤ C) := {}

instance functor_category_has_colimits [has_colimits C] : has_colimits (K ⥤ C) := {}

instance evaluation_preserves_limits_of_shape [has_limits_of_shape J C] (k : K) :
  preserves_limits_of_shape J ((evaluation K C).obj k) :=
{ preserves_limit :=
  λ F, preserves_limit_of_preserves_limit_cone (combined_is_limit _ _) $
    is_limit.of_iso_limit (limit.is_limit _)
      (evaluate_combined_cones F _ k).symm }

/--
If `F : J ⥤ K ⥤ C` is a functor into a functor category which has a limit,
then the evaluation of that limit at `k` is the limit of the evaluations of `F.obj j` at `k`.
-/
def limit_obj_iso_limit_comp_evaluation [has_limits_of_shape J C] (F : J ⥤ K ⥤ C) (k : K) :
  (limit F).obj k ≅ limit (F ⋙ ((evaluation K C).obj k)) :=
preserves_limit_iso ((evaluation K C).obj k) F

@[simp, reassoc]
lemma limit_obj_iso_limit_comp_evaluation_hom_π
  [has_limits_of_shape J C] (F : J ⥤ (K ⥤ C)) (j : J) (k : K) :
  (limit_obj_iso_limit_comp_evaluation F k).hom ≫ limit.π (F ⋙ ((evaluation K C).obj k)) j =
    (limit.π F j).app k :=
begin
  dsimp [limit_obj_iso_limit_comp_evaluation],
  simp,
end

@[simp, reassoc]
lemma limit_obj_iso_limit_comp_evaluation_inv_π_app
  [has_limits_of_shape J C] (F : J ⥤ (K ⥤ C)) (j : J) (k : K):
  (limit_obj_iso_limit_comp_evaluation F k).inv ≫ (limit.π F j).app k =
    limit.π (F ⋙ ((evaluation K C).obj k)) j :=
begin
  dsimp [limit_obj_iso_limit_comp_evaluation],
  rw iso.inv_comp_eq,
  simp,
end

@[ext]
lemma limit_obj_ext {H : J ⥤ K ⥤ C} [has_limits_of_shape J C]
  {k : K} {W : C} {f g : W ⟶ (limit H).obj k}
  (w : ∀ j, f ≫ (limits.limit.π H j).app k = g ≫ (limits.limit.π H j).app k) : f = g :=
begin
  apply (cancel_mono (limit_obj_iso_limit_comp_evaluation H k).hom).1,
  ext,
  simpa using w j,
end

instance evaluation_preserves_colimits_of_shape [has_colimits_of_shape J C] (k : K) :
  preserves_colimits_of_shape J ((evaluation K C).obj k) :=
{ preserves_colimit :=
  λ F, preserves_colimit_of_preserves_colimit_cocone (combined_is_colimit _ _) $
    is_colimit.of_iso_colimit (colimit.is_colimit _)
      (evaluate_combined_cocones F _ k).symm }

/--
If `F : J ⥤ K ⥤ C` is a functor into a functor category which has a colimit,
then the evaluation of that colimit at `k` is the colimit of the evaluations of `F.obj j` at `k`.
-/
def colimit_obj_iso_colimit_comp_evaluation [has_colimits_of_shape J C] (F : J ⥤ K ⥤ C) (k : K) :
  (colimit F).obj k ≅ colimit (F ⋙ ((evaluation K C).obj k)) :=
preserves_colimit_iso ((evaluation K C).obj k) F

@[simp, reassoc]
lemma colimit_obj_iso_colimit_comp_evaluation_ι_inv
  [has_colimits_of_shape J C] (F : J ⥤ (K ⥤ C)) (j : J) (k : K) :
  colimit.ι (F ⋙ ((evaluation K C).obj k)) j ≫ (colimit_obj_iso_colimit_comp_evaluation F k).inv =
    (colimit.ι F j).app k :=
begin
  dsimp [colimit_obj_iso_colimit_comp_evaluation],
  simp,
end

@[simp, reassoc]
lemma colimit_obj_iso_colimit_comp_evaluation_ι_app_hom
  [has_colimits_of_shape J C] (F : J ⥤ (K ⥤ C)) (j : J) (k : K) :
  (colimit.ι F j).app k ≫ (colimit_obj_iso_colimit_comp_evaluation F k).hom =
     colimit.ι (F ⋙ ((evaluation K C).obj k)) j :=
begin
  dsimp [colimit_obj_iso_colimit_comp_evaluation],
  rw ←iso.eq_comp_inv,
  simp,
end

@[ext]
lemma colimit_obj_ext {H : J ⥤ K ⥤ C} [has_colimits_of_shape J C]
  {k : K} {W : C} {f g : (colimit H).obj k ⟶ W}
  (w : ∀ j, (colimit.ι H j).app k ≫ f = (colimit.ι H j).app k ≫ g) : f = g :=
begin
  apply (cancel_epi (colimit_obj_iso_colimit_comp_evaluation H k).inv).1,
  ext,
  simpa using w j,
end

instance evaluation_preserves_limits [has_limits C] (k : K) :
  preserves_limits ((evaluation K C).obj k) :=
{ preserves_limits_of_shape := λ J 𝒥, by resetI; apply_instance }

instance evaluation_preserves_colimits [has_colimits C] (k : K) :
  preserves_colimits ((evaluation K C).obj k) :=
{ preserves_colimits_of_shape := λ J 𝒥, by resetI; apply_instance }

end category_theory.limits


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import order.hom.basic
import order.bounded_order

/-!
# Bounded order homomorphisms

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

This file defines (bounded) order homomorphisms.

We use the `fun_like` design, so each type of morphisms has a companion typeclass which is meant to
be satisfied by itself and all stricter types.

## Types of morphisms

* `top_hom`: Maps which preserve `⊤`.
* `bot_hom`: Maps which preserve `⊥`.
* `bounded_order_hom`: Bounded order homomorphisms. Monotone maps which preserve `⊤` and `⊥`.

## Typeclasses

* `top_hom_class`
* `bot_hom_class`
* `bounded_order_hom_class`
-/

open function order_dual

variables {F α β γ δ : Type*}

/-- The type of `⊤`-preserving functions from `α` to `β`. -/
structure top_hom (α β : Type*) [has_top α] [has_top β] :=
(to_fun   : α → β)
(map_top' : to_fun ⊤ = ⊤)

/-- The type of `⊥`-preserving functions from `α` to `β`. -/
structure bot_hom (α β : Type*) [has_bot α] [has_bot β] :=
(to_fun   : α → β)
(map_bot' : to_fun ⊥ = ⊥)

/-- The type of bounded order homomorphisms from `α` to `β`. -/
structure bounded_order_hom (α β : Type*) [preorder α] [preorder β] [bounded_order α]
  [bounded_order β]
  extends order_hom α β :=
(map_top' : to_fun ⊤ = ⊤)
(map_bot' : to_fun ⊥ = ⊥)

section
set_option old_structure_cmd true

/-- `top_hom_class F α β` states that `F` is a type of `⊤`-preserving morphisms.

You should extend this class when you extend `top_hom`. -/
class top_hom_class (F : Type*) (α β : out_param $ Type*) [has_top α] [has_top β]
  extends fun_like F α (λ _, β) :=
(map_top (f : F) : f ⊤ = ⊤)

/-- `bot_hom_class F α β` states that `F` is a type of `⊥`-preserving morphisms.

You should extend this class when you extend `bot_hom`. -/
class bot_hom_class (F : Type*) (α β : out_param $ Type*) [has_bot α] [has_bot β]
  extends fun_like F α (λ _, β) :=
(map_bot (f : F) : f ⊥ = ⊥)

/-- `bounded_order_hom_class F α β` states that `F` is a type of bounded order morphisms.

You should extend this class when you extend `bounded_order_hom`. -/
class bounded_order_hom_class (F : Type*) (α β : out_param $ Type*) [has_le α] [has_le β]
  [bounded_order α] [bounded_order β]
  extends rel_hom_class F ((≤) : α → α → Prop) ((≤) : β → β → Prop) :=
(map_top (f : F) : f ⊤ = ⊤)
(map_bot (f : F) : f ⊥ = ⊥)

end

export top_hom_class (map_top) bot_hom_class (map_bot)

attribute [simp] map_top map_bot

@[priority 100] -- See note [lower instance priority]
instance bounded_order_hom_class.to_top_hom_class [has_le α] [has_le β]
  [bounded_order α] [bounded_order β] [bounded_order_hom_class F α β] :
  top_hom_class F α β :=
{ .. ‹bounded_order_hom_class F α β› }

@[priority 100] -- See note [lower instance priority]
instance bounded_order_hom_class.to_bot_hom_class [has_le α] [has_le β]
  [bounded_order α] [bounded_order β] [bounded_order_hom_class F α β] :
  bot_hom_class F α β :=
{ .. ‹bounded_order_hom_class F α β› }

@[priority 100] -- See note [lower instance priority]
instance order_iso_class.to_top_hom_class [has_le α] [order_top α] [partial_order β] [order_top β]
  [order_iso_class F α β] :
  top_hom_class F α β :=
{ map_top := λ f, top_le_iff.1 $ (map_inv_le_iff f).1 le_top,
  .. show order_hom_class F α β, from infer_instance }

@[priority 100] -- See note [lower instance priority]
instance order_iso_class.to_bot_hom_class [has_le α] [order_bot α] [partial_order β] [order_bot β]
  [order_iso_class F α β] :
  bot_hom_class F α β :=
--⟨λ f, le_bot_iff.1 $ (le_map_inv_iff f).1 bot_le⟩
{ map_bot := λ f, le_bot_iff.1 $ (le_map_inv_iff f).1 bot_le,
  .. show order_hom_class F α β, from infer_instance }

@[priority 100] -- See note [lower instance priority]
instance order_iso_class.to_bounded_order_hom_class [has_le α] [bounded_order α] [partial_order β]
  [bounded_order β] [order_iso_class F α β] :
  bounded_order_hom_class F α β :=
{ ..show order_hom_class F α β, from infer_instance,
  ..order_iso_class.to_top_hom_class,
  ..order_iso_class.to_bot_hom_class }

@[simp] lemma map_eq_top_iff [has_le α] [order_top α] [partial_order β] [order_top β]
  [order_iso_class F α β] (f : F) {a : α} : f a = ⊤ ↔ a = ⊤ :=
by rw [←map_top f, (equiv_like.injective f).eq_iff]

@[simp] lemma map_eq_bot_iff [has_le α] [order_bot α] [partial_order β] [order_bot β]
  [order_iso_class F α β] (f : F) {a : α} : f a = ⊥ ↔ a = ⊥ :=
by rw [←map_bot f, (equiv_like.injective f).eq_iff]

instance [has_top α] [has_top β] [top_hom_class F α β] : has_coe_t F (top_hom α β) :=
⟨λ f, ⟨f, map_top f⟩⟩

instance [has_bot α] [has_bot β] [bot_hom_class F α β] : has_coe_t F (bot_hom α β) :=
⟨λ f, ⟨f, map_bot f⟩⟩

instance [preorder α] [preorder β] [bounded_order α] [bounded_order β]
  [bounded_order_hom_class F α β] : has_coe_t F (bounded_order_hom α β) :=
⟨λ f, { to_fun := f, map_top' := map_top f, map_bot' := map_bot f, ..(f : α →o β) }⟩

/-! ### Top homomorphisms -/

namespace top_hom
variables [has_top α]

section has_top
variables [has_top β] [has_top γ] [has_top δ]

instance : top_hom_class (top_hom α β) α β :=
{ coe := top_hom.to_fun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  map_top := top_hom.map_top' }

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
instance : has_coe_to_fun (top_hom α β) (λ _, α → β) := fun_like.has_coe_to_fun

@[simp] lemma to_fun_eq_coe {f : top_hom α β} : f.to_fun = (f : α → β) := rfl

-- this must come after the coe_to_fun definition
initialize_simps_projections top_hom (to_fun → apply)

@[ext] lemma ext {f g : top_hom α β} (h : ∀ a, f a = g a) : f = g := fun_like.ext f g h

/-- Copy of a `top_hom` with a new `to_fun` equal to the old one. Useful to fix definitional
equalities. -/
protected def copy (f : top_hom α β) (f' : α → β) (h : f' = f) : top_hom α β :=
{ to_fun := f',
  map_top' := h.symm ▸ f.map_top' }

@[simp] lemma coe_copy (f : top_hom α β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' := rfl
lemma copy_eq (f : top_hom α β) (f' : α → β) (h : f' = f) : f.copy f' h = f := fun_like.ext' h

instance : inhabited (top_hom α β) := ⟨⟨λ _, ⊤, rfl⟩⟩

variables (α)

/-- `id` as a `top_hom`. -/
protected def id : top_hom α α := ⟨id, rfl⟩

@[simp] lemma coe_id : ⇑(top_hom.id α) = id := rfl

variables {α}

@[simp] lemma id_apply (a : α) : top_hom.id α a = a := rfl

/-- Composition of `top_hom`s as a `top_hom`. -/
def comp (f : top_hom β γ) (g : top_hom α β) : top_hom α γ :=
{ to_fun := f ∘ g,
  map_top' := by rw [comp_apply, map_top, map_top] }

@[simp] lemma coe_comp (f : top_hom β γ) (g : top_hom α β) : (f.comp g : α → γ) = f ∘ g := rfl
@[simp] lemma comp_apply (f : top_hom β γ) (g : top_hom α β) (a : α) :
  (f.comp g) a = f (g a) := rfl
@[simp] lemma comp_assoc (f : top_hom γ δ) (g : top_hom β γ) (h : top_hom α β) :
  (f.comp g).comp h = f.comp (g.comp h) := rfl
@[simp] lemma comp_id (f : top_hom α β) : f.comp (top_hom.id α) = f := top_hom.ext $ λ a, rfl
@[simp] lemma id_comp (f : top_hom α β) : (top_hom.id β).comp f = f := top_hom.ext $ λ a, rfl

lemma cancel_right {g₁ g₂ : top_hom β γ} {f : top_hom α β} (hf : surjective f) :
  g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
⟨λ h, top_hom.ext $ hf.forall.2 $ fun_like.ext_iff.1 h, congr_arg _⟩

lemma cancel_left {g : top_hom β γ} {f₁ f₂ : top_hom α β} (hg : injective g) :
  g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
⟨λ h, top_hom.ext $ λ a, hg $
  by rw [←top_hom.comp_apply, h, top_hom.comp_apply], congr_arg _⟩

end has_top

instance [preorder β] [has_top β] : preorder (top_hom α β) :=
preorder.lift (coe_fn : top_hom α β → α → β)

instance [partial_order β] [has_top β] : partial_order (top_hom α β) :=
partial_order.lift _ fun_like.coe_injective

section order_top
variables [preorder β] [order_top β]

instance : order_top (top_hom α β) := ⟨⟨⊤, rfl⟩, λ _, le_top⟩

@[simp] lemma coe_top : ⇑(⊤ : top_hom α β) = ⊤ := rfl
@[simp] lemma top_apply (a : α) : (⊤ : top_hom α β) a = ⊤ := rfl

end order_top

section semilattice_inf
variables [semilattice_inf β] [order_top β] (f g : top_hom α β)

instance : has_inf (top_hom α β) :=
⟨λ f g, ⟨f ⊓ g, by rw [pi.inf_apply, map_top, map_top, inf_top_eq]⟩⟩

instance : semilattice_inf (top_hom α β) := fun_like.coe_injective.semilattice_inf _ $ λ _ _, rfl

@[simp] lemma coe_inf : ⇑(f ⊓ g) = f ⊓ g := rfl
@[simp] lemma inf_apply (a : α) : (f ⊓ g) a = f a ⊓ g a := rfl

end semilattice_inf

section semilattice_sup
variables [semilattice_sup β] [order_top β] (f g : top_hom α β)

instance : has_sup (top_hom α β) :=
⟨λ f g, ⟨f ⊔ g, by rw [pi.sup_apply, map_top, map_top, sup_top_eq]⟩⟩

instance : semilattice_sup (top_hom α β) := fun_like.coe_injective.semilattice_sup _ $ λ _ _, rfl

@[simp] lemma coe_sup : ⇑(f ⊔ g) = f ⊔ g := rfl
@[simp] lemma sup_apply (a : α) : (f ⊔ g) a = f a ⊔ g a := rfl

end semilattice_sup

instance [lattice β] [order_top β] : lattice (top_hom α β) :=
fun_like.coe_injective.lattice _ (λ _ _, rfl) (λ _ _, rfl)

instance [distrib_lattice β] [order_top β] : distrib_lattice (top_hom α β) :=
fun_like.coe_injective.distrib_lattice _ (λ _ _, rfl) (λ _ _, rfl)

end top_hom

/-! ### Bot homomorphisms -/

namespace bot_hom
variables [has_bot α]

section has_bot
variables [has_bot β] [has_bot γ] [has_bot δ]

instance : bot_hom_class (bot_hom α β) α β :=
{ coe := bot_hom.to_fun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  map_bot := bot_hom.map_bot' }

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
instance : has_coe_to_fun (bot_hom α β) (λ _, α → β) := fun_like.has_coe_to_fun

@[simp] lemma to_fun_eq_coe {f : bot_hom α β} : f.to_fun = (f : α → β) := rfl

-- this must come after the coe_to_fun definition
initialize_simps_projections bot_hom (to_fun → apply)

@[ext] lemma ext {f g : bot_hom α β} (h : ∀ a, f a = g a) : f = g := fun_like.ext f g h

/-- Copy of a `bot_hom` with a new `to_fun` equal to the old one. Useful to fix definitional
equalities. -/
protected def copy (f : bot_hom α β) (f' : α → β) (h : f' = f) : bot_hom α β :=
{ to_fun := f',
  map_bot' := h.symm ▸ f.map_bot' }

@[simp] lemma coe_copy (f : bot_hom α β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' := rfl
lemma copy_eq (f : bot_hom α β) (f' : α → β) (h : f' = f) : f.copy f' h = f := fun_like.ext' h

instance : inhabited (bot_hom α β) := ⟨⟨λ _, ⊥, rfl⟩⟩

variables (α)

/-- `id` as a `bot_hom`. -/
protected def id : bot_hom α α := ⟨id, rfl⟩

@[simp] lemma coe_id : ⇑(bot_hom.id α) = id := rfl

variables {α}

@[simp] lemma id_apply (a : α) : bot_hom.id α a = a := rfl

/-- Composition of `bot_hom`s as a `bot_hom`. -/
def comp (f : bot_hom β γ) (g : bot_hom α β) : bot_hom α γ :=
{ to_fun := f ∘ g,
  map_bot' := by rw [comp_apply, map_bot, map_bot] }

@[simp] lemma coe_comp (f : bot_hom β γ) (g : bot_hom α β) : (f.comp g : α → γ) = f ∘ g := rfl
@[simp] lemma comp_apply (f : bot_hom β γ) (g : bot_hom α β) (a : α) :
  (f.comp g) a = f (g a) := rfl
@[simp] lemma comp_assoc (f : bot_hom γ δ) (g : bot_hom β γ) (h : bot_hom α β) :
  (f.comp g).comp h = f.comp (g.comp h) := rfl
@[simp] lemma comp_id (f : bot_hom α β) : f.comp (bot_hom.id α) = f := bot_hom.ext $ λ a, rfl
@[simp] lemma id_comp (f : bot_hom α β) : (bot_hom.id β).comp f = f := bot_hom.ext $ λ a, rfl

lemma cancel_right {g₁ g₂ : bot_hom β γ} {f : bot_hom α β} (hf : surjective f) :
  g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
⟨λ h, bot_hom.ext $ hf.forall.2 $ fun_like.ext_iff.1 h, congr_arg _⟩

lemma cancel_left {g : bot_hom β γ} {f₁ f₂ : bot_hom α β} (hg : injective g) :
  g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
⟨λ h, bot_hom.ext $ λ a, hg $
  by rw [←bot_hom.comp_apply, h, bot_hom.comp_apply], congr_arg _⟩

end has_bot

instance [preorder β] [has_bot β] : preorder (bot_hom α β) :=
preorder.lift (coe_fn : bot_hom α β → α → β)

instance [partial_order β] [has_bot β] : partial_order (bot_hom α β) :=
partial_order.lift _ fun_like.coe_injective

section order_bot
variables [preorder β] [order_bot β]

instance : order_bot (bot_hom α β) := ⟨⟨⊥, rfl⟩, λ _, bot_le⟩

@[simp] lemma coe_bot : ⇑(⊥ : bot_hom α β) = ⊥ := rfl
@[simp] lemma bot_apply (a : α) : (⊥ : bot_hom α β) a = ⊥ := rfl

end order_bot

section semilattice_inf
variables [semilattice_inf β] [order_bot β] (f g : bot_hom α β)

instance : has_inf (bot_hom α β) :=
⟨λ f g, ⟨f ⊓ g, by rw [pi.inf_apply, map_bot, map_bot, inf_bot_eq]⟩⟩

instance : semilattice_inf (bot_hom α β) := fun_like.coe_injective.semilattice_inf _ $ λ _ _, rfl

@[simp] lemma coe_inf : ⇑(f ⊓ g) = f ⊓ g := rfl
@[simp] lemma inf_apply (a : α) : (f ⊓ g) a = f a ⊓ g a := rfl

end semilattice_inf

section semilattice_sup
variables [semilattice_sup β] [order_bot β] (f g : bot_hom α β)

instance : has_sup (bot_hom α β) :=
⟨λ f g, ⟨f ⊔ g, by rw [pi.sup_apply, map_bot, map_bot, sup_bot_eq]⟩⟩

instance : semilattice_sup (bot_hom α β) := fun_like.coe_injective.semilattice_sup _ $ λ _ _, rfl

@[simp] lemma coe_sup : ⇑(f ⊔ g) = f ⊔ g := rfl
@[simp] lemma sup_apply (a : α) : (f ⊔ g) a = f a ⊔ g a := rfl

end semilattice_sup

instance [lattice β] [order_bot β] : lattice (bot_hom α β) :=
fun_like.coe_injective.lattice _ (λ _ _, rfl) (λ _ _, rfl)

instance [distrib_lattice β] [order_bot β] : distrib_lattice (bot_hom α β) :=
fun_like.coe_injective.distrib_lattice _ (λ _ _, rfl) (λ _ _, rfl)

end bot_hom

/-! ### Bounded order homomorphisms -/

namespace bounded_order_hom
variables [preorder α] [preorder β] [preorder γ] [preorder δ] [bounded_order α] [bounded_order β]
  [bounded_order γ] [bounded_order δ]

/-- Reinterpret a `bounded_order_hom` as a `top_hom`. -/
def to_top_hom (f : bounded_order_hom α β) : top_hom α β := { ..f }

/-- Reinterpret a `bounded_order_hom` as a `bot_hom`. -/
def to_bot_hom (f : bounded_order_hom α β) : bot_hom α β := { ..f }

instance : bounded_order_hom_class (bounded_order_hom α β) α β :=
{ coe := λ f, f.to_fun,
  coe_injective' := λ f g h, by obtain ⟨⟨_, _⟩, _⟩ := f; obtain ⟨⟨_, _⟩, _⟩ := g; congr',
  map_rel := λ f, f.monotone',
  map_top := λ f, f.map_top',
  map_bot := λ f, f.map_bot' }

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
instance : has_coe_to_fun (bounded_order_hom α β) (λ _, α → β) := fun_like.has_coe_to_fun

@[simp] lemma to_fun_eq_coe {f : bounded_order_hom α β} : f.to_fun = (f : α → β) := rfl

@[ext] lemma ext {f g : bounded_order_hom α β} (h : ∀ a, f a = g a) : f = g := fun_like.ext f g h

/-- Copy of a `bounded_order_hom` with a new `to_fun` equal to the old one. Useful to fix
definitional equalities. -/
protected def copy (f : bounded_order_hom α β) (f' : α → β) (h : f' = f) : bounded_order_hom α β :=
{ .. f.to_order_hom.copy f' h, .. f.to_top_hom.copy f' h, .. f.to_bot_hom.copy f' h }

@[simp] lemma coe_copy (f : bounded_order_hom α β) (f' : α → β) (h : f' = f) :
  ⇑(f.copy f' h) = f' :=
rfl

lemma copy_eq (f : bounded_order_hom α β) (f' : α → β) (h : f' = f) : f.copy f' h = f :=
fun_like.ext' h

variables (α)

/-- `id` as a `bounded_order_hom`. -/
protected def id : bounded_order_hom α α := { ..order_hom.id, ..top_hom.id α, ..bot_hom.id α }

instance : inhabited (bounded_order_hom α α) := ⟨bounded_order_hom.id α⟩

@[simp] lemma coe_id : ⇑(bounded_order_hom.id α) = id := rfl

variables {α}

@[simp] lemma id_apply (a : α) : bounded_order_hom.id α a = a := rfl

/-- Composition of `bounded_order_hom`s as a `bounded_order_hom`. -/
def comp (f : bounded_order_hom β γ) (g : bounded_order_hom α β) : bounded_order_hom α γ :=
{ ..f.to_order_hom.comp g.to_order_hom,
  ..f.to_top_hom.comp g.to_top_hom, ..f.to_bot_hom.comp g.to_bot_hom }

@[simp] lemma coe_comp (f : bounded_order_hom β γ) (g : bounded_order_hom α β) :
  (f.comp g : α → γ) = f ∘ g := rfl
@[simp] lemma comp_apply (f : bounded_order_hom β γ) (g : bounded_order_hom α β) (a : α) :
  (f.comp g) a = f (g a) := rfl
@[simp] lemma coe_comp_order_hom (f : bounded_order_hom β γ) (g : bounded_order_hom α β) :
  (f.comp g : order_hom α γ) = (f : order_hom β γ).comp g := rfl
@[simp] lemma coe_comp_top_hom (f : bounded_order_hom β γ) (g : bounded_order_hom α β) :
  (f.comp g : top_hom α γ) = (f : top_hom β γ).comp g := rfl
@[simp] lemma coe_comp_bot_hom (f : bounded_order_hom β γ) (g : bounded_order_hom α β) :
  (f.comp g : bot_hom α γ) = (f : bot_hom β γ).comp g := rfl
@[simp] lemma comp_assoc (f : bounded_order_hom γ δ) (g : bounded_order_hom β γ)
  (h : bounded_order_hom α β) :
  (f.comp g).comp h = f.comp (g.comp h) := rfl
@[simp] lemma comp_id (f : bounded_order_hom α β) : f.comp (bounded_order_hom.id α) = f :=
bounded_order_hom.ext $ λ a, rfl
@[simp] lemma id_comp (f : bounded_order_hom α β) : (bounded_order_hom.id β).comp f = f :=
bounded_order_hom.ext $ λ a, rfl

lemma cancel_right {g₁ g₂ : bounded_order_hom β γ} {f : bounded_order_hom α β} (hf : surjective f) :
  g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
⟨λ h, bounded_order_hom.ext $ hf.forall.2 $ fun_like.ext_iff.1 h, congr_arg _⟩

lemma cancel_left {g : bounded_order_hom β γ} {f₁ f₂ : bounded_order_hom α β} (hg : injective g) :
  g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
⟨λ h, bounded_order_hom.ext $ λ a, hg $
  by rw [←bounded_order_hom.comp_apply, h, bounded_order_hom.comp_apply], congr_arg _⟩

end bounded_order_hom

/-! ### Dual homs -/

namespace top_hom
variables [has_le α] [order_top α] [has_le β] [order_top β] [has_le γ] [order_top γ]

/-- Reinterpret a top homomorphism as a bot homomorphism between the dual lattices. -/
@[simps] protected def dual : top_hom α β ≃ bot_hom αᵒᵈ βᵒᵈ :=
{ to_fun := λ f, ⟨f, f.map_top'⟩,
  inv_fun := λ f, ⟨f, f.map_bot'⟩,
  left_inv := λ f, top_hom.ext $ λ _, rfl,
  right_inv := λ f, bot_hom.ext $ λ _, rfl }

@[simp] lemma dual_id : (top_hom.id α).dual = bot_hom.id _ := rfl
@[simp] lemma dual_comp (g : top_hom β γ) (f : top_hom α β) :
  (g.comp f).dual = g.dual.comp f.dual := rfl

@[simp] lemma symm_dual_id : top_hom.dual.symm (bot_hom.id _) = top_hom.id α := rfl
@[simp] lemma symm_dual_comp (g : bot_hom βᵒᵈ γᵒᵈ) (f : bot_hom αᵒᵈ βᵒᵈ) :
  top_hom.dual.symm (g.comp f) = (top_hom.dual.symm g).comp (top_hom.dual.symm f) := rfl

end top_hom

namespace bot_hom
variables [has_le α] [order_bot α] [has_le β] [order_bot β] [has_le γ] [order_bot γ]

/-- Reinterpret a bot homomorphism as a top homomorphism between the dual lattices. -/
@[simps] protected def dual : bot_hom α β ≃ top_hom αᵒᵈ βᵒᵈ :=
{ to_fun := λ f, ⟨f, f.map_bot'⟩,
  inv_fun := λ f, ⟨f, f.map_top'⟩,
  left_inv := λ f, bot_hom.ext $ λ _, rfl,
  right_inv := λ f, top_hom.ext $ λ _, rfl }

@[simp] lemma dual_id : (bot_hom.id α).dual = top_hom.id _ := rfl
@[simp] lemma dual_comp (g : bot_hom β γ) (f : bot_hom α β) :
  (g.comp f).dual = g.dual.comp f.dual := rfl

@[simp] lemma symm_dual_id : bot_hom.dual.symm (top_hom.id _) = bot_hom.id α := rfl
@[simp] lemma symm_dual_comp (g : top_hom βᵒᵈ γᵒᵈ) (f : top_hom αᵒᵈ βᵒᵈ) :
  bot_hom.dual.symm (g.comp f) = (bot_hom.dual.symm g).comp (bot_hom.dual.symm f) := rfl

end bot_hom

namespace bounded_order_hom
variables [preorder α] [bounded_order α] [preorder β] [bounded_order β] [preorder γ]
  [bounded_order γ]

/-- Reinterpret a bounded order homomorphism as a bounded order homomorphism between the dual
orders. -/
@[simps] protected def dual : bounded_order_hom α β ≃ bounded_order_hom αᵒᵈ βᵒᵈ :=
{ to_fun := λ f, ⟨f.to_order_hom.dual, f.map_bot', f.map_top'⟩,
  inv_fun := λ f, ⟨order_hom.dual.symm f.to_order_hom, f.map_bot', f.map_top'⟩,
  left_inv := λ f, ext $ λ a, rfl,
  right_inv := λ f, ext $ λ a, rfl }

@[simp] lemma dual_id : (bounded_order_hom.id α).dual = bounded_order_hom.id _ := rfl
@[simp] lemma dual_comp (g : bounded_order_hom β γ) (f : bounded_order_hom α β) :
  (g.comp f).dual = g.dual.comp f.dual := rfl

@[simp] lemma symm_dual_id :
  bounded_order_hom.dual.symm (bounded_order_hom.id _) = bounded_order_hom.id α := rfl
@[simp] lemma symm_dual_comp (g : bounded_order_hom βᵒᵈ γᵒᵈ) (f : bounded_order_hom αᵒᵈ βᵒᵈ) :
  bounded_order_hom.dual.symm (g.comp f) =
    (bounded_order_hom.dual.symm g).comp (bounded_order_hom.dual.symm f) := rfl

end bounded_order_hom


/-
Copyright (c) 2019 Jean Lo. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jean Lo
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.pointwise
import Mathlib.analysis.normed_space.basic
import Mathlib.PostPort

universes u_1 u_2 l

namespace Mathlib

/-!
# Seminorms and Local Convexity

This file introduces the following notions, defined for a vector space
over a normed field:

- the subset properties of being `absorbent` and `balanced`,

- a `seminorm`, a function to the reals that is positive-semidefinite,
  absolutely homogeneous, and subadditive.

We prove related properties.

## TODO

Define and show equivalence of two notions of local convexity for a
topological vector space over ℝ or ℂ: that it has a local base of
balanced convex absorbent sets, and that it carries the initial
topology induced by a family of seminorms.

## References
* [H. H. Schaefer, *Topological Vector Spaces*][schaefer1966]
-/

/-!
### Subset Properties

Absorbent and balanced sets in a vector space over a
nondiscrete normed field.
-/

/-- A set `A` absorbs another set `B` if `B` is contained in scaling
`A` by elements of sufficiently large norms. -/
def absorbs (𝕜 : Type u_1) [nondiscrete_normed_field 𝕜] {E : Type u_2} [add_comm_group E] [vector_space 𝕜 E] (A : set E) (B : set E) :=
  ∃ (r : ℝ), ∃ (H : r > 0), ∀ (a : 𝕜), r ≤ norm a → B ⊆ a • A

/-- A set is absorbent if it absorbs every singleton. -/
def absorbent (𝕜 : Type u_1) [nondiscrete_normed_field 𝕜] {E : Type u_2} [add_comm_group E] [vector_space 𝕜 E] (A : set E) :=
  ∀ (x : E), ∃ (r : ℝ), ∃ (H : r > 0), ∀ (a : 𝕜), r ≤ norm a → x ∈ a • A

/-- A set `A` is balanced if `a • A` is contained in `A` whenever `a`
has norm no greater than one. -/
def balanced (𝕜 : Type u_1) [nondiscrete_normed_field 𝕜] {E : Type u_2} [add_comm_group E] [vector_space 𝕜 E] (A : set E) :=
  ∀ (a : 𝕜), norm a ≤ 1 → a • A ⊆ A

/-- A balanced set absorbs itself. -/
theorem balanced.absorbs_self {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [add_comm_group E] [vector_space 𝕜 E] {A : set E} (hA : balanced 𝕜 A) : absorbs 𝕜 A A := sorry

/-!
Properties of balanced and absorbing sets in a topological vector space:
-/

/-- Every neighbourhood of the origin is absorbent. -/
theorem absorbent_nhds_zero {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [add_comm_group E] [vector_space 𝕜 E] {A : set E} [topological_space E] [topological_vector_space 𝕜 E] (hA : A ∈ nhds 0) : absorbent 𝕜 A := sorry

/-- The union of `{0}` with the interior of a balanced set
    is balanced. -/
theorem balanced_zero_union_interior {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [add_comm_group E] [vector_space 𝕜 E] {A : set E} [topological_space E] [topological_vector_space 𝕜 E] (hA : balanced 𝕜 A) : balanced 𝕜 (singleton 0 ∪ interior A) := sorry

/-- The interior of a balanced set is balanced if it contains the origin. -/
theorem balanced.interior {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [add_comm_group E] [vector_space 𝕜 E] {A : set E} [topological_space E] [topological_vector_space 𝕜 E] (hA : balanced 𝕜 A) (h : 0 ∈ interior A) : balanced 𝕜 (interior A) := sorry

/-- The closure of a balanced set is balanced. -/
theorem balanced.closure {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [add_comm_group E] [vector_space 𝕜 E] {A : set E} [topological_space E] [topological_vector_space 𝕜 E] (hA : balanced 𝕜 A) : balanced 𝕜 (closure A) := sorry

/-!
### Seminorms
-/

/-- A seminorm on a vector space over a normed field is a function to
the reals that is positive semidefinite, positive homogeneous, and
subadditive. -/
structure seminorm (𝕜 : Type u_1) (E : Type u_2) [normed_field 𝕜] [add_comm_group E] [vector_space 𝕜 E]
where
  to_fun : E → ℝ
  smul' : ∀ (a : 𝕜) (x : E), to_fun (a • x) = norm a * to_fun x
  triangle' : ∀ (x y : E), to_fun (x + y) ≤ to_fun x + to_fun y

protected instance seminorm.inhabited {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [add_comm_group E] [vector_space 𝕜 E] : Inhabited (seminorm 𝕜 E) :=
  { default := seminorm.mk (fun (_x : E) => 0) sorry sorry }

protected instance seminorm.has_coe_to_fun {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [add_comm_group E] [vector_space 𝕜 E] : has_coe_to_fun (seminorm 𝕜 E) :=
  has_coe_to_fun.mk (fun (p : seminorm 𝕜 E) => E → ℝ) fun (p : seminorm 𝕜 E) => seminorm.to_fun p

namespace seminorm

protected theorem smul {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [add_comm_group E] [vector_space 𝕜 E] (p : seminorm 𝕜 E) (c : 𝕜) (x : E) : coe_fn p (c • x) = norm c * coe_fn p x :=
  smul' p c x

protected theorem triangle {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [add_comm_group E] [vector_space 𝕜 E] (p : seminorm 𝕜 E) (x : E) (y : E) : coe_fn p (x + y) ≤ coe_fn p x + coe_fn p y :=
  triangle' p x y

@[simp] protected theorem zero {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [add_comm_group E] [vector_space 𝕜 E] (p : seminorm 𝕜 E) : coe_fn p 0 = 0 := sorry

@[simp] protected theorem neg {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [add_comm_group E] [vector_space 𝕜 E] (p : seminorm 𝕜 E) (x : E) : coe_fn p (-x) = coe_fn p x := sorry

theorem nonneg {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [add_comm_group E] [vector_space 𝕜 E] (p : seminorm 𝕜 E) (x : E) : 0 ≤ coe_fn p x := sorry

theorem sub_rev {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [add_comm_group E] [vector_space 𝕜 E] (p : seminorm 𝕜 E) (x : E) (y : E) : coe_fn p (x - y) = coe_fn p (y - x) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn p (x - y) = coe_fn p (y - x))) (Eq.symm (neg_sub y x))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn p (-(y - x)) = coe_fn p (y - x))) (seminorm.neg p (y - x))))
      (Eq.refl (coe_fn p (y - x))))

/-- The ball of radius `r` at `x` with respect to seminorm `p`
    is the set of elements `y` with `p (y - x) < `r`. -/
def ball {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [add_comm_group E] [vector_space 𝕜 E] (p : seminorm 𝕜 E) (x : E) (r : ℝ) : set E :=
  set_of fun (y : E) => coe_fn p (y - x) < r

theorem mem_ball {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [add_comm_group E] [vector_space 𝕜 E] (p : seminorm 𝕜 E) (x : E) (y : E) (r : ℝ) : y ∈ ball p x r ↔ coe_fn p (y - x) < r :=
  iff.rfl

theorem mem_ball_zero {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [add_comm_group E] [vector_space 𝕜 E] (p : seminorm 𝕜 E) (y : E) (r : ℝ) : y ∈ ball p 0 r ↔ coe_fn p y < r :=
  eq.mpr (id (Eq._oldrec (Eq.refl (y ∈ ball p 0 r ↔ coe_fn p y < r)) (propext (mem_ball p 0 y r))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn p (y - 0) < r ↔ coe_fn p y < r)) (sub_zero y))) (iff.refl (coe_fn p y < r)))

theorem ball_zero_eq {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [add_comm_group E] [vector_space 𝕜 E] (p : seminorm 𝕜 E) (r : ℝ) : ball p 0 r = set_of fun (y : E) => coe_fn p y < r := sorry

/-- Seminorm-balls at the origin are balanced. -/
theorem balanced_ball_zero {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [add_comm_group E] [vector_space 𝕜 E] (p : seminorm 𝕜 E) (r : ℝ) : balanced 𝕜 (ball p 0 r) := sorry