Coq 相互定义归纳类型的可判定等式定义

现在我有一个相互定义的感应型a和t：

Inductive a : Type :=
| basic : string -> (string * string) -> a
| complex : string -> list a -> nat -> list t -> (string * string) -> a
| complex2 : string -> list a -> a
with t : Type :=
| t_intro : string * a * (set string) * (set string) -> t.

我的问题是如何证明它们每个的可判定等式定义

Definition a_dec : forall (x y : a), {x = y} + {x <> y}.

Definition t_dec : forall (x y : t), {x = y} + {x <> y}.

定义a_dec:forall（xy:a），{x=y}+{xy}。 定义t_dec:forall（xy:t），{x=y}+{xy}。 您的类型具有嵌套的归纳类型，它们是归纳类型的递归出现，作为其他归纳类型的参数（在您的示例中为成对和列表）

和其他情况一样，你需要引导来展示你想要的东西。不幸的是，与更简单的类型不同，Coq没有自动生成此类类型归纳原则的内置机制，因此您必须推出自己的归纳原则。有一些关于一般问题的有趣链接。下面是一个如何解决您的情况，结合嵌套和相互递归。注意用于陈述归纳假设的辅助归纳法

Require Import String.
Require Import List.
Require Import ListSet.
Import ListNotations.

Set Implicit Arguments.

Inductive a : Type :=
| basic : string -> (string * string) -> a
| complex : string -> list a -> nat -> list t -> (string * string) -> a
| complex2 : string -> list a -> a
with t : Type :=
| t_intro : string * a * (set string) * (set string) -> t.

Inductive Forall' A (T : A -> Type) : list A -> Type :=
| Forall_nil' : Forall' T []
| Forall_cons' : forall x l, T x -> Forall' T l -> Forall' T (x :: l).

Definition build_forall A (T : A -> Type) (f : forall x, T x) :=
  fix F l : Forall' T l :=
  match l with
  | [] => Forall_nil' _
  | x :: l' => Forall_cons' x (f x) (F l')
  end.

Lemma forall_eq_dec A (l : list A) (H : Forall' (fun x => forall y, {x = y} + {x <> y}) l) :
  forall l', {l = l'} + {l <> l'}.
Proof.
  induction H as [| x l Hx Hl IH]; intros [|y l']; try (right; congruence); eauto.
  specialize (IH l').
  destruct IH; subst; try (right; congruence).
  destruct (Hx y); subst; try (right; congruence).
  eauto.
Qed.

Fixpoint a_ind' (Ta : a -> Type) (Tt : t -> Type)
                (H1 : forall s p, Ta (basic s p))
                (H2 : forall s la, Forall' Ta la ->
                      forall n lt, Forall' Tt lt ->
                      forall p, Ta (complex s la n lt p))
                (H3 : forall s la, Forall' Ta la -> Ta (complex2 s la))
                (H4 : forall s x, Ta x ->
                      forall ss1 ss2, Tt (t_intro (s, x, ss1, ss2))) x {struct x} : Ta x :=
  match x with
  | basic s p => H1 s p
  | complex s la n lt p => H2 s la (build_forall _ (a_ind' H1 H2 H3 H4) la)
                              n lt (build_forall _ (t_ind' H1 H2 H3 H4) lt)
                              p
  | complex2 s la => H3 s la (build_forall _ (a_ind' H1 H2 H3 H4) la)
  end
with t_ind' (Ta : a -> Type) (Tt : t -> Type)
            (H1 : forall s p, Ta (basic s p))
            (H2 : forall s la, Forall' Ta la ->
                  forall n lt, Forall' Tt lt ->
                  forall p, Ta (complex s la n lt p))
            (H3 : forall s la, Forall' Ta la -> Ta (complex2 s la))
            (H4 : forall s x, Ta x ->
                  forall ss1 ss2, Tt (t_intro (s, x, ss1, ss2))) x {struct x} : Tt x :=
  match x with
  | t_intro (s, x, ss1, ss2) => H4 s x (a_ind' H1 H2 H3 H4 x) ss1 ss2
  end.

Definition a_and_t_ind (Ta : a -> Type) (Tt : t -> Type)
                (H1 : forall s p, Ta (basic s p))
                (H2 : forall s la, Forall' Ta la ->
                      forall n lt, Forall' Tt lt ->
                      forall p, Ta (complex s la n lt p))
                (H3 : forall s la, Forall' Ta la -> Ta (complex2 s la))
                (H4 : forall s x, Ta x ->
                      forall ss1 ss2, Tt (t_intro (s, x, ss1, ss2))) :
  (forall x, Ta x) * (forall x, Tt x) :=
  (a_ind' H1 H2 H3 H4, t_ind' H1 H2 H3 H4).

Lemma pair_dec A B (HA : forall x y : A, {x = y} + {x <> y})
                   (HB : forall x y : B, {x = y} + {x <> y}) :
  forall x y : A * B, {x = y} + {x <> y}.
Proof. decide equality. Qed.

Definition a_and_t_dec : (forall x y : a, {x = y} + {x <> y}) *
                         (forall x y : t, {x = y} + {x <> y}).
Proof.
  apply a_and_t_ind.
  - intros s p [s' p'| |]; try (right; congruence).
    destruct (string_dec s s'); try (right; congruence).
    subst.
    destruct (pair_dec string_dec string_dec p p'); try (right; congruence).
    subst. eauto.
  - intros s la Hla n lt Hlt p y.
    destruct y as [|s' la' n' lt' p'|]; try (right; congruence).
    destruct (string_dec s s'); subst; try (right; congruence).
    destruct (forall_eq_dec Hla la'); subst; try (right; congruence).
    destruct (NPeano.Nat.eq_dec n n'); subst; try (right; congruence).
    destruct (forall_eq_dec Hlt lt'); subst; try (right; congruence).
    destruct (pair_dec string_dec string_dec p p'); subst; try (right; congruence).
    eauto.
  - intros s la Hla [| |s' la']; try (right; congruence).
    destruct (string_dec s s'); subst; try (right; congruence).
    destruct (forall_eq_dec Hla la'); subst; try (right; congruence).
    eauto.
  - intros s x Hx ss1 ss2 [[[[s' x'] ss1'] ss2']].
    destruct (string_dec s s'); subst; try (right; congruence).
    destruct (Hx x'); subst; try (right; congruence).
    destruct (list_eq_dec string_dec ss1 ss1'); subst; try (right; congruence).
    destruct (list_eq_dec string_dec ss2 ss2'); subst; try (right; congruence).
    eauto.
Qed.

Definition a_dec := fst a_and_t_dec.
Definition t_dec := snd a_and_t_dec.

需要导入字符串。
需要导入列表。
需要导入列表集。
导入列表符号。
设置隐式参数。
感应式a：类型：=
|基本：字符串->（字符串*字符串）->a
|复杂：字符串->列表a->nat->列表t->（字符串*字符串）->a
|complex2:string->list a->a
带t:类型：=
|t_简介：字符串*a*（设置字符串）*（设置字符串）->t。
归纳A（T:A->类型）：列出A->类型：=
|Forall_nil”：Forall'T[]
|Forall_cons'：Forall x l，T x->Forall'T l->Forall'T（x：：l）。
所有A的定义构建（T:A->Type）（f:forall x，T x）：=
修复F l:对于所有T l:=
匹配
|[]=>对于所有的_
|x：：l'=>对于所有的x（f x）（f l'）
结束。
all_eq_dec A（l:list A）（H:forall'（funx=>forall y，{x=y}+{xy}）l的引理：
对于所有l'，{l=l'}+{l'}。
证明。
诱导H为[| x l Hx Hl IH]；简介[| y l']；try（右；一致）；奥托。
专门化（IH l'）。
破坏IH；subst；尝试（正确；一致）。
自毁（Hx-y）；subst；尝试（正确；一致）。
奥托。
Qed。
固定点a_ind'（Ta:a->Type）（Tt:t->Type）
（H1：所有标准普尔、Ta（基本标准普尔））
（H2:forall s la，forall'Ta la->
对于所有n lt，对于所有Tt lt->
forall p、Ta（复杂s la n lt p））
（H3:forall s la，forall'Ta la->Ta（复合体s la））
（H4:forall s x，Ta x->
对于所有ss1 ss2，Tt（t_intro（s，x，ss1，ss2）））x{struct x}:Ta x:=
将x与
|基本标准普尔=>H1标准普尔
|复合物s la n lt p=>H2 s la（构建用于所有（独立于H1 H2 H3 H4）la）
n lt（建造用于所有（工业H1H2H3 H4）lt）
P
|复合体s la=>H3 s la（针对所有（独立于H1 H2 H3 H4）la的构建）
结束
带t_ind'（Ta:a->Type）（Tt:t->Type）
（H1：所有标准普尔、Ta（基本标准普尔））
（H2:forall s la，forall'Ta la->
对于所有n lt，对于所有Tt lt->
forall p、Ta（复杂s la n lt p））
（H3:forall s la，forall'Ta la->Ta（复合体s la））
（H4:forall s x，Ta x->
对于所有ss1 ss2，Tt（t_intro（s，x，ss1，ss2）））x{struct x}:Tt x:=
将x与
|简介（s，x，ss1，ss2）=>h4sx（a_ind'h1h2h3h4x）ss1ss2
结束。
定义a_和t_ind（Ta:a->Type）（Tt:t->Type）
（H1：所有标准普尔、Ta（基本标准普尔））
（H2:forall s la，forall'Ta la->
对于所有n lt，对于所有Tt lt->
forall p、Ta（复杂s la n lt p））
（H3:forall s la，forall'Ta la->Ta（复合体s la））
（H4:forall s x，Ta x->
对于所有ss1 ss2，Tt（t_简介（s，x，ss1，ss2））：
（全场x，全场x）*（全场x，全场x）：=
（a_ind'h1h2h3h4，t_ind'h1h2h3h4）。
引理对_dec A B（HA:forall x y:A，{x=y}+{x y}）
（HB:forall xy:B，{x=y}+{xy}）：
对于所有xy:A*B，{x=y}+{xy}。
证明。决定平等。Qed。
定义a_和t_dec：（对于所有x y:a，{x=y}+{x y}）*
（对于所有xy:t，{x=y}+{xy}）。
证明。
应用一个和。
-简介s p[s'p'| |]；尝试（正确；一致）。
自毁（string_dec s'）；尝试（正确；一致）。
替代品。
析构函数（对dec字符串dec字符串dec p'）；尝试（正确；一致）。
替换：eauto。
-简介s la Hla n lt Hlt p y。
将y分解为[| s'la'n'lt'p'|]；尝试（正确；一致）。
自毁（string_dec s'）；subst；尝试（正确；一致）。
破坏（为了所有的平衡）；subst；尝试（正确；一致）。
自毁（NPeano.Nat.eq_dec n'）；subst；尝试（正确；一致）。
自毁（用于所有设备）；subst；尝试（正确；一致）。
析构函数（对dec字符串dec字符串dec p'）；subst；尝试（正确；一致）。
奥托。
-介绍s la Hla[|s'la']；尝试（正确；一致）。
自毁（string_dec s'）；subst；尝试（正确；一致）。
破坏（为了所有的平衡）；subst；尝试（正确；一致）。
奥托。
-简介s x Hx ss1 ss2[[[s'x']ss1']ss2']。
自毁（string_dec s'）；subst；尝试（正确；一致）。
自毁（Hx'）；subst；尝试（正确；一致）。
自毁（列表_eq _decstring _decss1 ss1’）；subst；尝试（正确；一致）。
自毁（列表_eq _decstring _decss2 ss2'）；subst；尝试（正确；一致）。
奥托。
Qed。
定义a_dec:=fst a_和_t_dec。
定义t_dec:=snd a_和t_dec。

这里有两个单独的问题：

例如，您具有相互感应类型，因此需要声明相互不动点

Fixpoint a_dec (x y : a) : { x = y } + { x <> y }
with b_dec (x y : t) : { x = y } + { x <> y }.

使用此工具，您将无法直接使用

List.List

库，但您仍然可以在

List\u a

和

List a

（分别为

t

）之间建立双向转换，以便在无需导入时使用库

希望有帮助，

---

V.

很好的解释。正如你所知，从8.3开始

    Inductive a : Type :=
    | basic : string -> (string * string) -> a
    | complex : string -> list_a -> nat -> list_t -> (string * string) -> a
    | complex2 : string -> list_a -> a
    with t : Type :=
    | t_intro : string * a * (set string) * (set string) -> t.
    with list_a : Type
    | anil : list_a
    | acons : a -> list_a -> list_a
    with list_t : Type
    | tnil : list_t
    | tcons : t -> list_t -> list_t
    .