I have a proof state similar to what is shown below (I've simplified it some to focus on the essence of the problem I'm having). I'm almost certain that a contradiction exists in my assumptions. However, assumption H consists of a nested match that depends on the result of the expression "eq_nat_dec n n'". (I arrived at the left-hand-side of H by simplifying another function that is in terms of eq_nat_dec).
The good news is that i have an assumption (n0) that ensures that the "right" branch of the inner-most match should fire, which also ensures that the "inright" branch of the outer match should fire, resulting in the value "bad" ("good" and "bad" are two constructors of the same Inductive type, thus an assumption of good = bad would provide the necessary contradiction).
The bad news is that I don't know how to "inform" the inner match in assumption H about the assumption n0. I've tried using subst, and inversion on H, but the nested matches remain.
In conclusion: How do I force H to take the right branches of its matches using the information in n0?
n, n' : nat
H :
match
match eq_nat_dec n n' with
| left _ => inleft _
| right _ => inright _
end
with
| inleft _ => _
| inright _ => bad
end = good
n0 : n <> n'
============================
False
The only solution I know is to destruct eq_nat_dec n n' and proves that the left branch is contradictory because of n <> n'. It would give something like:
destruct (eq_nat_dec n n'); [contradiction | discriminate].
Indeed, as the previous answer said, destruct + congruence will work fine.
You could try to introduce a lemma:
Lemma eqn_rwN {x y : nat} (h : x <> y) : Nat.eq_dec x y = right h.
Proof.
destruct (Nat.eq_dec _ _); try congruence.
apply f_equal.
(* Use Eqdep_dec.eq_proofs_unicity? *)
Admitted.
so that you could rewrite the comparison, as this unicity of identity proofs should be provable given that nat has decidable equality:
Lemma u2
(n n' : nat)
(H : match (match Nat.eq_dec n n' with
| left x => inleft x
| right y => inright y
end)
with
| inleft x => true
| inright _ => false
end = true)
(hnn : n <> n') : False.
Proof. rewrite (eqn_rwN hnn) in H. congruence. Qed.
Other Coq libraries such as mathcomp take a different approach and put equality in bool, thus you can directly rewrite:
From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat.
Lemma u3 (n n' : nat)
(H : (if n == n' then true else false) = true)
(hnn : n != n') : False.
Proof. by rewrite (negbTE hnn) in H. Qed.
IMVHO this turns out to be more convenient if you are verifying algorithms.
Related
I have two lists, one constructed directly by recursion and the other constructed using a map operation. I'm trying to show they are equal, and surprisingly I got stuck.
Require Import Coq.Lists.List.
Import ListNotations.
Fixpoint ls_zeroes n :=
match n with
| 0 => nil
| S n' => 0 :: ls_zeroes n'
end.
Fixpoint ls_ones n := map S (ls_zeroes n).
Fixpoint ls_ones' n :=
match n with
| 0 => nil
| S n' => 1 :: ls_ones' n'
end.
Goal forall n, ls_ones n = ls_ones' n.
Proof.
intros.
induction n.
- reflexivity.
- simpl. f_equal. (* ??? *)
Abort.
This is what the context looks like:
1 subgoal
n : nat
IHn : ls_ones n = ls_ones' n
______________________________________(1/1)
map S (ls_zeroes n) = ls_ones' n
I thought fold ls_ones would map S (ls_zeroes n) into ls_ones n since that's literally the definition of ls_ones but it does nothing. If I try to unfold ls_ones in IHn I get a nasty recursive expression instead of the verbatim definition of ls_ones.
What is the cleanest way to complete this proof?
Notice that when you define ls_one and unfold the definition you gets :
(fix ls_ones (n0 : nat) : list nat := map S (ls_zeroes n0)) n = ls_ones' n
The problem is that ls_one isn't a fixpoint. Indeed, it's doesn't make a recursion. Once coq automatically defines the point {struct n0} (in that case the n argument), your proof gets stuck because n is never destructed in P k -> P (k + 1), 'cause k is not destructed.
Using :
Definition ls_ones n := map S (ls_zeroes n).
The proof becomes trivial :
Goal forall n, ls_ones n = ls_ones' n.
Proof.
intros.
induction n.
trivial.
unfold ls_ones in *.
simpl.
rewrite IHn.
trivial.
Qed.
I thought fold ls_ones would map S (ls_zeroes n) into ls_ones n since that's literally the definition of ls_ones
Is it? You said Fixpoint ls_ones, not Definition. Just like any Fixpoint, this means that the given definition of ls_ones is transformed into a fix. There's no recursive structure in the definition given, so this is pointless, but you said to do it, so Coq does it. Issue Print ls_ones. to see the actual definition. The true solution is to make ls_ones a Definition.
If you don't fix that, Coq will only reduce a Fixpoint if the recursive argument(s) start with constructors. Then, in order to complete this proof, you need to destruct n to show those constructors:
Goal forall n, ls_ones n = ls_ones' n.
Proof.
intros.
induction n.
- reflexivity.
- simpl. f_equal. destruct n; assumption.
Qed.
Unfortunately, due to the value being fixed in your definitions you must use induction to do the proof:
From mathcomp Require Import all_ssreflect.
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.
Fixpoint seq0 n :=
match n with
| 0 => nil
| S n' => 0 :: seq0 n'
end.
Fixpoint seq1 n :=
match n with
| 0 => nil
| S n' => 1 :: seq1 n'
end.
Lemma eq_F n : seq1 n = [seq n.+1 | n <- seq0 n].
Proof. by elim: n => //= n ->. Qed.
There is not a lot to proof tho. I'd recommend tho using the more general nseq count elem function instead of definition your own duplicate structures, then the proof follows pretty quickly from the general lemma about map:
Lemma eq_G n : nseq n 1 = [seq n.+1 | n <- nseq n 0].
Proof. by rewrite map_nseq. Qed.
I have the following in my proof environment:
1 subgoal
a, b : nat
H : (fix loop (m : nat) : nat :=
match (m - a) with
| 0 => m
| S m' => loop m'
end) b = 0
G : (b - a) = 0
Clearly, H is equivalent to
match (b - a) with
| 0 => b
| S m' => loop m'
end = 0
Which would then allow me to rewrite using G.
But since it is trapped in there, represented as (m - a), I cannot rewrite using G.
How do I unfold a fixpoint out by one iteration?
Edit: The following code will set up the proof environment. Just ignore the admit statements. Your goal is not to prove the statement (which is trivial) but to "unfold" the fixpoint.
From mathcomp Require Import all.
Goal forall a b : nat,
modn b a = 0 -> True.
Proof.
intros a b H.
unfold modn in H.
destruct a.
+ admit.
+ simpl in H.
assert ((b - a) = 0) as G.
- admit.
- unfold modn_rec in H.
To unfold a fixpoint you need to destruct its decreasing argument.
destruct b; simpl in H.
If you want to keep a single case, you'll have to prove the equality you mention in a separate lemma or assertion.
assert (Hfix : (fix loop m := match ... end) b = match ... end)
Currently, I've started working on proving theorems about first-order logic in Coq(VerifiedMathFoundations). I've proved deduction theorem, but then I got stuck with lemma 1 for theorem of correctness. So I've formulated one elegant piece of the lemma compactly and I invite the community to look at it. That is an incomplete the proof of well-foundness of the terms. How to get rid of the pair of "admit"s properly?
(* 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.
It is also available here: pastebin.
Update: At least transitivity is needed for well-foundness. I also started a proof, but didn't finished.
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.
You can do it by defining a height function on Terms, and showing that decreasing rela implies decreasing heights:
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.
(Note the use of the custom induction principle, which is needed because of the nested inductives.)
This style of development, however, is too complicated. Avoiding certain pitfalls would greatly simplify it:
The Coq standard vector library is too hard to use. The issue here is exacerbated because of the nested inductives. It would probably be better to use plain lists and have a separate well-formedness predicate on terms.
Defining a relation such as rela in proof mode makes it harder to read. Consider, for instance, the following simpler alternative:
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.
Folding left has a poor reduction behavior, because it forces us to generalize over the accumulator argument to get the induction to go through. This is why in my proof I had to switch to a fold_right.
I'm learning Coq and I've stumbled upon an exercise asking to create functions for the option type to/from bool and nat (i.e., bool to/from option X, nat to option nat), and then prove they commute. I can easily prove by induction on bool/nat, but I can't seem to make it work for the option type. The main problem in the bool question that I ran into is that, at some point, the goal is to prove that:
a : nat_iter 1 option Empty_set
============================
Some None = Some a
however, I don't know tell it the only possibility for nat_iter 1 option Empty_set is to be None (I have a lemma proving that, but can't rewrite a).
With the nat one, I don't think there is a bijection between nat and option nat, since I cannot prove that, given fromNat (toNat x) = x, Some 0 = None. Maybe there's a way to define toNat that makes this work.
Definition fromBool (b : bool) : fin 2 :=
match b with
| true => Some None
| false => None
end.
Definition toBool (x : fin 2) : bool :=
match x with
| None => false
| Some _ => true
end.
Lemma bool_fin b :
toBool (fromBool b) = b.
Proof. induction b ; reflexivity. Qed.
Lemma fin_bool x :
fromBool (toBool x) = x.
Proof. induction x ; simpl. Abort.
Definition fromNat (n : nat) : option nat :=
match n with
| 0 => None
| S n => Some (S n)
end.
Definition toNat (n : option nat) : nat :=
match n with
| None => 0
| Some x => x
end.
Lemma nat_option x :
toNat (fromNat x) = x.
Proof. induction x ; reflexivity. Qed.
Lemma option_nat x :
fromNat (toNat x) = x.
Proof. induction x. Abort.
Thanks.
I would like to use an hypothesis in a function to rule out some of the cases in a match statement. I wonder how this is done in Coq.
A very simple example is a function that uses match on a nat. I would like to use an hypothesis that says that n <> 0 so that I won't have to provide a match pattern for 0, like this:
Fixpoint minus_1 (n:nat) (H:n<>0): nat :=
match n with
| S n' => n'
end.
The above example gives Error: Non exhaustive pattern-matching: no clause found for pattern 0.
How do I make use of H to not have to provide a pattern for 0?
You can rely on the Program library to fill some gaps for you, for example:
Require Import Arith Program.
Program Fixpoint minus_1 (n: nat) (h: n <> 0) : nat :=
match n with
| S p => p
| _ => _
end.
or you can build the term "by hand" using tactics (in v8.4):
Fixpoint minus_1 (n: nat) (h: n <> 0) {struct n} : nat.
destruct n as [ | p ].
- case h; reflexivity.
- exact p.
Defined.
Here is a version that should work on older version of Coq:
Definition minus_1 (n: nat) (h: n <> 0) : nat.
revert h.
elim n.
intros heq; case heq; reflexivity.
intros p _ _; exact p.
Defined.
In all cases, you can use Print minus_1. to see the resulting term.
You can use a return annotation on the match:
Lemma notNotEqual : forall x:nat, (x <> x) -> False.
auto.
Qed.
Definition predecessor (n:nat) : n<>0 -> nat :=
match n return (n <> 0 -> nat) with
| 0 =>
fun H : 0 <> 0 =>
match notNotEqual 0 H with end
| S m => fun _ => m
end.
This is covered in Adam Chlipala's book, "Certified Programming with Dependent Types", starting in the chapter on Inductive Types. It is also covered in Chapter 17 of the Coq manual, "Extended pattern-matching", by Cristina Cornes and Hugo Herbelin.
You could also mix the function style with the tactics style using refine:
Definition predecessor_alt (n:nat) : n<>0 -> nat.
refine
(match n return (n <> 0 -> nat) with
| 0 => _
| S m => fun _ => m
end).
intros; assert False as nope.
auto.
inversion nope.
Defined.