How to prove a theorem on natural numbers using Coq list - coq

I'm new in Coq. To do practice on list and list of pairs, I used Coq list library to prove a simple theorem of natural numbers. I try to prove the simple property of natural numbers:
forall n, multiplier, a0....an, d1...dn:
((a0*multiplier)=d1)+((a1*multiplier)=d2)+((a2*multiplier)=d3)+...+((an*multiplier)=dn) = result
-> (a0+a1+a2+...+an) * multiplier = d1+d2+...+dn = result
((3*2)=6)+((5*2)=10)+((9*2)=18) = 34 -> (3+5+9)*2 = 6+10+18 = 34 can be an example of this property(i.e. n=3 and multiplier = 2).
I use list of pairs (storing a's in one list and d's in another list) to code this property in Coq as:
Require Import List.
Fixpoint addnumbers (L : list nat) : nat :=
match L with
| nil => 0
| H::tail => H + addnumbers tail
end.
Theorem resultAreEqual : forall (natListofpair :list (nat * nat))
(multiplier : nat) (result : nat),
Forall (fun '(a,d) => a * multiplier = d ) natListofpair ->
addnumbers(List.map (#fst nat nat) natListofpair) * multiplier = result ->
addnumbers (List.map (#snd nat nat) natListofpair) = result.
Proof.
intros.
destruct natListofpair.
subst. simpl. reflexivity.
rewrite <- H0.
inversion H.
destruct p. simpl.
But I don't know how I should continue this prove. I'm stuck in this proving for one week. I'd be thankful for your help.

One reason you are having difficulty is that you have stated your lemma in an indirect way. When proving something in Coq, it is very important that you state it as simple as possible, as this often leads to easier proofs. In this case, the statement can become much simpler by using higher-order functions on lists.
Require Import Coq.Arith.PeanoNat.
Require Import Coq.Lists.List.
Definition sum (l : list nat) := fold_right Nat.add 0 l.
Lemma my_lemma l m : sum (map (Nat.mul m) l) = m * sum l.
The sum function is the equivalent of your addnumbers. The lemma says "the result of multiplying all numbers in l by m and adding them is the same as the result of adding them up first and multiplying by m later".
To prove this result, we need a crucial ingredient that your proof was missing: induction. This is often needed in Coq when we want to reason about objects of unbounded size, such as lists. Here is one possible proof.
Proof.
unfold sum.
induction l as [|x l IH]; simpl.
- (* Nil case *)
now rewrite Nat.mul_0_r.
- (* Cons case *)
now rewrite IH, Nat.mul_add_distr_l.
Qed.

Related

proof of adding 1 to some number changes the parity in Coq

I defined even as:
Inductive even : nat -> Prop :=
| ev0: even O
| evSS: forall n, even n -> even (S (S n)).
But now I want to prove:
Lemma add1_diff (x: nat) : even (S x) = ~even x.
Can I prove:
even (S O) = (~ even O)
Thanks in advance.
You usually can't prove the equality of two Props. An equality in Prop means that the proof terms for a logical statement are equal. This is sometimes the case, but rarely. Here are a few examples:
Require Import PeanoNat.
Import Nat.
Inductive even : nat -> Prop :=
| ev0: even O
| evSS: forall n, even n -> even (S (S n)).
Example ex1 (n : nat) : (n >= 1) = (1 <= n).
Proof.
(* The proofs are equal because >= is defined in terms of <= *)
reflexivity.
Qed.
Example ex2: even (2+2) = even 4.
Proof.
(* The proofs are equal because 2+2 can be reduced to 4 *)
reflexivity.
Qed.
Example ex3 (n : nat) : even (2+n) = even (n+2).
Proof.
(* The proofs are equal because 2+n is equal to n+2 *)
rewrite add_comm.
reflexivity.
Qed.
Example ex4 (n : nat): even (S (S n)) = even n.
Proof.
(* The proofs cannot be equal, because the left side proof always
requires one evSS constructor more than the right hand side. *)
Abort.
For this reason one uses the equivalence of two Props, which is <->, rather than the equality. The equivalence of the last statement is provable:
Example ex4 (n : nat): even (S (S n)) <-> even n.
Proof.
split; intros H.
- inversion H.
assumption.
- constructor.
assumption.
Qed.
So to answer your question: the equality of the two statements is most likely not provable, but the equivalence is. In case you need help with that, please ask.
No, you cannot prove your goal: natively there is basically no way to prove equality of propositions. What you can do instead is to use propositional equivalence, rather than equality, that is prove
even (S 0) <-> ~ (even 0)
or more generally
Lemma add1_diff (x : nat) : even (S x) <-> ~ (even x)

Some help dealing with inject/unject and vector types

I'm reading through CPDT while doing the readings and exercises from Pierce's course here: https://www.cis.upenn.edu/~bcpierce/courses/670Fall12/
This question relates to HW10 here: https://www.cis.upenn.edu/~bcpierce/courses/670Fall12/HW10.v
Here's the code up to my question
Require Import Arith Bool List.
Require Import CpdtTactics MoreSpecif.
Set Implicit Arguments.
(* Length-Indexed Lists *)
Section ilist.
Variable A : Set.
Inductive ilist : nat -> Set :=
| Nil : ilist O
| Cons : forall n, A -> ilist n -> ilist (S n).
Definition ilength n (l : ilist n) := n.
Fixpoint app n1 (ls1 : ilist n1)
n2 (ls2 : ilist n2)
: ilist (n1 + n2) :=
match ls1
(*in (ilist n1) return (ilist (n1 + n2))*)
with
| Nil => ls2
| Cons _ x ls1' => Cons x (app ls1' ls2)
end.
(* Coq automatically adds annotations to the
definition of app. *)
Print app.
Fixpoint inject (ls : list A) : ilist (length ls) :=
match ls with
| nil => Nil
| h :: t => Cons h (inject t)
end.
Print inject.
Fixpoint unject n (ls : ilist n) : list A :=
match ls with
| Nil => nil
| Cons _ h t => h :: unject t
end.
Theorem inject_inverse : forall ls,
unject (inject ls) = ls.
induction ls; crush.
Qed.
(* Exercise (20 min) : Prove the opposite, that inject (unject ls) = ls.
You cannot state this theorem directly, since ls : ilist n
and inject (unject ls) : ilist (length (unject ls)).
One approach is to define an alternative version of equality ilist_eq
on ilists and prove that the equality holds under this definition.
If you do this, prove that ilist_eq is an equivalence relation (and try
to automate the proof).
Another more involved approach is to prove that n = length (unject ls)
and then to define a function that, given (ls : ilist n) and a
proof that m = n, produces an ilist m. In this approach you may
find proof irrelevance convenient.
*)
Because I really want to better understand dependent types and how to use proofs in programs, I decided to try to do the latter. Here is what I have so far.
Definition ilists_sizechange (n1 n2:nat) (l1:ilist n1) (P:n1=n2): ilist n2.
subst.
assumption.
Defined.
Lemma ilists_size_equal: forall n (ls:ilist n), n = length (unject ls).
Proof.
intros.
induction ls.
reflexivity.
simpl.
auto.
Qed.
Theorem unject_inject_thehardway: forall n (ls:ilist n),
inject (unject ls) = ilists_sizechange ls (ilists_size_equal ls).
Proof.
intros.
induction ls.
simpl.
?????????????????
Qed.
When I get to "?????????????????" that's where I'm stuck. I have a target like Nil = ilists_sizechange Nil (ilists_size_equal Nil) and I'm not really sure what I can do here.
I tried writing ilists_sizechange as a more direct function, but failed to do so. Not sure how to massage the type checking.
I guess I'm curious first if this approach is fruitful, or if I'm making some fundamental mistake. I'm also curious what the most concise way of expressing inject (unject ls) = ilists_sizechange ls (ilists_size_equal ls). is...here there are two custom functions (the sizechange and the proof of equality), and one imagines it should be possible with just one.
Coq is great but the syntax around dependently types stuff can be tricky. I appreciate any help!
Edit: I realize that an inductive type or something expressing equality of two lists and then building up and showing the sizes are equal is probably easier (eg the first suggestion they have), but I want to understand this case because I can imagine running into these sorts of issues in the future and I want to know how to work around them.
Edit2: I was able to make it past the Nil case using the following
dep_destruct (ilists_size_equal Nil).
compute.
reflexivity.
But then get stuck on the Cons case...I will try to prove some theorems and see if I can't get there, but I think I'm still missing something conceptual here.
Although functions may depend on proof objects, one approach (I'm going to show below) is to define the functions so that they don't use the proof objects except to construct other proof objects and to eliminate absurd cases, ensuring that opaque proofs never block computation. Another approach is to fully embrace dependently typed programming and the unification of "proofs as programs", but that's a much bigger paradigm shift to explain, so I'm not going to do that.
Starting with ilists_sizechange, we now care about the shape of the term constructed by tactics, so not all tactics are allowed. Not wanting to use the equality proof rules out the tactic subst. Instead we can recurse (induction) on the list l1 and pattern-match (destruct) on the natural number n2; there are four cases:
two absurd ones, which can be eliminated by using the equality (discriminate)
the 0 = 0 case, where you can just construct the empty list
the S m1 = S m2 case, where you can construct Cons, use the induction hypothesis (i.e., recursive call), and then you are asked for a proof of m1 = m2, which is where you can fall back to regular reasoning without caring what the proof term looks like.
Definition ilists_sizechange (n1 n2:nat) (l1:ilist n1) (P:n1=n2): ilist n2.
Proof.
revert n2 P. (* Generalize the induction hypothesis. *)
induction l1; destruct n2; discriminate + constructor; auto.
Defined.
While the rest of the proof below would technically work with that definition, it is still not ideal because any computation would unfold ilist_sizechange into an ugly function. While we've been careful to give that function the "right" computational behavior, tactic-based programming tends to be sloppy about some finer details of the syntax of those functions, which makes later proofs where they appear hard to read.
To have it look nicer in proofs, one way is to define a Fixpoint with the refine tactic. You write down the body of the function in Gallina, and put underscores for the proof terms, which become obligations that you have to prove separately. refine is not the only way to perform this technique, there's also the Program Fixpoint command and the Equations plugin. I would recommend looking into Equations. I stick with refine out of familiarity.
As you can see, intuitively all this function does is deconstruct the list l1, indexed by n1, and reconstruct it with index n2.
Fixpoint ilists_sizechange (n1 n2 :nat) (l1:ilist n1) {struct l1} : n1 = n2 -> ilist n2.
Proof.
refine (
match l1, n2 with
| Nil, 0 => fun _ => Nil
| Cons x xs, S n2' => fun EQ => Cons x (ilists_sizechange _ _ xs _)
| _, _ => fun _ => _
end
); try discriminate.
auto.
Defined.
The proof of ilists_size_equal needs no modification.
Lemma ilists_size_equal: forall n (ls:ilist n), n = length (unject ls).
Proof.
intros.
induction ls.
reflexivity.
simpl.
auto.
Qed.
For the final proof, there is one more step: first generalize the equality proof.
The idea is that ilists_sizechange doesn't actually look at it, but when it makes a recursive call it will need to construct some other proof, and this generalization allows you to use the induction hypothesis independently of that particular proof.
Theorem unject_inject_ : forall n (ls:ilist n) (EQ : n = length (unject ls)),
inject (unject ls) = ilists_sizechange ls EQ.
Proof.
intros n ls; induction ls; cbn.
- reflexivity.
- intros EQ. f_equal. apply IHls. (* Here we have ilists_sizechange applied to some big proof object, which we can ignore because the induction hypothesis generalizes over all such proof objects *)
Qed.
Then you want to specialize that theorem to use a concrete proof, ensuring that such a proof exists so the theorem is not vacuous.
Theorem unject_inject : forall n (ls:ilist n),
inject (unject ls) = ilists_sizechange ls (ilists_size_equal _).
Proof.
intros; apply unject_inject_.
Qed.
Here is one solution:
(* Length-Indexed Lists *)
Require Import Coq.Lists.List.
Import ListNotations.
Section ilist.
Variable A : Set.
Inductive ilist : nat -> Set :=
| Nil : ilist O
| Cons : forall {n}, A -> ilist n -> ilist (S n).
Fixpoint inject (ls : list A) : ilist (length ls) :=
match ls with
| nil => Nil
| h :: t => Cons h (inject t)
end.
Fixpoint unject {n} (ls : ilist n) : list A :=
match ls with
| Nil => nil
| Cons h t => h :: unject t
end.
Definition cast {A B : Set} (e : A = B) : A -> B :=
match e with eq_refl => fun x => x end.
Fixpoint length_unject n (l : ilist n) : length (unject l) = n :=
match l with
| Nil => eq_refl
| Cons _ l => f_equal S (length_unject _ l)
end.
Theorem unject_inverse n (ls : ilist n) :
cast (f_equal ilist (length_unject _ ls)) (inject (unject ls)) = ls.
Proof.
induction ls as [|n x l IH]; simpl; trivial.
revert IH.
generalize (inject (unject l)).
generalize (length_unject _ l).
generalize (length (unject l)).
intros m e.
destruct e.
simpl.
intros; congruence.
Qed.
End ilist.
The trick is to make your goal sufficiently general, and then to destruct the equality. The generalization is required to ensure that your goal is well-typed after destructing; failing to generalize will often lead to dependent-type errors.
Here, I've defined the length lemma by hand to be able to use the reduction machinery. But you could also have used proof irrelevance to get the proof to reduce to eq_refl after the fact.

Prove equality on list constructed with a map

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.

What should be done when simpl does not reduce all the necessary steps?

The following example is from chapter Poly of the Software Foundations book.
Definition fold_length {X : Type} (l : list X) : nat :=
fold (fun _ n => S n) l 0.
Theorem fold_length_correct : forall X (l : list X),
fold_length l = length l.
Proof.
intros.
induction l.
- simpl. reflexivity.
- simpl.
1 subgoal
X : Type
x : X
l : list X
IHl : fold_length l = length l
______________________________________(1/1)
fold_length (x :: l) = S (length l)
I expected it to simplify a step here on the left side. It certainly should be able to.
Theorem fold_length_correct : forall X (l : list X),
fold_length l = length l.
Proof.
intros.
induction l.
- simpl. reflexivity.
- simpl. rewrite <- IHl. simpl.
1 subgoal
X : Type
x : X
l : list X
IHl : fold_length l = length l
______________________________________(1/1)
fold_length (x :: l) = S (fold_length l)
During the running of the tests I had an issue where simpl would refuse to dive in, but reflexivity did the trick, so I tried the same thing here and the proof succeeded.
Note that one would not expect reflexivity to pass given the state of the goal, but it does. In this example it worked, but it did force me to do the rewrite in the opposite direction of what I intended originally.
Is it possible to have more control over simpl so that it does the desired reductions?
For the purposes of this answer, I'll assume the definition of fold is something along the lines of
Fixpoint fold {A B: Type} (f: A -> B -> B) (u: list A) (b: B): B :=
match u with
| [] => b
| x :: v => f x (fold f v b)
end.
(basically fold_right from the standard library). If your definition is substantially different, the tactics I recommend might not work.
The issue here is the behavior of simpl with constants that have to be unfolded before they can be simplified. From the documentation:
Notice that only transparent constants whose name can be reused in the recursive calls are possibly unfolded by simpl. For instance a constant defined by plus' := plus is possibly unfolded and reused in the recursive calls, but a constant such as succ := plus (S O) is never unfolded.
This is a bit hard to understand, so let's use an example.
Definition add_5 (n: nat) := n + 5.
Goal forall n: nat, add_5 (S n) = S (add_5 n).
Proof.
intro n.
simpl.
unfold add_5; simpl.
exact eq_refl.
Qed.
You'll see that the first call to simpl didn't do anything, even though add_5 (S n) could be simplified to S (n + 5). However, if I unfold add_5 first, it works perfectly. I think the issue is that plus_5 is not directly a Fixpoint. While plus_5 (S n) is equivalent to S (plus_5 n), that isn't actually the definition of it. So Coq doesn't recognize that its "name can be reused in the recursive calls". Nat.add (that is, "+") is defined directly as a recursive Fixpoint, so simpl does simplify it.
The behavior of simpl can be changed a little bit (see the documentation again). As Anton mentions in the comments, you can use the Arguments vernacular command to change when simpl tries to simplify. Arguments fold_length _ _ /. tells Coq that fold_length should be unfolded if at least two arguments are provided (the slash separates between the required arguments on the left and the unnecessary arguments on the right).[sup]1[\sup]
A simpler tactic to use if you don't want to deal with that is cbn which works here by default and works better in general. Quoting from the documentation:
The cbn tactic is claimed to be a more principled, faster and more predictable replacement for simpl.
Neither simpl with Arguments and a slash nor cbn reduce the goal to quite what you want in your case, since it'll unfold fold_length but not refold it. You could recognize that the call to fold is just fold_length l and refold it with fold (fold_length l).
Another possibility in your case is to use the change tactic. It seemed like you knew already that fold_length (a :: l) was supposed to simplify to S (fold_length l). If that's the case, you could use change (fold_length (a :: l)) with (S (fold_length l)). and Coq will try to convert one into the other (using only the basic conversion rules, not equalities like rewrite does).
After you've gotten the goal to S (fold_length l) = S (length l) using either of the above tactics, you can use rewrite -> IHl. like you wanted to.
I thought the slashes only made simpl unfold things less, which is why I didn't mention it before. I'm not sure what the default actually is, since putting the slash anywhere seems to make simpl unfold fold_length.

How to do induction on the length of a list in Coq?

When reasoning on paper, I often use arguments by induction on the length of some list. I want to formalized these arguments in Coq, but there doesn't seem to be any built in way to do induction on the length of a list.
How should I perform such an induction?
More concretely, I am trying to prove this theorem. On paper, I proved it by induction on the length of w. My goal is to formalize this proof in Coq.
There are many general patterns of induction like this one that can be covered
by the existing library on well founded induction. In this case, you can prove
any property P by induction on length of lists by using well_founded_induction, wf_inverse_image, and PeanoNat.Nat.lt_wf_0, as in the following comand:
induction l using (well_founded_induction
(wf_inverse_image _ nat _ (#length _)
PeanoNat.Nat.lt_wf_0)).
if you are working with lists of type T and proving a goal P l, this generates an
hypothesis of the form
H : forall y : list T, length y < length l -> P y
This will apply to any other datatype (like trees for instance) as long as you can map that other datatype to nat using any size function from that datatype to nat instead of length.
Note that you need to add Require Import Wellfounded. at the head of your development for this to work.
Here is how to prove a general list-length induction principle.
Require Import List Omega.
Section list_length_ind.
Variable A : Type.
Variable P : list A -> Prop.
Hypothesis H : forall xs, (forall l, length l < length xs -> P l) -> P xs.
Theorem list_length_ind : forall xs, P xs.
Proof.
assert (forall xs l : list A, length l <= length xs -> P l) as H_ind.
{ induction xs; intros l Hlen; apply H; intros l0 H0.
- inversion Hlen. omega.
- apply IHxs. simpl in Hlen. omega.
}
intros xs.
apply H_ind with (xs := xs).
omega.
Qed.
End list_length_ind.
You can use it like this
Theorem foo : forall l : list nat, ...
Proof.
induction l using list_length_ind.
...
That said, your concrete example example does not necessarily need induction on the length. You just need a sufficiently general induction hypothesis.
Import ListNotations.
(* ... some definitions elided here ... *)
Definition flip_state (s : state) :=
match s with
| A => B
| B => A
end.
Definition delta (s : state) (n : input) : state :=
match n with
| zero => s
| one => flip_state s
end.
(* ...some more definitions elided here ...*)
Theorem automata221: forall (w : list input),
extend_delta A w = B <-> Nat.odd (one_num w) = true.
Proof.
assert (forall w s, extend_delta s w = if Nat.odd (one_num w) then flip_state s else s).
{ induction w as [|i w]; intros s; simpl.
- reflexivity.
- rewrite IHw.
destruct i; simpl.
+ reflexivity.
+ rewrite <- Nat.negb_even, Nat.odd_succ.
destruct (Nat.even (one_num w)), s; reflexivity.
}
intros w.
rewrite H; simpl.
destruct (Nat.odd (one_num w)); intuition congruence.
Qed.
In case like this, it is often faster to generalize your lemma directly:
From mathcomp Require Import all_ssreflect.
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.
Section SO.
Variable T : Type.
Implicit Types (s : seq T) (P : seq T -> Prop).
Lemma test P s : P s.
Proof.
move: {2}(size _) (leqnn (size s)) => ss; elim: ss s => [|ss ihss] s hs.
Just introduce a fresh nat for the size of the list, and regular induction will work.