I would like to define an equality on CoList (Maybe Nat)s that only takes the justs into account. Of course, I can't just go from CoList (Maybe A) to CoList A, because that wouldn't necessarily be productive.
My question, then, is how could I define such an equivalence relation (with no eye towards decideability)? Does it help, if I can regard infinite just tails as non-equivalent?
@gallais, below, suggests I should be able to naïvely define this relation:
open import Data.Colist
open import Data.Maybe
open import Coinduction
open import Relation.Binary
module _ where
infix 4 _∼_
data _∼_ {A : Set} : Colist (Maybe A) → Colist (Maybe A) → Set where
end : [] ∼ []
nothingˡ : ∀ {xs ys} → ∞ (♭ xs ∼ ys) → nothing ∷ xs ∼ ys
nothingʳ : ∀ {xs ys} → ∞ (xs ∼ ♭ ys) → xs ∼ nothing ∷ ys
justs : ∀ {x xs ys} → ∞ (♭ xs ∼ ♭ ys) → just x ∷ xs ∼ just x ∷ ys
but proving it's transitive gets into (expected) problems from the termination checker:
refl : ∀ {A} → Reflexive (_∼_ {A})
refl {A} {[]} = end
refl {A} {just x ∷ xs} = justs (♯ refl)
refl {A} {nothing ∷ xs} = nothingˡ (♯ nothingʳ (♯ refl)) -- note how I could have defined this the other way round as well...
drop-nothingˡ : ∀ {A xs} {ys : Colist (Maybe A)} → nothing ∷ xs ∼ ys → ♭ xs ∼ ys
drop-nothingˡ (nothingˡ x) = ♭ x
drop-nothingˡ (nothingʳ x) = nothingʳ (♯ drop-nothingˡ (♭ x))
trans : ∀ {A} → Transitive (_∼_ {A})
trans end end = end
trans end (nothingʳ e2) = nothingʳ e2
trans (nothingˡ e1) e2 = nothingˡ (♯ trans (♭ e1) e2)
trans (nothingʳ e1) (nothingˡ e2) = trans (♭ e1) (♭ e2) -- This is where the problem is
trans (nothingʳ e1) (nothingʳ e2) = nothingʳ (♯ trans (♭ e1) (drop-nothingˡ (♭ e2)))
trans (justs e1) (nothingʳ e2) = nothingʳ (♯ trans (justs e1) (♭ e2))
trans (justs e1) (justs e2) = justs (♯ (trans (♭ e1) (♭ e2)))
So I tried making the case where both sides are nothing less ambiguous (like how @Vitus suggested):
module _ where
infix 4 _∼_
data _∼_ {A : Set} : Colist (Maybe A) → Colist (Maybe A) → Set where
end : [] ∼ []
nothings : ∀ {xs ys} → ∞ (♭ xs ∼ ♭ ys) → nothing ∷ xs ∼ nothing ∷ ys
nothingˡ : ∀ {xs y ys} → ∞ (♭ xs ∼ just y ∷ ys) → nothing ∷ xs ∼ just y ∷ ys
nothingʳ : ∀ {x xs ys} → ∞ (just x ∷ xs ∼ ♭ ys) → just x ∷ xs ∼ nothing ∷ ys
justs : ∀ {x xs ys} → ∞ (♭ xs ∼ ♭ ys) → just x ∷ xs ∼ just x ∷ ys
refl : ∀ {A} → Reflexive (_∼_ {A})
refl {A} {[]} = end
refl {A} {just x ∷ xs} = justs (♯ refl)
refl {A} {nothing ∷ xs} = nothings (♯ refl)
sym : ∀ {A} → Symmetric (_∼_ {A})
sym end = end
sym (nothings xs∼ys) = nothings (♯ sym (♭ xs∼ys))
sym (nothingˡ xs∼ys) = nothingʳ (♯ sym (♭ xs∼ys))
sym (nothingʳ xs∼ys) = nothingˡ (♯ sym (♭ xs∼ys))
sym (justs xs∼ys) = justs (♯ sym (♭ xs∼ys))
trans : ∀ {A} → Transitive (_∼_ {A})
trans end ys∼zs = ys∼zs
trans (nothings xs∼ys) (nothings ys∼zs) = nothings (♯ trans (♭ xs∼ys) (♭ ys∼zs))
trans (nothings xs∼ys) (nothingˡ ys∼zs) = nothingˡ (♯ trans (♭ xs∼ys) (♭ ys∼zs))
trans (nothingˡ xs∼ys) (nothingʳ ys∼zs) = nothings (♯ trans (♭ xs∼ys) (♭ ys∼zs))
trans (nothingˡ xs∼ys) (justs ys∼zs) = nothingˡ (♯ trans (♭ xs∼ys) (justs ys∼zs))
trans (nothingʳ xs∼ys) (nothings ys∼zs) = nothingʳ (♯ trans (♭ xs∼ys) (♭ ys∼zs))
trans {A} {just x ∷ xs} {nothing ∷ ys} {just z ∷ zs} (nothingʳ xs∼ys) (nothingˡ ys∼zs) = ?
trans (justs xs∼ys) (nothingʳ ys∼zs) = nothingʳ (♯ trans (justs xs∼ys) (♭ ys∼zs))
trans (justs xs∼ys) (justs ys∼zs) = justs (♯ trans (♭ xs∼ys) (♭ ys∼zs))
but now I don't know how to define the problematic case of trans (the one where I left a hole)
After much deliberation and spam in the comments section of the question (and procrastinating updating my local Agda to a version that has a real termination checker), I came up with this:
module Subcolist where
open import Data.Colist
open import Data.Maybe
open import Coinduction
open import Relation.Binary
module _ {a} {A : Set a} where
infix 4 _∼_
data _∼_ : Colist (Maybe A) → Colist (Maybe A) → Set a where
end : [] ∼ []
nothings : ∀ { xs ys} (r : ∞ (♭ xs ∼ ♭ ys)) → nothing ∷ xs ∼ nothing ∷ ys
nothingˡ : ∀ { xs ys} (r : (♭ xs ∼ ys)) → nothing ∷ xs ∼ ys
nothingʳ : ∀ { xs ys} (r : ( xs ∼ ♭ ys)) → xs ∼ nothing ∷ ys
justs : ∀ {x xs ys} (r : ∞ (♭ xs ∼ ♭ ys)) → just x ∷ xs ∼ just x ∷ ys
refl : Reflexive _∼_
refl {[]} = end
refl {just x ∷ xs} = justs (♯ refl)
refl {nothing ∷ xs} = nothings (♯ refl)
sym : Symmetric _∼_
sym end = end
sym (nothings xs∼ys) = nothings (♯ sym (♭ xs∼ys))
sym (nothingˡ xs∼ys) = nothingʳ (sym xs∼ys)
sym (nothingʳ xs∼ys) = nothingˡ (sym xs∼ys)
sym (justs xs∼ys) = justs (♯ sym (♭ xs∼ys))
drop-nothingˡ : ∀ {xs} {ys : Colist (Maybe A)} → nothing ∷ xs ∼ ys → ♭ xs ∼ ys
drop-nothingˡ (nothings r) = nothingʳ (♭ r)
drop-nothingˡ (nothingˡ r) = r
drop-nothingˡ (nothingʳ r) = nothingʳ (drop-nothingˡ r)
drop-nothingʳ : ∀ {xs : Colist (Maybe A)} {ys} → xs ∼ nothing ∷ ys → xs ∼ ♭ ys
drop-nothingʳ (nothings r) = nothingˡ (♭ r)
drop-nothingʳ (nothingˡ r) = nothingˡ (drop-nothingʳ r)
drop-nothingʳ (nothingʳ r) = r
drop-nothings : ∀ {xs ys : ∞ (Colist (Maybe A))} → nothing ∷ xs ∼ nothing ∷ ys → ♭ xs ∼ ♭ ys
drop-nothings (nothings r) = ♭ r
drop-nothings (nothingˡ r) = drop-nothingʳ r
drop-nothings (nothingʳ r) = drop-nothingˡ r
[]-trans : ∀ {xs ys : Colist (Maybe A)} → xs ∼ ys → ys ∼ [] → xs ∼ []
[]-trans xs∼ys end = xs∼ys
[]-trans xs∼ys (nothingˡ ys∼[]) = []-trans (drop-nothingʳ xs∼ys) ys∼[]
mutual
just-trans : ∀ {xs ys zs} {z : A} → xs ∼ ys → ys ∼ just z ∷ zs → xs ∼ just z ∷ zs
just-trans (justs r) (justs r₁) = justs (♯ (trans (♭ r) (♭ r₁)))
just-trans (nothingˡ xs∼ys) ys∼zs = nothingˡ (just-trans xs∼ys ys∼zs)
just-trans xs∼ys (nothingˡ ys∼zs) = just-trans (drop-nothingʳ xs∼ys) ys∼zs
nothing-trans : ∀ {xs ys : Colist (Maybe A)} {zs} → xs ∼ ys → ys ∼ nothing ∷ zs → xs ∼ nothing ∷ zs
nothing-trans (nothings xs∼ys) ys∼zs = nothings (♯ trans (♭ xs∼ys) (drop-nothings ys∼zs))
nothing-trans (nothingˡ xs∼ys) ys∼zs = nothings (♯ (trans xs∼ys (drop-nothingʳ ys∼zs)))
nothing-trans (nothingʳ xs∼ys) ys∼zs = nothing-trans xs∼ys (drop-nothingˡ ys∼zs)
nothing-trans {xs = just x ∷ xs} xs∼ys (nothingʳ ys∼zs) = nothingʳ (trans xs∼ys ys∼zs)
nothing-trans end xs∼ys = xs∼ys
trans : Transitive _∼_
trans {k = []} xs∼ys ys∼zs = []-trans xs∼ys ys∼zs
trans {k = nothing ∷ ks} xs∼ys ys∼zs = nothing-trans xs∼ys ys∼zs
trans {k = just k ∷ ks} xs∼ys ys∼zs = just-trans xs∼ys ys∼zs
equivalence : Setoid a a
equivalence = record
{ _≈_ = _∼_
; isEquivalence = record
{ refl = refl
; sym = sym
; trans = trans
}
}
I use mixed induction-coinduction and I believe it captures the notion you want. I needed to jump through some hoops to get past the termination/productivity checker as the naive version of trans does not pass it, but this seems to work. It was inspired in part by something I learned from Nils Anders Danielsson's implementation of the partiality monad, which has a similar sort of relation definition in there. It's not as complicated as this one, but the work to get Agda to accept it is largely similar. To generalize it slightly, it would seem more friendly to treat this as a setoid transformer and not just assume definitional/propositional equality for the justs case but that's a trivial change.
I did notice that the other two proposals outlaw nothing ∷ nothing ∷ [] ∼ [] which seemed contrary to the original question, so I edited the type to support that again. I think doing so stopped _∼_ from being uniquely inhabited, but fixing that would probably lead to several more constructors in the relation type and that was more effort than seemed worthwhile.
It's worth noting that at the time I'm writing this, Agda has an open bug (#787) in its termination checker that applies to my version. I'm not sure what causes that bug so I can't guarantee my version is entirely sound, but it makes sense to me.