Agda 坚持用异类等式证明

我有一个二进制数表示，加上一些与Nat的转换：

open import Data.Nat
open import Data.Nat.Properties
open import Function
open import Relation.Binary.PropositionalEquality hiding (trans; cong; subst; sym)
open import Relation.Binary.HeterogeneousEquality
open import Data.Unit
open import Algebra
module CS = CommutativeSemiring commutativeSemiring 

data Bin : ℕ → Set where
  zero  : Bin zero
  2*n   : ∀ {n} → Bin n → Bin (n + n)
  2*n+1 : ∀ {n} → Bin n → Bin (suc (n + n))

suc-lem : ∀ n → suc (suc (n + n)) ≡ suc n + suc n
suc-lem zero = refl
suc-lem (suc n) rewrite 
    CS.+-comm n (suc n)
  | suc-lem n | CS.+-comm n (suc (suc n)) 
  | CS.+-comm n (suc n) = refl

inc : ∀ {n} → Bin n → Bin (suc n)
inc zero = 2*n+1 zero
inc (2*n b) = 2*n+1 b
inc (2*n+1 {n} b) rewrite suc-lem n = 2*n (inc b)

nat2bin : (n : ℕ) → Bin n
nat2bin zero = zero
nat2bin (suc n) = inc (nat2bin n)

bin2nat : ∀ {n} → Bin n → ℕ
bin2nat {n} b = n

我想我需要异质性等式来证明这一点，因为两个Bin-s的Nat指数是否相等通常并不明显。我在Agda方面相当缺乏经验，所以请告诉我这种方法是否被误导了

我被以下几点困住了：

lem : ∀ n → 2*n+1 (inc (nat2bin n)) ≅ inc (inc (2*n+1 (nat2bin n)))
lem zero = refl
lem (suc n) = 
  subst
    (λ b → 2*n+1 (inc (inc (nat2bin n))) ≅ inc (inc b))
    (sym $ lem ?) ? 

显然，将

n

插入

sym$lem？

，会导致一个错误，抱怨

suc（n+n）！=n+suc n

---

我想知道为什么会发生这种情况，或者如何帮助它

事实证明，这个问题与类似，只是这里内射类型构造函数没有帮助

通常，当等式两侧的两种类型明显相等时，您可以使用

subst

实现异构等式：

hsubst :
  {A    : Set}
  (P    : A → Set)
  {x x' : A}
  → x ≅ x'
  → P x
  → P x' 
hsubst P refl p = p 

这个

hsubst

与命题等式的

subst

几乎相同，只是等式的类型不同。因为我们需要知道

x

和

x'

的类型是相等的，所以我们可以将我们的异构等式证明转换为普通的等式证明，然后使用常规的

subst

然而，OP（即me）试图使用两边都有索引类型的等式进行替换，并且索引是否相等并不明显。解决方案是通过索引参数化

hsubst

，并要求对索引进行额外的等式证明：

hsubst-ix1 : 
    {I    : Set}
    (C    : I → Set)  
    (P    : ∀ {i} → C i → Set)
    {i i' : I}
    {x    : C i}
    {x'   : C i'}
    → i ≡ i'
    → x ≅ x'
    → P x
    → P x'
hsubst-ix1 C P refl refl p = p

我做了一些实验，以找出哪些参数可以留待推断，结果如上所示。下面是一个人为的例子：

open import Relation.Binary.HeterogeneousEquality hiding (cong)
open import Relation.Binary.PropositionalEquality
open import Data.Nat
open import Data.Fin hiding (_+_)
open import Algebra
open import Data.Nat.Properties
module ℕplus = CommutativeSemiring commutativeSemiring

contrived-example : 
  ∀ n
  → (f : Fin (n + suc n)) 
  → (fromℕ (n + suc n) ≅ fromℕ (suc n + n))
  → (f ≅ fromℕ (n + suc n))
  → (f ≅ fromℕ (suc n + n)) 
contrived-example n f eq p =
  hsubst-ix1
    -- the type constructor to be indexed
    Fin
    -- substitution
    (λ f' → f ≅ f')
    -- proof that the indices are equal
    (cong suc (ℕplus.+-comm n (suc n)))
    -- heterogeneous equality
    eq
    -- original expression
    p

进口：

open import Level hiding (zero; suc)
open import Function
open import Relation.Binary.HeterogeneousEquality
  renaming (sym to hsym; trans to htrans; cong to hcong; subst to hsubst)
open import Relation.Binary.PropositionalEquality
open import Data.Nat
open import Data.Fin hiding (_+_)
open import Algebra
open import Data.Nat.Properties
module ℕplus = CommutativeSemiring commutativeSemiring

我对您的

inc

进行了一些重新安排，以简化工作：

inc : ∀ {n} → Bin n → Bin (suc n)
inc zero = 2*n+1 zero
inc (2*n b) = 2*n+1 b
inc (2*n+1 {n} b) = subst (Bin ∘ suc) (ℕplus.+-comm n (suc n)) (2*n (inc b))

引理：

lem : ∀ n → 2*n+1 (inc (nat2bin n)) ≅ inc (inc (2*n+1 (nat2bin n)))
lem zero = refl
lem (suc n) = {!!}

孔的类型为

2*n+1 (inc (inc (nat2bin n))) ≅
      inc
      (subst ((λ {.x} → Bin) ∘ suc) (ℕplus.+-comm (suc n) (suc (suc n)))
       (2*n (inc (inc (nat2bin n)))))

因此，我们需要从standart库中移除类似subst的内容：

≡-subst-removable : ∀ {a p} {A : Set a}
                    (P : A → Set p) {x y} (eq : x ≡ y) z →
                    P.subst P eq z ≅ z
≡-subst-removable P refl z = refl

类型

hsym $
  ≡-subst-removable
    (Bin ∘ suc)
    (ℕplus.+-comm (suc n) (suc (suc n)))
    (2*n $ inc $ inc $ nat2bin n)

是

几乎是我们所需要的。现在我们想添加hcong inc，但编译器拒绝了它。 下面是

cong

的实现：

cong : ∀ {a b} {A : Set a} {B : A → Set b} {x y}
       (f : (x : A) → B x) → x ≅ y → f x ≅ f y
cong f refl = refl

≡-cong-subst-removable : {α β γ : Level} {I : Set α} {i j : I}
                       -> (A : I -> Set β) {B : {k : I} -> A k -> Set γ}
                       -> (e : i ≡ j)
                       -> (x : A i)
                       -> (f : {k : I} -> (x : A k) -> B x)
                       -> f (subst A e x) ≅ f x
≡-cong-subst-removable _ refl _ _ = refl

lem' : ∀ n → 2*n+1 (inc (nat2bin n)) ≅ inc (inc (2*n+1 (nat2bin n)))
lem' zero = refl
lem' (suc n) = hsym $
  ≡-cong-subst-removable
    (Bin ∘ suc)
    (ℕplus.+-comm (suc n) (suc (suc n)))
    (2*n $ inc $ inc $ nat2bin n)
    inc

因此

x

和

y

必须是同一类型

A

，而我们的

subst

会更改类型。 下面是我们需要的

hcong

的实现：

hcong' : {α β γ : Level} {I : Set α} {i j : I}
       -> (A : I -> Set β) {B : {k : I} -> A k -> Set γ} {x : A i} {y : A j}
       -> i ≡ j
       -> (f : {k : I} -> (x : A k) -> B x)
       -> x ≅ y
       -> f x ≅ f y
hcong' _ refl _ refl = refl

最后的证据是：

lem : ∀ n → 2*n+1 (inc (nat2bin n)) ≅ inc (inc (2*n+1 (nat2bin n)))
lem zero = refl
lem (suc n) =
  hcong'
    (Bin ∘ suc)
    (ℕplus.+-comm (suc n) (suc (suc n)))
    inc
    $ hsym
      $ ≡-subst-removable
          (Bin ∘ suc)
          (ℕplus.+-comm (suc n) (suc (suc n)))
          (2*n $ inc $ inc $ nat2bin n)

此外，我们还可以合并

subst-removable

和

cong

：

cong : ∀ {a b} {A : Set a} {B : A → Set b} {x y}
       (f : (x : A) → B x) → x ≅ y → f x ≅ f y
cong f refl = refl

≡-cong-subst-removable : {α β γ : Level} {I : Set α} {i j : I}
                       -> (A : I -> Set β) {B : {k : I} -> A k -> Set γ}
                       -> (e : i ≡ j)
                       -> (x : A i)
                       -> (f : {k : I} -> (x : A k) -> B x)
                       -> f (subst A e x) ≅ f x
≡-cong-subst-removable _ refl _ _ = refl

lem' : ∀ n → 2*n+1 (inc (nat2bin n)) ≅ inc (inc (2*n+1 (nat2bin n)))
lem' zero = refl
lem' (suc n) = hsym $
  ≡-cong-subst-removable
    (Bin ∘ suc)
    (ℕplus.+-comm (suc n) (suc (suc n)))
    (2*n $ inc $ inc $ nat2bin n)
    inc

顺便说一句，皮尔斯的意思是这个数据类型，我想：

data Bin : Set where
  zero  : Bin
  2*n   : Bin → Bin
  2*n+1 : Bin → Bin

顺便说一句，不需要额外的定义，就可以证明你设计的例子：

contrived-example : {n : ℕ} {f : Fin (n + suc n)}
                  -> f ≅ fromℕ (n + suc n)
                  -> f ≅ fromℕ (suc n + n)
contrived-example {n} eq = htrans eq $ hcong fromℕ $ ≡-to-≅ $ ℕplus.+-comm n (suc n)

BTW3，hsubst-ix1可以减少很多，因为您使用异构相等，并且不需要证明类型相等：

hsubst' : {C1 C2 : Set} {x : C1} {y : C2}
        -> (P : {C : Set} -> C -> Set)
        -> x ≅ y
        -> P x
        -> P y
hsubst' _ refl x = x

contrived-example' : 
  ∀ n
  → (f : Fin (n + suc n)) 
  → (fromℕ (n + suc n) ≅ fromℕ (suc n + n))
  → (f ≅ fromℕ (n + suc n))
  → (f ≅ fromℕ (suc n + n)) 
contrived-example' n f eq p = hsubst' (λ f' → f ≅ f') eq p

---

我想知道如何使用标准库中的

Bin

数据类型，而不是说

data.Bin.Bin

。还有，为什么它允许无限多个

零的表示？也许你想要
2*n:∀ {n}→ 垃圾箱（suc n）→ Bin（suc n+suc n）
？@Helmut我从《软件基础》一书中复制了（某种程度上）数据类型。它有无限多个零，因此我们可以练习证明关于规范化掉不必要的构造函数的东西。这正是我寻找的那种专家答案。此外，我还可以看出，根据
subst
定义
inc
是多么有用，但是我很好奇如何用我原来的
rewrite
对
inc
的定义来证明
lem
。不一定是原来的定义，因为我现在看到
suc lem
是不必要的，但例如用
inc（2*n+1{n}b）和2*n$inc b…|重写ℕsr.+-comm n（suc n）=b'
换句话说：我如何撤销
重写
类似于我如何撤销
subst
？这是相关的：但我的代码中的这个机制出了问题：