In the following program, I'd like to define fsplit′ recursively:
{-# OPTIONS --cubical #-}
module _ where
open import Cubical.Core.Everything
open import Cubical.Foundations.Everything
open import Cubical.Data.Nat
open import Cubical.Data.Nat.Order
open import Cubical.Data.Fin
open import Cubical.Data.Sum
lemma : ∀ {x y} → x + suc y ≡ 1 → 0 ≡ y
lemma {x = x} {y = y} p = sym (snd (m+n≡0→m≡0×n≡0 {x} {y} (cong predℕ (sym (+-suc x y) ∙ p))))
fsplit′ : ∀ {k} (fj : Fin (suc k))
→ (flast ≡ fj) ⊎ (Σ[ fk ∈ Fin k ] inject< ≤-refl fk ≡ fj)
fsplit′ {k = zero} (j , fst₁ , p) = inl (Fin-fst-≡ (lemma p))
fsplit′ {k = suc k} (0 , q) = inr (0 , Fin-fst-≡ refl)
fsplit′ {k = suc k} (suc j , q) with fsplit′ {k = k} (j , pred-≤-pred q)
... | _ = ?
My aim is to pattern match on the result of the recursive call fsplit′ {k = k} (j , pred-≤-pred q). Using the with construct, however, leads to the following error message from Agda 2.6.2.2:
Expected an irrelevant argument, but found a relevant argument
when checking that the type
(k j : ℕ) (q : suc j < suc (suc k)) →
((k ,
0 ,
(λ i →
suc
(hcomp
(λ i₁ .o →
Agda.Builtin.Nat.suc-0
(primPOr i (~ i) (λ .o₁ → suc k) (λ .o₁ → suc k) o))
k)))
≡
(j ,
fst q ,
(λ i →
predℕ
(hcomp (doubleComp-faces (λ _ → suc (fst q + suc j)) (snd q) i)
(+-suc (fst q) (suc j) (~ i))))))
⊎
Σ (Σ ℕ (λ k₁ → Σ ℕ (λ k₂ → k₂ + suc k₁ ≡ k)))
(λ fk →
(fst fk ,
suc (fst (snd fk) + 0) ,
(λ i →
suc
(hcomp
(λ i₁ .o →
Agda.Builtin.Nat.suc-0
(primPOr i (~ i)
(λ .o₁ →
suc
(hcomp
(λ i₂ .o₂ →
Agda.Builtin.Nat.suc-0
(primPOr i₁ (~ i₁) (λ .o₃ → suc k)
(λ .o₃ → suc (fst (snd fk) + suc (fst fk))) o₂))
(hcomp
(λ i₂ .o₂ →
Agda.Builtin.Nat.suc-0
(primPOr i₁ (~ i₁)
(λ .o₃ →
suc
(hcomp
(λ i₃ .o₄ →
Agda.Builtin.Nat.suc-0
(primPOr i₂ (~ i₂)
(λ .o₅ →
suc
(hcomp
(doubleComp-faces (λ _ → suc (fst (snd fk) + fst fk))
(snd (snd fk)) i₃)
(+-suc (fst (snd fk)) (fst fk) (~ i₃))))
(λ .o₅ → suc (fst (snd fk) + suc (fst fk))) o₄))
(+-suc (fst (snd fk)) (fst fk) i₂)))
(λ .o₃ → suc (fst (snd fk) + suc (fst fk))) o₂))
(fst (snd fk) + suc (fst fk)))))
(λ .o₁ → suc (fst (snd fk) + 0 + suc (fst fk))) o))
(+-zero (fst (snd fk)) i + suc (fst fk)))))
≡
(j ,
fst q ,
(λ i →
predℕ
(hcomp (doubleComp-faces (λ _ → suc (fst q + suc j)) (snd q) i)
(+-suc (fst q) (suc j) (~ i)))))) →
((suc k ,
0 ,
(λ i →
suc
(suc
(hcomp
(λ i₁ .o →
Agda.Builtin.Nat.suc-0
(primPOr i (~ i) (λ .o₁ → suc k) (λ .o₁ → suc k) o))
k))))
≡ (suc j , q))
⊎
Σ (Σ ℕ (λ k₁ → Σ ℕ (λ k₂ → k₂ + suc k₁ ≡ suc k)))
(λ fk →
(fst fk ,
suc (fst (snd fk) + 0) ,
(λ i →
suc
(hcomp
(λ i₁ .o →
Agda.Builtin.Nat.suc-0
(primPOr i (~ i)
(λ .o₁ →
suc
(hcomp
(λ i₂ .o₂ →
Agda.Builtin.Nat.suc-0
(primPOr i₁ (~ i₁) (λ .o₃ → suc (suc k))
(λ .o₃ → suc (fst (snd fk) + suc (fst fk))) o₂))
(hcomp
(λ i₂ .o₂ →
Agda.Builtin.Nat.suc-0
(primPOr i₁ (~ i₁)
(λ .o₃ →
suc
(hcomp
(λ i₃ .o₄ →
Agda.Builtin.Nat.suc-0
(primPOr i₂ (~ i₂)
(λ .o₅ →
suc
(hcomp
(doubleComp-faces (λ _ → suc (fst (snd fk) + fst fk))
(snd (snd fk)) i₃)
(+-suc (fst (snd fk)) (fst fk) (~ i₃))))
(λ .o₅ → suc (fst (snd fk) + suc (fst fk))) o₄))
(+-suc (fst (snd fk)) (fst fk) i₂)))
(λ .o₃ → suc (fst (snd fk) + suc (fst fk))) o₂))
(fst (snd fk) + suc (fst fk)))))
(λ .o₁ → suc (fst (snd fk) + 0 + suc (fst fk))) o))
(+-zero (fst (snd fk)) i + suc (fst fk)))))
≡ (suc j , q))
of the generated with function is well-formed
What is going on here? How do I do a recurse-and-branch in the definition of fsplit′?
Related
The PLFA exercise: what if we write the arithmetic more "naturally" in Quantifiers chapter (https://plfa.github.io/Quantifiers/) ?
∃-even′ : ∀ {n : ℕ} → ∃[ m ] ( 2 * m ≡ n) → even n
∃-odd′ : ∀ {n : ℕ} → ∃[ m ] (2 * m + 1 ≡ n) → odd n
I have make the type right. But have got Termination checking failed for the following functions:
dbl≡2* : ∀ n → n + n ≡ 2 * n
dbl≡2* n = cong (n +_) (sym (+-identityʳ n))
+-suc1 : ∀ (m : ℕ) → m + 1 ≡ suc m
+-suc1 m =
begin
m + 1
≡⟨⟩
m + (suc zero)
≡⟨ +-suc m zero ⟩
suc (m + zero)
≡⟨ cong suc (+-identityʳ m) ⟩
suc m
∎
help1 : ∀ m → 2 * m + 1 ≡ suc (m + m)
help1 m =
begin
2 * m + 1
≡⟨ sym ( cong (_+ 1) (dbl≡2* m) ) ⟩
m + m + 1 -- must use every rule
≡⟨ +-assoc m m 1 ⟩
m + (m + 1)
≡⟨ cong (m +_) (+-suc1 m) ⟩
m + suc m
≡⟨ +-suc m m ⟩
suc (m + m)
∎
∃-even′ ⟨ zero , refl ⟩ = even-zero
∃-even′ ⟨ suc m , refl ⟩ rewrite +-identityʳ m
| +-suc m m
= even-suc (∃-odd′ ⟨ (m) , help1 m ⟩)
∃-odd′ ⟨ m , refl ⟩ rewrite +-suc (2 * m) 0
| +-identityʳ m
| +-identityʳ (m + m)
| dbl≡2* m
= odd-suc (∃-even′ ⟨ m , refl ⟩)
For the normal version, the same mutually-recursive define can work fine.
∃-even : ∀ {n : ℕ} → ∃[ m ] ( m * 2 ≡ n) → even n
∃-odd : ∀ {n : ℕ} → ∃[ m ] (1 + m * 2 ≡ n) → odd n
∃-even ⟨ zero , refl ⟩ = even-zero
∃-even ⟨ suc x , refl ⟩ = even-suc (∃-odd ⟨ x , refl ⟩)
∃-odd ⟨ x , refl ⟩ = odd-suc (∃-even ⟨ x , refl ⟩)
∃-even′ ⟨ zero , refl ⟩ = even-zero
∃-even′ ⟨ suc m , refl ⟩ rewrite +-identityʳ m
| +-suc m m
= even-suc (∃-odd′ ⟨ m , help1 m ⟩)
∃-odd′ ⟨ m , refl ⟩ rewrite +-suc (2 * m) 0
| +-identityʳ m
| +-identityʳ (m + m)
| dbl≡2* m
= odd-suc (∃-even′ ⟨ m , refl ⟩)
Your recursive calls are:
∃-even′ ⟨ suc m , refl ⟩ -> ∃-odd′ ⟨ m , help1 m ⟩
∃-odd′ ⟨ m , refl ⟩ -> ∃-even′ ⟨ m , refl ⟩
In the first one, suc m -> m decreases, but refl -> help1 m (on its surface) increases. If you passed refl as the second argument to ∃-odd′, then the termination checker would accept it, since it means the second argument stays the same, while the first one strictly monotonically decreases over a complete chain of two calls.
So how can we change that first recursive call to ∃-odd′ ⟨ m , refl ⟩? By rewriting by sym (help1 m):
∃-even′ ( suc m , refl ) rewrite +-identityʳ m
| +-suc m m
| sym (help1 m)
= even-suc (∃-odd′ (m , refl))
This code is then accepted by the termination checker.
This is in continuation of this question, based on this answer. Using the technique explained by Saizan, and factoring my fromList-toList proof a bit to avoid the problematic recursion, I managed to fill in all but one cases of fromList-toList. I think it's easiest if I just show everything I have:
{-# OPTIONS --cubical #-}
module _ where
open import Cubical.Core.Everything
open import Cubical.Foundations.Everything hiding (assoc)
data FreeMonoid {ℓ} (A : Type ℓ) : Type ℓ where
[_] : A → FreeMonoid A
ε : FreeMonoid A
_·_ : FreeMonoid A → FreeMonoid A → FreeMonoid A
εˡ : ∀ x → ε · x ≡ x
εʳ : ∀ x → x · ε ≡ x
assoc : ∀ x y z → (x · y) · z ≡ x · (y · z)
squash : isSet (FreeMonoid A)
infixr 20 _·_
open import Cubical.Data.List hiding ([_])
module ListVsFreeMonoid {ℓ} {A : Type ℓ} (AIsSet : isSet A) where
listIsSet : isSet (List A)
listIsSet = isOfHLevelList 0 AIsSet
toList : FreeMonoid A → List A
toList [ x ] = x ∷ []
toList ε = []
toList (m₁ · m₂) = toList m₁ ++ toList m₂
toList (εˡ m i) = toList m
toList (εʳ m i) = ++-unit-r (toList m) i
toList (assoc m₁ m₂ m₃ i) = ++-assoc (toList m₁) (toList m₂) (toList m₃) i
toList (squash m₁ m₂ p q i j) = listIsSet (toList m₁) (toList m₂) (cong toList p) (cong toList q) i j
fromList : List A → FreeMonoid A
fromList [] = ε
fromList (x ∷ xs) = [ x ] · fromList xs
toList-fromList : ∀ xs → toList (fromList xs) ≡ xs
toList-fromList [] = refl
toList-fromList (x ∷ xs) = cong (x ∷_) (toList-fromList xs)
fromList-homo : ∀ xs ys → fromList xs · fromList ys ≡ fromList (xs ++ ys)
fromList-homo [] ys = εˡ (fromList ys)
fromList-homo (x ∷ xs) ys = assoc [ x ] (fromList xs) (fromList ys) ∙ cong ([ x ] ·_) (fromList-homo xs ys)
fromList-toList-· : ∀ {m₁ m₂ : FreeMonoid A} → fromList (toList m₁) ≡ m₁ → fromList (toList m₂) ≡ m₂ → fromList (toList (m₁ · m₂)) ≡ m₁ · m₂
fromList-toList-· {m₁} {m₂} p q = sym (fromList-homo (toList m₁) (toList m₂)) ∙ cong₂ _·_ p q
fromList-toList : ∀ m → fromList (toList m) ≡ m
fromList-toList [ x ] = εʳ [ x ]
fromList-toList ε = refl
fromList-toList (m₁ · m₂) = fromList-toList-· (fromList-toList m₁) (fromList-toList m₂)
fromList-toList (εˡ m i) = isSet→isSet' squash
(fromList-toList-· refl (fromList-toList m))
(fromList-toList m)
(λ i → fromList (toList (εˡ m i)))
(λ i → εˡ m i)
i
fromList-toList (εʳ m i) = isSet→isSet' squash
(fromList-toList-· (fromList-toList m) refl)
(fromList-toList m)
((λ i → fromList (toList (εʳ m i))))
(λ i → εʳ m i)
i
fromList-toList (assoc m₁ m₂ m₃ i) = isSet→isSet' squash
(fromList-toList-· (fromList-toList-· (fromList-toList m₁) (fromList-toList m₂)) (fromList-toList m₃))
(fromList-toList-· (fromList-toList m₁) (fromList-toList-· (fromList-toList m₂) (fromList-toList m₃)))
(λ i → fromList (toList (assoc m₁ m₂ m₃ i)))
(λ i → assoc m₁ m₂ m₃ i)
i
fromList-toList (squash x y p q i j) = ?
Sets are groupoids so I thought I can try doing exactly the same in that last case as before, just one dimension higher. But this is where I start failing: for some reason, two of the six faces cannot be constructed using the fact that FreeMonoid is a set. In more concrete terms, in the two missing faces in the code below, if I just try to refine by putting isSet→isSet' squash in the hole (with no more arguments specified), I already get "cannot refine".
Here's my code for the four faces that I managed to fill in:
fromList-toList (squash x y p q i j) = isGroupoid→isGroupoid' (hLevelSuc 2 _ squash)
{fromList (toList x)}
{x}
{fromList (toList y)}
{y}
{fromList (toList (p i))}
{p i}
{fromList (toList (q i))}
{q i}
{λ k → fromList (toList (p k))}
{fromList-toList x}
{fromList-toList y}
{p}
{λ k → fromList (toList (squash x y p q k i))}
{fromList-toList (p i)}
{fromList-toList (q i)}
{λ k → squash x y p q k i}
{λ k → fromList (toList (p (i ∧ k)))}
{λ k → p (i ∧ k)}
{λ k → fromList (toList (q (i ∨ ~ k)))}
{λ k → q (i ∨ ~ k)}
?
f2
f3
?
f5
f6
i
j
where
f2 = isSet→isSet' squash
(fromList-toList x) (fromList-toList (p i))
(λ k → fromList (toList (p (i ∧ k)))) (λ k → p (i ∧ k))
f3 = isSet→isSet' squash
(fromList-toList y) (fromList-toList (q i))
(λ k → fromList (toList (q (i ∨ ~ k)))) (λ k → q (i ∨ ~ k))
f5 = isSet→isSet' squash (fromList-toList x) (fromList-toList y)
(λ k → fromList (toList (p k)))
(λ k → p k)
f6 = isSet→isSet' squash (fromList-toList (p i)) (fromList-toList (q i))
(λ k → fromList (toList (squash x y p q k i)))
(λ k → squash x y p q k i)
The reported types of the two missing faces are:
Square
(λ k → fromList (toList (p (i ∧ k))))
(λ k → fromList (toList (p k)))
(λ k → fromList (toList (squash x y p q k i)))
(λ k → fromList (toList (q (i ∨ ~ k))))
and
Square
(λ k → p (i ∧ k))
p
(λ k → squash x y p q k i)
(λ k → q (i ∨ ~ k))
Of course, I make no claims that the existing four faces are correct.
So I guess my question is either, what are the two missing faces, or alternatively, what are the correct 6 faces?
The six faces are not arbitrary ones between the endpoints, they are given by the type and other clauses of fromList-toList.
To find them out we can use the strategy from the other answer but one dimension higher. First we declare a cube define through conging of fromList-toList:
fromList-toList (squash x y p q i j) = { }0
where
r : Cube ? ? ? ? ? ?
r = cong (cong fromList-toList) (squash x y p q)
We can then ask agda to solve the six ?s by C-c C-s and after a little cleanup we get:
r : Cube (λ i j → fromList (toList (squash x y p q i j)))
(λ i j → fromList-toList x j)
(λ i j → fromList-toList y j)
(λ i j → squash x y p q i j)
(λ i j → fromList-toList (p i) j)
(λ i j → fromList-toList (q i) j)
r = cong (cong fromList-toList) (squash x y p q)
in this case we are able to use those faces directly as there's no problem with recursion.
fromList-toList (squash x y p q i j)
= isGroupoid→isGroupoid' (hLevelSuc 2 _ squash)
(λ i j → fromList (toList (squash x y p q i j)))
(λ i j → fromList-toList x j)
(λ i j → fromList-toList y j)
(λ i j → squash x y p q i j)
(λ i j → fromList-toList (p i) j)
(λ i j → fromList-toList (q i) j)
i j
By the way, if you are going to prove more equalities by induction it may pay off to implement a more general function first:
elimIntoProp : (P : FreeMonoid A → Set) → (∀ x → isProp (P x))
→ (∀ x → P [ x ]) → P ε → (∀ x y → P x → P y → P (x · y)) → ∀ x → P x
as paths in FreeMonoid A are a proposition.
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 ∎
I have a standard untyped lambda calculus definition and some operations and I'm trying to show a property related to the associativity of substitutions. Unfortunately, I have to show a lot of code to make things clear.
open import Data.Nat renaming (ℕ to Nat) using (zero ; suc ; _+_)
open import Data.Vec.Properties
open import Data.Vec
using (Vec ; [] ; _∷_ ; map ; lookup ; allFin ; tabulate ; tail ; head)
open import Data.Fin using (Fin ; zero ; suc)
open import Function using (_∘_ ; _$_)
open import Relation.Binary.PropositionalEquality
open ≡-Reasoning
data WellScopedTm : Nat → Set where
var : (n : Nat) → Fin n → WellScopedTm n
lam : (n : Nat) → WellScopedTm (suc n) → WellScopedTm n
app : (n : Nat) → WellScopedTm n → WellScopedTm n → WellScopedTm n
↑_ : ∀ n → Vec (Fin (suc n)) n
↑ _ = tabulate suc
rename : ∀ {n m} (t : WellScopedTm n) (is : Vec (Fin m) n) → WellScopedTm m
rename {_} {m} (var _ i) is = var m (lookup i is)
rename {n} {m} (lam _ t) is = lam m (rename t (zero ∷ map suc is))
rename {n} {m} (app _ t u) is = app m (rename t is) (rename u is)
-- q
q : (n : Nat) → WellScopedTm (suc n)
q n = var (suc n) zero
-- id
idSub : (n : Nat) → Vec (WellScopedTm n) n
idSub n = tabulate (var n)
-- weakening (derived)
lift : {n : Nat} → WellScopedTm n → WellScopedTm (suc n)
lift t = rename t (↑ _)
-- p
projSub : (n : Nat) → Vec (WellScopedTm (suc n)) n
projSub = map lift ∘ idSub -- or tabulate (lift ∘ (var n))
-- sub
sub : ∀ {n m} → WellScopedTm n → Vec (WellScopedTm m) n → WellScopedTm m
sub (var _ i) ts = lookup i ts
sub (lam _ t) ts = lam _ (sub t (var _ zero ∷ map lift ts))
sub (app _ t u) ts = app _ (sub t ts) (sub u ts)
-- composition of homs
comp : ∀ {m n k} → Vec (WellScopedTm n) k → Vec (WellScopedTm m) n → Vec (WellScopedTm m) k
comp [] _ = []
comp (t ∷ ts) us = sub t us ∷ comp ts us
Specifically, I want to show that
compAssoc : ∀ {m n k p} (ts : Vec (WellScopedTm n) k) (us : Vec (WellScopedTm m) n)
(vs : Vec (WellScopedTm p) m) → comp (comp ts us) vs ≡ comp ts (comp us vs)
compInSub : ∀ {m n k} (t : WellScopedTm n) (ts : Vec (WellScopedTm k) n)
(us : Vec (WellScopedTm m) k) → sub t (comp ts us) ≡ sub (sub t ts) us
The proofs I came up with rely on each other, the proof of associativity is this
compAssoc [] us vs = refl
compAssoc (x ∷ ts) us vs = sym $
trans (cong (λ d → d ∷ comp ts (comp us vs)) (compInSub x us vs))
(sym (cong (_∷_ (sub (sub x us) vs)) (compAssoc ts us vs)))
However, in the lambda case of the second property, I have to use associativity in the two open goals and the termination checker complains.
compInSub (var _ zero) (v ∷ ts) us = refl
compInSub (var _ (suc x)) (v ∷ ts) us = compInSub (var _ x) ts us
compInSub (app n t u) ts us =
trans (cong (λ z → app _ z (sub u (comp ts us))) (compInSub t ts us))
(cong (app _ (sub (sub t ts) us)) (compInSub u ts us))
compInSub (lam n t) ts us = sym $
begin
lam _ (sub (sub t (q _ ∷ map lift ts)) (q _ ∷ map lift us))
≡⟨ cong (lam _) (sym $ compInSub t (q _ ∷ map lift ts) (q _ ∷ map lift us)) ⟩
lam _ (sub t $ q _ ∷ comp (map lift ts) (q _ ∷ map lift us))
≡⟨ cong (λ x → lam _ (sub t $ q _ ∷ comp x _)) (mlift=xs∘p ts) ⟩
lam _ (sub t $ q _ ∷ comp (comp ts (projSub _)) (q _ ∷ map lift us))
≡⟨ cong (λ x → lam _ (sub t $ q _ ∷ comp _ (q _ ∷ x))) (mlift=xs∘p us) ⟩
lam _ (sub t $ q _ ∷ comp (comp ts (projSub _)) (q _ ∷ comp us (projSub _)))
≡⟨ cong (λ x → lam _ (sub t $ q _ ∷ x )) {!!} ⟩ -- compAssoc ts (projSub _) (q _ ∷ comp us (projSub _))
lam _ (sub t $ q _ ∷ comp ts (comp (projSub _) (q _ ∷ comp us (projSub _))))
≡⟨ cong (λ x → lam _ (sub t $ q _ ∷ comp ts x)) (p∘x∷ts (q _) (comp us (projSub _))) ⟩ --
lam _ (sub t $ q _ ∷ comp ts (comp us (projSub _)))
≡⟨ cong (λ x → lam _ (sub t $ q _ ∷ x)) (sym {!!}) ⟩ -- compAssoc ts us (projSub _)
lam _ (sub t $ q _ ∷ comp (comp ts us) (projSub _))
≡⟨ cong (λ x → lam _ (sub t $ q _ ∷ x)) (sym (mlift=xs∘p (comp ts us))) ⟩
lam _ (sub t $ q _ ∷ map lift (comp ts us))
∎
Is the termination checker right to disallow the calls on associativity I commented? If not, any remedies?
Lastly, some postulates so that the code typechecks
postulate p∘x∷ts : ∀ {n k : Nat} (t : WellScopedTm n) (ts : Vec (WellScopedTm n) k) → comp (projSub k) (t ∷ ts) ≡ ts
postulate mlift=xs∘p : ∀ {n m : Nat} (xs : Vec (WellScopedTm n) m) → map lift xs ≡ comp xs (projSub n)
I have the following definition
open import Relation.Binary.PropositionalEquality
data _≅_ (A B : Set) : Set where
mkBij : (f : A → B) (g : B → A)
→ (∀ a → a ≡ g (f a))
→ (∀ b → b ≡ f (g b))
→ A ≅ B
And I'm trying to show transitivity. I have what I need, but I don't know how to combine them to get the proof object I want. This is the proof so far.
transtv : ∀ {A B C} → A ≅ B → B ≅ C → A ≅ C
transtv (mkBij f₁ g₁ x y) (mkBij f₂ g₂ w z) =
mkBij (λ x₁ → f₂ (f₁ x₁)) (λ z₁ → g₁ (g₂ z₁))
(λ a → let xa = x a
wb = w (f₁ a)
in {!!})
(λ c → let zc = z c
yb = y (g₂ c)
in {!!})
In the first hole, I have these: (the second hole is identical)
Goal: a ≡ g₁ (g₂ (f₂ (f₁ a)))
wb : f₁ a ≡ g₂ (f₂ (f₁ a))
xa : a ≡ g₁ (f₁ a)
Now, it's obvious that if I replace f₁ a with g₂ (f₂ (f₁ a)) in xa I get to the goal. But I don't know how to do this substitution in agda. What kind of function or language construct do I need to do this?
You can write it very compactly as
trans xa (cong g₁ wb)
Or, using Function._⟨_⟩_:
xa ⟨ trans ⟩ (cong g₁ wb)
I solved it with equational reasoning in the following way:
transtv : ∀ {A B C} → A ≅ B → B ≅ C → A ≅ C
transtv (mkBij f₁ g₁ x y) (mkBij f₂ g₂ w z) =
mkBij (λ x₁ → f₂ (f₁ x₁)) (λ z₁ → g₁ (g₂ z₁))
(λ a → let xa = x a
wb = w (f₁ a)
in begin
a
≡⟨ xa ⟩
g₁ (f₁ a)
≡⟨ cong g₁ wb ⟩
g₁ (g₂ (f₂ (f₁ a)))
∎)
(λ c → let zc = z c
yb = y (g₂ c)
in begin
c
≡⟨ zc ⟩
f₂ (g₂ c)
≡⟨ cong f₂ yb ⟩
f₂ (f₁ (g₁ (g₂ c)))
∎)