Agda中使用标准库的对/列表的字典排序

时间:2014-06-23 08:57:54

标签: standard-library agda

Agda标准库包含一些模块Relation.Binary.*.(Non)StrictLex(目前仅适用于ProductList)。我们可以使用这些模块轻松地为自然数对(即IsStrictTotalOrder)构建一个实例,例如ℕ × ℕ

open import Data.Nat as ℕ using (ℕ; _<_)
open import Data.Nat.Properties as ℕ
open import Relation.Binary using (module StrictTotalOrder; IsStrictTotalOrder)
open import Relation.Binary.PropositionalEquality using (_≡_)
open import Relation.Binary.Product.StrictLex using (×-Lex; _×-isStrictTotalOrder_)
open import Relation.Binary.Product.Pointwise using (_×-Rel_)

ℕ-isSTO : IsStrictTotalOrder _≡_ _<_
ℕ-isSTO = StrictTotalOrder.isStrictTotalOrder ℕ.strictTotalOrder

ℕ×ℕ-isSTO : IsStrictTotalOrder (_≡_ ×-Rel _≡_) (×-Lex _≡_ _<_ _<_)
ℕ×ℕ-isSTO = ℕ-isSTO ×-isStrictTotalOrder ℕ-isSTO

这使用逐点相等_≡_ ×-Rel _≡_创建实例。在命题相等的情况下,这应该等同于使用只是命题相等。

是否有一种简单的方法可以使用正常的命题相等将上面的实例转换为IsStrictTotalOrder _≡_ (×-Lex _≡_ _<_ _<_)类型的实例?

1 个答案:

答案 0 :(得分:2)

所需的套件不易组装:

open import Data.Product
open import Function using (_∘_; case_of_)
open import Relation.Binary

_⇔₂_ : ∀ {a ℓ₁ ℓ₂} {A : Set a} → Rel A ℓ₁ → Rel A ℓ₂ → Set _
_≈_ ⇔₂ _≈′_ = (∀ {x y} → x ≈ y → x ≈′ y) × (∀ {x y} → x ≈′ y → x ≈ y)

-- I was unable to write this nicely using Data.Product.map... 
-- hence it is moved here to a toplevel where it can pattern-match
-- on the product of proofs
transform-resp : ∀ {a ℓ₁ ℓ₂ ℓ} {A : Set a} {≈ : Rel A ℓ₁} {≈′ : Rel A ℓ₂} {< : Rel A ℓ} →
                 ≈ ⇔₂ ≈′ →
                 < Respects₂ ≈ → < Respects₂ ≈′
transform-resp (to ,  from) = λ { (resp₁ , resp₂) → (resp₁ ∘ from , resp₂ ∘ from) }

transform-isSTO : ∀ {a ℓ₁ ℓ₂ ℓ} {A : Set a} {≈ : Rel A ℓ₁} {≈′ : Rel A ℓ₂} {< : Rel A ℓ} →
                  ≈ ⇔₂ ≈′ →
                  IsStrictTotalOrder ≈ < → IsStrictTotalOrder ≈′ <
transform-isSTO {≈′ = ≈′} {< = <} (to , from) isSTO = record
  { isEquivalence = let open IsEquivalence (IsStrictTotalOrder.isEquivalence isSTO)
                    in record { refl = to refl
                              ; sym = to ∘ sym ∘ from
                              ; trans = λ x y → to (trans (from x) (from y))
                              }
  ; trans = IsStrictTotalOrder.trans isSTO
  ; compare = compare
  ; <-resp-≈ = transform-resp (to , from) (IsStrictTotalOrder.<-resp-≈ isSTO)
  }
  where
    compare : Trichotomous ≈′ <
    compare x y with IsStrictTotalOrder.compare isSTO x y
    compare x y | tri< a ¬b ¬c = tri< a (¬b ∘ from) ¬c
    compare x y | tri≈ ¬a b ¬c = tri≈ ¬a (to b) ¬c
    compare x y | tri> ¬a ¬b c = tri> ¬a (¬b ∘ from) c

然后我们可以用它来解决你原来的问题:

ℕ×ℕ-isSTO′ : IsStrictTotalOrder _≡_ (×-Lex _≡_ _<_ _<_)
ℕ×ℕ-isSTO′ = transform-isSTO (to , from) ℕ×ℕ-isSTO
  where
    open import Function using (_⟨_⟩_)
    open import Relation.Binary.PropositionalEquality

    to : ∀ {a b} {A : Set a} {B : Set b}
         {x x′ : A} {y y′ : B} → (x , y) ⟨ _≡_ ×-Rel _≡_ ⟩ (x′ , y′) → (x , y) ≡ (x′ , y′)
    to (refl , refl) = refl

    from : ∀ {a b} {A : Set a} {B : Set b}
           {x x′ : A} {y y′ : B} → (x , y) ≡ (x′ , y′) → (x , y) ⟨ _≡_ ×-Rel _≡_ ⟩ (x′ , y′)
    from refl = refl , refl