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)
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.
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.
Add is often defined as:
add : ℕ -> ℕ -> ℕ
add zero m = m
add (suc n) m = suc (add n m)
This definition is short, but makes the proof of things like add-comm rather complex, requiring two inductive functions and calls to subst, cong and sym. If we, instead, define add as:
add : ℕ -> ℕ -> ℕ
add zero zero = zero
add (suc n) zero = suc n
add zero (suc m) = suc m
add (suc n) (suc m) = suc (suc (add n m))
Then the proof of commutativity becomes almost trivial:
add-comm : forall a b -> add a b ≡ add b a
add-comm zero zero = refl
add-comm zero (suc b) = refl
add-comm (suc a) zero = refl
add-comm (suc a) (suc b) = cong suc (cong suc (add-comm a b))
Is there any negative side to defining functions like add by listing all cases, rather than being economic?
You win some definitional equalities, but you lose others. In this case, you lose that add (suc a) b is suc (add a b) for any b. In short, if you have more cases here, you need more cases and/or proofs elsewhere, for example for Vec appending:
open import Data.Vec
add-zero : ∀ n → add zero n ≡ n
add-zero zero = refl
add-zero (suc n) = refl
suc-add : ∀ n m → suc (add n m) ≡ add (suc n) m
suc-add zero zero = refl
suc-add zero (suc m) = cong suc (cong suc (sym (add-zero m)))
suc-add (suc n) zero = refl
suc-add (suc n) (suc m) rewrite suc-add n m = refl
append : ∀ {n m}{A : Set} → Vec A n → Vec A m → Vec A (add n m)
append [] ys = subst (Vec _) (sym (add-zero _)) ys
append (x ∷ xs) ys = subst (Vec _) (suc-add _ _) (x ∷ append xs ys)
(the original add-comm doesn't require two definitions):
add : ℕ -> ℕ -> ℕ
add zero m = m
add (suc n) m = suc (add n m)
add-comm : ∀ n m → add n m ≡ add m n
add-comm zero zero = refl
add-comm zero (suc m) = cong suc (add-comm zero m)
add-comm (suc n) zero = cong suc (add-comm n zero)
add-comm (suc n) (suc m)
rewrite add-comm n (suc m)
| sym (add-comm (suc n) m)
| add-comm n m = refl
The Agda standard library has a few properties on how reverse and _++_ work on List. Trying to transfer these proofs to Vec appears to be non-trivial (disregarding universes):
open import Data.Nat
open import Data.Vec
open import Relation.Binary.HeterogeneousEquality
unfold-reverse : {A : Set} → (x : A) → {n : ℕ} → (xs : Vec A n) →
reverse (x ∷ xs) ≅ reverse xs ++ [ x ]
TL;DR: How to prove unfold-reverse?
The rest of this question outlines approaches to doing so and explains what problems surface.
The type of this property is very similar to the List counter part in Data.List.Properties. The proof involves a helper which roughly translates to:
open import Function
helper : ∀ {n m} → (xs : Vec A n) → (ys : Vec A m) →
foldl (Vec A ∘ (flip _+_ n)) (flip _∷_) xs ys ≅ reverse ys ++ xs
Trying to insert this helper in unfold-reverse fails, because the left hand reverse is a foldl application with Vec A ∘ suc as first argument whereas the left hand side of helper has a foldl application with Vec A ∘ (flip _+_ 1) as first argument. Even though suc ≗ flip _+_ 1 is readily available from Data.Nat.Properties.Simple, it cannot be used here as cong would need a non-pointwise equality here and we don't have extensionality without further assumptions.
Removing the flip from flip _+_ n in helper yields a type error, so that is no option either.
Any other ideas?
The Data.Vec.Properties module contains this function:
foldl-cong : ∀ {a b} {A : Set a}
{B₁ : ℕ → Set b}
{f₁ : ∀ {n} → B₁ n → A → B₁ (suc n)} {e₁}
{B₂ : ℕ → Set b}
{f₂ : ∀ {n} → B₂ n → A → B₂ (suc n)} {e₂} →
(∀ {n x} {y₁ : B₁ n} {y₂ : B₂ n} →
y₁ ≅ y₂ → f₁ y₁ x ≅ f₂ y₂ x) →
e₁ ≅ e₂ →
∀ {n} (xs : Vec A n) →
foldl B₁ f₁ e₁ xs ≅ foldl B₂ f₂ e₂ xs
foldl-cong _ e₁=e₂ [] = e₁=e₂
foldl-cong {B₁ = B₁} f₁=f₂ e₁=e₂ (x ∷ xs) =
foldl-cong {B₁ = B₁ ∘ suc} f₁=f₂ (f₁=f₂ e₁=e₂) xs
Here is more or less elaborated solution:
unfold-reverse : {A : Set} → (x : A) → {n : ℕ} → (xs : Vec A n) →
reverse (x ∷ xs) ≅ reverse xs ++ (x ∷ [])
unfold-reverse x xs = begin
foldl (Vec _ ∘ _+_ 1) (flip _∷_) (x ∷ []) xs
≅⟨ (foldl-cong
{B₁ = Vec _ ∘ _+_ 1}
{f₁ = flip _∷_}
{e₁ = x ∷ []}
{B₂ = Vec _ ∘ flip _+_ 1}
{f₂ = flip _∷_}
{e₂ = x ∷ []}
(λ {n} {a} {as₁} {as₂} as₁≅as₂ -> {!!})
refl
xs) ⟩
foldl (Vec _ ∘ flip _+_ 1) (flip _∷_) (x ∷ []) xs
≅⟨ helper (x ∷ []) xs ⟩
reverse xs ++ x ∷ []
∎
Note, that only B₁ and B₂ are distinct in the arguments of the foldl-cong function. After simplifying context in the hole we have
Goal: a ∷ as₁ ≅ a ∷ as₂
————————————————————————————————————————————————————————————
as₁≅as₂ : as₁ ≅ as₂
as₂ : Vec A (n + 1)
as₁ : Vec A (1 + n)
a : A
n : ℕ
A : Set
So we need to prove, that at each recursive call adding an element to an accumulator of type Vec A (n + 1) is equal to adding an element to an accumulator of type Vec A (1 + n), and then results of two foldls are equal. The proof itself is simple. Here is the whole code:
open import Function
open import Relation.Binary.HeterogeneousEquality
open import Data.Nat
open import Data.Vec
open import Data.Nat.Properties.Simple
open import Data.Vec.Properties
open ≅-Reasoning
postulate
helper : ∀ {n m} {A : Set} (xs : Vec A n) (ys : Vec A m)
-> foldl (Vec A ∘ flip _+_ n) (flip _∷_) xs ys ≅ reverse ys ++ xs
cong' : ∀ {α β γ} {I : Set α} {i j : I}
-> (A : I -> Set β) {B : {k : I} -> A k -> Set γ} {x : A i} {y : A j}
-> i ≅ j
-> (f : {k : I} -> (x : A k) -> B x)
-> x ≅ y
-> f x ≅ f y
cong' _ refl _ refl = refl
unfold-reverse : {A : Set} → (x : A) → {n : ℕ} → (xs : Vec A n) →
reverse (x ∷ xs) ≅ reverse xs ++ (x ∷ [])
unfold-reverse x xs = begin
foldl (Vec _ ∘ _+_ 1) (flip _∷_) (x ∷ []) xs
≅⟨ (foldl-cong
{B₁ = Vec _ ∘ _+_ 1}
{f₁ = flip _∷_}
{e₁ = x ∷ []}
{B₂ = Vec _ ∘ flip _+_ 1}
{f₂ = flip _∷_}
{e₂ = x ∷ []}
(λ {n} {a} {as₁} {as₂} as₁≅as₂ -> begin
a ∷ as₁
≅⟨ cong' (Vec _) (sym (≡-to-≅ (+-comm n 1))) (_∷_ a) as₁≅as₂ ⟩
a ∷ as₂
∎)
refl
xs) ⟩
foldl (Vec _ ∘ flip _+_ 1) (flip _∷_) (x ∷ []) xs
≅⟨ helper (x ∷ []) xs ⟩
reverse xs ++ x ∷ []
∎
I wrote an Agda-function applyPrefix to apply a fixed-size-vector-function to the initial part of a longer vector where the vector-sizes m, n and k may stay implicit. Here's the definition together with a helper-function split:
split : ∀ {A m n} → Vec A (n + m) → (Vec A n) × (Vec A m)
split {_} {_} {zero} xs = ( [] , xs )
split {_} {_} {suc _} (x ∷ xs) with split xs
... | ( ys , zs ) = ( (x ∷ ys) , zs )
applyPrefix : ∀ {A n m k} → (Vec A n → Vec A m) → Vec A (n + k) → Vec A (m + k)
applyPrefix f xs with split xs
... | ( ys , zs ) = f ys ++ zs
I need a symmetric function applyPostfix which applies a fixed-size-vector-function to the tail-part of a longer vector.
applyPostfix ∀ {A n m k} → (Vec A n → Vec A m) → Vec A (k + n) → Vec A (k + m)
applyPostfix {k = k} f xs with split {_} {_} {k} xs
... | ( ys , zs ) = ys ++ (f zs)
As the definition of applyPrefix already shows, the k-Argument cannot stay implicit when applyPostfix is used. For example:
change2 : {A : Set} → Vec A 2 → Vec A 2
change2 ( x ∷ y ∷ [] ) = (y ∷ x ∷ [] )
changeNpre : {A : Set}{n : ℕ} → Vec A (2 + n) → Vec A (2 + n)
changeNpre = applyPrefix change2
changeNpost : {A : Set}{n : ℕ} → Vec A (n + 2) → Vec A (n + 2)
changeNpost = applyPost change2 -- does not work; n has to be provided
Does anyone know a technique, how to implement applyPostfix so that the k-argument may stay implicit when using applyPostfix?
What I did is proofing / programming:
lem-plus-comm : (n m : ℕ) → (n + m) ≡ (m + n)
and use that lemma when defining applyPostfix:
postfixApp2 : ∀ {A}{n m k : ℕ} → (Vec A n → Vec A m) → Vec A (k + n) → Vec A (k + m)
postfixApp2 {A} {n} {m} {k} f xs rewrite lem-plus-comm n k | lem-plus-comm k n | lem-plus-comm k m | lem-plus-comm m k = reverse (drop {n = n} (reverse xs)) ++ f (reverse (take {n = n} (reverse xs)))
Unfortunately, this didnt help, since I use the k-Parameter for calling the lemma :-(
Any better ideas how to avoid k to be explicit? Maybe I should use a snoc-View on Vectors?
What you can do is to give postfixApp2 the same type as applyPrefix.
The source of the problem is that a natural number n can be unified with p + q only if p is known. This is because + is defined via induction on the first argument.
So this one works (I'm using the standard-library version of commutativity on +):
+-comm = comm
where
open IsCommutativeSemiring isCommutativeSemiring
open IsCommutativeMonoid +-isCommutativeMonoid
postfixApp2 : {A : Set} {n m k : ℕ}
→ (Vec A n → Vec A m)
→ Vec A (n + k) → Vec A (m + k)
postfixApp2 {A} {n} {m} {k} f xs rewrite +-comm n k | +-comm m k =
applyPostfix {k = k} f xs
Yes, I'm reusing the original applyPostfix here and just give it a different type by rewriting twice.
And testing:
changeNpost : {A : Set} {n : ℕ} → Vec A (2 + n) → Vec A (2 + n)
changeNpost = postfixApp2 change2
test : changeNpost (1 ∷ 2 ∷ 3 ∷ 4 ∷ []) ≡ 1 ∷ 2 ∷ 4 ∷ 3 ∷ []
test = refl