I'm trying to prove some lemmas that are mutually recursive, but unfortunately not structurally recursive, so I have to use Data.Nat.Induction.Acc, resulting in half of my code dedicated to explicitly mentioning proofs of facts like m ≤ m ⊔ n. Ideally, I'd like to hide these technicalities as much as possible, and upon a quick glance implicit arguments seem promising (and much more lightweight than going full metaprogramming/reflection). But, alas, I'm stuck on that route.
As a model example, consider some mutually recursive trees:
open import Data.Nat.Base
open import Data.Nat.Properties
open import Relation.Binary.PropositionalEquality using (_≡_; refl; subst; sym)
mutual
data U : Set where
U-only : U
U-with-Vs : (v₁ v₂ : V) → U
data V : Set where
V-only : V
V-with-Us : (u₁ u₂ : U) -> V
along with some functions yielding something that's smaller (for the obvious definition of a size), but not structurally smaller:
mutual
iso-U : U → V
iso-U U-only = V-only
iso-U (U-with-Vs v₁ v₂) = V-with-Us (iso-V v₁) (iso-V v₂)
iso-V : V → U
iso-V V-only = U-only
iso-V (V-with-Us u₁ u₂) = U-with-Vs (iso-U u₁) (iso-U u₂)
Now let's define those obvious size measures and prove that iso doesn't change that size:
mutual
size-U : U → ℕ
size-U U-only = zero
size-U (U-with-Vs v₁ v₂) = suc (size-V v₁ ⊔ size-V v₂)
size-V : V → ℕ
size-V V-only = zero
size-V (V-with-Us u₁ u₂) = suc (size-U u₁ ⊔ size-U u₂)
mutual
size-U-iso-V : ∀ v
→ size-U (iso-V v) ≡ size-V v
size-U-iso-V V-only = refl
size-U-iso-V (V-with-Us u₁ u₂) rewrite size-V-iso-U u₁ | size-V-iso-U u₂ = refl
size-V-iso-U : ∀ u
→ size-V (iso-U u) ≡ size-U u
size-V-iso-U U-only = refl
size-V-iso-U (U-with-Vs v₁ v₂) rewrite size-U-iso-V v₁ | size-U-iso-V v₂ = refl
Finally we get to write a nonsensical and useless function that still models what I need to do in my real code:
open import Data.Nat.Induction
module Explicit where
mutual
count-U : (u : U) → Acc _<_ (size-U u) → ℕ
count-U U-only _ = zero
count-U (U-with-Vs v₁ v₂) (acc rec) =
let ineq = m≤m⊔n (size-V v₁) (size-V v₂)
ineq' = subst (_≤ size-V v₁ ⊔ size-V v₂) (sym (size-U-iso-V v₁)) ineq
r₁ = rec _ (s≤s ineq')
r₂ = rec _ (s≤s (n≤m⊔n _ _))
in suc (count-U (iso-V v₁) r₁ + count-V v₂ r₂)
count-V : (v : V) → Acc _<_ (size-V v) → ℕ
count-V V-only _ = zero
count-V (V-with-Us u₁ u₂) (acc rec) =
let r₁ = rec _ (s≤s (m≤m⊔n _ _))
r₂ = rec _ (s≤s (n≤m⊔n _ _))
in suc (count-U u₁ r₁ + count-U u₂ r₂)
This typechecks, but all those r₁s, r₂s and whatever they require in count-U are completely irrelevant to the logic of these functions, and I'd like to get rid of them.
Let's give it a shot with instance arguments? Here's my attempt:
module Instance where
instance
m≤m⊔n' : ∀ {m n} → m ≤ m ⊔ n
m≤m⊔n' {m} {n} = m≤m⊔n m n
n≤m⊔n' : ∀ {m n} → n ≤ m ⊔ n
n≤m⊔n' {m} {n} = n≤m⊔n m n
acc-rec : ∀ {a z} → ⦃ Acc _<_ z ⦄ → ⦃ a < z ⦄ → Acc _<_ a
acc-rec ⦃ acc rec ⦄ ⦃ a<z ⦄ = rec _ a<z
mutual
count-U : (u : U) → ⦃ Acc _<_ (size-U u) ⦄ → ℕ
count-U U-only = zero
count-U (U-with-Vs v₁ v₂) = suc ({! !} + count-V v₂)
count-V : (v : V) → ⦃ Acc _<_ (size-V v) ⦄ → ℕ
count-V V-only = zero
count-V (V-with-Us u₁ u₂) = {! !}
Agda doesn't like it, though, apparently considering the instance argument to count-U as a candidate, and being not sure which one of the two lemmas about ⊔ to use:
Failed to solve the following constraints:
Resolve instance argument
_124
: (v₃ v₄ : V) ⦃ z : Acc _<_ (size-U (U-with-Vs v₃ v₄)) ⦄ →
size-V v₄ < _z_122 (v₁ = v₃) (v₂ = v₄)
Candidates
λ {m} {n} → m≤m⊔n m n : ({m n : ℕ} → m ≤ m ⊔ n)
λ {m} {n} → n≤m⊔n m n : ({m n : ℕ} → n ≤ m ⊔ n)
Resolve instance argument
_123
: (v₃ v₄ : V) ⦃ z : Acc _<_ (size-U (U-with-Vs v₃ v₄)) ⦄ →
Acc _<_ (_z_122 (v₁ = v₃) (v₂ = v₄))
Candidates
_ : Acc _<_ (size-U (U-with-Vs v₁ v₂))
acc-rec : ({a z : ℕ} ⦃ _ : Acc _<_ z ⦄ ⦃ _ : a < z ⦄ → Acc _<_ a)
And even if I leave just a single top-level instance of presumably the right shape
acc-rec : ∀ {m n} → ⦃ Acc _<_ (suc (m ⊔ n)) ⦄ → Acc _<_ n
acc-rec ⦃ acc rec ⦄ = rec _ (s≤s (n≤m⊔n _ _))
Agda would still complain.
I've re-read the section on instance resolution in Agda docs a few times, but I'm still not sure why it behaves this way.
What am I doing wrong? Can I achieve what I want with instance arguments? Or shall I just go and learn Agda metaprogramming?
Related
I'm new to Agda and am puzzled by this one.
open import Data.Vec
open import Data.Nat
open import Data.Nat.DivMod
open import Data.Fin hiding (_+_ ; splitAt)
open import Data.Product
open import Relation.Binary.PropositionalEquality
difference : ∀ m (n : Fin m) → ∃ λ o → m ≡ toℕ n + o
difference zero ()
difference (suc m) zero = suc m , refl
difference (suc m) (suc n) with difference m n
difference (suc m) (suc n) | o , p1 = o , cong suc p1
takeFin : ∀ {A : Set} {m : ℕ} (n : Fin m) → Vec A m → Vec A (toℕ n)
takeFin {A} {m = m} n vec with difference m n
... | o , p rewrite p with splitAt (toℕ n) vec
... | xs , _ , _ = xs
The takeFin function gives the error message:
m != lhs of type ℕ
when checking that the type
{m : ℕ} (n : Fin m) (o : ℕ) (p : m ≡ toℕ n + o) (lhs : ℕ) →
lhs ≡ toℕ n + o → {A : Set} (vec : Vec A lhs) → Vec A (toℕ n)
of the generated with function is well-formed
but the following functions do compile
takeFin' : ∀ {A : Set} {m : ℕ} (n : Fin m) → Vec A m → Vec A m
takeFin' {A} {m = m} n a vec with difference m n
... | o , p rewrite p with splitAt (toℕ n) vec
... | xs , ys , _ = xs ++ ys
takeFin'' : ∀ {A : Set} {m : ℕ} (n : Fin m) → A → Vec A m → Vec A (toℕ n)
takeFin'' {A} {m = m} n a vec = replicate a
Can anyone help me out?
As new Agda users tend to do, you did complicate matters a lot more than you needed to. What you intend to prove can actually be done in a much simpler way, as follows:
open import Data.Vec
open import Data.Fin
takeFin : ∀ {a} {A : Set a} {m} {n : Fin m} → Vec A m → Vec A (toℕ n)
takeFin {n = zero} (x ∷ v) = []
takeFin {n = suc _} (x ∷ v) = x ∷ takeFin v
You should always try to write simple inductive proofs rather than using unnecessary intermediate lemmas.
As to why your version does not typecheck (it's not compilation, it's type checking) the reason lies in your rewrite call which is made on an element of m ≡ toℕ n + o while your goal is of type Vec A (toℕ n) and does not contain any occurrence of m. What you want to do instead is to transform the type of vec in your context, while rewrite only acts over the goal. Here is how I would make it work:
takeFin : ∀ {A : Set} {m} {n : Fin m} → Vec A m → Vec A (toℕ n)
takeFin {m = m} {n} vec with difference m n
... | _ , p = proj₁ (splitAt (toℕ n) (subst (Vec _) p vec))
It works but as you can see it is far less elegant (and it also requires the difference function that you defined) and, more importantly, it uses subst which is often discouraged.
As a side note, and mostly for fun, it's possible to make the function a bit more concise and elegant (but less understandable) as follows:
open import Function
takeFin : ∀ {A : Set} {m} {n : Fin m} → Vec A m → Vec A (toℕ n)
takeFin {n = n} = proj₁ ∘ (splitAt (toℕ n)) ∘ (subst (Vec _) (proj₂ (difference _ n)))
This version, while a lot more complicated to read, shows how powerful Agda is in inferring the values of parameters, as only n is explicitly given.
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.
Question
I'm trying to implement a rotate function on Vec, which moves every element n positions to the left, looping around. I could implement that function by using splitAt. Here is a sketch:
open import Data.Nat
open import Data.Nat.DivMod
open import Data.Fin
open import Data.Vec
open import Relation.Nullary.Decidable
open import Relation.Binary.PropositionalEquality
rotateLeft : {A : Set} -> {w : ℕ} -> {w≢0 : False (w ≟ 0)} -> ℕ -> Vec A w -> Vec A w
rotateLeft {A} {w} n vec =
let parts = splitAt (toℕ (n mod w)) {n = ?} vec
in ?
The problem is that splitAt requires two inputs, m and n, such that the size of the vector is m + n. Since the size of the vector here is w, I need to find a k such that k + toℕ (n mod w) = w. I couldn't find any standard function handy for that. What is the best way to proceed?
Some possibilities?
Perhaps it would be helpful if k = n mod w gave me a proof that k < w, that way I could try implementing a function diff : ∀ {k w} -> k < w -> ∃ (λ a : Nat) -> a + k = w. Another possibility would be to just receive a and b as inputs, rather than the bits to shift and size of the vector, but I'm not sure that is the best interface.
Update
I've implemented the following:
add-diff : (a : ℕ) -> (b : Fin (suc a)) -> toℕ b + (a ℕ-ℕ b) ≡ a
add-diff zero zero = refl
add-diff zero (suc ())
add-diff (suc a) zero = refl
add-diff (suc a) (suc b) = cong suc (aaa a b)
Now I just need a proof that ∀ {n m} -> n mod m < m.
Here's what I came up with.
open import Data.Vec
open import Data.Nat
open import Data.Nat.DivMod
open import Data.Fin hiding (_+_)
open import Data.Product
open import Relation.Binary.PropositionalEquality
open import Data.Nat.Properties using (+-comm)
difference : ∀ m (n : Fin m) → ∃ λ o → m ≡ toℕ n + o
difference zero ()
difference (suc m) zero = suc m , refl
difference (suc m) (suc n) with difference m n
difference (suc m) (suc n) | o , p1 = o , cong suc p1
rotate-help : ∀ {A : Set} {m} (n : Fin m) → Vec A m → Vec A m
rotate-help {A} {m = m} n vec with difference m n
... | o , p rewrite p with splitAt (toℕ n) vec
... | xs , ys , _ = subst (Vec A) (+-comm o (toℕ n)) (ys ++ xs)
rotate : ∀ {A : Set} {m} (n : ℕ) → Vec A m → Vec A m
rotate {m = zero} n v = v
rotate {m = suc m} n v = rotate-help (n mod suc m) v
After talking with adamse on IRC, I've came up with this:
open import Data.Fin hiding (_+_)
open import Data.Vec
open import Data.Nat
open import Data.Nat.Properties
open import Data.Nat.DivMod
open import Data.Empty
open import Data.Product
open import Relation.Binary.PropositionalEquality
open import Relation.Nullary.Decidable
diff : {a : ℕ} → {b : Fin a} → ∃ λ c → toℕ b + c ≡ a
diff {zero} {()}
diff {suc a} {zero} = suc a , refl
diff {suc a} {suc b} with diff {a} {b}
... | c , prf = c , cong suc prf
rotateLeft : {A : Set} → {w : ℕ} → {w≢0 : False (w ≟ 0)} → ℕ → Vec A w → Vec A w
rotateLeft {A} {w} {w≢0} n v =
let m = _mod_ n w {w≢0}
d = diff {w} {m}
d₁ = proj₁ d
d₂ = proj₂ d
d₃ = subst (λ x → x ≡ w) (+-comm (toℕ (n mod w)) d₁) d₂
v₁ = subst (λ x → Vec A x) (sym d₂) v
sp = splitAt {A = A} (toℕ m) {n = d₁} v₁
xs = proj₁ (proj₂ sp)
ys = proj₁ sp
in subst (λ x → Vec A x) d₃ (xs ++ ys)
Which is nowhere as elegant as his implementation (partly because I'm still learning Agda's syntax so I opt to just use functions), but works. Now I should return a more refined type, I believe. (Can't thank him enough!)
For your last question to just prove k < w, since k = toℕ (n mod w), you can use bounded from Data.Fin.Properties:
bounded : ∀ {n} (i : Fin n) → toℕ i ℕ< n
I have a definition with the following type:
insert : ∀ {n} → (i : Fin (suc n)) → ∀ t → Env n → Env (suc n)
weaken : ∀ {t t₀ n} {Γ : Env n} → (i : Fin (suc n)) → (e : Γ ⊢ t₀) → (insert i t Γ) ⊢ t₀
Given two environments Γ : Env n and Γ′ : Env n′, and a pointer to a position in the second one, i : Fin (suc n), I would like to weaken an e : (Γ′ ++ Γ) ⊢ t₀.
In theory, this should be easy by using something like
let i′ = raise n′ i
weaken {t} i′ e : insert i′ t (Γ′ ++ Γ) ⊢ t₀
However, in practice it doesn't work out so nicely, because the typechecker is not convinced that raise n′ i has type Fin (suc _) (required by weaken):
(n′ + suc n) != (suc (_n_550 i e)) of type ℕ
when checking that the
expression i′ has type Fin (suc (_n_550 i e))
My problem is, I could use something like +-suc : ∀ n′ n → n′ + suc n ≡ suc (n′ + n) to substitute the type of i′, but then the resulting type from weaken i′ e will not have the form insert i′ t (Γ′ ++ Γ) ⊢ t₀.
Given two environments Γ : Env n and Γ′ : Env n′
Those are contexts.
It should be possible to change the type of insert to
data Bound : ℕ -> Set where
zero : ∀ {n} -> Bound n
suc : ∀ {n} -> Bound n -> Bound (suc n)
insert : ∀ {n} → (i : Bound n) → ∀ t → Env n → Env (suc n)
without changing the body of the function.
You can write a version of raise that raises under suc:
raise′ : ∀ {m} n → Fin (suc m) → Fin (suc (n + m))
raise′ zero i = i
raise′ (suc n) i = suc (raise′ n i)
But the actual solution is to rename terms using either functions:
Ren : Con -> Con -> Set
Ren Γ Δ = ∀ {σ} -> σ ∈ Γ -> σ ∈ Δ
keepʳ : ∀ {Γ Δ σ} -> Ren Γ Δ -> Ren (Γ ▻ σ) (Δ ▻ σ)
keepʳ r vz = vz
keepʳ r (vs v) = vs (r v)
ren : ∀ {Γ Δ σ} -> Ren Γ Δ -> Γ ⊢ σ -> Δ ⊢ σ
ren r (var v) = var (r v)
ren r (ƛ b ) = ƛ (ren (keepʳ r) b)
ren r (f · x) = ren r f · ren r x
or order preserving embeddings.