Coq 如何证明一阶语言的术语是有根据的?
目前,我已经开始在Coq()中证明关于一阶逻辑的定理。我已经证明了演绎定理,但后来我陷入了正确性定理的引理1。所以我已经简洁地描述了一个优雅的引理,我邀请社区来看看它。这是一个不完整的证据,证明了条款的充分性。如何正确地摆脱这对“承认”呢Coq 如何证明一阶语言的术语是有根据的?,coq,Coq,目前,我已经开始在Coq()中证明关于一阶逻辑的定理。我已经证明了演绎定理,但后来我陷入了正确性定理的引理1。所以我已经简洁地描述了一个优雅的引理,我邀请社区来看看它。这是一个不完整的证据,证明了条款的充分性。如何正确地摆脱这对“承认”呢 (* PUBLIC DOMAIN *) Require Export Coq.Vectors.Vector. Require Export Coq.Lists.List. Require Import Bool.Bool. Require Import Log
(* PUBLIC DOMAIN *)
Require Export Coq.Vectors.Vector.
Require Export Coq.Lists.List.
Require Import Bool.Bool.
Require Import Logic.FunctionalExtensionality.
Require Import Coq.Program.Wf.
Definition SetVars := nat.
Definition FuncSymb := nat.
Definition PredSymb := nat.
Record FSV := {
fs : FuncSymb;
fsv : nat;
}.
Record PSV := MPSV{
ps : PredSymb;
psv : nat;
}.
Inductive Terms : Type :=
| FVC :> SetVars -> Terms
| FSC (f:FSV) : (Vector.t Terms (fsv f)) -> Terms.
Definition rela : forall (x y:Terms), Prop.
Proof.
fix rela 2.
intros x y.
destruct y as [s|f t].
+ exact False.
+ refine (or _ _).
exact (Vector.In x t).
simple refine (@Vector.fold_left Terms Prop _ False (fsv f) t).
intros Q e.
exact (or Q (rela x e)).
Defined.
Definition snglV {A} (a:A) := Vector.cons A a 0 (Vector.nil A).
Definition wfr : @well_founded Terms rela.
Proof.
clear.
unfold well_founded.
assert (H : forall (n:Terms) (a:Terms), (rela a n) -> Acc rela a).
{ fix iHn 1.
destruct n.
+ simpl. intros a b; destruct b.
+ simpl. intros a Q. destruct Q as [L|R].
* admit. (* smth like apply Acc_intro. intros m Hm. apply (iHn a). exact Hm. *)
* admit. (* like in /Arith/Wf_nat.v *)
}
intros a.
simple refine (H _ _ _).
exact (FSC (Build_FSV 0 1) (snglV a)).
simpl.
apply or_introl.
constructor.
Defined.
也可在以下位置获取:
更新:至少传递性对于良好的基础是必要的。我也开始了一个证明,但没有完成
Fixpoint Tra (a b c:Terms) (Hc : rela c b) (Hb : rela b a) {struct a}: rela c a.
Proof.
destruct a.
+ simpl in * |- *.
exact Hb.
+ simpl in * |- *.
destruct Hb.
- apply or_intror.
revert f t H .
fix RECU 1.
intros f t H.
(* ... *)
Admitted.
您可以通过在
术语上定义高度函数来实现,并显示降低rela
意味着降低高度:
Require Export Coq.Vectors.Vector.
Require Export Coq.Lists.List.
Require Import Bool.Bool.
Require Import Logic.FunctionalExtensionality.
Require Import Coq.Program.Wf.
Definition SetVars := nat.
Definition FuncSymb := nat.
Definition PredSymb := nat.
Record FSV := {
fs : FuncSymb;
fsv : nat;
}.
Record PSV := MPSV{
ps : PredSymb;
psv : nat;
}.
Unset Elimination Schemes.
Inductive Terms : Type :=
| FVC :> SetVars -> Terms
| FSC (f:FSV) : (Vector.t Terms (fsv f)) -> Terms.
Set Elimination Schemes.
Definition Terms_rect (T : Terms -> Type)
(H_FVC : forall sv, T (FVC sv))
(H_FSC : forall f v, (forall n, T (Vector.nth v n)) -> T (FSC f v)) :=
fix loopt (t : Terms) : T t :=
match t with
| FVC sv => H_FVC sv
| FSC f v =>
let fix loopv s (v : Vector.t Terms s) : forall n, T (Vector.nth v n) :=
match v with
| @Vector.nil _ => Fin.case0 _
| @Vector.cons _ t _ v => fun n => Fin.caseS' n (fun n => T (Vector.nth (Vector.cons _ t _ v) n))
(loopt t)
(loopv _ v)
end in
H_FSC f v (loopv _ v)
end.
Definition Terms_ind := Terms_rect.
Fixpoint height (t : Terms) : nat :=
match t with
| FVC _ => 0
| FSC f v => S (Vector.fold_right (fun t acc => Nat.max acc (height t)) v 0)
end.
Definition rela : forall (x y:Terms), Prop.
Proof.
fix rela 2.
intros x y.
destruct y as [s|f t].
+ exact False.
+ refine (or _ _).
exact (Vector.In x t).
simple refine (@Vector.fold_left Terms Prop _ False (fsv f) t).
intros Q e.
exact (or Q (rela x e)).
Defined.
Require Import Lia.
Definition wfr : @well_founded Terms rela.
Proof.
apply (Wf_nat.well_founded_lt_compat _ height).
intros t1 t2. induction t2 as [sv2|f2 v2 IH]; simpl; try easy.
intros [t_v|t_sub]; apply Lt.le_lt_n_Sm.
{ clear IH. induction t_v; simpl; lia. }
revert v2 IH t_sub; generalize (fsv f2); clear f2.
intros k v2 IH t_sub.
enough (H : exists n, rela t1 (Vector.nth v2 n)).
{ destruct H as [n H]. apply IH in H. clear IH t_sub.
transitivity (height (Vector.nth v2 n)); try lia; clear H.
induction v2 as [|t2 m v2 IHv2].
- inversion n.
- apply (Fin.caseS' n); clear n; simpl; try lia.
intros n. specialize (IHv2 n). lia. }
clear IH.
assert (H : Vector.fold_right (fun t Q => Q \/ rela t1 t) v2 False).
{ revert t_sub; generalize False.
induction v2 as [|t2 n v2]; simpl in *; trivial.
intros P H; specialize (IHv2 _ H); clear H.
induction v2 as [|t2' n v2 IHv2']; simpl in *; tauto. }
clear t_sub.
induction v2 as [|t2 k v2 IH]; simpl in *; try easy.
destruct H as [H|H].
- apply IH in H.
destruct H as [n Hn].
now exists (Fin.FS n).
- now exists Fin.F1.
Qed.
(请注意自定义归纳原则的使用,这是因为嵌套归纳原则所必需的。)
然而,这种开发方式太复杂了。避免某些陷阱将大大简化:
Coq标准向量库太难使用。这里的问题由于嵌套归纳法而加剧。最好使用简单的列表,并在术语上有一个单独的格式良好的谓词
在校对模式下定义关系(如rela
)会使阅读更困难。例如,考虑以下更简单的替代方案:
Fixpoint rela x y :=
match y with
| FVC _ => False
| FSC f v =>
Vector.In x v \/
Vector.fold_right (fun z P => rela x z \/ P) v False
end.
左折有一个糟糕的归约行为,因为它迫使我们对累加器参数进行泛化,从而得到归纳法。这就是为什么在我的证明中,我必须切换到右折叠
您可以通过在术语上定义高度函数来实现,并显示降低rela
意味着降低高度:
Require Export Coq.Vectors.Vector.
Require Export Coq.Lists.List.
Require Import Bool.Bool.
Require Import Logic.FunctionalExtensionality.
Require Import Coq.Program.Wf.
Definition SetVars := nat.
Definition FuncSymb := nat.
Definition PredSymb := nat.
Record FSV := {
fs : FuncSymb;
fsv : nat;
}.
Record PSV := MPSV{
ps : PredSymb;
psv : nat;
}.
Unset Elimination Schemes.
Inductive Terms : Type :=
| FVC :> SetVars -> Terms
| FSC (f:FSV) : (Vector.t Terms (fsv f)) -> Terms.
Set Elimination Schemes.
Definition Terms_rect (T : Terms -> Type)
(H_FVC : forall sv, T (FVC sv))
(H_FSC : forall f v, (forall n, T (Vector.nth v n)) -> T (FSC f v)) :=
fix loopt (t : Terms) : T t :=
match t with
| FVC sv => H_FVC sv
| FSC f v =>
let fix loopv s (v : Vector.t Terms s) : forall n, T (Vector.nth v n) :=
match v with
| @Vector.nil _ => Fin.case0 _
| @Vector.cons _ t _ v => fun n => Fin.caseS' n (fun n => T (Vector.nth (Vector.cons _ t _ v) n))
(loopt t)
(loopv _ v)
end in
H_FSC f v (loopv _ v)
end.
Definition Terms_ind := Terms_rect.
Fixpoint height (t : Terms) : nat :=
match t with
| FVC _ => 0
| FSC f v => S (Vector.fold_right (fun t acc => Nat.max acc (height t)) v 0)
end.
Definition rela : forall (x y:Terms), Prop.
Proof.
fix rela 2.
intros x y.
destruct y as [s|f t].
+ exact False.
+ refine (or _ _).
exact (Vector.In x t).
simple refine (@Vector.fold_left Terms Prop _ False (fsv f) t).
intros Q e.
exact (or Q (rela x e)).
Defined.
Require Import Lia.
Definition wfr : @well_founded Terms rela.
Proof.
apply (Wf_nat.well_founded_lt_compat _ height).
intros t1 t2. induction t2 as [sv2|f2 v2 IH]; simpl; try easy.
intros [t_v|t_sub]; apply Lt.le_lt_n_Sm.
{ clear IH. induction t_v; simpl; lia. }
revert v2 IH t_sub; generalize (fsv f2); clear f2.
intros k v2 IH t_sub.
enough (H : exists n, rela t1 (Vector.nth v2 n)).
{ destruct H as [n H]. apply IH in H. clear IH t_sub.
transitivity (height (Vector.nth v2 n)); try lia; clear H.
induction v2 as [|t2 m v2 IHv2].
- inversion n.
- apply (Fin.caseS' n); clear n; simpl; try lia.
intros n. specialize (IHv2 n). lia. }
clear IH.
assert (H : Vector.fold_right (fun t Q => Q \/ rela t1 t) v2 False).
{ revert t_sub; generalize False.
induction v2 as [|t2 n v2]; simpl in *; trivial.
intros P H; specialize (IHv2 _ H); clear H.
induction v2 as [|t2' n v2 IHv2']; simpl in *; tauto. }
clear t_sub.
induction v2 as [|t2 k v2 IH]; simpl in *; try easy.
destruct H as [H|H].
- apply IH in H.
destruct H as [n Hn].
now exists (Fin.FS n).
- now exists Fin.F1.
Qed.
(请注意自定义归纳原则的使用,这是因为嵌套归纳原则所必需的。)
然而,这种开发方式太复杂了。避免某些陷阱将大大简化:
Coq标准向量库太难使用。这里的问题由于嵌套归纳法而加剧。最好使用简单的列表,并在术语上有一个单独的格式良好的谓词
在校对模式下定义关系(如rela
)会使阅读更困难。例如,考虑以下更简单的替代方案:
Fixpoint rela x y :=
match y with
| FVC _ => False
| FSC f v =>
Vector.In x v \/
Vector.fold_right (fun z P => rela x z \/ P) v False
end.
左折有一个糟糕的归约行为,因为它迫使我们对累加器参数进行泛化,从而得到归纳法。这就是为什么在我的证明中,我必须切换到右折叠
这是第一条建议的实现:。这不是小事。我也没有成功地从术语中提取术语列表(即参数)。(对应的函数“prototype”配备了冗余案例的证明草图)@ged如果您编写一个函数preterm->option term
,尝试将一个preterm强制转换为一个term,并将该函数部分映射到参数列表上,那么就更容易了,而不是从术语传播证明。本要点中描述了这种方法:。代码使用数学组件库,该库对该习惯用法有很好的支持。这是第1条建议的实现:。这不是小事。我也没有成功地从术语中提取术语列表(即参数)。(对应的函数“prototype”配备了冗余案例的证明草图)@ged如果您编写一个函数preterm->option term
,尝试将一个preterm强制转换为一个term,并将该函数部分映射到参数列表上,那么就更容易了,而不是从术语传播证明。本要点中描述了这种方法:。代码使用了数学组件库,它对这个习惯用法有很好的支持。