I'm trying to define first-order logic in Coq and beginning at terms.
Supposing that c1 and c2 are two constant symbols, variables are nat and f1 and f2 are two function symbols whose arities are 1 and 2 respectively, I wrote the following code.
Definition var := nat.
Inductive const : Type :=
| c1
| c2.
Inductive term : Type :=
| Con : const -> term
| Var : var -> term
| F1 : term -> term
| F2 : term -> term -> term.
Then, I got a desired induction.
Check term_ind.
(* ==> term_ind
: forall P : term -> Prop,
(forall c : const, P (Con c)) ->
(forall v : var, P (Var v)) ->
(forall t : term, P t -> P (F1 t)) ->
(forall t : term, P t -> forall t0 : term, P t0 -> P (F2 t t0)) ->
forall t : term, P t *)
Then I wanted to separate functions from the definition of term, so I rewrote the above.
(*Idea A*)
Inductive funct {X : Type} : Type :=
| f1 : X -> funct
| f2 : X -> X -> funct.
Inductive term : Type :=
| Con : const -> term
| Var : var -> term
| Fun : #funct term -> term.
Check term_ind.
(* ==> term_ind
: forall P : term -> Prop,
(forall c : const, P (Con c)) ->
(forall v : var, P (Var v)) ->
(forall f1 : funct, P (Fun f1)) ->
forall t : term, P t *)
Check funct_ind term.
(* ==> funct_ind term
: forall P : funct -> Prop,
(forall x : term, P (f1 x)) ->
(forall x x0 : term, P (f2 x x0)) ->
forall f1 : funct, P f1 *)
(*Idea B*)
Inductive term : Type :=
| Con : const -> term
| Var : var -> term
| Fun : funct -> term
with funct : Type :=
| f1 : term -> funct
| f2 : term -> term -> funct.
Check term_ind.
(* ==> term_ind
: forall P : term -> Prop,
(forall c : const, P (Con c)) ->
(forall v : var, P (Var v)) ->
(forall f1 : funct, P (Fun f1)) ->
forall t : term, P t *)
Check funct_ind.
(* ==> funct_ind
: forall P : funct -> Prop,
(forall t : term, P (f1 t)) ->
(forall t t0 : term, P (f2 t t0)) ->
forall f1 : funct, P f1 *)
However, both ways seem not to generate the desired induction because they don't have induction hypotheses.
How can I construct term with functions separated from the definition of term without loss of proper induction?
Thanks.
This is a common issue with Coq: the induction principles generated for mutually inductive types and for types with complex recursive occurrences are too weak. Fortunately, this can be fixed by defining the induction principles by hand. In your case, the simplest approach is to use the mutually inductive definition, since Coq can lend us a hand for proving the principle.
First, let ask Coq not to generate its weak default induction principle:
Unset Elimination Schemes.
Inductive term : Type :=
| Con : const -> term
| Var : var -> term
| Fun : funct -> term
with funct : Type :=
| f1 : term -> funct
| f2 : term -> term -> funct.
Set Elimination Schemes.
(This is not strictly necessary, but it helps keeping the global namespace clean.)
Now, let us use the Scheme command to generate a mutual induction principle for these types:
Scheme term_ind' := Induction for term Sort Prop
with funct_ind' := Induction for funct Sort Prop.
(*
term_ind'
: forall (P : term -> Prop) (P0 : funct -> Prop),
(forall c : const, P (Con c)) ->
(forall v : var, P (Var v)) ->
(forall f1 : funct, P0 f1 -> P (Fun f1)) ->
(forall t : term, P t -> P0 (f1 t)) ->
(forall t : term, P t -> forall t0 : term, P t0 -> P0 (f2 t t0)) ->
forall t : term, P t
*)
This principle is already powerful enough for us to prove properties of term, but it is a bit awkward to use, since it requires us to specify a property that we want to prove about the funct type as well (the P0 predicate). We can simplify it a bit to avoid mentioning this auxiliary predicate: all we need to know is that the terms inside the function calls satisfy the predicate that we want to prove.
Definition lift_pred (P : term -> Prop) (f : funct) : Prop :=
match f with
| f1 t => P t
| f2 t1 t2 => P t1 /\ P t2
end.
Lemma term_ind (P : term -> Prop) :
(forall c, P (Con c)) ->
(forall v, P (Var v)) ->
(forall f, lift_pred P f -> P (Fun f)) ->
forall t, P t.
Proof.
intros HCon HVar HFun.
apply (term_ind' P (lift_pred P)); trivial.
now intros t1 IH1 t2 IH2; split.
Qed.
If you prefer, you can also rewrite this to look more like the original induction principle:
Reset term_ind.
Lemma term_ind (P : term -> Prop) :
(forall c, P (Con c)) ->
(forall v, P (Var v)) ->
(forall t, P t -> P (Fun (f1 t))) ->
(forall t1, P t1 -> forall t2, P t2 -> P (Fun (f2 t1 t2))) ->
forall t, P t.
Proof.
intros HCon HVar HFun_f1 HFun_f2.
apply (term_ind' P (lift_pred P)); trivial.
- now intros [t|t1 t2]; simpl; intuition.
- now simpl; intuition.
Qed.
Edit
To get an induction principle for your other approach, you have to write a proof term by hand:
Definition var := nat.
Inductive const : Type :=
| c1
| c2.
Inductive funct (X : Type) : Type :=
| f1 : X -> funct X
| f2 : X -> X -> funct X.
Arguments f1 {X} _.
Arguments f2 {X} _ _.
Unset Elimination Schemes.
Inductive term : Type :=
| Con : const -> term
| Var : var -> term
| Fun : funct term -> term.
Set Elimination Schemes.
Definition term_ind (P : term -> Type)
(HCon : forall c, P (Con c))
(HVar : forall v, P (Var v))
(HF1 : forall t, P t -> P (Fun (f1 t)))
(HF2 : forall t1, P t1 -> forall t2, P t2 -> P (Fun (f2 t1 t2))) :
forall t, P t :=
fix loop (t : term) : P t :=
match t with
| Con c => HCon c
| Var v => HVar v
| Fun (f1 t) => HF1 t (loop t)
| Fun (f2 t1 t2) => HF2 t1 (loop t1) t2 (loop t2)
end.
Related
I tried to implement the following Coq code:
Set Implicit Arguments.
Inductive fun_eq A B (f : A -> B) : forall C D, (C -> D) -> Prop :=
fun_eqrefl : forall g : A -> B, f = g -> fun_eq f g.
Lemma fun_eq0 A B (f g : A -> B) : fun_eq f g -> f = g.
Proof. intros H. destruct H.
But destruct H. fails with an error message:
Abstracting over the terms "A", "B" and "g" leads to a term
fun (A0 B0 : Type) (g0 : A0 -> B0) => f = g0 which is ill-typed.
Reason is: Illegal application:
The term "#eq" of type "forall A : Type, A -> A -> Prop" cannot be applied to the terms
"A0 -> B0" : "Type"
"f" : "A -> B"
"g0" : "A0 -> B0"
The 2nd term has type "A -> B" which should be coercible to
"A0 -> B0".
I think there would be two workarounds for this kind of error, neither of which worked in this case.
One is to admit the proof_irrelevance. However, it is impossible to construct an alternating proof for fun_eq f g because the argument of fun_eqrefl is what we want.
Another way is to provide an exact term using refine, but I couldn't come up with such a term. Also, if there were such a term (it would involve match statement), I suspect my previous question could be solved in a similar way.
Is it possible to prove fun_eq0? If so, how can it be done?
You can prove it using UIP (special case of proof irrelevance for eq).
The trick is to rewrite one side of the equality f to cast eq_refl f, where cast : A = B -> A -> B, and use UIP/proof irrelevance to replace eq_refl with an equality proof obtained from the H : fun_eq f g assumption. That way, when you destruct H, the type of the LHS changes simultaneously with the type of the RHS.
Set Implicit Arguments.
From Coq Require Import ProofIrrelevance.
Inductive fun_eq A B (f : A -> B) : forall C D, (C -> D) -> Prop :=
fun_eqrefl : forall g : A -> B, f = g -> fun_eq f g.
(* Extract the equality on types *)
Definition fun_eq_tyeq {A B C D} (f : A -> B) (g : C -> D) (H : fun_eq f g) : (A -> B) = (C -> D) :=
match H with
| fun_eqrefl _ => eq_refl
end.
Definition cast A B (e : A = B) (x : A) : B := eq_rect A (fun T => T) x B e.
Lemma fun_eq0 A B (f g : A -> B) : fun_eq f g -> f = g.
Proof.
intros H.
change (cast eq_refl f = g).
replace eq_refl with (fun_eq_tyeq H) by apply UIP.
destruct H.
cbn.
auto.
Qed.
I have a simple lazy binary tree implementation:
CoInductive LTree (A : Set) : Set :=
| LLeaf : LTree A
| LBin : A -> (LTree A) -> (LTree A) -> LTree A.
And following properties:
(* Having some infinite branch *)
CoInductive SomeInfinite {A} : LTree A -> Prop :=
SomeInfinite_LBin :
forall (a : A) (l r : LTree A), (SomeInfinite l \/ SomeInfinite r) ->
SomeInfinite (LBin _ a l r).
(* Having only finite branches (i.e. being finite) *)
Inductive AllFinite {A} : LTree A -> Prop :=
| AllFinite_LLeaf : AllFinite (LLeaf A)
| AllFinite_LBin :
forall (a : A) (l r : LTree A), (AllFinite l /\ AllFinite r) ->
AllFinite (LBin _ a l r).
I would like to prove a theorem that states that a finite tree does not have any infinite branches:
Theorem allfinite_noinfinite : forall {A} (t : LTree A), AllFinite t -> not (SomeInfinite t).
...but I got lost after first few tactics. The hypothesis itself seems pretty trivial, but I cannot even start with it. What would proving of such a theorem look like?
The proof is actually not difficult (but you stumbled upon some annoying quirks): to start, the main idea of the proof is that you have an inductive witness that t is finite, so you can do an induction on that witness concluding with a contradiction when t is just a leaf and reusing the inductive hypothesis when it is a binary node.
Now the annoying problem is that Coq does not derive the right induction principle for AllFinite because of /\ : compare
Inductive AllFinite {A} : LTree A -> Prop :=
| AllFinite_LLeaf : AllFinite (LLeaf A)
| AllFinite_LBin :
forall (a : A) (l r : LTree A), AllFinite l /\ AllFinite r ->
AllFinite (LBin _ a l r).
Check AllFinite_ind.
(* AllFinite_ind *)
(* : forall (A : Set) (P : LTree A -> Prop), *)
(* P (LLeaf A) -> *)
(* (forall (a : A) (l r : LTree A), *)
(* AllFinite l /\ AllFinite r -> P (LBin A a l r)) -> *)
(* forall l : LTree A, AllFinite l -> P l *)
with
Inductive AllFinite' {A} : LTree A -> Prop :=
| AllFinite'_LLeaf : AllFinite' (LLeaf A)
| AllFinite'_LBin :
forall (a : A) (l r : LTree A), AllFinite' l -> AllFinite' r ->
AllFinite' (LBin _ a l r).
Check AllFinite'_ind.
(* AllFinite'_ind *)
(* : forall (A : Set) (P : LTree A -> Prop), *)
(* P (LLeaf A) -> *)
(* (forall (a : A) (l r : LTree A), *)
(* AllFinite' l -> P l -> AllFinite' r -> P r -> P (LBin A a l r)) -> *)
(* forall l : LTree A, AllFinite' l -> P l *)
In the inductive case, the first version does not give you the expected inductive hypothesis. So either you can change your AllFinite to AllFInite', or you need to reprove the induction principle by hand.
I can define finite types in Coq like this:
Inductive fin : nat -> Set :=
| FZ : forall {n}, fin (S n)
| FS : forall {n}, fin n -> fin (S n).
Definition void := fin 0.
Definition unit := fin 1.
Definition vunit : unit := FZ.
Definition bool := fin 2.
Definition true : bool := FZ.
Definition false : bool := FS FZ.
Can I proof the induction principles for void, unit and bool just from the induction principles of nat and fin?
I have proven the induction principle for void already:
Lemma void_ind : forall (P : void -> Prop) (x : void), P x.
Proof.
intros.
inversion x.
Qed.
But I don't know how to proceed with unit:
Lemma unit_ind : forall (P : unit -> Prop) (x : unit), P vunit -> P x.
I figure I need:
Lemma unit_uniq : forall (x : fin 1), x = FZ.
And in my head this seems obvious, but I don't know how to proceed with the proof.
After that I also like to prove:
Lemma bool_ind : forall (P : bool -> Prop) (x : bool), P true -> P false -> P x.
There are many ways of deriving these induction principles. Since you asked
explicitly about using the induction principles for fin and nat, I am going
to use those. Actually, since all the derived types are finite, we can get away
with just using a case analysis principle, which we can define in terms of
induction. Here is how we define case analysis for the natural numbers. (I am
putting the Type valued recursor here, since we'll need the extra generality.)
Definition nat_case :
forall (P : nat -> Type),
P 0 ->
(forall n, P (S n)) ->
forall n, P n :=
fun P HZ HS => nat_rect P HZ (fun n _ => HS n).
We can define an analogous principle for fin. But to make it more useful, we
add a little twist. The original recursor for fin is parameterized over a
predicate P : forall n, fin n -> Prop that must work for fins of an
arbitrary upper bound. We'll use nat_case so that we can fix the upper bound
we use (cf. the types of P below).
Inductive fin : nat -> Set :=
| FZ : forall {n}, fin (S n)
| FS : forall {n}, fin n -> fin (S n).
Definition fin_case_result n : fin n -> Type :=
nat_case (fun n => fin n -> Type)
(fun x : fin 0 =>
forall (P : fin 0 -> Type), P x)
(fun m (x : fin (S m)) =>
forall (P : fin (S m) -> Type),
P FZ ->
(forall y, P (FS y)) ->
P x)
n.
Definition fin_case :
forall n (x : fin n), fin_case_result n x :=
fun n x =>
fin_rect fin_case_result
( (* FZ case *)
fun m P HZ HS => HZ)
( (* FS case.
The blank is the result of the recursive call. *)
fun m (y : fin m) _ P HZ HS => HS y)
n x.
Thanks to fin_case, we can define the induction principles you wanted:
Definition void := fin 0.
Definition unit := fin 1.
Definition vunit : unit := FZ.
Definition bool := fin 2.
Definition true : bool := FZ.
Definition false : bool := FS FZ.
Definition void_ind :
forall (P : void -> Prop)
(x : void),
P x :=
fun P x => fin_case 0 x P.
Definition unit_ind :
forall (P : unit -> Prop)
(HZ : P vunit)
(x : unit),
P x :=
fun P HZ x =>
fin_case 1 x P HZ (void_ind (fun y => P (FS y))).
Definition bool_ind :
forall (P : bool -> Prop)
(HT : P true)
(HF : P false)
(x : bool),
P x :=
fun P HT HF x =>
fin_case 2 x P HT (unit_ind (fun y => P (FS y)) HF).
I am currently going through the book 'Computational Type Theory and Interactive Theorem Proving with Coq' by Gert Smolka, and on page 93, the following inductive predicate is defined:
Inductive G (f:nat -> bool) : nat -> Prop :=
| mkG : forall (n:nat), (f n = false -> G f (S n)) -> G f n
.
Then on page 95 it is argued that one can define an eliminator:
Definition elimG : forall (f:nat -> bool) (p:nat -> Type),
(forall (n:nat), (f n = false -> p (S n)) -> p n) ->
forall (n:nat), G f n -> p n.
Proof.
...
The book spells out an expression of a term of this type, namely:
elimG f p g n (mkG _ _ h) := g n (λe. elimG f p g (S n) (h e))
(I have changed a few notations for the purpose of this post)
which I formally translated as:
refine (
fun (f:nat -> bool) (p:nat -> Type) =>
fun (H1:forall (n:nat), (f n = false -> p (S n)) -> p n) =>
fun (n:nat) (H2:G f n) =>
match H2 with
| mkG _ _ H3 => _
end
).
However, Coq will not allow me to carry out the pattern match due to the elim restriction.
The book informally says "Checking that the defining equation of elimG is well-typed is not difficult"
I am posting this in the hope that someone familiar with the book will have an opinion as to whether the author made a mistake, or whether I am missing something.
EDIT:
Having played around with the two answers below, the simplest term expression I have come up with is as follows:
Definition elimG
(f:nat -> bool)
(p:nat -> Type)
(g: forall (n:nat), (f n = false -> p (S n)) -> p n)
: forall (n:nat), G f n -> p n
:= fix k (n:nat) (H:G f n) : p n := g n
(fun e => k (S n)
( match H with
| mkG _ _ H => H
end e)).
This definition is possible, there's just a subtlety here. The G (which is in Prop) is never needed to make a decision here, because it only has one constructor. So you just do the
elimG f p g n h := g n (λe. elimG f p g (S n) _)
"unconditionally" outside of any match on h. That hole now has expected type G f (S n), which now is in Prop, and we can do our match on h there. We also have to do some rewriting shenanigans with the match. Putting everything together, we write
Fixpoint elimG
(f : nat -> bool) (p : nat -> Type)
(g : forall (n:nat), (f n = false -> p (S n)) -> p n)
(n : nat) (H : G f n) {struct H}
: p n :=
g n
(fun e =>
elimG f p g (S n)
(match H in G _ n return f n = false -> G f (S n) with (* in and return clause can be inferred; we're rewriting the n in e's type *)
| mkG _ _ H => H
end e)).
That's a tricky one.
The author is not wrong, it is possible to define such an elimination principle but you have to be careful about how and when you match on your hypothesis.
The error that you get from Coq is that you are matching on a proposition to build an element of a Type. Coq forbid this so that proposition can be erased when extracting code, so you cannot do such a case-analysis of a proposition to build some computationally meaningful object (there are exceptions to this rule for instance for empty propositions).
Since you cannot start by pattern matching on H2, you can try to push this case-analysis as late as possible. Here you only need to do the case analysis in the application (h e) so you could replace it by match H2 with mkG _ n' h -> h e end.
However this does not work because h is of type f' n' = false -> ... whereas e : f n = false and you need to explain to Coq that n and n' are the same. This is achieved through dependent pattern matching, putting the apllication outside of the match and using a return clause in the script below (actually Coq can infer this return clause, I'm just leaving it for explanations).
Inductive G (f:nat -> bool) : nat -> Prop :=
| mkG : forall (n:nat), (f n = false -> G f (S n)) -> G f n
.
Fixpoint elimG (f:nat -> bool) (p:nat -> Type)
(g : forall (n:nat), (f n = false -> p (S n)) -> p n)
(n:nat) (H : G f n) {struct H} : p n.
Proof.
refine (g n (fun e => elimG f p g (S n) _)).
refine (match H in G _ n0 return f n0 = false -> G f (S n0) with mkG _ _ h => h end e).
Qed.
I'm trying to formalize applicaion of context-free grammars in practice task. I have problems in proving one lemma. I tried to simplify my context to outline the problem, but it is still a bit cumbersome.
So I defined CFG in Chomsky normal form and derivability of list of terminals as follows:
Require Import List.
Import ListNotations.
Inductive ter : Type := T : nat -> ter.
Inductive var : Type := V : nat -> var.
Inductive eps : Type := E : eps.
Inductive rule : Type :=
| Rt : var -> ter -> rule
| Rv : var -> var -> var -> rule
| Re : var -> eps -> rule.
Definition grammar := list rule.
Inductive der_ter_list : grammar -> var -> list ter -> Prop :=
| Der_eps : forall (g : grammar) (v : var) (e : eps),
In (Re v e) g -> der_ter_list g v []
| Der_ter : forall (g : grammar) (v : var) (t : ter),
In (Rt v t) g -> der_ter_list g v [t]
| Der_var : forall (g : grammar) (v v1 v2 : var) (tl1 tl2 : list ter),
In (Rv v v1 v2) g -> der_ter_list g v1 tl1 -> der_ter_list g v2 tl2 ->
der_ter_list g v (tl1 ++ tl2).
I have objects that store terminal and some additional info, for example:
Inductive obj : Set := Get_obj : nat -> ter -> obj.
And I try to define all possible lists of objects, which are derivable from given nonterminal (with helper functions):
Fixpoint get_all_pairs (l1 l2 : list (list obj)) : list (list obj) := match l1 with
| [] => []
| l::t => (map (fun x => l ++ x) l2) ++ get_all_pairs t l2
end.
Fixpoint getLabels (objs : list obj) : list ter := match objs with
| [] => []
| (Get_obj yy ter)::t => ter::(getLabels t)
end.
Inductive paths : grammar -> var -> list (list obj) -> Prop :=
| Empty_paths : forall (g : grammar) (v : var) (e : eps),
In (Re v e) g -> paths g v [[]]
| One_obj_path : forall (g : grammar) (v : var) (n : nat) (t : ter) (objs : list obj),
In (Rt v t) g -> In (Get_obj n t) objs -> paths g v [[Get_obj n t]]
| Combine_paths : forall (g : grammar) (v v1 v2 : var) (l1 l2 : list (list obj)),
In (Rv v v1 v2) g -> paths g v1 l1 -> paths g v2 l2 -> paths g v (get_all_pairs l1 l2).
(Each constructor of paths actually corresponds to constructor of rule)
And now I'm trying to proof fact about paths by induction, that every element in paths can be derived from nonterminal:
Theorem derives_all_path : forall (g: grammar) (v : var)
(ll : list (list obj)) (pths : paths g v ll), forall (l : list obj),
In l ll -> der_ter_list g v (getLabels l).
Proof.
intros g v ll pt l contains.
induction pt.
This construction generates 3 subgoals, 1st and 2nd I've proved by applying Der_eps and Der_ter constructors respectively.
But context in 3rd subgoal is not relevant to prove my goal, it has:
contains : In l (get_all_pairs l1 l2)
IHpt1 : In l l1 -> der_ter_list g v1 (getLabels l)
IHpt2 : In l l2 -> der_ter_list g v2 (getLabels l)
So contains means that l is concatenation of some elements from l1 and l2, but premises in IHpt1 and IHpt2 are true iff l2 and l1 has empty lists, which is not true in general, so it is impossible to prove goal with this context.
The problem can be resolved if l in contains, IHpt1, IHpt2 will be different lists, but unfortunately I don't know how to explain it to Coq. Is it any way somehow change IHpt1 and IHpt2 to prove the goal, or any other way to prove the whole fact?
I tried to look on paths_ind, but it didn't make me happy.
It looks like your induction hypothesis is not strong enough. If you perform induction pt on a more polymorphic goal, you'll get more useful hypotheses not tied to the specific l you started with.
You should try:
intros g v ll pt; induction pt; intros l contains.