Instance search fails with multiple solutions even though all solutions are equal - agda

Instance search requires that all found solutions are unique. According to the Agda wiki (https://agda.readthedocs.io/en/v2.6.0.1/language/instance-arguments.html, bottom of the page),
From the previous stage we get a list of potential solutions. If the list is empty we fail with an error saying that no instance for C vs could be found (no). If there is a single solution we use it to solve the goal (yes), and if there are multiple solutions we check if they are all equal. If they are, we solve the goal with one of them (yes), but if they are not, we postpone instance resolution (maybe), hoping that some of the maybes will turn into nos once we know more about the involved metavariables.
Here I have some code that uses rose trees of bools. There are two data structures Trues and Falses that witness that the contents of a rose tree is all true or all false, respectively. There is also a function Opp that swaps all trues to falses and vice-versa. Naturally, Trues x -> Falses (Opp x) and vice-versa, so I wrote a function OppTF to witness this. However, Agda now complains that there are two ways to prove Falses (B []), either directly with the constructor for Falses, or via the function OppTF. Of course, both of these produce the same result, and I prove this with the uniq function that proves that if p : Trues (B []) then p is unique. Nevertheless, Agda does not realise this.
How can I convince Agda that all solutions are equal? Unfortunately I cannot make the proof irrelevant with .{{ _ : Falses x }} as I need it later on. So I need to do one of the following:
Coax Agda into fully normalising both candidate solutions, which will reveal they are equal.
Use the uniq proof to convince Agda that all solutions are equal.
Make Agda stop caring about duplicate solutions, without making the argument irrelevant.
Is it possible to do any of these, and if so, how?
Code and error below:
module Example where
open import Data.List
open import Data.Bool
open import Relation.Binary.PropositionalEquality
data Rose : Set where
V : Bool → Rose
B : List Rose → Rose
Opp : Rose → Rose
Opp' : List Rose → List Rose
Opp (V x) = V (not x)
Opp (B xs) = B (Opp' xs)
Opp' [] = []
Opp' (x ∷ xs) = Opp x ∷ Opp' xs
data Trues : Rose → Set
data Trues' : List Rose → Set
data Trues where
instance VTrues : Trues (V true)
instance TTrues : ∀ {ts} ⦃ _ : Trues' ts ⦄ → Trues (B ts)
data Trues' where
instance VTrues' : Trues' []
instance TTrues' : ∀ {t ts} ⦃ _ : Trues t ⦄ ⦃ _ : Trues' ts ⦄ → Trues' (t ∷ ts)
data Falses : Rose → Set
data Falses' : List Rose → Set
data Falses where
instance VFalses : Falses (V false)
instance TFalses : ∀ {ts} ⦃ _ : Falses' ts ⦄ → Falses (B ts)
data Falses' where
instance VFalses' : Falses' []
instance TFalses' : ∀ {t ts} ⦃ _ : Falses t ⦄ ⦃ _ : Falses' ts ⦄ → Falses' (t ∷ ts)
instance
OppTF : ∀ {x} ⦃ _ : Trues x ⦄ → Falses (Opp x)
OppTF' : ∀ {xs} ⦃ _ : Trues' xs ⦄ → Falses' (Opp' xs)
OppTF {x} ⦃ VTrues ⦄ = VFalses
OppTF {x} ⦃ TTrues ⦃ xs ⦄ ⦄ = TFalses ⦃ OppTF' ⦃ xs ⦄ ⦄
OppTF' {[]} ⦃ VTrues' ⦄ = VFalses'
OppTF' {x ∷ xs} ⦃ TTrues' ⦃ p ⦄ ⦃ ps ⦄ ⦄ = TFalses' ⦃ OppTF ⦃ p ⦄ ⦄ ⦃ OppTF' ⦃ ps ⦄ ⦄
data Str : Rose → Set where
Tor : ∀ {x : Rose} → Str x
dummy : ∀ {x : Rose} ⦃ _ : Falses x ⦄ → Rose
dummy {x} = x
test : Rose
test = dummy {B []}
uniq : ∀ {p : Falses (B [])} → p ≡ TFalses ⦃ VFalses' ⦄
uniq {TFalses {_} ⦃ VFalses' ⦄} = refl
Error:
Failed to solve the following constraints:
Resolve instance argument _70 : Falses (B [])
Candidates
TFalses : {ts : List Rose} ⦃ _ : Falses' ts ⦄ → Falses (B ts)
OppTF : {x : Rose} ⦃ _ : Trues x ⦄ → Falses (Opp x)
(stuck)

This was solved over on the Zulip chat with the option
{-# OPTIONS --overlapping-instances #-}
In this particular case, allowing overlapping instances doesn't cause a slowdown, however in my actual use-case it did, so also adding
{-# OPTIONS --overlapping-instances --instance-search-depth 10 #-}
greatly sped it up (the default search depth is 500).

Related

Abusing instance arguments to mimic tactics

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?

Agda: rewrite subexpression

I'm trying to prove:
AddTodoSetsNewCompletedToFalse :
∀ {n : ℕ} (todos : Vec Todo (1 + n)) (text : String) →
Todo.completed (last (AddTodo todos text)) ≡ false
AddTodoSetsNewCompletedToFalse todos text = ?
where
AddTodoLastAddedElementIsTodo :
∀ {a} {A : Set a} {n} (todos : Vec Todo n) (text : String) →
last (AddTodo todos text) ≡
record
{ id = 1
; completed = false
; text = text
}
AddTodoLastAddedElementIsTodo todos text = vecLast todos
and
vecLast : ∀ {a} {A : Set a} {l n} (xs : Vec A n) → last (xs ∷ʳ l) ≡ l
vecLast [] = refl
vecLast (_ ∷ xs) = P.trans (prop (xs ∷ʳ _)) (vecLast xs)
where
prop : ∀ {a} {A : Set a} {n x} (xs : Vec A (suc n)) → last (x ∷ xs) ≡ last xs
prop xs with initLast xs
... | _ , _ , refl = refl
I tried using rewrite and got:
AddTodoSetsNewCompletedToFalse :
∀ {a} {A : Set a} {n} (todos : Vec Todo n) (text : String) →
Todo.completed (last (AddTodo todos text)) ≡ false
AddTodoSetsNewCompletedToFalse todos text rewrite AddTodoLastAddedElementIsTodo todos text = refl
but the error:
_a_100 : Agda.Primitive.Level
showed up.
I'm not sure how to resolve this.
from here I understand that this is related to the implicit argument. But not sure how to fix it
This sort of error indicates an unsolved metavariable, which means that Agda has failed to infer an implicit argument
Thanks!
You do not use A for anything in the type of AddTodoSetsNewCompletedToFalse. Also, that is not an error, but an unsolved meta.
So what happens is that wherever you use AddTodoSetsNewCompletedToFalse, nothing in the arguments or the result type constrains the choice of A (and, subsequently, a) so the unifier has no way of solving these metavariables. You can make explicit what happens by writing AddTodoSetsNewCompletedToFalse {a = _} {A = _} and observing that these two metas are unsolved.
You should simply remove the first two parameters (a and A) from AddTodoSetsNewCompletedToFalse's type.

Is the univalence axiom injective?

Is the univalence axiom invertible (modulo paths)? Is it possible to prove, using Agda's Cubical library, to prove the following:
open import Cubical.Core.Glue
uaInj : ∀ {ℓ} {A B : Set ℓ} {f g : A ≃ B} →
ua f ≡ ua g → equivFun f ≡ equivFun g
I suspect the above should hold, because in example 3.19 of the HoTT book, there is a step in the proof where an equivalence between two equivalences is used to prove the equivalence between their functions:
[...] so f is an
equivalence. Hence, by univalence, f gives rise to a path p : A ≡ A.
If p were equal to refl A, then (again by univalence) f would equal the
identity function of A.
Sure, ua is an equivalence, so it's injective. In the HoTT book, the inverse of ua is idtoeqv, so by congruence idtoeqv (ua f) ≡ idtoeqv (ua g) and then by inverses f ≡ g. I'm not familiar with the contents of cubical Agda prelude but this should be provable since it follows directly from the statement of univalence.
To put András's answer into code, we can prove injectivity of equivalency functions in general:
equivInj : ∀ {ℓ₁ ℓ₂} {A : Set ℓ₁} {B : Set ℓ₂} (f : A ≃ B) →
∀ x x′ → equivFun f x ≡ equivFun f x′ → x ≡ x′
equivInj f x x′ p = cong fst $ begin
x , refl ≡⟨ sym (equivCtrPath f (equivFun f x) (x , refl)) ⟩
equivCtr f (equivFun f x) ≡⟨ equivCtrPath f (equivFun f x) (x′ , p) ⟩
x′ , p ∎
and then given
univalence : ∀ {ℓ} {A B : Set ℓ} → (A ≡ B) ≃ (A ≃ B)
we get
uaInj : ∀ {ℓ} {A B : Set ℓ} {f g : A ≃ B} → ua f ≡ ua g → equivFun f ≡ equivFun g
uaInj {f = f} {g = g} = cong equivFun ∘ equivInj (invEquiv univalence) f g
The only problem is, univalence is not readily available in the Cubical library. Hopefully that is getting sorted out shortly.
UPDATE: In reaction to the above bug ticket, proof of univalence is now available in the Cubical library.

Agda's standard library Data.AVL.Sets containing Data.String as values

I am trying to figure out how to use Agda's standard library implementation of finite sets based on AVL trees in the Data.AVL.Sets module. I was able to do so successfully using ℕ as the values with the following code.
import Data.AVL.Sets
open import Data.Nat.Properties as ℕ
open import Relation.Binary using (module StrictTotalOrder)
open Data.AVL.Sets (StrictTotalOrder.isStrictTotalOrder ℕ.strictTotalOrder)
test = singleton 5
Now I want to achieve the same thing but with Data.String as the values. There doesn't seem to be a corresponding Data.String.Properties module, but Data.String exports strictTotalOrder : StrictTotalOrder _ _ _ which I thought looked appropriate.
However, just strictly replacing the modules according to this assumption fails.
import Data.AVL.Sets
open import Data.String as String
open import Relation.Binary using (module StrictTotalOrder)
open Data.AVL.Sets (StrictTotalOrder.isStrictTotalOrder String.strictTotalOrder)
Produces the error
.Relation.Binary.List.Pointwise.Rel
(StrictTotalOrder._≈_ .Data.Char.strictTotalOrder) (toList x) (toList x₁)
!= x .Relation.Binary.Core.Dummy.≡ x₁ of type Set
when checking that the expression
StrictTotalOrder.isStrictTotalOrder String.strictTotalOrder
has type
Relation.Binary.IsStrictTotalOrder .Relation.Binary.Core.Dummy._≡_
__<__3
which I find difficult to unpack in detail since I have no idea what the Core.Dummy stuff is. It seems that there is some problem with the pointwise definition of the total order for Strings, but I can't figure it out.
If you look at Data.AVL.Sets, you can see that it is parameterised by a strict total order associated to the equivalence relation _≡_ (defined in Relation.Binary.PropositionalEquality):
module Data.AVL.Sets
{k ℓ} {Key : Set k} {_<_ : Rel Key ℓ}
(isStrictTotalOrder : IsStrictTotalOrder _≡_ _<_)
where
Now we can have a look at how the strict total order on Strings is defined. We first convert the Strings to List Chars and then compare them based on the strict lexicographic ordering for lists:
strictTotalOrder =
On.strictTotalOrder
(StrictLex.<-strictTotalOrder Char.strictTotalOrder)
toList
If we dig into the code for StrictLex.<-strictTotalOrder, we can see that the equivalence relation associated to our List of Chars is built using the pointwise lifting Pointwise.isEquivalence of whatever the equivalence relation for Chars is.
But Pointwise.isEquivalence is defined in term of this datatype:
data Rel {a b ℓ} {A : Set a} {B : Set b}
(_∼_ : REL A B ℓ) : List A → List B → Set (a ⊔ b ⊔ ℓ) where
[] : Rel _∼_ [] []
_∷_ : ∀ {x xs y ys} (x∼y : x ∼ y) (xs∼ys : Rel _∼_ xs ys) →
Rel _∼_ (x ∷ xs) (y ∷ ys)
So when Agda expects a strict total order associated to _≡_, we instead provided it with a strict total order associated to Rel _ on toList which has no chance of unifying.
How do we move on from here? Well, you could define your own strict total order on strings. Alternatively, you can try to turn the current one into one where _≡_ is the equivalence used. This is what I am going to do in the rest of this post.
So, I want to reuse an IsStrictTotalOrder R O with a different equivalence relation R′. The trick is to notice that if can transport values from R a b to R′ a b then, I should be fine! So I introduce a notion of RawIso A B which states that we can always transport values from A to B and vice-versa:
record RawIso {ℓ : Level} (A B : Set ℓ) : Set ℓ where
field
push : A → B
pull : B → A
open RawIso public
Then we can prove that RawIsos preserve a lot of properties:
RawIso-IsEquivalence :
{ℓ ℓ′ : Level} {A : Set ℓ} {R R′ : Rel A ℓ′} →
(iso : {a b : A} → RawIso (R a b) (R′ a b)) →
IsEquivalence R → IsEquivalence R′
RawIso-IsEquivalence = ...
RawIso-Trichotomous :
{ℓ ℓ′ ℓ′′ : Level} {A : Set ℓ} {R R′ : Rel A ℓ′} {O : Rel A ℓ′′} →
(iso : {a b : A} → RawIso (R a b) (R′ a b)) →
Trichotomous R O → Trichotomous R′ O
RawIso-Trichotomous = ...
RawIso-Respects₂ :
{ℓ ℓ′ ℓ′′ : Level} {A : Set ℓ} {R R′ : Rel A ℓ′} {O : Rel A ℓ′′} →
(iso : {a b : A} → RawIso (R a b) (R′ a b)) →
O Respects₂ R → O Respects₂ R′
RawIso-Respects₂ = ...
All these lemmas can be combined to prove that given a strict total order, we can build a new one via a RawIso:
RawIso-IsStrictTotalOrder :
{ℓ ℓ′ ℓ′′ : Level} {A : Set ℓ} {R R′ : Rel A ℓ′} {O : Rel A ℓ′′} →
(iso : {a b : A} → RawIso (R a b) (R′ a b)) →
IsStrictTotalOrder R O → IsStrictTotalOrder R′ O
RawIso-IsStrictTotalOrder = ...
Now that we know we can transport strict total orders along these RawIsos, we simply need to prove that the equivalence relation used by the strict total order defined in Data.String is in RawIso with propositional equality. It's (almost) simply a matter of unfolding the definitions. The only problem is that equality on characters is defined by first converting them to natural numbers and then using propositional equality. But the toNat function used has no stated property (compare e.g. to toList and fromList which are stated to be inverses)! I threw in this hack and I think it should be fine but if someone has a better solution, I'd love to know it!
toNat-injective : {c d : Char} → toNat c ≡ toNat d → c ≡ d
toNat-injective {c} pr with toNat c
toNat-injective refl | ._ = trustMe -- probably unsafe
where open import Relation.Binary.PropositionalEquality.TrustMe
Anyway, now that you have this you can unfold the definitions and prove:
rawIso : {a b : String} →
RawIso ((Ptwise.Rel (_≡_ on toNat) on toList) a b) (a ≡ b)
rawIso {a} {b} = record { push = `push ; pull = `pull } where
`push : {a b : String} → (Ptwise.Rel (_≡_ on toNat) on toList) a b → a ≡ b
`push {a} {b} pr =
begin
a ≡⟨ sym (fromList∘toList a) ⟩
fromList (toList a) ≡⟨ cong fromList (aux pr) ⟩
fromList (toList b) ≡⟨ fromList∘toList b ⟩
b
∎ where
aux : {xs ys : List Char} → Ptwise.Rel (_≡_ on toNat) xs ys → xs ≡ ys
aux = Ptwise.rec (λ {xs} {ys} _ → xs ≡ ys)
(cong₂ _∷_ ∘ toNat-injective) refl
`pull : {a b : String} → a ≡ b → (Ptwise.Rel (_≡_ on toNat) on toList) a b
`pull refl = Ptwise.refl refl
Which allows you to
stringSTO : IsStrictTotalOrder _ _
stringSTO = StrictTotalOrder.isStrictTotalOrder String.strictTotalOrder
open Data.AVL.Sets (RawIso-IsStrictTotalOrder rawIso stringSTO)
Phew!
I have uploaded a raw gist so that you can easily access the code, see the imports, etc.

Problems with a conductive proof

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))

Resources