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.
Related
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.
I'm trying to reason on a TRS, and I have ran into the following proof obligation:
infinite_sequence : forall t' : Term,
transitive_closure R t t' ->
exists t'' : Term, R t' t''
============================
exists f : nat -> Term, forall n : nat, R (f n) (f (n + 1))
With transitive_closure defined as follows:
Definition transitive_closure (trs : TRS) (x y : Term) :=
exists f: nat -> Term,
f 0 = x
/\
exists l: nat,
f l = y
/\
forall n: nat,
n < l
->
trs (f n) (f (n + 1))
.
So when I unfold:
infinite_sequence : forall t' : Term,
(exists f : nat -> Term,
f 0 = t /\
(exists l : nat,
f l = t' /\
(forall n : nat, n < l -> R (f n) (f (n + 1))))) ->
exists t'' : Term, R t' t''
============================
exists f : nat -> Term, forall n : nat, R (f n) (f (n + 1))
Is this proof obligation possible to fulfill? I am not married this exact definition of transitive_closure, so if it becomes much easier by choosing a different definition for that, I'm open to that.
Since your goal starts with exists f : nat -> Term, you have to explicitly build such a function. The easiest way to do so is to first build a function with a slightly richer return type ({ u: Term | transitive_closure R t u } instead of Term) and then to project pointwise its first component to finish the proof. This would give the following script:
simple refine (let f : nat -> { u: Term | transitive_closure R t u } := _ in _).
- fix f 1.
intros [|n].
{ exists t. exists (fun _ => t). admit. }
destruct (f n) as [t' H].
destruct (infinite_sequence t' H) as [t'' H']. (* ISSUE *)
exists t''.
destruct H as [f' [H1 [l [H2 H3]]]].
exists (fun m => if Nat.ltb m l then f' m else t'').
admit.
- exists (fun n => proj1_sig (f n)).
intros n.
rewrite Nat.add_1_r.
simpl.
destruct (f n) as [fn Hn].
now destruct infinite_sequence as [t'' H'].
The two admit are just there to keep the code simple; there is nothing difficult about them. The real issue comes from the line destruct (infinite_sequence t' H), since Coq will complain that "Case analysis on sort Set is not allowed for inductive definition ex." Indeed, infinite_sequence states that there exists t'' such that R t' t'', but it does so in a non-informative way (i.e., in Prop), while you need it to build a function that lives in the concrete world (i.e., in Set).
There are only two axiom-free solutions, but both might be incompatible with the remaining of your development. The easiest one is to put infinite_sequence in Set, which means its type is changed to forall t', transitive_closure R t t' -> { t'' | R t' t'' }.
The second solution requires R to be a decidable relation and Term to be an enumerable set. That way, you can still build a concrete t'' by enumerating all the terms until you find one that satisfies R t' t''. In that case, infinite_sequence is only used to prove that this process terminates, so it can be non-informative.
I need to apply FixL_Accumulate to prove the goal, but the unification fails due to the let statements and internal "if-then-else". The question is about how to match the shapes here?
Require Import ZArith.
Inductive branch (A B C : Prop) : Prop :=
| Then: A -> B -> branch A B C
| Else: not A -> C -> branch A B C
.
Definition itep (A B C : Prop) := (A -> B) /\ (~A -> C).
Axiom ite_then : forall A B C : Prop, itep A B C -> A -> B.
Axiom ite_else : forall A B C : Prop, itep A B C -> ~A -> C.
Axiom ite_both : forall A B C : Prop, itep A B C -> (B \/ C).
Axiom contrap: forall P Q : Prop, (P -> Q) -> ~Q -> ~P.
Parameter L_Accumulate : Z -> Z -> Z.
Hypothesis FixL_Accumulate: forall (n c: Z),
let x := ((L_Accumulate n c))%Z in
let x_1 := (n - 1%Z)%Z in itep ((n <= 0)%Z) ((x = c)%Z)
(((n + ((L_Accumulate x_1 c%Z))) = x)%Z).
Goal
forall (i c : Z),
(i > 0)%Z ->
((((L_Accumulate i%Z c%Z)) = ((i + ((L_Accumulate (i - 1%Z)%Z c%Z))))%Z)).
Proof.
intros.
(* something like: apply (#FixL_Accumulate i c). *)
Qed.
I've found the solution. The issue was because of the symmetry. Thus the question was incorrect.
Proof.
intros.
symmetry.
apply (#FixL_Accumulate i c).
intuition.
Qed.
I noticed that Coq synthesizes different induction principles on equality for Prop and Type. Does anybody have an explanation for that?
Equality is defined as
Inductive eq (A : Type) (x : A) : A -> Prop := eq_refl : x = x
And the associated induction principle has the following type:
eq_ind
: forall (A : Type) (x : A) (P : A -> Prop),
P x -> forall y : A, x = y -> P y
Now let's define a Type pendant of eq:
Inductive eqT {A:Type}(x:A):A->Type:= eqT_refl: eqT x x.
The automatically generated induction principle is
eqT_ind
: forall (A : Type) (x : A) (P : forall a : A, eqT x a -> Prop),
P x (eqT_refl x) -> forall (y : A) (e : eqT x y), P y e
Note: I'm going to use _rect principles everywhere instead of _ind, since _ind principles are usually implemented via the _rect ones.
Type of eqT_rect
Let's take a look at the predicate P.
When dealing with inductive families, the number of arguments of P is equal to the number of non-parametric arguments (indices) + 1.
Let me give some examples (they can be easily skipped).
Natural numbers don't have parameters at all:
Inductive nat : Set := O : nat | S : nat -> nat.
So, the predicate P will be of type nat -> Type.
Lists have one parametric argument (A):
Inductive list (A : Type) : Type :=
nil : list A | cons : A -> list A -> list A.
Again, P has only one argument: P : list A -> Type.
Vectors are a different:
Inductive vec (A : Type) : nat -> Type :=
nil : vec A 0
| cons : A -> forall n : nat, vec A n -> vec A (S n).
P has 2 arguments, because n in vec A n is a non-parameteric argument:
P : forall n : nat, vec A n -> Type
The above explains eqT_rect (and, of course, eqT_ind as a consequence), since the argument after (x : A) is non-parametric, P has 2 arguments:
P : forall a : A, eqT x a -> Type
which justifies the overall type for eqT_rect:
eqT_rect
: forall (A : Type) (x : A) (P : forall a : A, eqT x a -> Type),
P x (eqT_refl x) -> forall (y : A) (e : eqT x y), P y e
The induction principle obtained in this way is called a maximal induction principle.
Type of eq_rect
The generated induction principles for inductive predicates (such as eq) are simplified to express proof irrelevance (the term for this is simplified induction principle).
When defining a predicate P, Coq simply drops the last argument of the predicate (which is the type being defined, and it lives in Prop). That's why the predicate used in eq_rect is unary. This fact shapes the type of eq_rect:
eq_rect :
forall (A : Type) (x : A) (P : A -> Type),
P x -> forall y : A, x = y -> P y
How to generate maximal induction principle
We can also make Coq generate non-simplified induction principle for eq:
Scheme eq_rect_max := Induction for eq Sort Type.
The resulting type is
eq_rect_max :
forall (A : Type) (x : A) (P : forall a : A, x = a -> Type),
P x eq_refl -> forall (y : A) (e : x = y), P y e
and it has the same structure as eqT_rect.
References
For more detailed explanation see sect. 14.1.3 ... 14.1.6 of the book "Interactive Theorem Proving and Program Development (Coq'Art: The Calculus of Inductive Constructions)" by Bertot and Castéran (2004).
I'm trying to demonstrate the difference in code generation between Coq Extraction mechanism and MAlonzo compiler in Agda. I came up with this simple example in Agda:
data Nat : Set where
zero : Nat
succ : Nat → Nat
data List (A : Set) : Set where
nil : List A
cons : A → List A → List A
length : ∀ {A} → List A → Nat
length nil = zero
length (cons _ xs) = succ (length xs)
data Fin : Nat → Set where
finzero : ∀ {n} → Fin (succ n)
finsucc : ∀ {n} → Fin n → Fin (succ n)
elemAt : ∀ {A} (xs : List A) → Fin (length xs) → A
elemAt nil ()
elemAt (cons x _) finzero = x
elemAt (cons _ xs) (finsucc n) = elemAt xs n
Direct translation to Coq (with absurd pattern emulation) yields:
Inductive Nat : Set :=
| zero : Nat
| succ : Nat -> Nat.
Inductive List (A : Type) : Type :=
| nil : List A
| cons : A -> List A -> List A.
Fixpoint length (A : Type) (xs : List A) {struct xs} : Nat :=
match xs with
| nil => zero
| cons _ xs' => succ (length _ xs')
end.
Inductive Fin : Nat -> Set :=
| finzero : forall n : Nat, Fin (succ n)
| finsucc : forall n : Nat, Fin n -> Fin (succ n).
Lemma finofzero : forall f : Fin zero, False.
Proof. intros a; inversion a. Qed.
Fixpoint elemAt (A : Type) (xs : List A) (n : Fin (length _ xs)) : A :=
match xs, n with
| nil, _ => match finofzero n with end
| cons x _, finzero _ => x
| cons _ xs', finsucc m n' => elemAt _ xs' n' (* fails *)
end.
But the last case in elemAt fails with:
File "./Main.v", line 26, characters 46-48:
Error:
In environment
elemAt : forall (A : Type) (xs : List A), Fin (length A xs) -> A
A : Type
xs : List A
n : Fin (length A xs)
a : A
xs' : List A
n0 : Fin (length A (cons A a xs'))
m : Nat
n' : Fin m
The term "n'" has type "Fin m" while it is expected to have type
"Fin (length A xs')".
It seems that Coq does not infer succ m = length A (cons A a xs'). What should I
tell Coq so it would use this information? Or am I doing something completely senseless?
Doing pattern matching is the equivalent of using the destruct tactic.
You won't be able to prove finofzero directly using destruct.
The inversion tactic automatically generates some equations before doing what destruct does.
Then it tries to do what discriminate does. The result is really messy.
Print finofzero.
To prove something like fin zero -> P you should change it to fin n -> n = zero -> P first.
To prove something like list nat -> P (more usually forall l : list nat, P l) you don't need to change it to list A -> A = nat -> P, because list's only argument is a parameter in its definition.
To prove something like S n <= 0 -> False you should change it to S n1 <= n2 -> n2 = 0 -> False first, because the first argument of <= is a parameter while the second one isn't.
In a goal f x = f y -> P (f y), to rewrite with the hypothesis you first need to change the goal to f x = z -> f y = z -> P z, and only then will you be able to rewrite with the hypothesis using induction, because the first argument of = (actually the second) is a parameter in the definition of =.
Try defining <= without parameters to see how the induction principle changes.
In general, before using induction on a predicate you should make sure it's arguments are variables. Otherwise information might be lost.
Conjecture zero_succ : forall n1, zero = succ n1 -> False.
Conjecture succ_succ : forall n1 n2, succ n1 = succ n2 -> n1 = n2.
Lemma finofzero : forall n1, Fin n1 -> n1 = zero -> False.
Proof.
intros n1 f1.
destruct f1.
intros e1.
eapply zero_succ.
eapply eq_sym.
eapply e1.
admit.
Qed.
(* Use the Show Proof command to see how the tactics manipulate the proof term. *)
Definition elemAt' : forall (A : Type) (xs : List A) (n : Nat), Fin n -> n = length A xs -> A.
Proof.
fix elemAt 2.
intros A xs.
destruct xs as [| x xs'].
intros n f e.
destruct (finofzero f e).
destruct 1.
intros e.
eapply x.
intros e.
eapply elemAt.
eapply H.
eapply succ_succ.
eapply e.
Defined.
Print elemAt'.
Definition elemAt : forall (A : Type) (xs : List A), Fin (length A xs) -> A :=
fun A xs f => elemAt' A xs (length A xs) f eq_refl.
CPDT has more about this.
Maybe things would be clearer if at the end of a proof Coq performed eta reduction and beta/zeta reduction (wherever variables occur at most once in scope).
I think your problem is similar to Dependent pattern matching in coq . Coq's match does not infer much, so you have to help it by providing the equality by hand.