Skip to content

Commit

Permalink
working on simple Gluing example for CartesianCategory
Browse files Browse the repository at this point in the history
Split Categories/Instances/Sets/More.agda into More and Properties.agda,
because importing Categories/Limits/BinProducts caused cyclic imports.

I don't know why, but compiling takes painfully long for
Gluing/CartesianCategory.
  • Loading branch information
hejohns committed Jun 20, 2024
1 parent 0849f9f commit a0b1980
Show file tree
Hide file tree
Showing 7 changed files with 183 additions and 15 deletions.
1 change: 0 additions & 1 deletion Cubical/Categories/Displayed/Instances/Path.agda
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,6 @@ open import Cubical.Categories.Displayed.HLevels
open import Cubical.Categories.Displayed.HLevels.More
open import Cubical.Categories.Displayed.Functor
open import Cubical.Categories.Displayed.Section.Base
open import Cubical.Categories.Displayed.Constructions.Graph
open import Cubical.Categories.Displayed.Instances.Terminal
open import Cubical.Categories.Displayed.Constructions.StructureOver
open import Cubical.Categories.Displayed.Properties
Expand Down
19 changes: 18 additions & 1 deletion Cubical/Categories/Displayed/Instances/Sets/Properties.agda
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
{-# OPTIONS --safe #-}
--{-# OPTIONS --safe #-}
{-# OPTIONS --allow-unsolved-metas #-}
module Cubical.Categories.Displayed.Instances.Sets.Properties where

open import Cubical.Foundations.Prelude
Expand All @@ -13,13 +14,15 @@ open import Cubical.Data.Unit
open import Cubical.Categories.Category
open import Cubical.Categories.Instances.Sets
open import Cubical.Categories.Instances.Sets.More
open import Cubical.Categories.Instances.Sets.Properties
open import Cubical.Categories.Displayed.Base
open import Cubical.Categories.Displayed.Functor
open import Cubical.Categories.Displayed.Fibration.Base
open import Cubical.Categories.Displayed.Fibration.Properties
open import Cubical.Categories.Displayed.Instances.Sets.Base
open import Cubical.Categories.Displayed.Presheaf
open import Cubical.Categories.Displayed.Limits.Terminal
open import Cubical.Categories.Displayed.Limits.BinProduct


private
Expand Down Expand Up @@ -55,3 +58,17 @@ VerticalTerminalsSETᴰ dᴰ .universalᴰ .equiv-proof _ = uniqueExists
LiftedTerminalSETᴰ : {ℓ ℓ'} LiftedTerminal (SETᴰ ℓ ℓ') terminal'SET
LiftedTerminalSETᴰ {ℓ} {ℓ'} =
Vertical/𝟙→LiftedTerm _ (VerticalTerminalsSETᴰ _)

module _ {ℓSETᴰ ℓSETᴰ' : Level} where
VerticalBinProdsSETᴰ : VerticalBinProducts (SETᴰ ℓSETᴰ ℓSETᴰ')
VerticalBinProdsSETᴰ {d = X} (Xᴰ , Xᴰ') .vertexᴰ x =
⟨ Xᴰ x ⟩ × ⟨ Xᴰ' x ⟩ , isSet× (Xᴰ x .snd) (Xᴰ' x .snd)
VerticalBinProdsSETᴰ {d = X} (Xᴰ , Xᴰ') .elementᴰ = (λ _ fst) , (λ _ snd)
VerticalBinProdsSETᴰ {d = X} (Xᴰ , Xᴰ') .universalᴰ {x = Y} {xᴰ = Yᴰ} {f = h} .equiv-proof (f , g) =
uniqueExists (λ y yᴰ f y yᴰ , g y yᴰ) refl
(λ h isSet×
(SETᴰ ℓSETᴰ ℓSETᴰ' .isSetHomᴰ {yᴰ = Xᴰ})
(SETᴰ ℓSETᴰ ℓSETᴰ' .isSetHomᴰ {yᴰ = Xᴰ'})
_
(f , g))
λ h p {!!}
11 changes: 0 additions & 11 deletions Cubical/Categories/Instances/Sets/More.agda
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,6 @@ open import Cubical.Data.Unit

open import Cubical.Categories.Category
open import Cubical.Categories.Functor
open import Cubical.Categories.Limits.Terminal.More
open import Cubical.Categories.Bifunctor.Redundant
open import Cubical.Categories.Instances.Sets
open import Cubical.Categories.Constructions.BinProduct
Expand Down Expand Up @@ -51,13 +50,3 @@ module _ {A}{B} (f : CatIso (SET ℓ) A B) a where
∙ transportRefl _
∙ transportRefl _
∙ cong (f .fst) (transportRefl _ ∙ transportRefl _ ))

open UniversalElement
terminal'SET : Terminal' (SET ℓ)
terminal'SET .vertex = Unit* , isSetUnit*
terminal'SET .element = tt
terminal'SET .universal X .equiv-proof y = uniqueExists
(λ _ tt*)
(isPropUnit tt tt)
(λ _ p' q' isSetUnit tt tt p' q')
(λ _ _ funExt λ _ isPropUnit* tt* tt*)
40 changes: 40 additions & 0 deletions Cubical/Categories/Instances/Sets/Properties.agda
Original file line number Diff line number Diff line change
@@ -0,0 +1,40 @@
{-# OPTIONS --safe #-}
module Cubical.Categories.Instances.Sets.Properties where

open import Cubical.Foundations.Prelude
open import Cubical.Foundations.Equiv
open import Cubical.Foundations.HLevels
open import Cubical.Data.Unit
open import Cubical.Data.Sigma

open import Cubical.Categories.Category
open import Cubical.Categories.Instances.Sets
open import Cubical.Categories.Presheaf
open import Cubical.Categories.Limits.Terminal.More
open import Cubical.Categories.Limits.BinProduct.More

private variable : Level

open UniversalElement
open Category

terminal'SET : Terminal' (SET ℓ)
terminal'SET .vertex = Unit* , isSetUnit*
terminal'SET .element = tt
terminal'SET .universal X .equiv-proof y = uniqueExists
(λ _ tt*)
(isPropUnit tt tt)
(λ _ p' q' isSetUnit tt tt p' q')
(λ _ _ funExt λ _ isPropUnit* tt* tt*)

module _ {ℓSET : Level} where
BinProducts'SET : BinProducts' (SET ℓSET)
BinProducts'SET (X , Y) .vertex = X .fst × Y .fst , isSet× (X .snd) (Y .snd)
BinProducts'SET (X , Y) .element = fst , snd
BinProducts'SET (X , Y) .universal Z .equiv-proof (f , g) =
uniqueExists (λ z f z , g z) refl
(λ h isSet×
(SET ℓSET .isSetHom {x = Z} {y = X})
(SET ℓSET .isSetHom {x = Z} {y = Y})
((λ z (h z) .fst) , λ z (h z) .snd) (f , g))
λ h p i z (sym p) i .fst z , (sym p) i .snd z
1 change: 0 additions & 1 deletion Cubical/Categories/Presheaf/Constructions.agda
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,6 @@ open import Cubical.Categories.NaturalTransformation
open import Cubical.Categories.Instances.Functors
open import Cubical.Categories.Instances.Sets
open import Cubical.Categories.Presheaf.Base
open import Cubical.Categories.Presheaf.More
open import Cubical.Categories.Bifunctor.Redundant

private
Expand Down
1 change: 0 additions & 1 deletion Cubical/Categories/Profunctor/General.agda
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,6 @@ open import Cubical.Data.Sigma

open import Cubical.Categories.Presheaf.Base
open import Cubical.Categories.Presheaf.Representable
open import Cubical.Categories.Presheaf.More
open import Cubical.Categories.Instances.Functors.More

private
Expand Down
125 changes: 125 additions & 0 deletions Gluing/CartesianCategory.agda
Original file line number Diff line number Diff line change
@@ -0,0 +1,125 @@
{-# OPTIONS --allow-unsolved-metas #-}
--{-# OPTIONS --safe #-}
module Gluing.CartesianCategory where

open import Cubical.Foundations.Prelude
open import Cubical.Relation.Nullary hiding (⟪_⟫)
open import Cubical.Data.Nat
open import Cubical.Data.Nat.Properties
open import Cubical.Data.Bool
open import Cubical.Data.Sum

open import Cubical.Categories.Category renaming (isIso to isIsoC)
open import Cubical.Categories.Functor
open import Cubical.Categories.Constructions.Free.CartesianCategory.Base as Law
open import Cubical.Categories.Constructions.Free.CartesianCategory.ProductQuiver
open import Cubical.Categories.Limits.Cartesian.Base
open import Cubical.Categories.Limits.Terminal.More
open import Cubical.Categories.Limits.BinProduct.More
open import Cubical.Categories.Instances.Sets
open import Cubical.Categories.Instances.Sets.More
open import Cubical.Categories.Instances.Sets.Properties

open import Cubical.Categories.Displayed.Section.Base
open import Cubical.Categories.Displayed.Instances.Sets.Base
open import Cubical.Categories.Displayed.Instances.Sets.Properties
open import Cubical.Categories.Displayed.Constructions.Reindex.Properties

open Category
open Section

-- TODO: add an object that nothing uses, for a second example
module _ where
data OB : Type ℓ-zero where
ans : OB

discreteOB : Discrete OB
discreteOB = sectionDiscrete {A = ℕ}
(λ _ ans)
(λ _ 0)
(λ { ans refl })
discreteℕ

isSetOB : isSet OB
isSetOB = Discrete→isSet discreteOB

data MOR : Type ℓ-zero where
t f : MOR

discreteMOR : Discrete MOR
discreteMOR = sectionDiscrete {A = ℕ}
(λ { zero t ; (suc _) f })
(λ { t 0 ; f 1 })
(λ { t refl ; f refl })
discreteℕ

isSetMOR : isSet MOR
isSetMOR = Discrete→isSet discreteMOR

interleaved mutual -- not actually mutually recursive, just to interleave
dom cod : MOR ProdExpr OB

dom t =
cod t = ↑ ans

dom f =
cod f = ↑ ans

QUIVER : ×Quiver _
QUIVER .fst = OB
QUIVER .snd .ProductQuiver.mor = MOR
QUIVER .snd .ProductQuiver.dom = dom
QUIVER .snd .ProductQuiver.cod = cod

private module Q = ×QuiverNotation QUIVER

FREECC : CartesianCategory _ _
FREECC = FreeCartesianCategory QUIVER

open Terminal'Notation
(terminalToUniversalElement {C = FREECC .fst} (FREECC .snd .fst))

[ans] : FREECC .fst .ob
[ans] = ↑ ans

[t] [f] : FREECC .fst [ 𝟙 , [ans] ]
[t] = ↑ₑ t
[f] = ↑ₑ f

boolToExp : Bool FREECC .fst [ 𝟙 , [ans] ]
boolToExp = if_then [t] else [f]

[t]≠[f] : ¬ ([t] ≡ [f])
[t]≠[f] p = true≢false (cong n p)
where
sem : Functor (FREECC .fst) (SET ℓ-zero)
sem = Law.rec _
(SET ℓ-zero ,
Terminal'ToTerminal terminal'SET ,
BinProducts'ToBinProducts _ BinProducts'SET)
(λ { ans Bool , isSetBool})
λ { t λ _ true ; f λ _ false}
n : FREECC .fst [ 𝟙 , [ans] ] Bool
n e = (sem ⟪ e ⟫) _

CanonicalForm : FREECC .fst [ 𝟙 , [ans] ] Type _
CanonicalForm e = ([t] ≡ e) ⊎ ([f] ≡ e)

isSetCanonicalForm : {e} isSet (CanonicalForm e)
isSetCanonicalForm {e = e} = isSet⊎
(isProp→isSet (FREECC .fst .isSetHom [t] e))
(isProp→isSet (FREECC .fst .isSetHom [f] e))

canonicity : e CanonicalForm e
canonicity e = {!!}
where
pts = FREECC .fst [ 𝟙 ,-]
Canonicalize : Section pts (SETᴰ _ _)
Canonicalize = elimLocal _
(VerticalTerminalsSETᴰ (pts ⟅ ⊤ ⟆))
(λ Fcᴰ Fc'ᴰ isFib→F⟪π₁⟫* (BinProducts'SET _) Fcᴰ isFibrationSet ,
isFib→F⟪π₂⟫* (BinProducts'SET _) Fc'ᴰ isFibrationSet)
(λ Fcᴰ Fc'ᴰ {!!})
(λ { ans global-ans CanonicalForm global-ans , isSetCanonicalForm})
λ { t global-ans λ ⟨⟩ inl (sym (FREECC .fst .⋆IdL _) ∙ congS (λ x x ⋆⟨ FREECC .fst ⟩ _) 𝟙η')
; f global-ans λ ⟨⟩ inr (sym (FREECC .fst .⋆IdL _) ∙ congS (λ x x ⋆⟨ FREECC .fst ⟩ _) 𝟙η') }

0 comments on commit a0b1980

Please sign in to comment.