在递归函数定义中使用 forall

发布于 2024-10-07 06:46:22 字数 4231 浏览 7 评论 0原文

我试图使用 Function 使用度量来定义递归定义,但出现错误:

Error: find_call_occs : Prod

我将整个源代码发布在底部,但我的功能是

Function kripke_sat (M : kripke) (s : U) (p : formula) {measure size p}: Prop :=
match p with
| Proposition p'  => L M (s)(p')
| Not p' => ~ kripke_sat M s p'
| And p' p''   => kripke_sat M s p' /\ kripke_sat M s p''
| Or p' p''  => kripke_sat M s p' \/ kripke_sat M s p''
| Implies p' p''  => ~kripke_sat M s p' \/  kripke_sat M s p''
| Knows a p' =>  forall t, ~(K M a) s t \/ kripke_sat M t p' 
| EvKnows p' => forall i, kripke_sat M s (Knows i p' ) 
end.

我知道问题是由于 foralls 造成的:如果我用 True 替换它们,它就会起作用。我 还知道如果我的右侧使用含义(->),我会得到同样的错误。 Fixpoint 可与 foralls 配合使用,但不允许我定义度量。

有什么建议吗?

正如所承诺的,我的完整代码是:

Module Belief.

Require Import Arith.EqNat.
Require Import Arith.Gt.
Require Import Arith.Plus.
Require Import Arith.Le.
Require Import Arith.Lt.
Require Import Logic.
Require Import Logic.Classical_Prop.
Require Import Init.Datatypes.

Require Import funind.Recdef.

(* Formalization of a variant of a logic of knowledge, as given in Halpern 1995 *)

Section Kripke.

  Variable n : nat.
  (* Universe of "worlds" *)
  Definition U := nat.
  (* Universe of Principals *)
  Definition P := nat.
  (* Universe of Atomic propositions *)
  Definition A := nat.

  Inductive prop : Type := 
  | Atomic : A -> prop.

  Definition beq_prop (p1 p2 :prop) : bool :=
    match (p1,p2) with
      | (Atomic p1', Atomic p2') => beq_nat p1' p2'
    end.

  Inductive actor : Type :=
  | Id : P -> actor.

  Definition beq_actor (a1 a2: actor) : bool :=
    match (a1,a2) with
      | (Id a1', Id a2') => beq_nat a1' a2'
    end.

  Inductive formula : Type :=
  | Proposition : prop -> formula
  | Not : formula -> formula
  | And :  formula  -> formula -> formula
  | Or :  formula -> formula -> formula
  | Implies :  formula -> formula ->formula
  | Knows : actor -> formula -> formula
  | EvKnows :  formula -> formula (*me*)
    .

  Inductive con : Type :=
  | empty : con
  | ext : con -> prop -> con.

  Notation " C # P " := (ext C P) (at level 30).

  Require Import Relations.

  Record kripke : Type := mkKripke {
    K : actor -> relation U; 
    K_equiv: forall y, equivalence _ (K y);
    L : U -> (prop -> Prop)
  }.

Fixpoint max (a b: nat) : nat :=
   match a, b with
   | 0, _ => a
   | _, 0 => b
   | S(a'), S(b') => 1 + max a' b'
end.

Fixpoint length (p: formula) : nat :=
  match p with
     | Proposition p' => 1
     | Not p' => 1 + length(p')
     | And p' p'' => 1 + max (length p') (length p'')
     | Or p' p''  => 1 + max (length p') (length p'')
     | Implies p' p'' => 1 + max  (length p') (length p'')
     | Knows a p'  => 1 + length(p')
     | EvKnows p' => 1 + length(p')
end.

Fixpoint numKnows (p: formula): nat :=
  match p with
 | Proposition p' => 0
 | Not p' => 0 + numKnows(p')
 | And p' p'' => 0 + max (numKnows p') (numKnows p'')
 | Or p' p''  => 0 + max (numKnows p') (numKnows p'')
 | Implies p' p'' => 0 + max  (numKnows p') (numKnows p'')
 | Knows a p'  => 0 + numKnows(p')
 | EvKnows p' => 1 + numKnows(p')
end.

Definition size (p: formula): nat :=
(numKnows p) + (length p).

Definition twice (n: nat) : nat :=
n + n.

Theorem duh: forall a: nat, 1 + a > a.
Proof.   induction a. apply gt_Sn_O.
apply gt_n_S in IHa. unfold plus in *. apply IHa. Qed.

Theorem eq_lt_lt: forall (a b c d: nat), a = b -> c<d -> a+ c< b+d.
Proof. intros. apply plus_le_lt_compat. 
apply eq_nat_elim with (n:=a) (m := b). apply le_refl.
apply eq_nat_is_eq. apply H.  apply H0. Qed.


Function kripke_sat (M : kripke) (s : U) (p : formula) {measure size p}: Prop :=
  match p with
| Proposition p'  => L M (s)(p')
| Not p' => ~ kripke_sat M s p'
| And p' p''   => kripke_sat M s p' /\ kripke_sat M s p''
| Or p' p''  => kripke_sat M s p' \/ kripke_sat M s p''
| Implies p' p''  => ~kripke_sat M s p' \/  kripke_sat M s p''
| Knows a p' =>   forall t, ~(K M a) s t \/ kripke_sat M t p'
| EvKnows p' =>  forall i, kripke_sat M s (Knows i p' )  
 end.

I'm trying to use Function to define a recursive definition using a measure, and I'm getting the error:

Error: find_call_occs : Prod

I'm posting the whole source code at the bottom, but my function is

Function kripke_sat (M : kripke) (s : U) (p : formula) {measure size p}: Prop :=
match p with
| Proposition p'  => L M (s)(p')
| Not p' => ~ kripke_sat M s p'
| And p' p''   => kripke_sat M s p' /\ kripke_sat M s p''
| Or p' p''  => kripke_sat M s p' \/ kripke_sat M s p''
| Implies p' p''  => ~kripke_sat M s p' \/  kripke_sat M s p''
| Knows a p' =>  forall t, ~(K M a) s t \/ kripke_sat M t p' 
| EvKnows p' => forall i, kripke_sat M s (Knows i p' ) 
end.

I know the problem is due to the foralls: if I replace them with True, it works. I
also know I get the same error if my right-hand-side uses implications (->).
Fixpoint works with foralls, but doesn't allow me to define a measure.

Any advice?

As promised, my complete code is:

Module Belief.

Require Import Arith.EqNat.
Require Import Arith.Gt.
Require Import Arith.Plus.
Require Import Arith.Le.
Require Import Arith.Lt.
Require Import Logic.
Require Import Logic.Classical_Prop.
Require Import Init.Datatypes.

Require Import funind.Recdef.

(* Formalization of a variant of a logic of knowledge, as given in Halpern 1995 *)

Section Kripke.

  Variable n : nat.
  (* Universe of "worlds" *)
  Definition U := nat.
  (* Universe of Principals *)
  Definition P := nat.
  (* Universe of Atomic propositions *)
  Definition A := nat.

  Inductive prop : Type := 
  | Atomic : A -> prop.

  Definition beq_prop (p1 p2 :prop) : bool :=
    match (p1,p2) with
      | (Atomic p1', Atomic p2') => beq_nat p1' p2'
    end.

  Inductive actor : Type :=
  | Id : P -> actor.

  Definition beq_actor (a1 a2: actor) : bool :=
    match (a1,a2) with
      | (Id a1', Id a2') => beq_nat a1' a2'
    end.

  Inductive formula : Type :=
  | Proposition : prop -> formula
  | Not : formula -> formula
  | And :  formula  -> formula -> formula
  | Or :  formula -> formula -> formula
  | Implies :  formula -> formula ->formula
  | Knows : actor -> formula -> formula
  | EvKnows :  formula -> formula (*me*)
    .

  Inductive con : Type :=
  | empty : con
  | ext : con -> prop -> con.

  Notation " C # P " := (ext C P) (at level 30).

  Require Import Relations.

  Record kripke : Type := mkKripke {
    K : actor -> relation U; 
    K_equiv: forall y, equivalence _ (K y);
    L : U -> (prop -> Prop)
  }.

Fixpoint max (a b: nat) : nat :=
   match a, b with
   | 0, _ => a
   | _, 0 => b
   | S(a'), S(b') => 1 + max a' b'
end.

Fixpoint length (p: formula) : nat :=
  match p with
     | Proposition p' => 1
     | Not p' => 1 + length(p')
     | And p' p'' => 1 + max (length p') (length p'')
     | Or p' p''  => 1 + max (length p') (length p'')
     | Implies p' p'' => 1 + max  (length p') (length p'')
     | Knows a p'  => 1 + length(p')
     | EvKnows p' => 1 + length(p')
end.

Fixpoint numKnows (p: formula): nat :=
  match p with
 | Proposition p' => 0
 | Not p' => 0 + numKnows(p')
 | And p' p'' => 0 + max (numKnows p') (numKnows p'')
 | Or p' p''  => 0 + max (numKnows p') (numKnows p'')
 | Implies p' p'' => 0 + max  (numKnows p') (numKnows p'')
 | Knows a p'  => 0 + numKnows(p')
 | EvKnows p' => 1 + numKnows(p')
end.

Definition size (p: formula): nat :=
(numKnows p) + (length p).

Definition twice (n: nat) : nat :=
n + n.

Theorem duh: forall a: nat, 1 + a > a.
Proof.   induction a. apply gt_Sn_O.
apply gt_n_S in IHa. unfold plus in *. apply IHa. Qed.

Theorem eq_lt_lt: forall (a b c d: nat), a = b -> c<d -> a+ c< b+d.
Proof. intros. apply plus_le_lt_compat. 
apply eq_nat_elim with (n:=a) (m := b). apply le_refl.
apply eq_nat_is_eq. apply H.  apply H0. Qed.


Function kripke_sat (M : kripke) (s : U) (p : formula) {measure size p}: Prop :=
  match p with
| Proposition p'  => L M (s)(p')
| Not p' => ~ kripke_sat M s p'
| And p' p''   => kripke_sat M s p' /\ kripke_sat M s p''
| Or p' p''  => kripke_sat M s p' \/ kripke_sat M s p''
| Implies p' p''  => ~kripke_sat M s p' \/  kripke_sat M s p''
| Knows a p' =>   forall t, ~(K M a) s t \/ kripke_sat M t p'
| EvKnows p' =>  forall i, kripke_sat M s (Knows i p' )  
 end.

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(2

只为守护你 2024-10-14 06:46:22

“Function”插件仍然处于实验阶段。
在文档中你可以找到

term0 必须构建为纯模式匹配树(match...with),仅在每个分支的末尾具有 λ 抽象和应用程序。

但我必须承认这个错误消息远非明确
(通常此类错误消息应以“请报告”结尾,或者是更多用户信息
友好,我认为这是一个错误)。这意味着函数体内不允许使用 forall(我不知道这种行为是否有理论上的原因)。

所以你需要在没有帮助的情况下“手动”进行定义
功能。这是一个小例子,您可以根据自己的开发进行调整。
祝你好运 !


Inductive form : Set := 
  | T : form 
  | K : nat -> form -> form
  | eK : form -> form.

Fixpoint size (f : form) : nat := match f with 
  | T => 1 
  | K _ f => S (size f)
  | eK f => S (S (size f))
end.

Require Import Wf.
Require Import Wf_nat.

Definition R x y := size x < size y.
Lemma R_wf : well_founded R.
  apply well_founded_ltof.
Qed.

Lemma lem1 : 
  forall x n, R x (K n x).
unfold R; intuition.
Qed.

Lemma lem2 : 
   forall x n, R (K n x) (eK x).
unfold R; intuition.
Qed.


Definition interpret : form -> Prop.
(* we use the well_founded_induction instead of Function *)
refine (well_founded_induction_type R_wf (fun _ => Prop) (fun x f => _)).
destruct x.
exact True.                                     (* ⟦T⟧ ≡ True *)
exact (n = 2 /\ f x (lem1 x n)).                (* ⟦K n F⟧ ≡ (n = 2) ∧ ⟦F⟧ *)
exact (forall n:nat, f (K n x) (lem2 x n)).     (* ⟦eK F⟧ ≡ ∀n:nat,⟦K n F⟧ *)
Defined.

PS:我将使用以下更简单版本的代码来填写错误报告。

  Require Import Recdef.

  Inductive I : Set := 
  | C  : I.

  Definition m (_ : I) := 0.

  Function f (x : I)  {measure m x} : Type := match x with 
  | C => nat -> nat end.

The "Function" plugin is still very experimental.
In the documentation you can find

term0 must be build as a pure pattern-matching tree (match...with) with λ-abstractions and applications only at the end of each branch.

But I have to agree that this error message is far from being explicit
(normally such error messages should either end with "Please report" or be more user
friendly, I consider this as a bug). It means foralls are not allowed in the body of a Function (I don't know whether or not there are theoretical reasons for this behavior).

So you need to do your definition "by hand" without the help of
Function. Here is a small example you can adapt for your development.
Good luck !


Inductive form : Set := 
  | T : form 
  | K : nat -> form -> form
  | eK : form -> form.

Fixpoint size (f : form) : nat := match f with 
  | T => 1 
  | K _ f => S (size f)
  | eK f => S (S (size f))
end.

Require Import Wf.
Require Import Wf_nat.

Definition R x y := size x < size y.
Lemma R_wf : well_founded R.
  apply well_founded_ltof.
Qed.

Lemma lem1 : 
  forall x n, R x (K n x).
unfold R; intuition.
Qed.

Lemma lem2 : 
   forall x n, R (K n x) (eK x).
unfold R; intuition.
Qed.


Definition interpret : form -> Prop.
(* we use the well_founded_induction instead of Function *)
refine (well_founded_induction_type R_wf (fun _ => Prop) (fun x f => _)).
destruct x.
exact True.                                     (* ⟦T⟧ ≡ True *)
exact (n = 2 /\ f x (lem1 x n)).                (* ⟦K n F⟧ ≡ (n = 2) ∧ ⟦F⟧ *)
exact (forall n:nat, f (K n x) (lem2 x n)).     (* ⟦eK F⟧ ≡ ∀n:nat,⟦K n F⟧ *)
Defined.

PS: I am going to fill a bug report with the following simpler version of your code.

  Require Import Recdef.

  Inductive I : Set := 
  | C  : I.

  Definition m (_ : I) := 0.

  Function f (x : I)  {measure m x} : Type := match x with 
  | C => nat -> nat end.
复古式 2024-10-14 06:46:22

错误消息在 Coq 8.4 中已更改,但问题仍然存在。新的错误消息是:“错误:找到了一个产品。无法处理这样的术语”

错误消息中的此更改也导致 Marc 的错误被关闭:
http://www.lix.polytechnique.fr/coq/bugs /show_bug.cgi?id=2457

The error message has changed in Coq 8.4 but the problem is still there. The new error message is: "Error: Found a product. Can not treat such a term"

This change in error message also lead to Marc's bug being closed:
http://www.lix.polytechnique.fr/coq/bugs/show_bug.cgi?id=2457

~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文