I'm trying to understand coinduction (I'm reading Sangiorgi's book) using Agda. I already managed to prove some simple equalities between streams, but I'm stuck trying to prove that all natural numbers (values of type ℕ) are in the stream allℕ --- function allℕisℕ. Any tip on how should I proceed with this?
open import Coinduction
open import Data.Nat
module Simple where
data Stream (A : Set) : Set where
_∷_ : A → ∞ (Stream A) → Stream A
infix 4 _∈_
data _∈_ {A : Set} : A → Stream A → Set where
here : ∀ {x xs} → x ∈ x ∷ xs
there : ∀ {x y xs} → (x ∈ ♭ xs) → x ∈ y ∷ xs
enum : ℕ → Stream ℕ
enum n = n ∷ (♯ enum (suc n))
allℕ : Stream ℕ
allℕ = enum 0
allℕisℕ : ∀ (n : ℕ) → n ∈ allℕ
allℕisℕ n = ?
Just sharing the complete solution...
open import Coinduction
open import Data.Nat
module Simple where
data Stream (A : Set) : Set where
_∷_ : A → ∞ (Stream A) → Stream A
infix 4 _∈_
data _∈_ {A : Set} : A → Stream A → Set where
here : ∀ {x xs} → x ∈ x ∷ xs
there : ∀ {x y xs} → (x ∈ ♭ xs) → x ∈ y ∷ xs
enum : ℕ → Stream ℕ
enum n = n ∷ (♯ enum (suc n))
allℕ : Stream ℕ
allℕ = enum 0
∈-suc : ∀ {n m : ℕ} → n ∈ enum m → suc n ∈ enum (suc m)
∈-suc here = here
∈-suc (there p) = there (∈-suc p)
allℕisℕ : ∀ (n : ℕ) → n ∈ allℕ
allℕisℕ zero = here
allℕisℕ (suc n) = there (∈-suc (allℕisℕ n))
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.
data _[_]=_ {A : Set a} : ∀ {n} → Vec A n → Fin n → A → Set a where
here : ∀ {n} {x} {xs : Vec A n} → x ∷ xs [ zero ]= x
there : ∀ {n} {i} {x y} {xs : Vec A n}
(xs[i]=x : xs [ i ]= x) → y ∷ xs [ suc i ]= x
This is for Vec, but I can't find an analogous one for List.
It is available in a more generic form in Data.List.Relation.Unary.Any. Here is how it is defined.
data Any {A : Set a} (P : Pred A p) : Pred (List A) (a ⊔ p) where
here : ∀ {x xs} (px : P x) → Any P (x ∷ xs)
there : ∀ {x xs} (pxs : Any P xs) → Any P (x ∷ xs)
Here is an example of it in use.
open import Relation.Nullary
open import Relation.Binary.PropositionalEquality
open import Data.List
open import Data.List.Relation.Unary.Any
data NonRepeating {a} {A : Set a} : (l : List A) → Set a where
done : NonRepeating []
rest : ∀ {x xs} → ¬ Any (x ≡_) xs → NonRepeating xs → NonRepeating (x ∷ xs)
record UniqueList {a} (A : Set a) : Set a where
constructor _//_
field
l : List A
wf : NonRepeating l
Why do function composition (∘) and application ($) have the implementation as available in https://github.com/agda/agda-stdlib/blob/master/src/Function.agda#L74-L76?
Copied here for convenience:
_∘_ : ∀ {a b c}
{A : Set a} {B : A → Set b} {C : {x : A} → B x → Set c} →
(∀ {x} (y : B x) → C y) → (g : (x : A) → B x) →
((x : A) → C (g x))
f ∘ g = λ x → f (g x)
_∘'_ : ∀ {a b c} {A : Set a} {B : Set b} {C : Set c} →
(B → C) → (A → B) → (A → C)
f ∘' g = λ x → f (g x)
_$_ : ∀ {a b} {A : Set a} {B : A → Set b} →
((x : A) → B x) → ((x : A) → B x)
f $ x = f x
_$'_ : ∀ {a b} {A : Set a} {B : Set b} →
(A → B) → (A → B)
f $' x = f x
I initially thought the rationale behind this was that $ would be able to handle higher order types that $' wouldn't be able to handle. For example, consider A=Nat, B=List, f is ::, where B depends on A. But after a lot of testing, I couldn't come up with an example that would show that the implementation of $' is not sufficient. What scenarios does $ handle that $' isn't able to handle? (Similarly, what scenarios does ∘ handle that ∘' doesn't?
open import Agda.Builtin.Nat public
open import Agda.Primitive public
--data List {a} (A : Set a) : Set a where
-- [] : List A
-- _∷_ : (x : A) (xs : List A) → List A
data Vec {a} (A : Set a) : Nat → Set a where
[] : Vec A zero
_∷_ : ∀ {n} (x : A) (xs : Vec A n) → Vec A (suc n)
tail : ∀ {a n} {A : Set a} → Vec A (suc n) → Vec A n
tail (x ∷ s) = s
_$_ : ∀ {a b} {A : Set a} {B : A → Set b} →
((x : A) → B x) → ((x : A) → B x)
f $ x = f x
_$'_ : ∀ {a b} {A : Set a} {B : Set b} →
(A → B) → (A → B)
f $' x = f x
_∘_ : ∀ {a b c}
{A : Set a} {B : A → Set b} {C : {x : A} → B x → Set c} →
(∀ {x} (y : B x) → C y) → (g : (x : A) → B x) →
((x : A) → C (g x))
f ∘ g = λ x → f (g x)
_∘'_ : ∀ {a b c} {A : Set a} {B : Set b} {C : Set c} →
(B → C) → (A → B) → (A → C)
f ∘' g = λ x → f (g x)
Vecc : ∀ {a} → Nat → (A : Set a) → (Set a)
Vecc x y = Vec y x
data Pair {a b} (A : Set a) (B : A → Set b) : Set (a ⊔ b) where
_,_ : (x : A) → (y : B x) → Pair A B
-- Dependent Pair attempt
--fst : ∀ {a b} {A : Set a} {B : A → Set b} → Pair A B → A
--fst (a , b) = a
--
--f : Pair Nat $' Vec Nat
--f = _,_ zero $' []
--
--g : Pair (Pair Nat $' Vec Nat) $' λ x → Nat
--g = _,_ (_,_ zero $' []) $' zero
-- Some other attempt
--f : ∀ {a n} {A : Set a} → Vec A ((suc ∘' suc) n) → Vec A n
--f {a} = tail {a} ∘' tail {a}
-- Vec attempt
--f : ∀ {a} (A : Set a) → (Set a)
--f {a} = Vecc {a} (suc zero) ∘' Vecc {a} (suc zero)
--
--h = f Nat
--
--x : h
--x = (zero ∷ []) ∷ []
-- List attempt
--f : ∀ {a} (A : Set a) → (Set a)
--f {a} = List {a} ∘' List {a}
--
--g : ∀ {a} (A : Set a) → (Set a)
--g {a} = List {a} ∘ List {a}
--
--h = f Nat
--i = g Nat
--
--x : h
--x = (zero ∷ []) ∷ []
∘′ and $′ don't work with dependent functions. You simply didn't try any tests with dependent functions. For f $ x examples, f must be dependent, for f ∘ g, either of the functions must be dependent. Example:
open import Data.Nat
open import Data.Vec
open import Function
open import Relation.Binary.PropositionalEquality
replicate' : {A : Set} → A → (n : ℕ) → Vec A n
replicate' a n = replicate a
refl' : {A : Set}(a : A) → a ≡ a
refl' a = refl
-- fail1 : Vec ℕ 10
-- fail1 = replicate' 10 $′ 10
ok1 : Vec ℕ 10
ok1 = replicate' 10 $ 10
-- fail2 : ∀ n → replicate' 10 n ≡ replicate' 10 n
-- fail2 = refl' ∘′ replicate' 10
ok2 : ∀ n → replicate' 10 n ≡ replicate' 10 n
ok2 = refl' ∘ replicate' 10
One works with dependent functions, the other doesn't, as Andras Kovacs mentioned.
The important difference is that for non-dependent functions stronger proofs can be constructed. For example:
eq : {A B} -> f : (A -> B) -> x y : A -> x == y -> (f x) == (f y)
eq f x .x refl = refl
Here we can construct equality of f x and f y. But we can't do the same for dependent functions - because there is no way to prove B x == B y. So there is only a weaker proof that f x can be "cast" to f y.
transport : {A} {B : A -> Set} -> f : (x : A -> B x) -> x y : A -> x == y -> f x -> f y
transport f x .x refl fx = fx
(Actually, transport is usually defined as B x -> B y, not for a dependent function; but I just can't come up with a better name)
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.
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 ∷ []
∎