I want to show that
[seq q x t | x <- iota 0 (t + 1)] != [::]
I decided to destruct iota 0 (t + 1) because I have a lemma that says:
iota 0 (t + 1) != [::]
So the first case of destruct should have iota 0 (t + 1) = [::] which by the theorem mentioned is false, and I can discriminate. How can I rewrite the equation in the first destruct case using the lemma? I cannot figure it out.
Thanks.
You do not need to destruct. Note that iota is defined by recursion on its second variable. Your current goal cannot be simplified because t + 1 does not start with a constructor. However, you can do by rewrite addn1 to put it in a form where it can be solved.
In addition to computation, as Arthur suggests, you can sometimes use contraposition to deal with non-equalities (do Search "contra" for variant versions).
For instance, in your case, you can show, if you add some injectivity constraint:
Lemma foo (q : nat -> nat -> nat) t (injq: injective (q^~ t)) :
iota 0 (t + 1) != [::] -> [seq q x t | x <- iota 0 (t + 1)] != [::].
Proof.
apply: contra_neq.
rewrite [RHS]( _ : [::] = [seq q x t | x <- [::]]) //.
exact: inj_map.
Qed.
Related
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'm working on a proof using bit vectors from the bbv library which look like word : nat -> Set. I'm trying to prove that the most significant bit is the same if you chop off some lower-order bits:
Require Import bbv.Word.
Require Import Coq.Arith.PeanoNat.
Require Import Coq.Arith.Plus.
Lemma drop_msb : forall (n : nat) (x : word (S (S n))),
wmsb x false = wmsb (wtl x) false.
To prove this, the following lemma seems useful:
Check wmsb_split2.
(*
wmsb_split2 :
forall sz (w: word (sz + 1)) b,
wmsb w b = if weq (split2 _ 1 w) (natToWord _ 0) then false else true.
*)
Now, here's my attempt at the proof:
Proof.
intros n x.
assert (Snp : S (S n) = S n + 1). {
rewrite <- Nat.add_1_l.
apply plus_comm.
}
assert (xeq : word (S (S n)) = word ((S n) + 1)). {
rewrite Snp.
reflexivity.
}
rewrite wmsb_split2. (* Error: Found no subterm matching "wmsb ?M1864 ?M1865" in the current goal. *)
Here is the proof state.
n : nat
x : word (S (S n))
Snp : S (S n) = S n + 1
xeq : word (S (S n)) = word (S n + 1)
============================
wmsb x false = wmsb (wtl x) false
I'm confused why wmsb_split2 can't be applied; I see wmsb _ _ right there in the conclusion! Do I need some form of the uniqueness of identity proofs given in EqDepFacts?
I also have the extra assertions there in case I need to rewrite x, but I can't do that either.
There is a simpler proof by computation: because word is defined as a list of bits indexed by its length, if you know that the length is S (S n), then the first two constructors of the list are uniquely determined, and that fact is provided by the lemma destruct_word_S.
destruct_word_S :
forall (sz : nat) (w : word (S sz)),
exists (v : word sz) (b : bool), w = WS b v
In this case, that allows you to rewrite x : word (S (S n)) twice, into some term WS b0 (WS b1 x''), that enables both wmsb and wtl to compute.
To use destruct_word_S for rewriting, you have to destruct the two exists to expose the equality w = WS b v.
Lemma drop_msb : forall (n : nat) (x : word (S (S n))),
wmsb x false = wmsb (wtl x) false.
Proof.
intros.
destruct (destruct_word_S x) as [x' [b0 Ex]].
destruct (destruct_word_S x') as [x'' [b1 Ex']].
rewrite Ex.
rewrite Ex'. cbn.
(* Goal: wmsb x'' b1 = wmsb x'' b1 *)
reflexivity.
Qed.
I'm confused why wmsb_split2 can't be applied; I see wmsb _ _ right there in the conclusion!
The length of the word is an implicit argument to wmsb, and that's what doesn't unify here: the wmsb_split2 lemma uses #wmsb (sz + 1) and your goal uses #wmsb (S (S n)) on the left-hand side, and #wmsb (S n) on the right-hand side. But sz + 1 is not convertible to S (S n) (i.e., they can not normalize to the same term, for any instantiation of sz).
When dealing with indexed types, such as word, which is indexed by the length, equality behaves quite unintuitively.
I find that what works well in this context is inversion principles, like destruct_word_S, formulated in terms of homogeneous equality, i.e., =/eq, where both sides have the same type.
In contrast, heterogeneous equality spells trouble, and that's what you are getting into when you start thinking in terms of "a word (S sz) is also a word (sz + 1)", trying to equate things of different types.
Sadly I don't know of a good way of gaining the proper intuition here, other than the less than satisfactory path of learning about dependent type theory, to treat eq as "just another inductive type", being aware of all the ways it does not behave like a naive idea of "equality".
We have a function that inserts an element into a specific index of a list.
Fixpoint inject_into {A} (x : A) (l : list A) (n : nat) : option (list A) :=
match n, l with
| 0, _ => Some (x :: l)
| S k, [] => None
| S k, h :: t => let kwa := inject_into x t k
in match kwa with
| None => None
| Some l' => Some (h :: l')
end
end.
The following property of the aforementioned function is of relevance to the problem (proof omitted, straightforward induction on l with n not being fixed):
Theorem inject_correct_index : forall A x (l : list A) n,
n <= length l -> exists l', inject_into x l n = Some l'.
And we have a computational definition of permutations, with iota k being a list of nats [0...k]:
Fixpoint permute {A} (l : list A) : list (list A) :=
match l with
| [] => [[]]
| h :: t => flat_map (
fun x => map (
fun y => match inject_into h x y with
| None => []
| Some permutations => permutations
end
) (iota (length t))) (permute t)
end.
The theorem we're trying to prove:
Theorem num_permutations : forall A (l : list A) k,
length l = k -> length (permute l) = factorial k.
By induction on l we can (eventually) get to following goal: length (permute (a :: l)) = S (length l) * length (permute l). If we now simply cbn, the resulting goal is stated as follows:
length
(flat_map
(fun x : list A =>
map
(fun y : nat =>
match inject_into a x y with
| Some permutations => permutations
| None => []
end) (iota (length l))) (permute l)) =
length (permute l) + length l * length (permute l)
Here I would like to proceed by destruct (inject_into a x y), which is impossible considering x and y are lambda arguments. Please note that we will never get the None branch as a result of the lemma inject_correct_index.
How does one proceed from this proof state? (Please do note that I am not trying to simply complete the proof of the theorem, that's completely irrelevant.)
There is a way to rewrite under binders: the setoid_rewrite tactic (see ยง27.3.1 of the Coq Reference manual).
However, direct rewriting under lambdas is not possible without assuming an axiom as powerful as the axiom of functional extensionality (functional_extensionality).
Otherwise, we could have proved:
(* classical example *)
Goal (fun n => n + 0) = (fun n => n).
Fail setoid_rewrite <- plus_n_O.
Abort.
See here for more detail.
Nevertheless, if you are willing to accept such axiom, then you can use the approach described by Matthieu Sozeau in this Coq Club post to rewrite under lambdas like so:
Require Import Coq.Logic.FunctionalExtensionality.
Require Import Coq.Setoids.Setoid.
Require Import Coq.Classes.Morphisms.
Generalizable All Variables.
Instance pointwise_eq_ext {A B : Type} `(sb : subrelation B RB eq)
: subrelation (pointwise_relation A RB) eq.
Proof. intros f g Hfg. apply functional_extensionality. intro x; apply sb, (Hfg x). Qed.
Goal (fun n => n + 0) = (fun n => n).
setoid_rewrite <- plus_n_O.
reflexivity.
Qed.
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.
Consider the function defined below. It's not really important what it does.
Require Import Ring.
Require Import Vector.
Require Import ArithRing.
Fixpoint
ScatHUnion_0 {A} (n:nat) (pad:nat) : t A n -> t (option A) ((S pad) * n).
refine (
match n return (t A n) -> (t (option A) ((S pad)*n)) with
| 0 => fun _ => (fun H => _)(#nil (option A))
| S p =>
fun a =>
let foo := (#ScatHUnion_0 A p pad (tl a)) in
(fun H => _) (cons _ (Some (hd a)) _ (append (const None pad) foo))
end
).
rewrite <-(mult_n_O (S pad)); auto.
replace (S pad * S p) with ( (S (pad + S pad * p)) ); auto; ring.
Defined.
I want to prove
Lemma test0: #ScatHUnion_0 nat 0 0 ( #nil nat) = ( #nil (option nat)).
After doing
simpl. unfold eq_rect_r. unfold eq_rect.
the goal is
match mult_n_O 1 in (_ = y) return (t (option nat) y) with
| eq_refl => nil (option nat)
end = nil (option nat)
When trying to finish it off with
apply trans_eq with (Vector.const (#None nat) (1 * 0)); auto.
destruct (mult_n_O 1); auto.
the destruct doesn't work (see below for error message). However, If I first prove exactly the same goal in a lemma or even with assert inside the proof, I can apply and solve it, like this:
Lemma test1: #ScatHUnion_0 nat 0 0 ( #nil nat) = ( #nil (option nat)).
simpl. unfold eq_rect_r. unfold eq_rect.
assert (
match mult_n_O 1 in (_ = y) return (t (option nat) y) with
| eq_refl => nil (option nat)
end = nil (option nat)
) as H.
{
apply trans_eq with (Vector.const (#None nat) (1 * 0)); auto.
destruct (mult_n_O 1); auto.
}
apply H.
Qed.
Can someone explain why this is, and how one should think about this situation when one encounters it?
In Coq 8.4 I get the error
Toplevel input, characters 0-21:
Error: Abstracting over the terms "n" and "e" leads to a term
"fun (n : nat) (e : 0 = n) =>
match e in (_ = y) return (t (option nat) y) with
| eq_refl => nil (option nat)
end = const None n" which is ill-typed.
and in Coq 8.5 I get the error
Error: Abstracting over the terms "n" and "e" leads to a term
fun (n0 : nat) (e0 : 0 = n0) =>
match e0 in (_ = y) return (t (option nat) y) with
| eq_refl => nil (option nat)
end = const None n0
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
"t (option nat) 0" : "Set"
"match e0 in (_ = y) return (t (option nat) y) with
| eq_refl => nil (option nat)
end" : "t (option nat) n0"
"const None n0" : "t (option nat) n0"
The 2nd term has type "t (option nat) n0" which should be coercible to
"t (option nat) 0".
#Vinz answer explained the reason, and suggested Set Printing All. which shows what the difference is. The problem was that simpl. simplified the return type of the match. Using unfold ScatHUnion_0. instead of simpl. enabled me to use the destruct directly on the goal.
Fundamentally, my troubles stemmed from me wanting to convince the type system that 0=0 is the same as 0=1*0. (Btw, I still don't know the best way to do this.) I was using mult_n_O to show that, but it is opaque, so the type system couldn't unfold it when checking that the two types were equal.
When I replaced it with my own Fixpoint variant (which is not opaque),
Fixpoint mult_n_O n: 0 = n*0 :=
match n as n0 return (0 = n0 * 0) with
| 0 => eq_refl
| S n' => mult_n_O n'
end.
and used it in the definition of ScatHUnion_0, the lemma was trivial to prove:
Lemma test0: #ScatHUnion_0 nat 0 0 ( #nil nat) = ( #nil (option nat)).
reflexivity.
Qed.
Additional comment:
Here is a proof that works with the original opaque mult_n_O definition. It is based on a proof by Jason Gross.
It manipulates the type of mult_n_O 1 to be 0=0 by using generalize. It uses set to modify the term's implicit parts, such as the type in eq_refl, which is only visible after the Set Printing All. command. change can also do that, but replace and rewrite don't seem to be able to do that.
Lemma test02:
match mult_n_O 1 in (_ = y) return (t (option nat) y) with
| eq_refl => nil (option nat)
end = nil (option nat).
Proof.
Set Printing All.
generalize (mult_n_O 1 : 0=0).
simpl.
set (z:=0) at 2 3.
change (nil (option nat)) with (const (#None nat) z) at 2.
destruct e.
reflexivity.
Qed.
Update: Here is an even simpler proof thanks to the people at coq-club.
Lemma test03:
match mult_n_O 1 in (_ = y) return (t (option nat) y) with
| eq_refl => nil (option nat)
end = nil (option nat).
Proof.
replace (mult_n_O 1) with (#eq_refl nat 0);
auto using Peano_dec.UIP_nat.
Qed.
I would said it's because of dependent types, and you don't actually prove the exact same things in both case (try to Set Printing All. to see implicit types and hidden information).
The fact that such a destruct fails is often due to the fact that the dependency will introduce a ill-typed term at, and you have to be more precise in what you want to destruct (no secret here, its on a per case basis). By extracting a sub-lemma, you might have remove the troublesome dependency, and now the destruct can operate.