I'm trying to prove the (first part of the) subtyping lemma from Types and Programming Languages. Here's what I have so far:
data Type : Set where
_=>_ : Type → Type → Type
Top : Type
data _<:_ : Type → Type → Set where
s-refl : {S : Type} → S <: S
s-trans : {S T U : Type} → S <: U → U <: T → S <: T
s-top : {S : Type} → S <: Top
s-arrow : {S₁ S₂ T₁ T₂ : Type} → T₁ <: S₁ → S₂ <: T₂ → S₁ => S₂ <: T₁ => T₂
lemma-inversion₁ : {S T₁ T₂ : Type}
→ S <: T₁ => T₂
→ ∃[ (S₁ × S₂) ∈ (Type & Type) ] ((S ≡ (S₁ => S₂)) & (T₁ <: S₁) & (S₂ <: T₂))
lemma-inversion₁ (s-refl {T₁ => T₂}) = (T₁ × T₂) , (refl × s-refl × s-refl)
lemma-inversion₁ (s-arrow {S₁} {S₂} T₁<:S₁ S₂<∶T₂) = (S₁ × S₂) , (refl × T₁<:S₁ × S₂<∶T₂)
lemma-inversion₁ (s-trans {S} S<:U U<:T₁=>T₂) with lemma-inversion₁ U<:T₁=>T₂
... | (U₁ × U₂) , (U≡U₁=>U₂ × T₁<:U₁ × U₂<:T₂) with lemma-inversion₁ (subst (S <:_) U≡U₁=>U₂ S<:U)
... | (S₁ × S₂) , (S≡S₁=>S₂ × U₂<:S₁ × S₂<:U₂) = (S₁ × S₂) , (S≡S₁=>S₂ × s-trans T₁<:U₁ U₂<:S₁ × s-trans S₂<:U₂ U₂<:T₂)
This looks correct to me, but I get:
Termination checking failed for the following functions:
lemma-inversion₁
Problematic calls:
lemma-inversion₁ (s-trans S<:U U<:T₁=>T₂)
| lemma-inversion₁ U<:T₁=>T₂
lemma-inversion₁ U<:T₁=>T₂
lemma-inversion₁ (subst (_<:_ S) U≡U₁=>U₂ S<:U)
Looks like Agda can't infer termination because of the subst? Is that right? Is there a workaround?
Turns out I needed to pattern-match on refl, like this:
... | (U₁ × U₂) , (refl × T₁<:U₁ × U₂<:T₂) with lemma-inversion₁ S<:U
This lets Agda infer that U = U₁ => U₂ and the termination checker is happy.
Related
I was asked to finish one of the recommended question from plfa:
Exercise ⇔≃× (recommended)
Show that A ⇔ B as defined earlier is isomorphic to (A → B) × (B → A).
I know I need to prove some property of equivalence first, and here is my proof:
record _⇔_ (A B : Set) : Set where
field
to : A → B
from : B → A
⇔-refl : ∀ {A : Set} → A ⇔ A
⇔-refl =
record
{ to = λ{x → x}
; from = λ{y → y}
}
⇔-sym : ∀ {A B : Set}
→ A ⇔ B
→ B ⇔ A
⇔-sym A⇔B =
record
{ to = _⇔_.from A⇔B
; from = _⇔_.to A⇔B
}
⇔-trans : ∀ {A B C : Set}
→ A ⇔ B
→ B ⇔ C
→ A ⇔ C
⇔-trans A⇔B B⇔C =
record
{ to = (_⇔_.to B⇔C) ∘ (_⇔_.to A⇔B )
; from = (_⇔_.from A⇔B) ∘ (_⇔_.from B⇔C )
}
And now, from my understanding, I need to prove
⇔≃× : ∀ {A B : Set} → A ⇔ B ≃ (A → B) × (B → A)
So to prove this, we need to prove four sections: "to" "from" "from∘to" "to∘from"
⇔≃× : ∀ {A B : Set} → (A ⇔ B) ≃ ((A → B) × (B → A))
⇔≃× =
record
{ to = λ{ x ⇔ y → ⟨ ( x → y ) , ( y → x ) ⟩ }
; from = ?
; from∘to = ?
; to∘from = ?
}
But when I finish the "to" section, I want to see if it can pass. So I compile and I got this error message:
Cannot eliminate type (A → B) × (B → A) with variable pattern ⇔(did you supply too many arguments?)when checking the clause left hand side.extendedlambda2 x ⇔ y
Can anyone give some explanation on this type of error message?
Thanks in advance
λ{ x ⇔ y → binds three arguments: x, ⇔, and y but the function you're supposed to define only takes one.
What is wrong with this code?
EDIT:
I'm sending all the code including dependencies, imports, flags, etc.
I can't figure out where the error might be. I would be very grateful if someone could direct me how to fix this error.
{-# OPTIONS --type-in-type --without-K #-}
module Basic where
Type = Set
data Path {A : Type} : A → A → Type where
id : {M : A} → Path M M
_≃_ : {A : Type} → A → A → Type
_≃_ = Path
infix 9 _≃_
ap : {A B : Type} {M N : A}
(f : A → B) → Path{A} M N → Path{B} (f M) (f N)
ap f id = id
ap≃ : ∀ {A} {B : A → Type} {f g : (x : A) → B x}
→ Path f g → {x : A} → Path (f x) (g x)
ap≃ α {x} = ap (\ f → f x) α
postulate
λ≃ : ∀ {A} {B : A → Type} {f g : (x : A) → B x}
→ ((x : A) → Path (f x) (g x))
I'm getting this error:
Failed to solve the following constraints:
Has bigger sort: _44
piSort _25 (λ _ → Set) = Set
Has bigger sort: _25
Any help?
I didn't get quite the same error, but I got the file to check by annotating A with type Type in the type of λ≃:
postulate
λ≃ : ∀ {A : Type} {B : A → Type} {f g : (x : A) → B x}
→ ((x : A) → Path (f x) (g x))
The error I saw comes about because Agda will usually assume that you might want to use universe polymorphism, and there happens to be nothing else in the type of λ≃ that constrains A to the lowest universe Type.
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.
I'd like to write the Limit in Sets Category using Agda. Assuming local smallness, a functor is a pair of a map on Set OC and I, like this.
sobj : OC → Set c₂
smap : { i j : OC } → (f : I ) → sobj i → sobj j
A cone for the functor is a record with two fields. Using the record, commutativity of the cone and the properties of the Limit
are easily shown, except the uniqueness. The uniqueness of the Limit is turned out that a congruence of the records with two fields.
In the following agda code, I'd like to prove snat-cong lemma.
open import Level
module S where
open import Relation.Binary.Core
open import Function
import Relation.Binary.PropositionalEquality
record snat { c₂ } { I OC : Set c₂ } ( sobj : OC → Set c₂ )
( smap : { i j : OC } → (f : I ) → sobj i → sobj j ) : Set c₂ where
field
snmap : ( i : OC ) → sobj i
sncommute : ( i j : OC ) → ( f : I ) → smap f ( snmap i ) ≡ snmap j
smap0 : { i j : OC } → (f : I ) → sobj i → sobj j
smap0 {i} {j} f x = smap f x
open snat
snat-cong : { c : Level } { I OC : Set c } { SObj : OC → Set c } { SMap : { i j : OC } → (f : I )→ SObj i → SObj j }
( s t : snat SObj SMap )
→ ( ( λ i → snmap s i ) ≡ ( λ i → snmap t i ) )
→ ( ( λ i j f → smap0 s f ( snmap s i ) ≡ snmap s j ) ≡ ( ( λ i j f → smap0 t f ( snmap t i ) ≡ snmap t j ) ) )
→ s ≡ t
snat-cong s t refl refl = {!!}
This is quite simlar to the answer of
Equality on dependent record types .
So it should work something like
snat-cong s t refl refl = refl
but it gives an error like this.
.sncommute i j f != sncommute t i j f of type
.SMap f (snmap t i) ≡ snmap t j
Is there any help?
In snat-cong none of the arguments are saying assuming anything about sncommute s being equal to sncommute t. Instead what you are saying is that the type of sncommute s is equal to the type of sncommute t, but that already follows from the first equality.
The easiest way to state equality of the sncommutes itself is with heterogeneous equality. So snat-cong could look something like this:
open import Relation.Binary.HeterogeneousEquality using (_≅_;refl)
snat-cong : {c : Level}
{I OC : Set c}
{sobj : OC → Set c}
{smap : {i j : OC} → (f : I) → sobj i → sobj j}
→ (s t : snat sobj smap)
→ (snmap-≡ : snmap s ≡ snmap t)
→ (sncommute-≅ : sncommute s ≅ sncommute t)
→ s ≡ t
snat-cong _ _ refl refl = refl
If you want to be more explicit, or want to work with --without-K, then you could use a dependent equality type for sncommute-≅:
snat-cong' : {c : Level}
{I OC : Set c}
{sobj : OC → Set c}
{smap : {i j : OC} → (f : I) → sobj i → sobj j}
(s t : snat sobj smap)
→ (snmap-≡ : snmap s ≡ snmap t)
→ (sncommute-≡ : subst (\snmap → ∀ i j f → smap f (snmap i) ≡ snmap j) snmap-≡ (sncommute s) ≡ sncommute t)
→ s ≡ t
snat-cong' _ _ refl refl = refl
Recently I made a type for finite sets in Agda with the following implementation:
open import Relation.Nullary
open import Relation.Nullary.Negation
open import Data.Empty
open import Data.Unit
open import Relation.Binary.PropositionalEquality
open import Data.Nat
suc-inj : (n m : ℕ) → (suc n) ≡ (suc m) → n ≡ m
suc-inj n .n refl = refl
record Eq (A : Set) : Set₁ where
constructor mkEqInst
field
_decide≡_ : (a b : A) → Dec (a ≡ b)
open Eq {{...}}
mutual
data FinSet (A : Set) {{_ : Eq A }} : Set where
ε : FinSet A
_&_ : (a : A) → (X : FinSet A) → .{ p : ¬ (a ∈ X)} → FinSet A
_∈_ : {A : Set} → {{p : Eq A}} → (a : A) → FinSet A → Set
a ∈ ε = ⊥
a ∈ (b & B) with (a decide≡ b)
... | yes _ = ⊤
... | no _ = a ∈ B
_∉_ : {A : Set} → {{p : Eq A}} → (a : A) → FinSet A → Set
_∉_ a X = ¬ (a ∈ X)
decide∈ : {A : Set} → {{_ : Eq A}} → (a : A) → (X : FinSet A) → Dec (a ∈ X)
decide∈ a ε = no (λ z → z)
decide∈ a (b & X) with (a decide≡ b)
decide∈ a (b & X) | yes _ = yes tt
... | no _ = decide∈ a X
decide∉ : {A : Set} → {{_ : Eq A}} → (a : A) → (X : FinSet A) → Dec (a ∉ X)
decide∉ a X = ¬? (decide∈ a X)
instance
eqℕ : Eq ℕ
eqℕ = mkEqInst decide
where decide : (a b : ℕ) → Dec (a ≡ b)
decide zero zero = yes refl
decide zero (suc b) = no (λ ())
decide (suc a) zero = no (λ ())
decide (suc a) (suc b) with (decide a b)
... | yes p = yes (cong suc p)
... | no p = no (λ x → p ((suc-inj a b) x))
However, when I test this type out with the following:
test : FinSet ℕ
test = _&_ zero ε
Agda for some reason can't infer the implicit argument of type ¬ ⊥! However, auto of course finds the proof of this trivial proposition: λ x → x : ¬ ⊥.
My question is this: Since I've marked the implicit proof as irrelevant, why can't Agda simply run auto to find the proof of ¬ ⊥ during type checking? Presumably, whenever filling in other implicit arguments, it might matter exactly what proof Agda finda, so it shouldn't just run auto, but if the proof has been marked irrelevant, like it my case, why can't Agda find a proof?
Note: I have a better implementation of this, where I implement ∉ directly, and Agda can find the relevant proof, but I want to understand in general why Agda can't automatically find these sorts of proofs for implicit arguments. Is there any way in the current implementation of Agda to get these "auto implicits" like I want here? Or is there some theoretical reason why this would be a bad idea?
There's no fundamental reason why irrelevant arguments couldn't be solved by proof search, however the fear is that in many cases it would be slow and/or not find a solution.
A more user-directed thing would be to allow the user to specify that a certain argument should be inferred using a specific tactic, but that has not been implemented either. In your case you would provide a tactic that tries to solve the goal with (\ x -> x).
If you give a more direct definition of ∉, then the implicit argument gets type ⊤ instead of ¬ ⊥. Agda can fill in arguments of type ⊤ automatically by eta-expansion, so your code just works:
open import Relation.Nullary
open import Relation.Nullary.Negation
open import Data.Empty
open import Data.Unit
open import Relation.Binary.PropositionalEquality
open import Data.Nat
suc-inj : (n m : ℕ) → (suc n) ≡ (suc m) → n ≡ m
suc-inj n .n refl = refl
record Eq (A : Set) : Set₁ where
constructor mkEqInst
field
_decide≡_ : (a b : A) → Dec (a ≡ b)
open Eq {{...}}
mutual
data FinSet (A : Set) {{_ : Eq A}} : Set where
ε : FinSet A
_&_ : (a : A) → (X : FinSet A) → .{p : (a ∉ X)} → FinSet A
_∉_ : {A : Set} → {{p : Eq A}} → (a : A) → FinSet A → Set
a ∉ ε = ⊤
a ∉ (b & X) with (a decide≡ b)
... | yes _ = ⊥
... | no _ = a ∉ X
decide∉ : {A : Set} → {{_ : Eq A}} → (a : A) → (X : FinSet A) → Dec (a ∉ X)
decide∉ a ε = yes tt
decide∉ a (b & X) with (a decide≡ b)
... | yes _ = no (λ z → z)
... | no _ = decide∉ a X
instance
eqℕ : Eq ℕ
eqℕ = mkEqInst decide
where decide : (a b : ℕ) → Dec (a ≡ b)
decide zero zero = yes refl
decide zero (suc b) = no (λ ())
decide (suc a) zero = no (λ ())
decide (suc a) (suc b) with (decide a b)
... | yes p = yes (cong suc p)
... | no p = no (λ x → p ((suc-inj a b) x))
test : FinSet ℕ
test = _&_ zero ε