Skip to content

Some preparatory proofs for proving sorting+permutation is equality #2724 #2725

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

Open
wants to merge 4 commits into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
34 changes: 34 additions & 0 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
Expand Up @@ -235,6 +235,23 @@ Additions to existing modules
∙-cong-∣ : x ∣ y → a ∣ b → x ∙ a ∣ y ∙ b
```

* In `Data.Fin.Base`:
```agda
_≰_ : ∀ {n} → Rel (Fin n) 0ℓ
_≮_ : ∀ {n} → Rel (Fin n) 0ℓ
Comment on lines +240 to +241
Copy link
Contributor

Choose a reason for hiding this comment

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

Can we, by convention, avoid writing the ∀ {n} → prefix here?

```

* In `Data.Fin.Permutation`:
```agda
cast-id : .(m ≡ n) → Permutation m n
swap : Permutation m n → Permutation (suc (suc m)) (suc (suc n))
```

* In `Data.Fin.Properties`:
```agda
cast-involutive : .(eq₁ : m ≡ n) .(eq₂ : n ≡ m) → ∀ k → cast eq₁ (cast eq₂ k) ≡ k
```

* In `Data.Fin.Subset`:
```agda
_⊇_ : Subset n → Subset n → Set
Expand Down Expand Up @@ -266,14 +283,31 @@ Additions to existing modules
map-downFrom : ∀ (f : ℕ → A) n → map f (downFrom n) ≡ applyDownFrom f n
```

* In `Data.List.Relation.Binary.Permutation.Homogeneous`:
```agda
onIndices : Permutation R xs ys → Fin.Permutation (length xs) (length ys)
```

* In `Data.List.Relation.Binary.Permutation.Propositional`:
```agda
↭⇒↭ₛ′ : IsEquivalence _≈_ → _↭_ ⇒ _↭ₛ′_
```

* In `Data.List.Relation.Binary.Permutation.Setoid.Properties`:
```agda
xs↭ys⇒|xs|≡|ys| : xs ↭ ys → length xs ≡ length ys
¬x∷xs↭[] : ¬ (x ∷ xs ↭ [])
toFin-lookup : ∀ i → lookup xs i ≈ lookup ys (Inverse.to (toFin xs↭ys) i)
Copy link
Contributor

@jamesmckinna jamesmckinna Jun 5, 2025

Choose a reason for hiding this comment

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

I think this should be:

Suggested change
toFin-lookup : ∀ i → lookup xs i ≈ lookup ys (Inverse.to (toFin xs↭ys) i)
onIndices-lookup : ∀ i → lookup xs i ≈ lookup ys (Inverse.to (onIndices xs↭ys) i)

and again, do we need the ∀ i → prefix in CHANGELOG?

Copy link
Member

Choose a reason for hiding this comment

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

(explicit arguments should definitely be in the changelog - but does i need to be explicit?)

Copy link
Contributor

Choose a reason for hiding this comment

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

@Taneb I'm surprised to learn that (is it documented?): given that CHANGELOG isn't machine-checked, I use it to get (a sense of) the high-level gist of what's been added, and then look at the module for the exact details of the quantification/parametrisation etc.

As for whether i needs to be explicit in this lemma, I expect so, if only by analogy with (all the) lemmas about lookup in Data.List.Properties...?

```

* In `Data.List.Relation.Binary.Permutation.Propositional.Properties`:
```agda
filter-↭ : ∀ (P? : Pred.Decidable P) → xs ↭ ys → filter P? xs ↭ filter P? ys
```

* In `Data.List.Relation.Binary.Pointwise.Properties`:
```agda
lookup-cast : Pointwise R xs ys → .(∣xs∣≡∣ys∣ : length xs ≡ length ys) → ∀ i → R (lookup xs i) (lookup ys (cast ∣xs∣≡∣ys∣ i))
```

* In `Data.Product.Function.Dependent.Propositional`:
Expand Down
9 changes: 7 additions & 2 deletions src/Data/Fin/Base.agda
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,7 @@ open import Level using (0ℓ)
open import Relation.Binary.Core using (Rel)
open import Relation.Binary.PropositionalEquality.Core using (_≡_; _≢_; refl; cong)
open import Relation.Binary.Indexed.Heterogeneous.Core using (IRel)
open import Relation.Nullary.Negation.Core using (contradiction)
open import Relation.Nullary.Negation.Core using (¬_; contradiction)

private
variable
Expand Down Expand Up @@ -271,7 +271,7 @@ pinch {suc n} (suc i) (suc j) = suc (pinch i j)
------------------------------------------------------------------------
-- Order relations

infix 4 _≤_ _≥_ _<_ _>_
infix 4 _≤_ _≥_ _<_ _>_ _≰_ _≮_

_≤_ : IRel Fin 0ℓ
i ≤ j = toℕ i ℕ.≤ toℕ j
Expand All @@ -285,6 +285,11 @@ i < j = toℕ i ℕ.< toℕ j
_>_ : IRel Fin 0ℓ
i > j = toℕ i ℕ.> toℕ j

_≰_ : ∀ {n} → Rel (Fin n) 0ℓ
i ≰ j = ¬ (i ≤ j)

_≮_ : ∀ {n} → Rel (Fin n) 0ℓ
i ≮ j = ¬ (i < j)
Comment on lines +288 to +292
Copy link
Contributor

@jamesmckinna jamesmckinna Jun 5, 2025

Choose a reason for hiding this comment

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

Should we define these here, or have them created automatically by (defining and then) opening the corresponding bundle(s) in Data.Fin.Properties? cf. #2391 / #2490


------------------------------------------------------------------------
-- An ordering view.
Expand Down
116 changes: 89 additions & 27 deletions src/Data/Fin/Permutation.agda
Original file line number Diff line number Diff line change
Expand Up @@ -9,10 +9,10 @@
module Data.Fin.Permutation where

open import Data.Bool.Base using (true; false)
open import Data.Fin.Base using (Fin; suc; opposite; punchIn; punchOut)
open import Data.Fin.Patterns using (0F)
open import Data.Fin.Base using (Fin; suc; cast; opposite; punchIn; punchOut)
open import Data.Fin.Patterns using (0F; 1F)
open import Data.Fin.Properties using (punchInᵢ≢i; punchOut-punchIn;
punchOut-cong; punchOut-cong′; punchIn-punchOut; _≟_; ¬Fin0)
punchOut-cong; punchOut-cong′; punchIn-punchOut; _≟_; ¬Fin0; cast-involutive)
import Data.Fin.Permutation.Components as PC
open import Data.Nat.Base using (ℕ; suc; zero)
open import Data.Product.Base using (_,_; proj₂)
Expand All @@ -22,7 +22,7 @@ open import Function.Construct.Identity using (↔-id)
open import Function.Construct.Symmetry using (↔-sym)
open import Function.Definitions using (StrictlyInverseˡ; StrictlyInverseʳ)
open import Function.Properties.Inverse using (↔⇒↣)
open import Function.Base using (_∘_)
open import Function.Base using (_∘_; _∘′_)
open import Level using (0ℓ)
open import Relation.Binary.Core using (Rel)
open import Relation.Nullary using (does; ¬_; yes; no)
Expand Down Expand Up @@ -57,11 +57,15 @@ Permutation′ n = Permutation n n
------------------------------------------------------------------------
-- Helper functions

permutation : ∀ (f : Fin m → Fin n) (g : Fin n → Fin m) →
StrictlyInverseˡ _≡_ f g → StrictlyInverseʳ _≡_ f g → Permutation m n
permutation : ∀ (f : Fin m → Fin n)
(g : Fin n → Fin m) →
StrictlyInverseˡ _≡_ f g →
StrictlyInverseʳ _≡_ f g →
Permutation m n
permutation = mk↔ₛ′

infixl 5 _⟨$⟩ʳ_ _⟨$⟩ˡ_

_⟨$⟩ʳ_ : Permutation m n → Fin m → Fin n
_⟨$⟩ʳ_ = Inverse.to

Expand All @@ -75,44 +79,61 @@ inverseʳ : ∀ (π : Permutation m n) {i} → π ⟨$⟩ʳ (π ⟨$⟩ˡ i) ≡
inverseʳ π = Inverse.inverseˡ π refl

------------------------------------------------------------------------
-- Equality
-- Equality over permutations

infix 6 _≈_

_≈_ : Rel (Permutation m n) 0ℓ
π ≈ ρ = ∀ i → π ⟨$⟩ʳ i ≡ ρ ⟨$⟩ʳ i

------------------------------------------------------------------------
-- Example permutations

-- Identity
-- Permutation properties

id : Permutation n
id : Permutation n n
id = ↔-id _

-- Transpose two indices

transpose : Fin n → Fin n → Permutation′ n
transpose i j = permutation (PC.transpose i j) (PC.transpose j i) (λ _ → PC.transpose-inverse _ _) (λ _ → PC.transpose-inverse _ _)
flip : Permutation m n → Permutation n m
flip = ↔-sym

-- Reverse the order of indices
infixr 9 _∘ₚ_

reverse : Permutation′ n
reverse = permutation opposite opposite PC.reverse-involutive PC.reverse-involutive
_∘ₚ_ : Permutation m n → Permutation n o → Permutation m o
π₁ ∘ₚ π₂ = π₂ ↔-∘ π₁

------------------------------------------------------------------------
-- Operations
-- Non-trivial identity

-- Composition
cast-id : .(m ≡ n) → Permutation m n
cast-id m≡n = permutation
(cast m≡n)
(cast (sym m≡n))
(cast-involutive m≡n (sym m≡n))
(cast-involutive (sym m≡n) m≡n)

infixr 9 _∘ₚ_
_∘ₚ_ : Permutation m n → Permutation n o → Permutation m o
π₁ ∘ₚ π₂ = π₂ ↔-∘ π₁
------------------------------------------------------------------------
-- Transposition

-- Flip
-- Transposes two elements in the permutation, keeping the remainder
-- of the permutation the same
transpose : Fin n → Fin n → Permutation n n
transpose i j = permutation
(PC.transpose i j)
(PC.transpose j i)
(λ _ → PC.transpose-inverse _ _)
(λ _ → PC.transpose-inverse _ _)

flip : Permutation m n → Permutation n m
flip = ↔-sym
------------------------------------------------------------------------
-- Reverse

-- Reverses a permutation
reverse : Permutation n n
reverse = permutation
opposite
opposite
PC.reverse-involutive
PC.reverse-involutive

------------------------------------------------------------------------
-- Element removal
--
-- `remove k [0 ↦ i₀, …, k ↦ iₖ, …, n ↦ iₙ]` yields
Expand Down Expand Up @@ -159,8 +180,14 @@ remove {m} {n} i π = permutation to from inverseˡ′ inverseʳ′
punchOut {i = πʳ i} {punchIn (πʳ i) j} _ ≡⟨ punchOut-punchIn (πʳ i) ⟩
j ∎

-- lift: takes a permutation m → n and creates a permutation (suc m) → (suc n)
------------------------------------------------------------------------
-- Lifting

-- Takes a permutation m → n and creates a permutation (suc m) → (suc n)
-- by mapping 0 to 0 and applying the input permutation to everything else
--
-- Note: should be refactored as a special-case when we add the
-- concatenation of two permutations
lift₀ : Permutation m n → Permutation (suc m) (suc n)
lift₀ {m} {n} π = permutation to from inverseˡ′ inverseʳ′
where
Expand All @@ -180,6 +207,9 @@ lift₀ {m} {n} π = permutation to from inverseˡ′ inverseʳ′
inverseˡ′ 0F = refl
inverseˡ′ (suc j) = cong suc (inverseʳ π)

------------------------------------------------------------------------
-- Insertion

-- insert i j π is the permutation that maps i to j and otherwise looks like π
-- it's roughly an inverse of remove
insert : ∀ {m n} → Fin (suc m) → Fin (suc n) → Permutation m n → Permutation (suc m) (suc n)
Expand Down Expand Up @@ -221,6 +251,38 @@ insert {m} {n} i j π = permutation to from inverseˡ′ inverseʳ′
punchIn j (punchOut j≢k) ≡⟨ punchIn-punchOut j≢k ⟩
k ∎

------------------------------------------------------------------------
-- Swapping

-- Takes a permutation m → n and creates a permutation
-- suc (suc m) → suc (suc n) by mapping 0 to 1 and 1 to 0 and
-- then applying the input permutation to everything else
--
-- Note: should be refactored as a special-case when we add the
-- concatenation of two permutations
swap : Permutation m n → Permutation (suc (suc m)) (suc (suc n))
Copy link
Contributor

Choose a reason for hiding this comment

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

This is a special case of \oplus of two permutations.

Copy link
Contributor Author

Choose a reason for hiding this comment

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

I agree (lift0 should be as well!), but we don't have such an operation in the library. I have added a note that we should refactor it when we add that operator.

Copy link
Contributor

Choose a reason for hiding this comment

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

I have it buried in my Rig Categories repo. I need to port the basic operations on permutations over. I've got the full semiring defined there.

Copy link
Contributor

Choose a reason for hiding this comment

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

But also: Function.Related.TypeIsomorphisms etc. as per #2489 ?

Copy link
Contributor

Choose a reason for hiding this comment

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

Plus, of course: we only need this operation because Permutation.Setoid stipulates swap as a constructor... ;-)

Copy link
Contributor

Choose a reason for hiding this comment

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

Yes, absolutely, there is some great stuff in Function.Related.TypeIsomorphism. And a rather apt 'of course'.

swap {m} {n} π = permutation to from inverseˡ′ inverseʳ′
Copy link
Contributor

@jamesmckinna jamesmckinna Jun 6, 2025

Choose a reason for hiding this comment

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

Is this definition easier to describe/define indirectly, via the composition of

  • eval ((0F , 1F) ∷ (1F , 0F)) using Data.Fin.Permutation.Transposition.List
  • lift₀ {suc m} {suc n} (lift₀ {m} {n} π)

or indeed (more) directly, as transpose 0F 1F ∘ₚ lift₀ {suc m} {suc n} (lift₀ {m} {n} π)?

where
to : Fin (suc (suc m)) → Fin (suc (suc n))
to 0F = 1F
to 1F = 0F
to (suc (suc i)) = suc (suc (π ⟨$⟩ʳ i))

from : Fin (suc (suc n)) → Fin (suc (suc m))
from 0F = 1F
from 1F = 0F
from (suc (suc i)) = suc (suc (π ⟨$⟩ˡ i))

inverseʳ′ : StrictlyInverseʳ _≡_ to from
inverseʳ′ 0F = refl
inverseʳ′ 1F = refl
inverseʳ′ (suc (suc j)) = cong (suc ∘′ suc) (inverseˡ π)

inverseˡ′ : StrictlyInverseˡ _≡_ to from
inverseˡ′ 0F = refl
inverseˡ′ 1F = refl
inverseˡ′ (suc (suc j)) = cong (suc ∘′ suc) (inverseʳ π)

------------------------------------------------------------------------
-- Other properties

Expand Down
4 changes: 4 additions & 0 deletions src/Data/Fin/Properties.agda
Original file line number Diff line number Diff line change
Expand Up @@ -279,6 +279,10 @@ cast-trans {m = suc _} {n = suc _} {o = suc _} eq₁ eq₂ zero = refl
cast-trans {m = suc _} {n = suc _} {o = suc _} eq₁ eq₂ (suc k) =
cong suc (cast-trans (ℕ.suc-injective eq₁) (ℕ.suc-injective eq₂) k)

cast-involutive : .(eq₁ : m ≡ n) .(eq₂ : n ≡ m) →
∀ k → cast eq₁ (cast eq₂ k) ≡ k
cast-involutive eq₁ eq₂ k = trans (cast-trans eq₂ eq₁ k) (cast-is-id refl k)

------------------------------------------------------------------------
-- Properties of _≤_
------------------------------------------------------------------------
Expand Down
50 changes: 28 additions & 22 deletions src/Data/List/Relation/Binary/Permutation/Homogeneous.agda
Original file line number Diff line number Diff line change
Expand Up @@ -8,12 +8,15 @@

module Data.List.Relation.Binary.Permutation.Homogeneous where

open import Data.List.Base using (List; _∷_)
open import Data.List.Base using (List; _∷_; length)
open import Data.List.Relation.Binary.Pointwise.Base as Pointwise
using (Pointwise)
import Data.List.Relation.Binary.Pointwise.Properties as Pointwise
open import Data.Nat.Base using (ℕ; suc; _+_)
open import Data.Fin.Base using (Fin; zero; suc; cast)
import Data.Fin.Permutation as Fin
open import Level using (Level; _⊔_)
open import Function.Base using (_∘_)
open import Relation.Binary.Core using (Rel; _⇒_)
open import Relation.Binary.Bundles using (Setoid)
open import Relation.Binary.Structures using (IsEquivalence)
Expand All @@ -23,6 +26,7 @@ private
variable
a r s : Level
A : Set a
R S : Rel A r

data Permutation {A : Set a} (R : Rel A r) : Rel (List A) (a ⊔ r) where
refl : ∀ {xs ys} → Pointwise R xs ys → Permutation R xs ys
Expand All @@ -33,37 +37,39 @@ data Permutation {A : Set a} (R : Rel A r) : Rel (List A) (a ⊔ r) where
------------------------------------------------------------------------
-- The Permutation relation is an equivalence

module _ {R : Rel A r} where
sym : Symmetric R → Symmetric (Permutation R)
sym R-sym (refl xs∼ys) = refl (Pointwise.symmetric R-sym xs∼ys)
sym R-sym (prep x∼x′ xs↭ys) = prep (R-sym x∼x′) (sym R-sym xs↭ys)
sym R-sym (swap x∼x′ y∼y′ xs↭ys) = swap (R-sym y∼y′) (R-sym x∼x′) (sym R-sym xs↭ys)
sym R-sym (trans xs↭ys ys↭zs) = trans (sym R-sym ys↭zs) (sym R-sym xs↭ys)

sym : Symmetric R → Symmetric (Permutation R)
sym R-sym (refl xs∼ys) = refl (Pointwise.symmetric R-sym xs∼ys)
sym R-sym (prep x∼x′ xs↭ys) = prep (R-sym x∼x′) (sym R-sym xs↭ys)
sym R-sym (swap x∼x′ y∼y′ xs↭ys) = swap (R-sym y∼y′) (R-sym x∼x′) (sym R-sym xs↭ys)
sym R-sym (trans xs↭ys ys↭zs) = trans (sym R-sym ys↭zs) (sym R-sym xs↭ys)
isEquivalence : Reflexive R → Symmetric R → IsEquivalence (Permutation R)
isEquivalence R-refl R-sym = record
{ refl = refl (Pointwise.refl R-refl)
; sym = sym R-sym
; trans = trans
}

isEquivalence : Reflexive R → Symmetric R → IsEquivalence (Permutation R)
isEquivalence R-refl R-sym = record
{ refl = refl (Pointwise.refl R-refl)
; sym = sym R-sym
; trans = trans
}
setoid : Reflexive R → Symmetric R → Setoid _ _
setoid {R = R} R-refl R-sym = record
{ isEquivalence = isEquivalence {R = R} R-refl R-sym
}

setoid : Reflexive R → Symmetric R → Setoid _ _
setoid R-refl R-sym = record
{ isEquivalence = isEquivalence R-refl R-sym
}

map : ∀ {R : Rel A r} {S : Rel A s} →
(R ⇒ S) → (Permutation R ⇒ Permutation S)
map : (R ⇒ S) → (Permutation R ⇒ Permutation S)
map R⇒S (refl xs∼ys) = refl (Pointwise.map R⇒S xs∼ys)
map R⇒S (prep e xs∼ys) = prep (R⇒S e) (map R⇒S xs∼ys)
map R⇒S (swap e₁ e₂ xs∼ys) = swap (R⇒S e₁) (R⇒S e₂) (map R⇒S xs∼ys)
map R⇒S (trans xs∼ys ys∼zs) = trans (map R⇒S xs∼ys) (map R⇒S ys∼zs)

-- Measures the number of constructors, can be useful for termination proofs

steps : ∀ {R : Rel A r} {xs ys} → Permutation R xs ys → ℕ
steps : ∀ {xs ys} → Permutation R xs ys → ℕ
steps (refl _) = 1
steps (prep _ xs↭ys) = suc (steps xs↭ys)
steps (swap _ _ xs↭ys) = suc (steps xs↭ys)
steps (trans xs↭ys ys↭zs) = steps xs↭ys + steps ys↭zs

onIndices : ∀ {xs ys} → Permutation R xs ys → Fin.Permutation (length xs) (length ys)
onIndices (refl ≋) = Fin.cast-id (Pointwise.Pointwise-length ≋)
onIndices (prep e xs↭ys) = Fin.lift₀ (onIndices xs↭ys)
onIndices (swap e f xs↭ys) = Fin.swap (onIndices xs↭ys)
onIndices (trans ↭₁ ↭₂) = onIndices ↭₁ Fin.∘ₚ onIndices ↭₂
2 changes: 1 addition & 1 deletion src/Data/List/Relation/Binary/Permutation/Setoid.agda
Original file line number Diff line number Diff line change
Expand Up @@ -31,7 +31,7 @@ open ≋ S using (_≋_; _∷_; ≋-refl; ≋-sym; ≋-trans)
-- Definition, based on `Homogeneous`

open Homogeneous public
using (refl; prep; swap; trans)
using (refl; prep; swap; trans; onIndices)

infix 3 _↭_

Expand Down
Loading