Is the univalence axiom invertible (modulo paths)? Is it possible to prove, using Agda's Cubical library, to prove the following:
open import Cubical.Core.Glue
uaInj : ∀ {ℓ} {A B : Set ℓ} {f g : A ≃ B} →
ua f ≡ ua g → equivFun f ≡ equivFun g
I suspect the above should hold, because in example 3.19 of the HoTT book, there is a step in the proof where an equivalence between two equivalences is used to prove the equivalence between their functions:
[...] so f is an
equivalence. Hence, by univalence, f gives rise to a path p : A ≡ A.
If p were equal to refl A, then (again by univalence) f would equal the
identity function of A.
Sure, ua is an equivalence, so it's injective. In the HoTT book, the inverse of ua is idtoeqv, so by congruence idtoeqv (ua f) ≡ idtoeqv (ua g) and then by inverses f ≡ g. I'm not familiar with the contents of cubical Agda prelude but this should be provable since it follows directly from the statement of univalence.
To put András's answer into code, we can prove injectivity of equivalency functions in general:
equivInj : ∀ {ℓ₁ ℓ₂} {A : Set ℓ₁} {B : Set ℓ₂} (f : A ≃ B) →
∀ x x′ → equivFun f x ≡ equivFun f x′ → x ≡ x′
equivInj f x x′ p = cong fst $ begin
x , refl ≡⟨ sym (equivCtrPath f (equivFun f x) (x , refl)) ⟩
equivCtr f (equivFun f x) ≡⟨ equivCtrPath f (equivFun f x) (x′ , p) ⟩
x′ , p ∎
and then given
univalence : ∀ {ℓ} {A B : Set ℓ} → (A ≡ B) ≃ (A ≃ B)
we get
uaInj : ∀ {ℓ} {A B : Set ℓ} {f g : A ≃ B} → ua f ≡ ua g → equivFun f ≡ equivFun g
uaInj {f = f} {g = g} = cong equivFun ∘ equivInj (invEquiv univalence) f g
The only problem is, univalence is not readily available in the Cubical library. Hopefully that is getting sorted out shortly.
UPDATE: In reaction to the above bug ticket, proof of univalence is now available in the Cubical library.
Related
foldl : ∀ {a b} {A : Set a} (B : ℕ → Set b) {m} →
(∀ {n} → B n → A → B (suc n)) →
B zero →
Vec A m → B m
foldl b _⊕_ n [] = n
foldl b _⊕_ n (x ∷ xs) = foldl (λ n → b (suc n)) _⊕_ (n ⊕ x) xs
When translating the above function to Lean, I was shocked to find out that its true form is actually like...
def foldl : ∀ (P : ℕ → Type a) {n : nat}
(f : ∀ {n}, P n → α → P (n+1)) (s : P 0)
(l : Vec α n), P n
| P 0 f s (nil _) := s
| P (n+1) f s (cons x xs) := foldl (fun n, P (n+1)) (λ n, #f (n+1)) (#f 0 s x) xs
I find it really impressive that Agda is able to infer the implicit argument to f correctly. How is it doing that?
foldl : ∀ {a b} {A : Set a} (B : ℕ → Set b) {m} →
(∀ {n} → B n → A → B (suc n)) →
B zero →
Vec A m → B m
foldl b _⊕_ n [] = n
foldl b _⊕_ n (x ∷ xs) = foldl (λ n → b (suc n)) _⊕_ (_⊕_ {0} n x) xs
If I pass it 0 explicitly as in the Lean version, I get a hint as to the answer. What is going on is that Agda is doing the same thing as in the Lean version, namely wrapping the implicit arg so it is suc'd.
This is surprising as I thought that implicit arguments just means that Agda should provide them on its own. I did not think it would change the function when it is passed as an argument.
I was trying to prove that true ≡ false -> Empty assuming the J axiom. It is defined as:
J : Type
J = forall
{A : Set}
{C : (x y : A) → (x ≡ y) → Set} →
(c : ∀ x → C x x refl) →
(x y : A) →
(p : x ≡ y) →
C x y p
My attempt went like this:
bad : J → true ≡ false -> Empty
bad j e = j Bool (λ { true _ _ => Unit; false _ _ => Empty }) _
Now, to proceed with the proof, I needed a term c : ∀ x -> C x x refl. Since I instantiated C, it becomes c : ∀ x -> (λ { true _ _ => Unit; false _ _ => Empty } x x refl. Then I got stuck. c can't reduce further because we don't know the value of x. I wasn't able to complete this proof. But there is a different version of J:
J' : Type
J' = forall
{A : Set}
{x : A}
{C : (y : A) → (x ≡ y) → Set} →
(c : C x refl) →
(y : A) →
(p : x ≡ y) →
C y p
With this one, this problem is solved, because t can be fixed to be true. This makes the c argument reduce to Unit, which we can provide. My question is: can we convert the former version to the later? That is, can we build a term fix_x : J → J'? Does that hold in general (i.e., can indices be converted to parameters)?
First, regarding true ≡ false -> Empty: this is unprovable if you can only eliminate into Set0 with J, so you need an universe polymorphic or large definition. I write some preliminaries here:
{-# OPTIONS --without-K #-}
open import Relation.Binary.PropositionalEquality
open import Level
data Bool : Set where true false : Bool
data Empty : Set where
record Unit : Set where
constructor tt
JTy : ∀ {i j} → Set _
JTy {i}{j} =
{A : Set i}
(P : (x y : A) → (x ≡ y) → Set j) →
(pr : ∀ x → P x x refl) →
{x y : A} →
(p : x ≡ y) →
P x y p
J : ∀ {i}{j} → JTy {i}{j}
J P pr {x} refl = pr x
J₀ = J {zero}{zero}
Now, transport or subst is the only needed thing for true ≡ false -> Empty:
transp : ∀ {i j}{A : Set i}(P : A → Set j){x y} → x ≡ y → P x → P y
transp P = J (λ x y _ → P x -> P y) (λ _ px → px)
true≢false : true ≡ false → Empty
true≢false e = transp (λ {true → Unit; false → Empty}) e tt
Considering now proving the pointed J' from J, I know about three solutions, and each uses different features from the ambient theory.
The simplest one is to use universes to abstract over the induction motive:
JTy' : ∀ {i j} → Set _
JTy' {i}{j} =
{A : Set i}
{x : A}
(P : ∀ y → x ≡ y → Set j)
(pr : P x refl)
{y : A}
(p : x ≡ y)
→ P y p
JTy→JTy' : (∀ {i j} → JTy {i}{j}) → ∀ {i}{j} → JTy' {i}{j}
JTy→JTy' J {i} {j} {A} {x} P pr {y} e =
J (λ x y e → (P : ∀ y → x ≡ y → Set j) → P x refl → P y e)
(λ x P pr → pr) e P pr
If we only want to use a fixed universe level, then it is a bit more complicated. The following solution, sometimes called "contractible singletons", needs Σ-types, but nothing else:
open import Data.Product
JTy→JTy'withΣ : JTy {zero}{zero} → JTy' {zero}{zero}
JTy→JTy'withΣ J {A} {x} P pr {y} e =
J (λ {(x , r) (y , e) _ → P x r → P y e})
(λ _ px → px)
(J (λ x y e → (x , refl) ≡ (y , e))
(λ _ → refl)
e)
pr
There is a solution which doesn't even need Σ-s, but requires the beta rule for J, which says that J P pr {x} refl = pr x. It doesn't matter whether this rule holds definitionally or just as a propositional equality, but the construction is simpler when it holds definitionally, so let's do that. Note that I don't use any universe other than Set0.
transp₀ = transp {zero}{zero}
transp2 : ∀ {A : Set}{B : A → Set}(C : ∀ a → B a → Set)
{x y : A}(e : x ≡ y){b} → C x b → C y (transp₀ B e b)
transp2 {A}{B} C {x}{y} e {b} cxb =
J₀ (λ x y e → ∀ b → C x b → C y (transp₀ B e b)) (λ _ _ cxb → cxb) e b cxb
JTy→JTy'noΣU : JTy' {zero}{zero}
JTy→JTy'noΣU {A} {x} P pr {y} e =
transp₀ (P y) (J₀ (λ x y e → transp₀ (x ≡_) e refl ≡ e) (λ _ → refl) e)
(transp2 {A} {λ y → x ≡ y} P e pr)
Philosophically, the third version is the most "conservative", since it only assumes J. The addition of the beta rule is not really an extra thing, since it is always assumed to hold (definitionally or propositionally) for _≡_.
can indices be converted to parameters?
If you have propositional equality, then all indices can be converted to parameters, and fixed in constructors using equality proofs.
Suppose I have, using the cubical-demo library, the following things in scope:
i : I
p0 : x ≡ y
p1 : x' ≡ y'
q0 : x ≡ x'
q1 : y ≡ y'
How do I then construct
q' : p0 i ≡ p1 i
?
One way is by contracting singleton pairs with J, there might be simpler proofs though.
open import Cubical.PathPrelude
q' : ∀ {A : Set} (i : I) (x : A)
x' (q0 : x ≡ x')
y (p0 : x ≡ y)
y' (p1 : x' ≡ y')
(q1 : y ≡ y') → p0 i ≡ p1 i
q' i x = pathJ _ (pathJ _ (pathJ _ (\ q1 → q1)))
Another one I've come up with is I think closer to the spirit of the original problem instead of going around:
slidingLid : ∀ (p₀ : a ≡ b) (p₁ : c ≡ d) (q : a ≡ c) → ∀ i → p₀ i ≡ p₁ i
slidingLid p₀ p₁ q i j = comp (λ _ → A)
(λ{ k (i = i0) → q j
; k (j = i0) → p₀ (i ∧ k)
; k (j = i1) → p₁ (i ∧ k)
})
(inc (q j))
This one has the very nice property that it degenerates to q at i = i0 definitionally:
slidingLid₀ : ∀ p₀ p₁ q → slidingLid p₀ p₁ q i0 ≡ q
slidingLid₀ p₀ p₁ q = refl
I've found another solution to this, which is more explicit that it is gluing together a prefix of p0 (flipped), q0, and a prefix of p1:
open import Cubical.PathPrelude
module _ {ℓ} {A : Set ℓ} where
midPath : ∀ {a b c d : A} (p₀ : a ≡ b) (p₁ : c ≡ d) → (a ≡ c) → ∀ i → p₀ i ≡ p₁ i
midPath {a = a} {c = c} p₀ p₁ q i = begin
p₀ i ≡⟨ transp (λ j → p₀ (i ∧ j) ≡ a) refl ⟩
a ≡⟨ q ⟩
c ≡⟨ transp (λ j → c ≡ p₁ (i ∧ j)) refl ⟩
p₁ i ∎
The Agda standard library contains some modules Relation.Binary.*.(Non)StrictLex (currently only for Product and List). We can use these modules to easily construct an instance of, for example, IsStrictTotalOrder for pairs of natural numbers (i.e. ℕ × ℕ).
open import Data.Nat as ℕ using (ℕ; _<_)
open import Data.Nat.Properties as ℕ
open import Relation.Binary using (module StrictTotalOrder; IsStrictTotalOrder)
open import Relation.Binary.PropositionalEquality using (_≡_)
open import Relation.Binary.Product.StrictLex using (×-Lex; _×-isStrictTotalOrder_)
open import Relation.Binary.Product.Pointwise using (_×-Rel_)
ℕ-isSTO : IsStrictTotalOrder _≡_ _<_
ℕ-isSTO = StrictTotalOrder.isStrictTotalOrder ℕ.strictTotalOrder
ℕ×ℕ-isSTO : IsStrictTotalOrder (_≡_ ×-Rel _≡_) (×-Lex _≡_ _<_ _<_)
ℕ×ℕ-isSTO = ℕ-isSTO ×-isStrictTotalOrder ℕ-isSTO
This creates an instance using the pointwise equality _≡_ ×-Rel _≡_. In the case of propositional equality, this should be equivalent to using just propositional equality.
Is there an easy way of converting the instance above to an instance of type IsStrictTotalOrder _≡_ (×-Lex _≡_ _<_ _<_), using normal propositional equality?
The kit required isn't too hard to assemble:
open import Data.Product
open import Function using (_∘_; case_of_)
open import Relation.Binary
_⇔₂_ : ∀ {a ℓ₁ ℓ₂} {A : Set a} → Rel A ℓ₁ → Rel A ℓ₂ → Set _
_≈_ ⇔₂ _≈′_ = (∀ {x y} → x ≈ y → x ≈′ y) × (∀ {x y} → x ≈′ y → x ≈ y)
-- I was unable to write this nicely using Data.Product.map...
-- hence it is moved here to a toplevel where it can pattern-match
-- on the product of proofs
transform-resp : ∀ {a ℓ₁ ℓ₂ ℓ} {A : Set a} {≈ : Rel A ℓ₁} {≈′ : Rel A ℓ₂} {< : Rel A ℓ} →
≈ ⇔₂ ≈′ →
< Respects₂ ≈ → < Respects₂ ≈′
transform-resp (to , from) = λ { (resp₁ , resp₂) → (resp₁ ∘ from , resp₂ ∘ from) }
transform-isSTO : ∀ {a ℓ₁ ℓ₂ ℓ} {A : Set a} {≈ : Rel A ℓ₁} {≈′ : Rel A ℓ₂} {< : Rel A ℓ} →
≈ ⇔₂ ≈′ →
IsStrictTotalOrder ≈ < → IsStrictTotalOrder ≈′ <
transform-isSTO {≈′ = ≈′} {< = <} (to , from) isSTO = record
{ isEquivalence = let open IsEquivalence (IsStrictTotalOrder.isEquivalence isSTO)
in record { refl = to refl
; sym = to ∘ sym ∘ from
; trans = λ x y → to (trans (from x) (from y))
}
; trans = IsStrictTotalOrder.trans isSTO
; compare = compare
; <-resp-≈ = transform-resp (to , from) (IsStrictTotalOrder.<-resp-≈ isSTO)
}
where
compare : Trichotomous ≈′ <
compare x y with IsStrictTotalOrder.compare isSTO x y
compare x y | tri< a ¬b ¬c = tri< a (¬b ∘ from) ¬c
compare x y | tri≈ ¬a b ¬c = tri≈ ¬a (to b) ¬c
compare x y | tri> ¬a ¬b c = tri> ¬a (¬b ∘ from) c
Then we can use this to solve your original problem:
ℕ×ℕ-isSTO′ : IsStrictTotalOrder _≡_ (×-Lex _≡_ _<_ _<_)
ℕ×ℕ-isSTO′ = transform-isSTO (to , from) ℕ×ℕ-isSTO
where
open import Function using (_⟨_⟩_)
open import Relation.Binary.PropositionalEquality
to : ∀ {a b} {A : Set a} {B : Set b}
{x x′ : A} {y y′ : B} → (x , y) ⟨ _≡_ ×-Rel _≡_ ⟩ (x′ , y′) → (x , y) ≡ (x′ , y′)
to (refl , refl) = refl
from : ∀ {a b} {A : Set a} {B : Set b}
{x x′ : A} {y y′ : B} → (x , y) ≡ (x′ , y′) → (x , y) ⟨ _≡_ ×-Rel _≡_ ⟩ (x′ , y′)
from refl = refl , refl
I am new to Agda, and I think I still have a problem to think in that paradigm. Here is my question..
I have a type monoid and a type Group implemented as follows:
record Monoid : Set₁ where
constructor monoid
field Carrier : Set
_⊙_ : Carrier → Carrier → Carrier
e : Carrier
leftId : ∀ {x : Carrier} → (e ⊙ x) ≡ x
rightId : ∀ {x : Carrier} → (x ⊙ e) ≡ x
assoc : ∀ {x y z : Carrier} → (x ⊙ (y ⊙ z)) ≡ ((x ⊙ y) ⊙ z)
record Group : Set₁ where
constructor group
field m : Monoid
inv : Carrier → Carrier
inverse1 : {x y : Carrier} → x ⊙ (inv x) ≡ e
inverse2 : {x y : Carrier} → (inv x) ⊙ x ≡ e
Now, I want to proof the following lemma :
lemma1 : (x y : Carrier) → (inv x) ⊙ (x ⊙ y) ≡ y
lemma1 x y = ?
If I do it on paper, I will apply associativity then left identity.. but I do not know how to tell agda to apply these rules.. I have the problem of translating my thoughts to the Agda paradigm..
Any help is highly appreciated..
When you do the proof on the paper, applying associativity and then left identity uses ony key property of the identity relation - transitivity. That is, when you have a proof of p : x ≡ y and q : y ≡ z you can combine them into a single proof of trans p q : x ≡ z. The trans function is already part of the standard library (Relation.Binary.PropositionalEquality module), but its implementation is fairly simple anyways:
trans : {A : Set} {i j k : A} → i ≡ j → j ≡ k → i ≡ k
trans refl eq = eq
I'm using a bit different presentation of monoids and groups, but you can easily adapt the proof to your scenario.
open import Function
open import Relation.Binary.PropositionalEquality
Op₁ : Set → Set
Op₁ A = A → A
Op₂ : Set → Set
Op₂ A = A → A → A
record IsMonoid {A : Set}
(_∙_ : Op₂ A) (ε : A) : Set where
field
right-id : ∀ x → x ∙ ε ≡ x
left-id : ∀ x → ε ∙ x ≡ x
assoc : ∀ x y z → x ∙ (y ∙ z) ≡ (x ∙ y) ∙ z
record IsGroup {A : Set}
(_∙_ : Op₂ A) (ε : A) (_⁻¹ : Op₁ A) : Set where
field
monoid : IsMonoid _∙_ ε
right-inv : ∀ x → x ∙ x ⁻¹ ≡ ε
left-inv : ∀ x → x ⁻¹ ∙ x ≡ ε
open IsMonoid monoid public
(To keep things simple, indented code is written as part of the IsGroup record). We'd like to prove that:
lemma : ∀ x y → x ⁻¹ ∙ (x ∙ y) ≡ y
lemma x y = ?
The first step is to use associativity, that is assoc (x ⁻¹) x y, this leaves us with a goal (x ⁻¹ ∙ x) ∙ y ≡ y - once we prove that, we can merge these two parts together using trans:
lemma x y =
trans (assoc (x ⁻¹) x y) ?
Now, we need to apply the right inverse property, but the types don't seem to fit. We have left-inv x : x ⁻¹ ∙ x ≡ ε and we need to somehow deal with the extra y. This is when another property of the identity comes into play.
Ordinary functions preserve identity; if we have a function f and a proof p : x ≡ y we can apply f to both x and y and the proof should be still valid, that is cong f p : f x ≡ f y. Again, implementation is already in the standard library, but here it is anyways:
cong : {A : Set} {B : Set}
(f : A → B) {x y} → x ≡ y → f x ≡ f y
cong f refl = refl
What function should we apply? Good candidate seems to be λ z → z ∙ y, which adds the missing y part. So, we have:
cong (λ z → z ∙ y) (left-inv x) : (x ⁻¹ ∙ x) ∙ y ≡ ε ∙ y
Again, we just need to prove that ε ∙ y ≡ y and we can then piece those together using trans. But this last property is easy, it's just left-id y. Putting it all together, we get:
lemma : ∀ x y → x ⁻¹ ∙ (x ∙ y) ≡ y
lemma x y =
trans (assoc (x ⁻¹) x y) $
trans (cong (λ z → z ∙ y) (left-inv x)) $
(left-id y)
Standard library also gives us some nice syntactic sugar for this:
open ≡-Reasoning
lemma′ : ∀ x y → x ⁻¹ ∙ (x ∙ y) ≡ y
lemma′ x y = begin
x ⁻¹ ∙ (x ∙ y) ≡⟨ assoc (x ⁻¹) x y ⟩
(x ⁻¹ ∙ x) ∙ y ≡⟨ cong (λ z → z ∙ y) (left-inv x) ⟩
ε ∙ y ≡⟨ left-id y ⟩
y ∎
Behind the scenes, ≡⟨ ⟩ uses precisely trans to merge those proofs. The types are optional (the proofs themselves carry enough information about them), but they are here for readability.
To get your original Group record, we can do something like:
record Group : Set₁ where
field
Carrier : Set
_∙_ : Op₂ Carrier
ε : Carrier
_⁻¹ : Op₁ Carrier
isGroup : IsGroup _∙_ ε _⁻¹
open IsGroup isGroup public