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.
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'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.
Is functional extensionality provable for John Major's equality (possibly relying on safe axioms)?
Goal forall A (P:A->Type) (Q:A->Type)
(f:forall a, P a) (g:forall a, Q a),
(forall a, JMeq (f a) (g a)) -> JMeq f g.
If not, is it safe to assume it as an axiom?
It's provable from usual function extensionality.
Require Import Coq.Logic.FunctionalExtensionality.
Require Import Coq.Logic.JMeq.
Theorem jmeq_funext
A (P : A -> Type) (Q : A -> Type)
(f : forall a, P a)(g : forall a, Q a)
(h : forall a, JMeq (f a) (g a)) : JMeq f g.
Proof.
assert (pq_eq : P = Q).
apply functional_extensionality.
exact (fun a => match (h a) with JMeq_refl => eq_refl end).
induction pq_eq.
assert (fg_eq : f = g).
apply functional_extensionality_dep.
exact (fun a => JMeq_rect (fun ga => f a = ga) eq_refl (h a)).
induction fg_eq.
exact JMeq_refl.
Qed.
I got stuck while doing some coq proofs around the state monad. Concretely, I've simplified the situation to this proof:
Definition my_call {A B C} (f : A -> B * C) (a : A) : B * C :=
let (b, c) := f a in (b, c).
Lemma mycall_is_call : forall {A B C} (f : A -> B * C) (a : A), my_call f a = f a.
Proof.
intros A B C f a.
unfold my_call.
(* stuck! *)
Abort.
The resulting goal after invoking unfold is (let (b, c) := f a in (b, c)) = f a. If I'm not wrong, both sides of the equality should be exactly the same, but I don't know how to show it from here. Any help?
--
As a side note, I've seen that coq automatically applies the simplification when no product types are involved in the result of the function:
Definition my_call' {A B : Type} (f : A -> B) (a : A) : B :=
let b := f a in b.
Lemma my_call_is_call' : forall A B (f : A -> B) (a : A), my_call' f a = f a.
Proof.
intros A B f a.
unfold my_call'.
reflexivity.
Qed.
It's easy to see what you need to do next, once you recall that
let (b, c) := f a in (b, c)
is syntactic sugar for
match f a with (b, c) => (b, c) end
This means you need to destruct on f a to finish the proof:
Lemma mycall_is_call {A B C} (f : A -> B * C) a :
my_call f a = f a.
Proof.
unfold my_call.
now destruct (f a).
Qed.