Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Vec.Properties: introduce ≈-cong′ #2424

Draft
wants to merge 7 commits into
base: master
Choose a base branch
from

Conversation

mildsunrise
Copy link
Contributor

@mildsunrise mildsunrise commented Jul 1, 2024

Additions

This PR introduces the ≈-cong′ lemma:

≈-cong′ :  {f-len : ℕ} (f :  {n}  Vec A n  Vec B (f-len n))
          {xs : Vec A m} {ys : Vec A n} .{eq}  xs ≈[ eq ] ys 
          f xs ≈[ cong f-len eq ] f ys
≈-cong′ f {xs = []}     {ys = []}     refl = cast-is-id refl (f [])
≈-cong′ f {xs = x ∷ xs} {ys = y ∷ ys} refl = ≈-cong′ (f ∘ (x ∷_)) refl

This lemma does for ≈[_] what cong does for : given f and xs ≈[ _ ] ys it proves f xs ≈[ _ ] f ys.
More specifically, it proves that any Vec A n → Vec B m function that is polymorphic in n must preserve ≈[_].

Current status

Compare this with the existing ≈-cong lemma (introduced by @shhyou with #2067 along with the reasoning system):

≈-cong :  .{l≡o : l ≡ o} .{m≡n : m ≡ n} {xs : Vec A m} {ys zs} (f : Vec A o  Vec A n) 
         xs ≈[ m≡n ] f (cast l≡o ys)  ys ≈[ l≡o ] zs  xs ≈[ m≡n ] f zs
≈-cong f xs≈fys ys≈zs = trans xs≈fys (cong f ys≈zs)

This lemma works for a non-polymorphic f, but it requires the user to supply proof that f preserves ≈[_].
We already have a handful of these proofs written for some functions:

map-cast : (f : A  B) .(eq : m ≡ n) (xs : Vec A m) 
           map f (cast eq xs) ≡ cast eq (map f xs)
map-cast {n = zero}  f eq []       = refl
map-cast {n = suc _} f eq (x ∷ xs)
  = cong (f x ∷_) (map-cast f (suc-injective eq) xs)

cast-++ˡ :  .(eq : m ≡ o) (xs : Vec A m) {ys : Vec A n} 
           cast (cong (_+ n) eq) (xs ++ ys) ≡ cast eq xs ++ ys
cast-++ˡ {o = zero}  eq []       {ys} = cast-is-id refl (cast eq [] ++ ys)
cast-++ˡ {o = suc o} eq (x ∷ xs) {ys} = cong (x ∷_) (cast-++ˡ (cong pred eq) xs)

cast-++ʳ :  .(eq : n ≡ o) (xs : Vec A m) {ys : Vec A n} 
           cast (cong (m +_) eq) (xs ++ ys) ≡ xs ++ cast eq ys
cast-++ʳ {m = zero}  eq []       {ys} = refl
cast-++ʳ {m = suc m} eq (x ∷ xs) {ys} = cong (x ∷_) (cast-++ʳ eq xs)

cast-∷ʳ :  .(eq : suc n ≡ suc m) x (xs : Vec A n) 
          cast eq (xs ∷ʳ x) ≡ (cast (cong pred eq) xs) ∷ʳ x
cast-∷ʳ {m = zero}  eq x []       = refl
cast-∷ʳ {m = suc m} eq x (y ∷ xs) = cong (y ∷_) (cast-∷ʳ (cong pred eq) x xs)
cast-∷ʳ _ x _ = ≈-cong′ (_∷ʳ x) refl

cast-reverse :  .(eq : m ≡ n)  cast eq ∘ reverse {A = A} {n = m} ≗ reverse ∘ cast eq
cast-reverse {n = zero}  eq []       = refl
cast-reverse {n = suc n} eq (x ∷ xs) = begin
  reverse (x ∷ xs)           ≂⟨ reverse-∷ x xs ⟩
  reverse xs ∷ʳ x            ≈⟨ ≈-cong (_∷ʳ x) (cast-∷ʳ eq x (reverse xs))
                                       (cast-reverse (cong pred eq) xs) ⟩
  reverse (cast _ xs) ∷ʳ x   ≂⟨ reverse-∷ x (cast (cong pred eq) xs) ⟨
  reverse (x ∷ cast _ xs)    ≈⟨⟩
  reverse (cast eq (x ∷ xs)) ∎
  where open CastReasoning

Simplifications

≈-cong′ is used in a similar way, except that it doesn't require manually proving preservation of cast for f.
So, most uses of ≈-cong (including all current ones) can be migrated to ≈-cong′ just by removing the 2nd argument:

-≈-cong (_∷ʳ x) (cast-∷ʳ (cong suc (List.length-reverse xs)) _ _) (fromList-reverse xs)
+≈-cong′ (_∷ʳ x) (fromList-reverse xs)

An extreme example is example4-cong², where we show chaining ≈-cong. This can also be done with ≈-cong′, but there we can further express it as a single ≈-cong′ of the composition, as we tend to do with cong:

-≈-cong reverse (cast-reverse (cong (_+ n) (+-comm 1 m)) ((xs ∷ʳ a) ++ ys))
-        (≈-cong (_++ ys) (cast-++ˡ (+-comm 1 m) (xs ∷ʳ a))
-                (unfold-∷ʳ _ a xs))
+≈-cong′ (reverse ∘ (_++ ys)) (unfold-∷ʳ _ a xs)

And the 'cast preservation' proofs above, should you still need them, are just special cases of ≈-cong′:

map-cast f _ _ = sym (≈-cong′ (map f) refl)
cast-++ˡ _ _ {ys} = ≈-cong′ (_++ ys) refl
cast-++ʳ _ xs = ≈-cong′ (xs ++_) refl
cast-∷ʳ _ x _ = ≈-cong′ (_∷ʳ x) refl
cast-reverse _ _ = ≈-cong′ reverse refl

@mildsunrise
Copy link
Contributor Author

(draft because we still need to figure out a good name for this lemma, and also update the documentation at doc/README/Data/Vec/Relation/Binary/Equality/Cast.agda)

src/Data/Vec/Properties.agda Outdated Show resolved Hide resolved
@shhyou
Copy link
Contributor

shhyou commented Jul 2, 2024

This improvement is awesome! In the long term, it'd be great if it's possible to prioritize this new lemma over the existing ≈-cong, perhaps taking up its name and giving the old one a different name.

src/Data/Vec/Properties.agda Outdated Show resolved Hide resolved
@MatthewDaggitt MatthewDaggitt added this to the v2.2 milestone Jul 4, 2024

open import Level using (Level)
open import Function using (_∘_)
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Maybe use Function.Base?

@@ -369,7 +369,7 @@ lookup∘update′ {i = i} {j} i≢j xs y = lookup∘updateAt′ i j i≢j xs
-- cast

open VecCast public
using (cast-is-id; cast-trans)
using (cast-is-id; cast-trans; ≈-cong′)
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think ≈-cong′ should not be put under public.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
Projects
None yet
Development

Successfully merging this pull request may close these issues.

4 participants