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.
Related
I'm having a great difficulty trying to prove even very simple lemmas about a function I defined. This is my definition:
Require Import List.
Require Export Omega.
Require Export FunInd.
Require Export Recdef.
Notation "A :: B" := (cons A B).
Notation "[]" := nil.
Notation "[[ A ]]" := (A :: nil).
Inductive tm :=
| E: nat -> tm
| L: list tm -> tm.
Definition T := list tm.
Fixpoint add_list (l: list nat) : nat :=
match l with
| [] => 0
| n :: l' => n + (add_list l')
end.
Fixpoint depth (t: tm) : nat :=
match t with
| E _ => 1
| L l => 1 + (add_list (map depth l))
end.
Definition sum_depth (l: T) := add_list (map depth l).
Function sum_total (l: T) {measure sum_depth l} : nat :=
match l with
| [] => 0
| [[E n]] => n
| [[L li]] => sum_total li
| E n :: l' => n + (sum_total l')
| L li :: l' => (sum_total li) + (sum_total l')
end.
Proof.
- auto.
- intros; unfold sum_depth; subst. simpl; omega.
- intros; subst; unfold sum_depth; simpl; omega.
- intros; subst; unfold sum_depth; simpl; omega.
Defined.
The inductive type can't be changed.
I can prove simple propositions like Lemma test : forall n, sum_total [[E n]] = n. using the compute tactic, but another trivial lemma like Lemma test2 : forall l, sum_total [[L l]] = sum_total l. hangs.
First, it seems OK that the compute tactic "hangs" on the goal you mention (because when using the Function … Proof. … Defined. definition methodology, your function sum_total incorporates some proof terms, which are not intended to be computed − all the more on an arbitrary argument l; maybe a tactic such as simpl or cbn would be more suitable in this context).
Independently of my comment on list notations, I had a closer look on your formalization and it seems the Function command is unneeded in your case, because sum_total is essentially structural, so you could use a mere Fixpoint, provided the inductive type you are looking at is slightly rephrased to be defined in one go as a mutually-defined inductive type (see the corresponding doc of the Inductive command in Coq's refman which gives a similar, typical example of "tree / forest").
To elaborate on your example, you may want to adapt your definition (if it is possible for your use case) like this:
Inductive tm :=
| E: nat -> tm
| L: T -> tm
with T :=
Nil : T
| Cons : forall (e : tm) (l : T), T.
Notation "[[ A ]]" := (Cons A Nil).
Fixpoint sum_total (l: T) {struct l} : nat :=
match l with
| Nil => 0
| [[E n]] => n
| [[L li]] => sum_total li
| Cons (E n) l' => n + (sum_total l')
| Cons (L li) l' => (sum_total li) + (sum_total l')
end.
(* and the lemma you were talking about is immediate *)
Lemma test2 : forall l, sum_total [[L l]] = sum_total l.
reflexivity.
Qed.
Otherwise (if you cannot rephrase your tm inductive like this), another solution would be to use another strategy than Function to define your sum_total function, e.g. Program Fixpoint, or the Equations plugin (which are much more flexible and robust than Function when dealing with non-structural recursion / dependently-typed pattern matching).
Edit: as the OP mentions the inductive type itself can't be changed, there is a direct solution, even when using the mere Function machinery: relying on the "equation lemma" that is automatically generated by the definition.
To be more precise, if you take your script as is, then you get the following lemma "for free":
Search sum_total "equation".
(*
sum_total_equation:
forall l : T,
sum_total l =
match l with
| [] => 0
| [[E n]] => n
| E n :: (_ :: _) as l' => n + sum_total l'
| [[L li]] => sum_total li
| L li :: (_ :: _) as l' => sum_total li + sum_total l'
end
*)
So you could easily state and prove the lemma you are interested in by doing:
Lemma test2 : forall l, sum_total [[L l]] = sum_total l.
intros l.
rewrite sum_total_equation.
reflexivity.
Qed.
Here is an answer that doesn't require changing the inductive type.
There is a simple definition of sum_total that is both comparatively easy to understand and gives (almost) the lemma you are looking for by compute.
Fixpoint sum_tm (t : tm) : nat :=
match t with
| E n => n
| L li => list_sum (map sum_tm li)
end.
Definition sum_total (l : T) : nat := list_sum (map sum_tm l).
Lemma test2 : forall l, sum_total [[L l]] = sum_total l + 0.
reflexivity.
Qed.
(list_sum comes from the List module.)
Notice how the definition of sum_tm and sum_total exactly follows the structure of the definition of term and T, with list_sum (composed with map) corresponding to the use of list. This pattern is in general effective for these problems with nested inductives.
If you want to get rid of the + 0, you can define a different version of list_sum that includes a case for the singleton list (and you can fuse this with map if you want, though it is not necessary).
That would look like replacing list_sum with list_sum_alt defined as
Fixpoint list_sum_alt (l : list nat) : nat :=
match l with
| [] => 0
| [[n]] => n
| n :: li => n + list_sum_alt li
end.
With this definition, test2 holds by compute.
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'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 am trying to proof that the application of an empty Substitution on a term is equal to the given term.
Here is the code:
Require Import Coq.Strings.String.
Require Import Coq.Lists.List.
Require Import Coq.Arith.EqNat.
Require Import Recdef.
Require Import Omega.
Import ListNotations.
Set Implicit Arguments.
Inductive Term : Type :=
| Var : nat -> Term
| Fun : string -> list Term -> Term.
Definition Subst : Type := list (nat*Term).
Definition maybe{X Y: Type} (x : X) (f : Y -> X) (o : option Y): X :=
match o with
|None => x
|Some a => f a
end.
Fixpoint lookup {A B : Type} (eqA : A -> A -> bool) (kvs : list (A * B)) (k : A) : option B :=
match kvs with
|[] => None
|(x,y) :: xs => if eqA k x then Some y else lookup eqA xs k
end.
I am trying to proof some properties of this function.
Fixpoint apply (s : Subst) (t : Term) : Term :=
match t with
| Var x => maybe (Var x) id (lookup beq_nat s x )
| Fun f ts => Fun f (map (apply s ) ts)
end.
Lemma empty_apply_on_term:
forall t, apply [] t = t.
Proof.
intros.
induction t.
reflexivity.
I am stuck after the reflexivity. I wanted to do induction on the list build in a term but if i do so i'ĺl get stuck in a loop.
i will appreciate any help.
The problem is that the automatically generated inductive principle for the Term type is too weak, because it has another inductive type list inside it (specifically, list is applied to the very type being constructed). Adam Chlipala's CPDT gives a good explanation of what's going on, as well as an example of how to manually build a better inductive principle for such types in the inductive types chapter. I've adapted his example nat_tree_ind' principle for your Term inductive, using the builtin Forall rather than a custom definition. With it, your theorem becomes easy to prove:
Section Term_ind'.
Variable P : Term -> Prop.
Hypothesis Var_case : forall (n:nat), P (Var n).
Hypothesis Fun_case : forall (s : string) (ls : list Term),
Forall P ls -> P (Fun s ls).
Fixpoint Term_ind' (tr : Term) : P tr :=
match tr with
| Var n => Var_case n
| Fun s ls =>
Fun_case s
((fix list_Term_ind (ls : list Term) : Forall P ls :=
match ls with
| [] => Forall_nil _
| tr'::rest => Forall_cons tr' (Term_ind' tr') (list_Term_ind rest)
end) ls)
end.
End Term_ind'.
Lemma empty_apply_on_term:
forall t, apply [] t = t.
Proof.
intros.
induction t using Term_ind'; simpl; auto.
f_equal.
induction H; simpl; auto.
congruence.
Qed.
This is a typical trap for beginners. The problem is that your definition of Term has a recursive occurrence inside another inductive type -- in this case, list. Coq does not generate a useful inductive principle for such types, unfortunately; you have to program your own. Adam Chlipala's CDPT has a chapter on inductive types that describes the problem. Just look for "nested inductive types".
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.