建立一个prod的sigma和不相交的和之间的同构

时间:2017-08-07 07:31:35

标签: coq coq-tactic

我根据不相交和的定义定义了一个Boole归纳类型:

Inductive Boole :=
  | inlb (a: unit)
  | inrb (b: unit).

鉴于两种类型AB我试图证明

之间的同态
sigT (fun x: Boole => prod ((eq x (inrb tt)) -> A) (eq x (inlb tt) -> B))

A + B

我设法证明了同构的一面

Definition sum_to_sigT {A} {B} (z: A + B) :
  sigT (fun x: Boole => prod ((eq x (inrb tt)) -> A) (eq x (inlb tt) -> B)).
Proof.
case z.
  move=> a.
  exists (inrb tt).
  rewrite //=.
move=> b.
  exists (inlb tt).
  rewrite //=.
Defined.

Lemma eq_inla_inltt (a: unit) : eq (inlb a) (inlb tt).
Proof.
by case a.
Qed.

Lemma eq_inra_inrtt (a: unit) : eq (inrb a) (inrb tt).
Proof.
by case a.
Qed.

Definition sigT_to_sum {A} {B} 
  (w: sigT (fun x: Boole => prod ((eq x (inrb tt)) -> A) (eq x (inlb tt) -> B))) :
  A + B.
Proof.
destruct w.
destruct p.
destruct x.
apply (inr (b (eq_inla_inltt a0))).
apply (inl (a (eq_inra_inrtt b0))).
Defined.

Definition eq_sum_sigT {A} {B} (x: A + B): 
  eq x (sigT_to_sum (sum_to_sigT x)).
Proof.
by case x.
Defined.

但是我在证明对方方面遇到了麻烦,主要是因为我没有设法在以下证明中涉及的不同xp之间建立平等:

Definition eq_sigT_sum {A} {B} 
  (y: sigT (fun x: Boole => prod ((eq x (inrb tt)) -> A) (eq x (inlb tt) -> B))) : eq y (sum_to_sigT (sigT_to_sum y)).
Proof.
case: (sum_to_sigT (sigT_to_sum y)).
  move=> x p.
  destruct y.
  destruct x.
  destruct p.
Defined.

有谁知道我怎么能证明后一个引理?

感谢您的帮助。

1 个答案:

答案 0 :(得分:1)

这听起来很奇怪,你无法用Coq的理论来证明这个结果。

让我们只调用sigT (fun x => prod (eq x (inrb tt) -> A) (eq x (inlb tt) -> B))类型TT的任何元素都具有existT x (pair f g)形式,其中x : Boolef : eq x (inrb tt) -> Ag : eq x (inlb tt) -> B。要显示结果,您需要争辩两个T类型的表达式是相等的,这在某些时候需要证明类型为f1的两个f2eq x (inrb tt) -> A项是平等的。

问题是eq x (inrb tt) -> A的元素是函数:它们将xinrb tt相等的证据作为输入,并生成一个术语结果输入A。遗憾的是,在大多数情况下,Coq中函数相等的概念太弱而无法使用。通常在数学中,我们认为两个函数相等,表明它们产生相同的结果,即:

forall f g : A -> B,
  (forall x : A, f x = g x) -> f = g.

此原则通常称为功能扩展性,默认情况下在Coq中不可用。幸运的是,该理论允许我们将其安全地添加为公理而不损害理论的正确性。它甚至可以在标准库中使用。我在这里包含了一个结果略有修改版本的证明。 (我已经冒昧使用ssreflect库,因为我看到你也在使用它。)

From mathcomp Require Import ssreflect ssrfun ssrbool eqtype.

Require Import Coq.Logic.FunctionalExtensionality.

Section Iso.

Variables A B : Type.

Inductive sum' :=
| Sum' x of x = true -> A & x = false -> B.

Definition sum'_of_sum (x : A + B) :=
  match x with
  | inl a =>
    Sum' true
         (fun _ => a)
         (fun e : true = false =>
            match e in _ = c return if c then A else B with
            | erefl => a
            end)
  | inr b =>
    Sum' false
         (fun e =>
            match e in _ = c return if c then A else B with
            | erefl => b
            end)
         (fun _ => b)
  end.

Definition sum_of_sum' (x : sum') : A + B :=
  let: Sum' b f g := x in
  match b return (b = true -> A) -> (b = false -> B) -> A + B with
  | true => fun f _ => inl (f erefl)
  | false => fun _ g => inr (g erefl)
  end f g.

Lemma sum_of_sum'K : cancel sum_of_sum' sum'_of_sum.
Proof.
case=> [[]] /= f g; congr Sum'; apply: functional_extensionality => x //;
by rewrite (eq_axiomK x).
Qed.

End Iso.