Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix levels in Free so this isn't necessary #72

Open
github-actions bot opened this issue Nov 6, 2023 · 0 comments
Open

Fix levels in Free so this isn't necessary #72

github-actions bot opened this issue Nov 6, 2023 · 0 comments
Labels

Comments

@github-actions
Copy link

github-actions bot commented Nov 6, 2023

https://api.github.com/pufferffish/agda-symmetries/blob/28ef99ce9f4589b5eaa75867c088e45a4f142397/Experiments/Norm.agda#L5


{-# OPTIONS --cubical #-}

open import Agda.Primitive

-- TODO: Fix levels in Free so this isn't necessary
module Experiments.Norm {ℓ : Level} {A : Set ℓ} where

open import Cubical.Foundations.Everything
open import Cubical.Functions.Embedding
open import Cubical.Data.Sigma
open import Cubical.Data.Fin
open import Cubical.Data.Nat
open import Cubical.Data.Nat.Order
open import Cubical.Data.Sum as ⊎
open import Cubical.Induction.WellFounded
import Cubical.Data.Empty as ⊥
open import Cubical.HITs.SetQuotients as Q

import Cubical.Structures.Set.CMon.Desc as M
import Cubical.Structures.Free as F

open import Cubical.Structures.Set.CMon.Free as F
open import Cubical.Structures.Set.CMon.QFreeMon
open import Cubical.Structures.Set.CMon.Bag
open import Cubical.Structures.Set.CMon.SList as S

module CMonDef = F.Definition M.CMonSig M.CMonEqSig M.CMonSEq

module FCM = CMonDef.Free

ηᵇ : A -> Bag A
ηᵇ = FCM.η bagFreeDef

ηˢ : A -> SList A
ηˢ = FCM.η {ℓ' = ℓ} slistDef

ηˢ♯ : structHom < Bag A , FCM.α bagFreeDef > < SList A , FCM.α {ℓ' = ℓ} slistDef >
ηˢ♯ = FCM.ext bagFreeDef S.isSetSList (FCM.sat {ℓ' = ℓ} S.slistDef) ηˢ

ηᵇ♯ : structHom < SList A , FCM.α {ℓ' = ℓ} slistDef > < Bag A , FCM.α bagFreeDef >
ηᵇ♯ = FCM.ext slistDef Q.squash/ (FCM.sat bagFreeDef) (FCM.η bagFreeDef)

ηᵇ♯∘ηˢ♯ : structHom < Bag A , FCM.α bagFreeDef > < Bag A , FCM.α bagFreeDef >
ηᵇ♯∘ηˢ♯ = structHom∘ < Bag _ , FCM.α bagFreeDef > < SList _ , FCM.α {ℓ' = ℓ} slistDef > < Bag _ , FCM.α bagFreeDef > ηᵇ♯ ηˢ♯

ηᵇ♯∘ηˢ♯-β : ηᵇ♯∘ηˢ♯ .fst ∘ ηᵇ ≡ ηᵇ
ηᵇ♯∘ηˢ♯-β =
    ηᵇ♯ .fst ∘ ηˢ♯ .fst ∘ ηᵇ
  ≡⟨ cong (ηᵇ♯ .fst ∘_) (FCM.ext-η bagFreeDef S.isSetSList (FCM.sat {ℓ' = ℓ} slistDef) ηˢ) ⟩
    ηᵇ♯ .fst ∘ ηˢ
  ≡⟨ FCM.ext-η slistDef Q.squash/ (FCM.sat bagFreeDef) ηᵇ ⟩
    ηᵇ
  ∎

ηᵇ♯∘ηˢ♯-η : ηᵇ♯∘ηˢ♯ ≡ idHom < Bag A , FCM.α bagFreeDef >
ηᵇ♯∘ηˢ♯-η = FCM.hom≡ bagFreeDef Q.squash/ (FCM.sat bagFreeDef) ηᵇ♯∘ηˢ♯ (idHom _) ηᵇ♯∘ηˢ♯-β

𝔫𝔣 : Bag A -> SList A
𝔫𝔣 = ηˢ♯ .fst

𝔫𝔣-inj : {as bs : Bag A} -> 𝔫𝔣 as ≡ 𝔫𝔣 bs -> as ≡ bs
𝔫𝔣-inj {as} {bs} p = sym (funExt⁻ (cong fst ηᵇ♯∘ηˢ♯-η) as) ∙ cong (ηᵇ♯ .fst) p ∙ funExt⁻ (cong fst ηᵇ♯∘ηˢ♯-η) bs

norm : isEmbedding 𝔫𝔣
norm = injEmbedding isSetSList 𝔫𝔣-inj

-- also equivalence

@github-actions github-actions bot added the todo label Nov 6, 2023
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
Projects
None yet
Development

No branches or pull requests

0 participants