I have a definition involving match, similar like this:
Definition five (n: nat): bool :=
match n with
| 5 => true
| _ => false
end.
I try to proof something similar like this:
Theorem fiveT: forall (n: nat),
n <> 5 -> five n = false.
Proof. intros. unfold five.
But when I unfold the definition of five, I don't know how to tell coq that the first match case is irrelevant because of H. How can I proof this?
1 goal
n : nat
H : n <> 5
______________________________________(1/1)
match n with
| 5 => true
| _ => false
end = false
Please note that my real problem is much bigger than this one but I wanted to give a small understandable example, so please don't tell me a complete different approach from mine, thank you :)
You can use the contrapositive of your lemma, and then a (not elegant) case analysis to get rid of all the cases different from 5, for which evaluation works trivially (I'm using ssreflect here, but you should get the idea):
From mathcomp Require Import all_ssreflect.
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.
Definition five (n: nat): bool :=
match n with
| 5 => true
| _ => false
end.
Theorem fiveT: forall (n: nat), n <> 5 -> five n = false.
Proof.
move=> n.
apply: contra_notF.
have [/eqP -> //|ne0] := boolP (n == 0).
have [/eqP -> //|ne1] := boolP (n == 1).
have [/eqP -> //|ne2] := boolP (n == 2).
have [/eqP -> //|ne3] := boolP (n == 3).
have [/eqP -> //|ne4] := boolP (n == 4).
have [/eqP -> //|ne5] := boolP (n == 5).
have [n' -> //=]: exists n', n = S (S (S (S (S (S n'))))).
exists (n - 6).
have lt0n: 0 < n by rewrite lt0n.
have lt1n: 1 < n by rewrite ltn_neqAle lt0n eq_sym ne1.
have lt2n: 2 < n by rewrite ltn_neqAle lt1n eq_sym ne2.
have lt3n: 3 < n by rewrite ltn_neqAle lt2n eq_sym ne3.
have lt4n: 4 < n by rewrite ltn_neqAle lt3n eq_sym ne4.
have lt5n: 5 < n by rewrite ltn_neqAle lt4n eq_sym ne5.
by rewrite !subnSK ?subn0.
Qed.
There got to be a cleaner way to do this, though ;)
Related
Task: write a function to convert natural numbers to binary numbers.
Inductive bin : Type :=
| Z
| A (n : bin)
| B (n : bin).
(* Division by 2. Returns (quotient, remainder) *)
Fixpoint div2_aux (n accum : nat) : (nat * nat) :=
match n with
| O => (accum, O)
| S O => (accum, S O)
| S (S n') => div2_aux n' (S accum)
end.
Fixpoint nat_to_bin (n: nat) : bin :=
let (q, r) := (div2_aux n 0) in
match q, r with
| O, O => Z
| O, 1 => B Z
| _, O => A (nat_to_bin q)
| _, _ => B (nat_to_bin q)
end.
The 2-nd function gives an error, because it is not structurally recursive:
Recursive call to nat_to_bin has principal argument equal to
"q" instead of a subterm of "n".
What should I do to prove that it always terminates because q is always less then n.
Prove that q is (almost always) less than n:
(* This condition is sufficient, but a "better" one is n <> 0
That makes the actual function slightly more complicated, though *)
Theorem div2_aux_lt {n} (prf : fst (div2_aux n 0) <> 0) : fst (div2_aux n 0) < n.
(* The proof is somewhat involved...
I did it by proving
forall n k, n <> 0 ->
fst (div2_aux n k) < n + k /\ fst (div2_aux (S n) k) < S n + k
by induction on n first *)
Then proceed by well-founded induction on lt:
Require Import Arith.Wf_nat.
Definition nat_to_bin (n : nat) : bin :=
lt_wf_rec (* Recurse down a chain of lts instead of structurally *)
n (fun _ => bin) (* Starting from n and building a bin *)
(fun n rec => (* At each step, we have (n : nat) and (rec : forall m, m < n -> bin) *)
match div2_aux n 0 as qr return (fst qr <> 0 -> fst qr < n) -> _ with (* Take div2_aux_lt as an argument; within the match the (div2_aux_lt n 0) in its type is rewritten in terms of the matched variables *)
| (O, r) => fun _ => if r then Z else B Z (* Commoning up cases for brevity *)
| (S _ as q, r) => (* note: O is "true" and S _ is "false" *)
fun prf => (if r then A else B) (rec q (prf ltac:(discriminate)))
end div2_aux_lt).
I might suggest making div2_aux return nat * bool.
Alternatively, Program Fixpoint supports these kinds of induction, too:
Require Import Program.
(* I don't like the automatic introing in program_simpl and
now/easy can solve some of our obligations. *)
#[local] Obligation Tactic := (now program_simpl) + cbv zeta.
(* {measure n} is short for {measure n lt}, which can replace the
core language {struct arg} when in a Program Fixpoint
(n can be any expression and lt can be any well-founded relation
on the type of that expression) *)
#[program] Fixpoint nat_to_bin (n : nat) {measure n} : bin :=
match div2_aux n 0 with
| (O, O) => Z
| (O, _) => B Z
| (q, O) => A (nat_to_bin q)
| (q, _) => B (nat_to_bin q)
end.
Next Obligation.
intros n _ q [_ mem] prf%(f_equal fst).
simpl in *.
subst.
apply div2_aux_lt.
auto.
Defined.
Next Obligation.
intros n _ q r [mem _] prf%(f_equal fst).
specialize (mem r).
simpl in *.
subst.
apply div2_aux_lt.
auto.
Defined.
I have spent a lot of time on the notion of well founded induction and thought it was time to apply it to a simple case. So I wanted to use it do define the factorial function and came up with:
Definition fac : nat -> nat := Fix LtWellFounded (fun _ => nat) (* 'LtWellFounded' is some proof *)
(fun (n:nat) =>
match n as n' return (forall (m:nat), m < n' -> nat) -> nat with
| 0 => fun _ => 1
| S m => fun (g : forall (k:nat), k < S m -> nat) => S m * g m (le_n (S m))
end).
but then of course immediately arises the question of correctness. And when attempting to
prove that my function coincided everywhere with a usual implementation of fac, I realized things were far from trivial. In fact simply showing that fac 0 = 1:
Lemma fac0 : fac 0 = 1.
Proof.
unfold fac, Fix, Fix_F.
Show.
appears to be difficult. I am left with a goal:
1 subgoal
============================
(fix Fix_F (x : nat) (a : Acc lt x) {struct a} : nat :=
match x as n' return ((forall m : nat, m < n' -> nat) -> nat) with
| 0 => fun _ : forall m : nat, m < 0 -> nat => 1
| S m =>
fun g : forall k : nat, k < S m -> nat => S m * g m (le_n (S m))
end (fun (y : nat) (h : y < x) => Fix_F y (Acc_inv a h))) 0
(LtWellFounded' 0) = 1
and I cannot see how to reduce it further. Can anyone suggest a way foward ?
An application of a fixpoint only reduces when the argument it's recursing on has a constructor at its head. destruct (LtWellFounded' 0) to reveal the constructor, and then this will reduce to 1 = 1. Or, better, make sure LtWellFounded' is transparent (its proof should end with Defined., not Qed.), and then this entire proof is just reflexivity..
Some of the types that you give can actually be inferred by Coq, so you can also write
your fib in a slightly more readable form. Use dec to not forget which if branch your are in, and make the recursive function take a recursor fac as argument. It can be called with smaller arguments. By using refine, you can put in holes (a bit like in Agda), and get a proof obligation later.
Require Import Wf_nat PeanoNat Psatz. (* for lt_wf, =? and lia *)
Definition dec b: {b=true}+{b=false}.
now destruct b; auto.
Defined.
Definition fac : nat -> nat.
refine (Fix lt_wf _
(fun n fac =>
if dec (n =? 0)
then 1
else n * (fac (n - 1) _))).
clear fac. (* otherwise proving fac_S becomes impossible *)
destruct n; [ inversion e | lia].
Defined.
Lemma fac_S n: fac (S n) = (S n) * fac n.
unfold fac at 1; rewrite Fix_eq; fold fac.
now replace (S n - 1) with n by lia.
now intros x f g H; case dec; intros; rewrite ?H.
Defined.
Compute fac 8.
gives
Compute fac 8.
= 40320
: nat
I have some trouble understanding how to use some of the things I've defined in Coq within proofs. I have this fragment of definition and functions:
Inductive string : Set :=
| E : string
| s : nat -> string -> string.
Inductive deduce : Set :=
|de : string -> string -> deduce.
Infix "|=" := de.
Inductive Rules : deduce -> Prop :=
| compress : forall (n : nat) (A : string), rule (( s n ( s n A)) |= ( s n A))
| transitive : forall A B C : string, rule (A |= B) -> rule (B |= C) -> rule (A |= C).
Fixpoint RepString (n m : nat): string:=
match n with
|0 => E
|S n => s m ( RepString n m)
end.
I need to prove something apparently easy but I bump into two problems:
Lemma LongCompress (C : string)(n : nat): n >=1 -> Rules
((RepString n 0 ) |= (s 0 E) ).
Proof.
intros.
induction n.
inversion H.
simpl.
apply compress.
So here I have problem one, I get:
"Unable to unify "Rules (s ?M1805 (s ?M1805 ?M1806) |= s ?M1805 ?M1806)" with
"Rules (s 0 (RepString n 0) |- s 0 E)".'"
Now, I can see why I get the error, while technically RepString n 0 is the same as s 0 (s 0 (s 0( ... s 0 E))) I simply can't find the way to let coq know that, I've tried messing with apply compress with like 10 different things I still can't get it right. I need to "unfold" it something like that (of course unfold doesn't work...).
I'm out of ideas and I would very much appreciate any input you have on this!
EDIT FROM NOW ON.
Inductive Rules : deduce -> Prop :=
| compress : forall (n : nat) (A : string), rule (( s n ( s n A)) |= ( s n A))
| transitive : forall A B C : string, rule (A |= B) -> rule (B |= C) -> rule (A |= C)
| inspection : forall (n m : nat) (A : string), m < n -> rule ((s n A) |- (s m A)).
Definition less (n :nat ) (A B : string) := B |= (s n A).
Lemma oneLess (n m : nat): rule (less 0 (RepString n 1) (RepString m 1)) <-> n< m.
I have generalised the lemmas that Anton Trunov helped me prove, but now I bumped into another wall. I think the problem might start with the way I've written the Theorem itself, I will appreciate any ideas.
I'd prove something a little bit more general: for any two non-empty strings of zeros s = 0000...0 and t = 00...0, if length s > length t, then s |= t, i.e.
forall n m,
m <> 0 ->
n > m ->
Rules (RepString n 0 |= RepString m 0).
Here is a helper lemma:
Require Import Coq.Arith.Arith.
Require Import Coq.omega.Omega.
Hint Constructors Rules. (* add this line after the definition of `Rules` *)
Lemma LongCompress_helper (n m k : nat):
n = (S m) + k ->
Rules (RepString (S n) 0 |= RepString (S m) 0).
Proof.
generalize dependent m.
generalize dependent n.
induction k; intros n m H.
- Search (?X + 0 = ?X). rewrite Nat.add_0_r in H.
subst. simpl. eauto.
- apply (transitive _ (RepString n 0) _); simpl in H; rewrite H.
+ simpl. constructor.
+ apply IHk. omega.
Qed.
Now, we can easily prove our advertised general lemma:
Lemma LongCompress_general (n m : nat):
m <> 0 ->
n > m ->
Rules (RepString n 0 |= RepString m 0).
Proof.
intros Hm Hn. destruct n.
- inversion Hn.
- destruct m.
+ exfalso. now apply Hm.
+ apply LongCompress_helper with (k := n - m - 1). omega.
Qed.
It's easy to see that any sufficiently long string of zeros can be compressed into the singleton-string 0:
Lemma LongCompress (n : nat):
n > 1 -> Rules ( RepString n 0 |= s 0 E ).
Proof.
intro H. replace (s 0 E) with (RepString 1 0) by easy.
apply LongCompress_general; auto.
Qed.
I am trying to define a function in Coq called interval that given two natural numbers computes the list of all natural numbers between these two. However my definition is not primitive-recursive. Here is my code:
Require Coq.Program.Tactics.
Require Coq.Program.Wf.
Inductive bool : Type :=
| true : bool
| false : bool.
Fixpoint leq_nat (m:nat) (n:nat) : bool :=
match m with
| 0 => true
| S x => match n with
| 0 => false
| S y => leq_nat x y
end
end.
Notation "m <= n" := (leq_nat m n).
Notation "x :: l" := (cons x l) (at level 60, right associativity).
Program Fixpoint intervalo (m:nat) (n:nat) {measure ((S n) - m)}: list nat :=
match m <= n with
| false => nil
| true => m :: (intervalo (S m) n)
end.
Next Obligation.
As you can see I am using well founded recursion on the length of the interval. I define the measure to be this value, i.e S n - m.
I would expect to be asked to proof that forall m, n, true = m <= n -> S n - S m < S n - m
However, the proof obligations that I get do not look like this and are rather confusing. I am asked to prove that:
m : nat
n : nat
intervalo : forall m0 n0 : nat,
match m0 with
| 0 => S n0
| S l => n0 - l
end < match m with
| 0 => S n
| S l => n - l
end -> list nat
Heq_anonymous : true = (m <= n)
============================
n - m < match m with
| 0 => S n
| S l => n - l
end
And that:
============================
well_founded
(Wf.MR lt
(fun recarg : {_ : nat & nat} =>
match projT1 recarg with
| 0 => S (projT2 recarg)
| S l => projT2 recarg - l
end))
Can someone please explain me why Coq asks me to prove this instead of just forall m, n, true = m <= n -> S n - S m < S n - m. In addition, how can I finish this proof? Or how can I make it look more like what I am expecting Coq to ask me to proof?
Thank you.
What confuses you here is that the term S n - m is partially unfolded and that you have an additional hypothesis. If you type:
clear intervalo.
change (match m with
| 0 => S n
| S l => n - l
end) with (S n - m).
change (n - m) with (S n - S m).
then you'll see that the first goal you're asked to prove is indeed a direct consequence of forall m, n, true = m <= n -> S n - S m < S n - m.
The second one is simply stating that your measure is well-founded (once more with some degree of unfolding of S n - m thrown in). I probably have a different version of Coq (version 8.5beta2) because in my case this thing is discharged automatically.
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.