在商数类型上定义非一元函数时,避免使用扩展性假设

时间:2012-05-13 12:52:29

标签: agda

我正在尝试使用多个参数来定义具有多个参数的函数。使用currying,我可以减少在逐点产品setoid上定义函数的问题:

module Foo where

open import Quotient
open import Relation.Binary
open import Relation.Binary.PropositionalEquality as P using (proof-irrelevance)

private
  open import Relation.Binary.Product.Pointwise
  open import Data.Product

  _×-quot_ : ∀ {c ℓ} {S : Setoid c ℓ} → Quotient S → Quotient S → Quotient (S ×-setoid S)
  _×-quot_ {S = S} = rec S (λ x → rec S (λ y → [ x , y ])
                           (λ {y} {y′} y≈y′ → [ refl , y≈y′ ]-cong))
                           (λ {x} {x′} x≈x′ → extensionality (elim _ _ (λ _ → [ x≈x′ , refl ]-cong)
                           (λ _ → proof-irrelevance _ _)))
    where
    open Setoid S
    postulate extensionality : P.Extensionality _ _

我的问题是,有没有办法证明×-quot的健全性而不假设延伸性?

1 个答案:

答案 0 :(得分:4)

您需要扩展性,因为您选择的P的{​​{1}}参数值是函数类型。如果您避免这种情况并使用rec类型代替Quotient,则可以执行此操作:

P

另一种证明方式,通过module Quotients where open import Quotient open import Relation.Binary open import Relation.Binary.PropositionalEquality as P using (proof-irrelevance; _≡_) private open import Relation.Binary.Product.Pointwise open import Data.Product open import Function.Equality map-quot : ∀ {c₁ ℓ₁ c₂ ℓ₂} {A : Setoid c₁ ℓ₁} {B : Setoid c₂ ℓ₂} → A ⟶ B → Quotient A → Quotient B map-quot f = rec _ (λ x → [ f ⟨$⟩ x ]) (λ x≈y → [ cong f x≈y ]-cong) map-quot-cong : ∀ {c₁ ℓ₁ c₂ ℓ₂} {A : Setoid c₁ ℓ₁} {B : Setoid c₂ ℓ₂} → let open Setoid (A ⇨ B) renaming (_≈_ to _≐_) in (f₁ f₂ : A ⟶ B) → (f₁ ≐ f₂) → (x : Quotient A) → map-quot f₁ x ≡ map-quot f₂ x map-quot-cong {A = A} {B = B} f₁ f₂ eq x = elim _ (λ x → map-quot f₁ x ≡ map-quot f₂ x) (λ x' → [ eq (Setoid.refl A) ]-cong) (λ x≈y → proof-irrelevance _ _) x _×-quot₁_ : ∀ {c ℓ} {A B : Setoid c ℓ} → Quotient A → Quotient B → Quotient (A ×-setoid B) _×-quot₁_ {A = A} {B = B} qx qy = rec A (λ x → map-quot (f x) qy) (λ {x} {x′} x≈x′ → map-quot-cong (f x) (f x′) (λ eq → x≈x′ , eq) qy) qx where module A = Setoid A f = λ x → record { _⟨$⟩_ = _,_ x; cong = λ eq → (A.refl , eq) } (我先做了,决定不扔掉):

_<$>_

另一版 infixl 3 _<$>_ _<$>_ : ∀ {c₁ ℓ₁ c₂ ℓ₂} {A : Setoid c₁ ℓ₁} {B : Setoid c₂ ℓ₂} → Quotient (A ⇨ B) → Quotient A → Quotient B _<$>_ {A = A} {B = B} qf qa = rec (A ⇨ B) {P = Quotient B} (λ x → map-quot x qa) (λ {f₁} {f₂} f₁≈f₂ → map-quot-cong f₁ f₂ f₁≈f₂ qa) qf comma0 : ∀ {c ℓ} → ∀ {A B : Setoid c ℓ} → Setoid.Carrier (A ⇨ B ⇨ A ×-setoid B) comma0 {A = A} {B = B} = record { _⟨$⟩_ = λ x → record { _⟨$⟩_ = λ y → x , y ; cong = λ eq → Setoid.refl A , eq } ; cong = λ eqa eqb → eqa , eqb } comma : ∀ {c ℓ} → ∀ {A B : Setoid c ℓ} → Quotient (A ⇨ B ⇨ A ×-setoid B) comma = [ comma0 ] _×-quot₂_ : ∀ {c ℓ} {A B : Setoid c ℓ} → Quotient A → Quotient B → Quotient (A ×-setoid B) a ×-quot₂ b = comma <$> a <$> b ,现在使用_<$>_

join

这里很明显,那里有某种单子。真是个不错的发现! :)