对具有相同类型的两个值进行依赖模式匹配
Dependent pattern matching on two values with the same type
我们将使用有限集的标准定义：
Inductive fin : nat -> Set :=
| F1 : forall {n : nat}, fin (S n)
| FS : forall {n : nat}, fin n -> fin (S n).
让我们假设我们有一些 P : forall {m : nat} (x y : fin m) : Set（
重要的是 P 的两个参数属于同一类型）。为了
出于演示目的，设 P 为：
Definition P {m : nat} (x y : fin m) := {x = y} + {x <> y}.
现在，我们要编写一个比较两个数字的自定义函数：
Fixpoint feq_dec {m : nat} (x y : fin m) : P x y.
这个想法很简单：我们匹配 x 和 y，对于 x = F1，y = F1 我们
平凡地 return 相等，对于 x = FS x'，y = FS y' 我们递归调用
x' 和 y' 的过程，对于其他情况，我们可以简单地 return
不平等。
将这个想法直接翻译成 Coq 显然失败了：
refine (
match x, y return P x y with
| F1 _, F1 _ => _
| FS _ x', F1 _ => _
| F1 _, FS _ y' => _
| FS _ x', FS _ y' => _
end
).
(*
* The term "y0" has type "fin n0" while it is expected to have type "fin n".
*)
在 x 和 y 的比赛中，我们丢失了类型信息，因此我们无法将它们应用于 P。
传递类型相等性证明的标准技巧在这里没有帮助：
refine (
match x in fin mx, y in fin my return mx = my -> P x y with
| F1 _, F1 _ => _
| FS _ x', F1 _ => _
| F1 _, FS _ y' => _
| FS _ x', FS _ y' => _
end eq_refl
).
(*
* The term "y0" has type "fin my" while it is expected to have type "fin mx".
*)
所以，也许我们可以使用相等性证明来转换 x 与
y?
Definition fcast {m1 m2 : nat} (Heq : m1 = m2) (x : fin m1) : fin m2.
Proof.
rewrite <- Heq.
apply x.
Defined.
我们还需要能够在以后摆脱强制转换。但是，我注意到
fcast eq_refl x = x 是不够的，因为我们需要让它与
任意等价证明。我发现了一个叫做 UIP 的东西
我需要的。
Require Import Coq.Program.Program.
Lemma fcast_void {m : nat} : forall (x : fin m) (H : m = m),
fcast H x = x.
Proof.
intros.
rewrite -> (UIP nat m m H eq_refl).
trivial.
Defined.
现在我们准备完成整个定义：
refine (
match x in fin mx, y in fin my
return forall (Hmx : m = mx) (Hmy : mx = my), P (fcast Hmy x) y with
| F1 _, F1 _ => fun Hmx Hmy => _
| FS _ x', F1 _ => fun Hmx Hmy => _
| F1 _, FS _ y' => fun Hmx Hmy => _
| FS _ x', FS _ y' => fun Hmx Hmy => _
end eq_refl eq_refl
); inversion Hmy; subst; rewrite fcast_void.
- left. reflexivity.
- right. intro Contra. inversion Contra.
- right. intro Contra. inversion Contra.
- destruct (feq_dec _ x' y') as [Heq | Hneq].
+ left. apply f_equal. apply Heq.
+ right. intro Contra. dependent destruction Contra. apply Hneq. reflexivity.
Defined.
它通过了！但是，它不会计算出任何有用的值。例如
以下产生一个包含五个嵌套匹配项而不是一个简单值的术语
（in_right 或 in_left）。我怀疑问题出在我的 UIP 公理上
用过。
Compute (@feq_dec 5 (FS F1) (FS F1)).
所以最后，我想出的定义几乎没有用。
我还尝试使用 convoy 模式 进行嵌套匹配，而不是在
同样的时间，但我遇到了同样的障碍：一旦我对第二个值进行匹配，P 就不再适用于它。我可以用其他方式做吗？
这是一个已知问题，在大多数情况下，使用基础 nat 上的等式然后获利比 to_nat 函数是内射的要好：
From mathcomp Require Import all_ssreflect.
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.
Require Import PeanoNat Fin.
Fixpoint to_nat m (x : t m) :=
match x with
| F1 _ => 0
| FS _ x => (to_nat x).+1
end.
Lemma to_nat_inj m : injective (@to_nat m).
Proof.
elim: m / => /= [|m t iht y].
exact: (caseS (fun n (y : t n.+1) => _)).
move: m y t iht.
by apply: (caseS (fun n (y : t n.+1) => _)) => //= n p t iht [] /iht ->.
Qed.
Lemma feq_dec {m : nat} (x y : t m) : {x = y} + {x <> y}.
Proof.
have [heq | heqN] := Nat.eq_dec (to_nat x) (to_nat y).
by left; apply: to_nat_inj.
by right=> H; apply: heqN; rewrite H.
Qed.
但即便如此，操作起来还是很麻烦。您可以尝试使用 ssreflect 中包含的 'I_n 类型，它将计算值与边界分开，在 SO 中进行一些搜索应该会给您足够的指示。
如果你把 Qeds 变成 Defined 以上将计算你的情况，一般来说它应该足以给你 left ? 或 right ? 允许依赖它的证明继续。
然而，如果你想让它在不相等的情况下通过一个正常的形式，它需要大量的调整[主要是，O_S 引理是不透明的，这也会影响 Nat.eq_dec ]
您可以手写条款，但这是一场噩梦。这里我描述了计算部分和使用策略来处理证明：
Fixpoint feq_dec {m : nat} (x y : fin m) : P x y.
refine (
match m return forall (x y : fin m), P x y with
| O => _
| S m' => fun x y =>
match (case x, case y) with
| (inright eqx , inright eqy) => left _
| (inleft (exist _ x' eqx), inright eqy) => right _
| (inright eqx , inleft (exist _ y' eqy)) => right _
| (inleft (exist _ x' eqx), inleft (exist _ y' eqy)) =>
match feq_dec _ x' y' with
| left eqx'y' => left _
| right neqx'y' => right _
end
end
end x y); simpl in *; subst.
- inversion 0.
- reflexivity.
- intro Heq; apply neqx'y'.
assert (Heq' : Some x' = Some y') by exact (f_equal finpred Heq).
inversion Heq'; reflexivity.
- inversion 1.
- inversion 1.
- reflexivity.
Defined.
以这种方式定义的函数按预期工作：
Compute (@feq_dec 5 (FS F1) (FS F1)).
(*
= left eq_refl
: P (FS F1) (FS F1)
*)
此代码依赖于 3 个技巧：
1。首先检查绑定 m.
确实，如果您对绑定 m 一无所知，您将从 x 和 y 的比赛中分别了解到两个不同的事实，您将需要调和这些事实（即表明 m 给你的两个前身实际上是相等的）。另一方面，如果您知道 m 具有 S m' 的形状，那么您可以...
2。使用 case 函数根据边界的形状反转项
如果您知道边界的形状为 S m'，那么对于您的每个 fin，您都知道您属于以下两种情况之一：fin 是F1 或某些 x' 是 FS x'。 case 正式化：
Definition C {m : nat} (x : fin (S m)) :=
{ x' | x = FS x' } + { x = F1 }.
Definition case {m : nat} (x : fin (S m)) : C x :=
match x in fin (S n) return { x' | x = FS x' } + { x = F1 } with
| F1 => inright eq_refl
| FS x' => inleft (exist _ x' eq_refl)
end.
Coq 将足够聪明，可以检测到我们从 case 中 return 得到的值是它采用的参数的直接子项。因此，当 x 和 y 都具有形状 FS _ 时执行递归调用不会有问题！
3。将同余与临时函数结合使用以剥离构造函数
在我们执行递归调用但在 return 中得到否定答案的分支中，我们需要证明 FS x' <> FS y' 知道 x' <> y'。这意味着我们需要将 Heq : FS x' = FS y' 变成 x' = y'.
因为 FS 有一个复杂的 return 类型，简单地在 Heq 上执行 inversion 不会产生可用的结果（我们得到依赖对之间的相等性一个 nat p 和一个 fin p)。这是 finpred 发挥作用的地方：它是一个完整的函数，当面对 FS _ 时，它会简单地剥离 FS 构造函数。
Definition finpred {m : nat} (x : fin m) : option (fin (pred m)) :=
match x with
| F1 => None
| FS x' => Some x'
end.
结合 f_equal 和 Heq 我们得到一个证明 Some x' = Some y' 我们可以在其上使用 inversion 并获得我们想要的平等。
我们将使用有限集的标准定义：
Inductive fin : nat -> Set :=
| F1 : forall {n : nat}, fin (S n)
| FS : forall {n : nat}, fin n -> fin (S n).
让我们假设我们有一些 P : forall {m : nat} (x y : fin m) : Set（
重要的是 P 的两个参数属于同一类型）。为了
出于演示目的，设 P 为：
Definition P {m : nat} (x y : fin m) := {x = y} + {x <> y}.
现在，我们要编写一个比较两个数字的自定义函数：
Fixpoint feq_dec {m : nat} (x y : fin m) : P x y.
这个想法很简单：我们匹配 x 和 y，对于 x = F1，y = F1 我们
平凡地 return 相等，对于 x = FS x'，y = FS y' 我们递归调用
x' 和 y' 的过程，对于其他情况，我们可以简单地 return
不平等。
将这个想法直接翻译成 Coq 显然失败了：
refine (
match x, y return P x y with
| F1 _, F1 _ => _
| FS _ x', F1 _ => _
| F1 _, FS _ y' => _
| FS _ x', FS _ y' => _
end
).
(*
* The term "y0" has type "fin n0" while it is expected to have type "fin n".
*)
在 x 和 y 的比赛中，我们丢失了类型信息，因此我们无法将它们应用于 P。
传递类型相等性证明的标准技巧在这里没有帮助：
refine (
match x in fin mx, y in fin my return mx = my -> P x y with
| F1 _, F1 _ => _
| FS _ x', F1 _ => _
| F1 _, FS _ y' => _
| FS _ x', FS _ y' => _
end eq_refl
).
(*
* The term "y0" has type "fin my" while it is expected to have type "fin mx".
*)
所以，也许我们可以使用相等性证明来转换 x 与
y?
Definition fcast {m1 m2 : nat} (Heq : m1 = m2) (x : fin m1) : fin m2.
Proof.
rewrite <- Heq.
apply x.
Defined.
我们还需要能够在以后摆脱强制转换。但是，我注意到
fcast eq_refl x = x 是不够的，因为我们需要让它与
任意等价证明。我发现了一个叫做 UIP 的东西
我需要的。
Require Import Coq.Program.Program.
Lemma fcast_void {m : nat} : forall (x : fin m) (H : m = m),
fcast H x = x.
Proof.
intros.
rewrite -> (UIP nat m m H eq_refl).
trivial.
Defined.
现在我们准备完成整个定义：
refine (
match x in fin mx, y in fin my
return forall (Hmx : m = mx) (Hmy : mx = my), P (fcast Hmy x) y with
| F1 _, F1 _ => fun Hmx Hmy => _
| FS _ x', F1 _ => fun Hmx Hmy => _
| F1 _, FS _ y' => fun Hmx Hmy => _
| FS _ x', FS _ y' => fun Hmx Hmy => _
end eq_refl eq_refl
); inversion Hmy; subst; rewrite fcast_void.
- left. reflexivity.
- right. intro Contra. inversion Contra.
- right. intro Contra. inversion Contra.
- destruct (feq_dec _ x' y') as [Heq | Hneq].
+ left. apply f_equal. apply Heq.
+ right. intro Contra. dependent destruction Contra. apply Hneq. reflexivity.
Defined.
它通过了！但是，它不会计算出任何有用的值。例如
以下产生一个包含五个嵌套匹配项而不是一个简单值的术语
（in_right 或 in_left）。我怀疑问题出在我的 UIP 公理上
用过。
Compute (@feq_dec 5 (FS F1) (FS F1)).
所以最后，我想出的定义几乎没有用。
我还尝试使用 convoy 模式 进行嵌套匹配，而不是在
同样的时间，但我遇到了同样的障碍：一旦我对第二个值进行匹配，P 就不再适用于它。我可以用其他方式做吗？
这是一个已知问题，在大多数情况下，使用基础 nat 上的等式然后获利比 to_nat 函数是内射的要好：
From mathcomp Require Import all_ssreflect.
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.
Require Import PeanoNat Fin.
Fixpoint to_nat m (x : t m) :=
match x with
| F1 _ => 0
| FS _ x => (to_nat x).+1
end.
Lemma to_nat_inj m : injective (@to_nat m).
Proof.
elim: m / => /= [|m t iht y].
exact: (caseS (fun n (y : t n.+1) => _)).
move: m y t iht.
by apply: (caseS (fun n (y : t n.+1) => _)) => //= n p t iht [] /iht ->.
Qed.
Lemma feq_dec {m : nat} (x y : t m) : {x = y} + {x <> y}.
Proof.
have [heq | heqN] := Nat.eq_dec (to_nat x) (to_nat y).
by left; apply: to_nat_inj.
by right=> H; apply: heqN; rewrite H.
Qed.
但即便如此，操作起来还是很麻烦。您可以尝试使用 ssreflect 中包含的 'I_n 类型，它将计算值与边界分开，在 SO 中进行一些搜索应该会给您足够的指示。
如果你把 Qeds 变成 Defined 以上将计算你的情况，一般来说它应该足以给你 left ? 或 right ? 允许依赖它的证明继续。
然而，如果你想让它在不相等的情况下通过一个正常的形式，它需要大量的调整[主要是，O_S 引理是不透明的，这也会影响 Nat.eq_dec ]
您可以手写条款，但这是一场噩梦。这里我描述了计算部分和使用策略来处理证明：
Fixpoint feq_dec {m : nat} (x y : fin m) : P x y.
refine (
match m return forall (x y : fin m), P x y with
| O => _
| S m' => fun x y =>
match (case x, case y) with
| (inright eqx , inright eqy) => left _
| (inleft (exist _ x' eqx), inright eqy) => right _
| (inright eqx , inleft (exist _ y' eqy)) => right _
| (inleft (exist _ x' eqx), inleft (exist _ y' eqy)) =>
match feq_dec _ x' y' with
| left eqx'y' => left _
| right neqx'y' => right _
end
end
end x y); simpl in *; subst.
- inversion 0.
- reflexivity.
- intro Heq; apply neqx'y'.
assert (Heq' : Some x' = Some y') by exact (f_equal finpred Heq).
inversion Heq'; reflexivity.
- inversion 1.
- inversion 1.
- reflexivity.
Defined.
以这种方式定义的函数按预期工作：
Compute (@feq_dec 5 (FS F1) (FS F1)).
(*
= left eq_refl
: P (FS F1) (FS F1)
*)
此代码依赖于 3 个技巧：
1。首先检查绑定 m.
确实，如果您对绑定 m 一无所知，您将从 x 和 y 的比赛中分别了解到两个不同的事实，您将需要调和这些事实（即表明 m 给你的两个前身实际上是相等的）。另一方面，如果您知道 m 具有 S m' 的形状，那么您可以...
2。使用 case 函数根据边界的形状反转项
如果您知道边界的形状为 S m'，那么对于您的每个 fin，您都知道您属于以下两种情况之一：fin 是F1 或某些 x' 是 FS x'。 case 正式化：
Definition C {m : nat} (x : fin (S m)) :=
{ x' | x = FS x' } + { x = F1 }.
Definition case {m : nat} (x : fin (S m)) : C x :=
match x in fin (S n) return { x' | x = FS x' } + { x = F1 } with
| F1 => inright eq_refl
| FS x' => inleft (exist _ x' eq_refl)
end.
Coq 将足够聪明，可以检测到我们从 case 中 return 得到的值是它采用的参数的直接子项。因此，当 x 和 y 都具有形状 FS _ 时执行递归调用不会有问题！
3。将同余与临时函数结合使用以剥离构造函数
在我们执行递归调用但在 return 中得到否定答案的分支中，我们需要证明 FS x' <> FS y' 知道 x' <> y'。这意味着我们需要将 Heq : FS x' = FS y' 变成 x' = y'.
因为 FS 有一个复杂的 return 类型，简单地在 Heq 上执行 inversion 不会产生可用的结果（我们得到依赖对之间的相等性一个 nat p 和一个 fin p)。这是 finpred 发挥作用的地方：它是一个完整的函数，当面对 FS _ 时，它会简单地剥离 FS 构造函数。
Definition finpred {m : nat} (x : fin m) : option (fin (pred m)) :=
match x with
| F1 => None
| FS x' => Some x'
end.
结合 f_equal 和 Heq 我们得到一个证明 Some x' = Some y' 我们可以在其上使用 inversion 并获得我们想要的平等。