module Cat.Instances.Graphs.Omega where
The subgraph classifier🔗
private module _ {o ℓ} where open Sub (Graphs-pullbacks {o} {ℓ}) public variable o ℓ o' ℓ' : Level X Y Z : Graph o ℓ
Since the category of graphs is a presheaf category, we know for a fact that it has a subobject classifier, and we could simply transport this result over the equivalence to obtain the ‘subgraph classifier’. However, since the shape category for graphs is very simple, we can directly compute what this classifier is in terms of nodes and edges.
The subgraph classifier is the graph with nodes the set of propositions, and such that the edges from to are the spans from to
Intuitively, a map into the subgraph classifier assigns to each node the proposition of whether it belongs to the subgraph; and, to each edge, a proposition indicating belonging of the edge, which additionally remembers that an edge can only be included if its endpoints are.
Ωᴳ : Graph o ℓ Ωᴳ .Node = Lift _ Ω Ωᴳ .Edge P Q = Σ[ e ∈ Lift _ Ω ] (⌞ e ⌟ → ⌞ P ⌟) × (⌞ e ⌟ → ⌞ Q ⌟) Ωᴳ .Node-set = hlevel 2 Ωᴳ .Edge-set = hlevel 2
The “true” arrow into the subgraph classifier simply picks out the
true proposition ⊤Ω
, and
the true span over that. We now turn to showing the universal property
of
as a graph.
trueᴳ : Graph-hom (⊤ᴳ {o} {ℓ}) (Ωᴳ {o'} {ℓ'}) trueᴳ .node _ = lift ⊤Ω trueᴳ .edge _ = lift ⊤Ω , _ , _
private tru' : Subobject (Ωᴳ {o'} {ℓ'}) tru' = point→subobject Graphs-finitely-complete Graphs-is-category trueᴳ
For this, suppose that we have a subgraph We want to compute a “name” First, the fibres over the nodes are propositions, so we can directly take this as the node part of
private module work (m : Subobject X) where Nodes : X .Node → Type _ Nodes x = fibre (m .map .node) x
However, we can only ask about the fibres for edges between and in i.e. those for which the endpoints literally come from We can extend this to work for arbitrary by quantifying fibres and over the endpoints, and then asking for a fibre of over the transport of to an edge along and
Edges : ∀ {x y} → X .Edge x y → Type _ Edges {x} {y} e = Σ[ (mx , p) ∈ Nodes x ] Σ[ (my , q) ∈ Nodes y ] fibre (m .map .edge) (subst₂ (X .Edge) (sym p) (sym q) e)
Since both the node and edge part of a monomorphism of graphs are set embeddings, these types are propositions; and, by construction, our predicate on edges implies that both endpoints are also included. We thus have a map into the subgraph classifier.
open Subobject m renaming (map to mm) using () node-emb : is-embedding (mm .node) node-emb = is-monic→node-is-embedding (m .monic) edge-emb : ∀ {x y} → is-embedding (mm .edge {x} {y}) edge-emb = is-monic→edge-is-embedding (m .monic) nodes : X .Node → Ω nodes x = elΩ (Nodes x) Edges-is-prop : ∀ {x y} {e : X .Edge x y} → is-prop (Edges e) Edges-is-prop = Σ-is-hlevel 1 (node-emb _) λ _ → Σ-is-hlevel 1 (node-emb _) λ _ → edge-emb _ edges : ∀ {x y} → X .Edge x y → Ω edges e = elΩ (Edges e)
name : Graph-hom X (Ωᴳ {o} {ℓ}) name .node x = lift (nodes x) name .edge {x} {y} e = record { fst = lift (edges e) ; snd = rec! (λ mx p _ _ _ _ → inc (mx , p)) , rec! (λ _ _ my q _ _ → inc (my , q)) }
Let us show that this construction is an equivalence between subgraphs and their names. We define a helper function for recovering a fibre over a node from the information that our proposition about nodes is true.
from-node : ∀ {x} → lift {ℓ = ℓ} (nodes x) ≡ lift ⊤Ω → fibre (mm .node) x from-node p = □-out (node-emb _) (from-is-true (ap lower p))
To recover an edge, we have to work a bit harder. First, we
presuppose that we already have fibres
over the source and target nodes. Projecting the information from our
Edges
proposition at some
then gives a new pair of fibres
an edge
between these fibres, and a proof that
is the transport of
along
from-edge : {x y : ⌞ X ⌟} {e : X .Edge x y} → ((mx , p) : Nodes x) ((my , q) : Nodes y) → e ∈ edges → fibre (mm .edge) (subst₂ (X .Edge) (sym p) (sym q) e) from-edge {x} {y} {e} (mx , p) (my , q) w using ((mx' , p') , (my' , q') , e⁻¹' , γ) ← □-out {A = Edges e} Edges-is-prop w = record { fst = subst₂ (m .domain .Edge) x⁻¹p y⁻¹p e⁻¹' ; snd = rem₁ } where abstract
This is almost what we want, except the transport is in the wrong place and talks about the wrong paths. We can fix this up by showing that the fibres (hence the nodes) must be identical, since is an embedding on nodes, and some algebra regarding transports.
x⁻¹p : mx' ≡ mx x⁻¹p = ap fst (node-emb _ (mx' , p') (mx , p)) y⁻¹p : my' ≡ my y⁻¹p = ap fst (node-emb _ (my' , q') (my , q)) rem₁ : mm .edge (subst₂ (m .domain .Edge) x⁻¹p y⁻¹p e⁻¹') ≡ subst₂ (X .Edge) (sym p) (sym q) e rem₁ = mm .edge (subst₂ (m .domain .Edge) x⁻¹p y⁻¹p e⁻¹') ≡⟨ sym (subst₂-fibrewise (λ x y → mm .edge {x} {y}) x⁻¹p y⁻¹p e⁻¹') ⟩≡ subst₂ (X .Edge) (ap· mm x⁻¹p) (ap· mm y⁻¹p) (mm .edge e⁻¹') ≡⟨ ap (subst₂ (X .Edge) (ap· mm x⁻¹p) (ap· mm y⁻¹p)) γ ⟩≡ subst₂ (X .Edge) (ap· mm x⁻¹p) (ap· mm y⁻¹p) (subst₂ (X .Edge) (sym p') (sym q') e) ≡⟨ sym (subst₂-∙ (X .Edge) _ _ _ _ e) ⟩≡ subst₂ (X .Edge) _ _ e ≡⟨ ap₂ (λ a b → subst₂ (X .Edge) {b' = m .map .node my} a b e) prop! prop! ⟩≡ subst₂ (X .Edge) (sym p) (sym q) e ∎
This provides all we need to show that is the pullback of the true arrow along its name. We show that the subobjects are mutually embedded: in one direction, we can trivially show that the propositions are true by constructing the fibres. In the converse direction, we can use the helper functions defined above.
named-name : m ≅ₘ name ^* tru' named-name = Sub-antisym record { map = record where node x = m .map · x , lift tt , ap lift (to-is-true (inc (x , refl))) edge {x} {y} e = m .map .edge e , lift tt , Σ-pathp (ap lift (to-is-true (inc ((x , refl) , (y , refl) , e , sym (transport-refl _))))) (to-pathp refl) ; sq = Graph-hom-path (λ x → refl) (λ x → refl) } record { map = record where node (x , lift tt , e) = from-node e .fst edge {x , lift tt , p} {y , lift tt , q} (e , lift tt , pe) = from-edge (from-node p) (from-node q) (from-is-true (ap lower (apd (λ i → fst) pe))) .fst ; sq = ext λ where .node x _ e → sym (from-node e .snd) .edge {x , _ , p} {y , _ , q} (e , _ , pe) → to-pathp $ sym $ from-edge (from-node p) (from-node q) (from-is-true (ap lower (apd (λ i → fst) pe))) .snd }
Showing that you get back after into a subgraph by pulling back the true arrow and computing its name is a similar calculation.
private module mk = make-subobject-classifier name-named : (h : Graphs.Hom X Ωᴳ) → work.name (h ^* tru') ≡ h name-named {X = X} h = Graph-hom-path nodep λ e → Σ-prop-pathp rem (edgep e) where open work (h ^* tru') nodep : ∀ x → lift (elΩ (Nodes x)) ≡ h .node x nodep x = ap lift $ Ω-ua (λ e → let (x , lift tt , p) , α = (□-out (node-emb _) e) in subst (λ e → ⌞ h .node e ⌟) α (from-is-true (ap lower p))) (λ hx → inc ((x , _ , ap lift (to-is-true hx)) , refl)) edgep : ∀ {x y} (e : X .Edge x y) → lift (elΩ (Edges e)) ≡ h .edge e .fst edgep {x} {y} e = ap lift $ Ω-ua (λ fb → let (((x⁻¹ , _) , α) , ((y⁻¹ , _) , β) , (e⁻¹ , lift tt , p) , γ) = □-out Edges-is-prop fb in subst₂ {A = X .Node × X .Node} {B = uncurry (X .Edge)} (λ (x , y) e → e ∈ h .edge {x} {y}) (Σ-pathp α β) (to-pathp⁻ γ) (from-is-true (ap lower (apd (λ i → fst) p)))) (λ he → inc ( ((x , _ , ap lift (to-is-true (h .edge e .snd .fst he))) , refl) , ((y , _ , ap lift (to-is-true (h .edge e .snd .snd he))) , refl) , (e , _ , Σ-pathp (ap lift (to-is-true he)) (to-pathp refl)) , sym (transport-refl _))) rem : ∀ {x y} (i : I) (A : Lift ℓ Ω) → is-prop ((⌞ A ⌟ → ⌞ nodep x i ⌟) × (⌞ A ⌟ → ⌞ nodep y i ⌟)) rem {x = x} {y} i _ = ×-is-hlevel 1 (fun-is-hlevel 1 (nodep x i .lower .is-tr)) (fun-is-hlevel 1 (nodep y i .lower .is-tr))
Since the category of graphs is univalent, these constructs suffice to show it has a subobject classifier.
Graph-omega : Subobject-classifier (Graphs o ℓ) Graph-omega = to-subobject-classifier Graphs-finitely-complete Graphs-is-category λ where .mk.Ω → Ωᴳ .mk.true → trueᴳ .mk.name m → work.name m .mk.name-named m → name-named m .mk.named-name m → work.named-name m