I have that for all j in {1, 2, .. N} such that j ≠ i it holds that a_j ≤ b_j. I want to prove in Coq that
How can I do that and what modules are the best for these kinds of manipulations?
The mathematical components library has a theory of "big" operations with lots of lemmas. Here is how one might prove your result:
From mathcomp Require Import all_ssreflect.
Lemma test N (f g : nat -> nat) (i : 'I_N) :
(forall j, j != i -> f i <= g i) ->
\sum_(j < N | j != i) f i <= \sum_(j < N | j != i) g i.
Proof. move=> f_leq_g; exact: leq_sum. Qed.
Edit
If you want to reason about operations over the real numbers, you will also need to install the mathematical components analysis library. Here is how one might adapt this proof to work over the real numbers:
(* Bring real numbers into scope, as well as
the theory of algebraic and numeric structures *)
Require Import Coq.Reals.Reals.
From mathcomp Require Import all_ssreflect ssralg ssrnum Rstruct reals.
(* Change summation and other notations to work over rings
rather than the naturals *)
Local Open Scope ring_scope.
Lemma test N (f g : nat -> R) (i : 'I_N) :
(forall j, j != i -> f i <= g i) ->
\sum_(j < N | j != i) f i <= \sum_(j < N | j != i) g i.
Proof. move=> f_leq_g; exact: Num.Theory.ler_sum. Qed.
You can do this without the mathematical components library using lia and induction.
Require Import Arith.
Require Import Lia.
Fixpoint sum (f: nat -> nat) (N: nat) :=
match N with
| 0 => 0
| S m => f 0 + sum (fun x => f (S x)) m
end.
Fixpoint sum_except (f: nat -> nat) (i : nat) (N: nat) {struct N} :=
match N with
| 0 => 0
| S m =>
match i with
| 0 => 0 + sum (fun x => f (S x)) m
| S j => f 0 + sum_except (fun x => f (S x)) j m
end
end.
Lemma SumLess : forall N a b,
(forall j, a j <= b j) ->
sum a N <= sum b N.
Proof.
induction N.
- simpl; lia.
- intros; simpl.
admit. (* I'll leave this as an exercise. Use lia. *)
Qed.
Lemma SumExceptLess :
forall N i a b,
(forall j, not (j = i) ->
a j <= b j) ->
sum_except a i N <= sum_except b i N.
Proof.
induction N.
- simpl. lia.
- destruct i.
simpl.
+ intros.
apply SumLess; auto.
+ intros; simpl.
admit. (* Again, I'll leave this for you to discover. Use lia. Follow the same pattern as you did in SumLess. *)
Qed.
Related
I'm basically trying to prove
Theorem le_unique {x y : nat} (p q : x <= y) : p = q.
without assuming any axioms (e.g. proof irrelevance). In particular, I've tried to get through le_unique by induction and inversion, but it never seems to get far
Theorem le_unique (x y : nat) (p q : x <= y) : p = q.
Proof.
revert p q.
induction x as [ | x rec_x]. (* induction on y similarly fruitless; induction on p, q fails *)
- destruct p as [ | y p].
+ inversion q as [ | ]. (* destruct q fails and inversion q makes no progress *)
admit.
+ admit.
- admit.
Admitted.
In the standard library, this lemma can be found as Peano_dec.le_unique in the module Coq.Arith.Peano_dec.
As for a relatively simple direct proof, I like to go by induction on p itself.
After proving by hand a few induction principles that Coq doesn't automatically generate, and remembering that proofs of equality on nat are unique, the proof is a relatively straightforward induction on p followed by cases on q, giving four cases two of which are absurd.
Below is a complete Coq file proving le_unique.
Import EqNotations.
Require Eqdep_dec PeanoNat.
Lemma nat_uip {x y : nat} (p q : x = y) : p = q.
apply Eqdep_dec.UIP_dec.
exact PeanoNat.Nat.eq_dec.
Qed.
(* Generalize le_ind to prove things about the proof *)
Lemma le_ind_dependent :
forall (n : nat) (P : forall m : nat, n <= m -> Prop),
P n (le_n n) ->
(forall (m : nat) (p : n <= m), P m p -> P (S m) (le_S n m p)) ->
forall (m : nat) (p : n <= m), P m p.
exact (fun n P Hn HS => fix ind m p : P m p := match p with
| le_n _ => Hn | le_S _ m p => HS m p (ind m p) end).
Qed.
(*
Here we give an proof-by-cases principle for <= which keeps both the left
and right hand sides fixed.
*)
Lemma le_case_remember (x y : nat) (P : x <= y -> Prop)
(IHn : forall (e : y = x), P (rew <- e in le_n x))
(IHS : forall y' (q' : x <= y') (e : y = S y'), P (rew <- e in le_S x y' q'))
: forall (p : x <= y), P p.
exact (fun p => match p with le_n _ => IHn | le_S _ y' q' => IHS y' q' end eq_refl).
Qed.
Theorem le_unique {x y : nat} (p q : x <= y) : p = q.
revert q.
induction p as [|y p IHp] using le_ind_dependent;
intro q;
case q as [e|x' q' e] using le_case_remember.
- rewrite (nat_uip e eq_refl).
reflexivity.
- (* x = S x' but x <= x', so S x' <= x', which is a contradiction *)
exfalso.
rewrite e in q'.
exact (PeanoNat.Nat.nle_succ_diag_l _ q').
- (* S y' = x but x <= y', so S y' <= y', which is a contradiction *)
exfalso; clear IHp.
rewrite <- e in p.
exact (PeanoNat.Nat.nle_succ_diag_l _ p).
- injection e as e'.
(* We now get rid of e as equal to (f_equal S e'), and then destruct e'
now that it is an equation between variables. *)
assert (f_equal S e' = e).
+ apply nat_uip.
+ destruct H.
destruct e'.
change (le_S x y p = le_S x y q').
f_equal.
apply IHp.
Qed.
Inspired by Eqdep_dec (and with a lemma from it), I've been able to cook this proof up. The idea is that x <= y can be converted to exists k, y = k + x, and roundtripping through this conversion produces a x <= y that is indeed = to the original.
(* Existing lemmas (e.g. Nat.le_exists_sub) seem unusable (declared opaque) *)
Fixpoint le_to_add {x y : nat} (prf : x <= y) : exists k, y = k + x :=
match prf in _ <= y return exists k, y = k + x with
| le_n _ => ex_intro _ 0 eq_refl
| le_S _ y prf =>
match le_to_add prf with
| ex_intro _ k rec =>
ex_intro
_ (S k)
match rec in _ = z return S y = S z with eq_refl => eq_refl end
end
end.
Fixpoint add_to_le (x k : nat) : x <= k + x :=
match k with
| O => le_n x
| S k => le_S x (k + x) (add_to_le x k)
end.
Theorem rebuild_le
{x y : nat} (prf : x <= y)
: match le_to_add prf return x <= y with
| ex_intro _ k prf =>
match prf in _ = z return x <= z -> x <= y with
| eq_refl => fun p => p
end (add_to_le x k)
end = prf.
Proof.
revert y prf.
fix rec 2. (* induction is not enough *)
destruct prf as [ | y prf].
- reflexivity.
- specialize (rec y prf).
simpl in *.
destruct (le_to_add prf) as [k ->].
subst prf.
reflexivity.
Defined.
Then, any two x <= ys will produce the same k, by injectivity of +. The decidability of = on nat tells us that the produced equalities are also equal. Thus, the x <= ys map to the same exists k, y = k + x, and mapping that equality back tells us the x <= ys were also equal.
Theorem le_unique (x y : nat) (p q : x <= y) : p = q.
Proof.
rewrite <- (rebuild_le p), <- (rebuild_le q).
destruct (le_to_add p) as [k ->], (le_to_add q) as [l prf].
pose proof (f_equal (fun n => n - x) prf) as prf'.
simpl in prf'.
rewrite ?Nat.add_sub in prf'.
subst l.
apply K_dec with (p := prf).
+ decide equality.
+ reflexivity.
Defined.
I'm still hoping there's a better (i.e. shorter) proof available.
I tried following proof,
Require Import List Omega.
Import ListNotations.
Variable X : Type.
Lemma length_n_nth_app_error_same : forall (n:nat) (x:X) (l:list X),
n <= length l -> 0 < n -> nth_error l n = nth_error (l ++ [x]) n .
Proof.
intros.
induction l eqn:eqHl.
- unfold length in H. omega.
-
but I'm stuck, as what I have is only
1 subgoal
n : nat
x : X
l : list X
a : X
l0 : list X
eqHl : l = a :: l0
H : n <= length (a :: l0)
H0 : 0 < n
IHl0 : l = l0 ->
n <= length l0 ->
nth_error l0 n = nth_error (l0 ++ [x]) n
______________________________________(1/1)
nth_error (a :: l0) n = nth_error ((a :: l0) ++ [x]) n
I've met some similar cases also for other proofs on lists.
I don't know if the usual induction would be useful here.
How should I prove this?
Should I use generalize?
Your theorem is wrong. Maybe your understanding of nth_error is incorrect.
Specifically, when n = length l, nth_error l n returns None while nth_error (l ++ [x]) n returns Some x.
Require Import List Omega.
Import ListNotations.
Lemma length_n_nth_app_error_not_always_same :
(forall (n:nat) (X:Type) (x:X) (l:list X),
n <= length l -> 0 < n -> nth_error l n = nth_error (l ++ [x]) n)
-> False.
Proof.
intros.
assert (1 <= 1) by omega. assert (0 < 1) by omega.
specialize (H 1 nat 2 [1] H0 H1). simpl in H. inversion H. Qed.
On the other hand, proving a similar theorem with fixed inequality is easy:
Lemma length_n_nth_app_error_same : forall (n:nat) (X:Type) (x:X) (l:list X),
n < length l -> nth_error l n = nth_error (l ++ [x]) n .
Proof.
induction n; intros.
- simpl. destruct l; simpl in *.
+ omega.
+ reflexivity.
- simpl. destruct l; simpl in *.
+ omega.
+ apply IHn. omega. Qed.
Note that I used induction n instead of induction l. It is mainly because nth_error does recursive calls on decreasing n.
Also, if you felt like an induction hypothesis is not general enough, it is probably because your order of intros and induction was wrong. The rule of thumb is to start the proof by induction, and then intros the variables. If it is still not enough, you can revert dependent all the variables other than the one to do induction, and then induction x; intros.
With the following definitions I want to prove lemma without_P
Variable n : nat.
Definition mnnat := {m : nat | m < n}.
Variable f : mnnat -> nat.
Lemma without_P : (exists x : mnnat, True) -> (exists x, forall y, f x <= f y).
Lemma without_P means: if you know (the finite) set mnnat is not empty, then there must exist an element in mnnat, that is the smallest of them all, after mapping f onto mnnat.
We know mnnat is finite, as there are n-1 numbers in it and in the context of the proof of without_P we also know mnnat is not empty, because of the premise (exists x : mnnat, True).
Now mnnat being non-empty and finite "naturally/intuitively" has some smallest element (after applying f on all its elements).
At the moment I am stuck at the point below, where I thought to proceed by induction over n, which is not allowed.
1 subgoal
n : nat
f : mnnat -> nat
x : nat
H' : x < n
______________________________________(1/1)
exists (y : nat) (H0 : y < n),
forall (y0 : nat) (H1 : y0 < n),
f (exist (fun m : nat => m < n) y H0) <= f (exist (fun m : nat => m < n) y0 H1)
My only idea here is to assert the existance of a function f' : nat -> nat like this: exists (f' : nat -> nat), forall (x : nat) (H0: x < n), f' (exist (fun m : nat => m < n) x H0) = f x, after solving this assertion I have proven the lemma by induction over n. How can I prove this assertion?
Is there a way to prove "non-empty, finite sets (after applying f to each element) have a minimum" more directly? My current path seems too hard for my Coq-skills.
Require Import Psatz Arith. (* use lia to solve the linear integer arithmetic. *)
Variable f : nat -> nat.
This below is essentially your goal, modulo packing of the statement into some dependent type. (It doesn't say that mi < n, but you can extend the proof statement to also contain that.)
Goal forall n, exists mi, forall i, i < n -> f mi <= f i.
induction n; intros.
- now exists 0; inversion 1. (* n cant be zero *)
- destruct IHn as [mi IHn]. (* get the smallest pos mi, which is < n *)
(* Is f mi still smallest, or is f n the smallest? *)
(* If f mi < f n then mi is the position of the
smallest value, otherwise n is that position,
so consider those two cases. *)
destruct (lt_dec (f mi) (f n));
[ exists mi | exists n];
intros.
+ destruct (eq_nat_dec i n).
subst; lia.
apply IHn; lia.
+ destruct (eq_nat_dec i n).
subst; lia.
apply le_trans with(f mi).
lia.
apply IHn.
lia.
Qed.
Your problem is an specific instance of a more general result which is proven for example in math-comp. There, you even have a notation for denoting "the minimal x such that it meets P", where P must be a decidable predicate.
Without tweaking your statement too much, we get:
From mathcomp Require Import all_ssreflect.
Variable n : nat.
Variable f : 'I_n.+1 -> nat.
Lemma without_P : exists x, forall y, f x <= f y.
Proof.
have/(_ ord0)[] := arg_minP (P:=xpredT) f erefl => i _ P.
by exists i => ?; apply/P.
Qed.
I found a proof to my assertion (exists (f' : nat -> nat), forall (x : nat) (H0: x < n), f (exist (fun m : nat => m < n) x H0) = f' x). by proving the similar assertion (exists (f' : nat -> nat), forall x : mnnat, f x = f' (proj1_sig x)). with Lemma f'exists. The first assertion then follows almost trivially.
After I proved this assertion I can do a similar proof to user larsr, to prove Lemma without_P.
I used the mod-Function to convert any nat to a nat smaller then n, apart from the base case of n = 0.
Lemma mod_mnnat : forall m,
n > 0 -> m mod n < n.
Proof.
intros.
apply PeanoNat.Nat.mod_upper_bound.
intuition.
Qed.
Lemma mod_mnnat' : forall m,
m < n -> m mod n = m.
Proof.
intros.
apply PeanoNat.Nat.mod_small.
auto.
Qed.
Lemma f_proj1_sig : forall x y,
proj1_sig x = proj1_sig y -> f x = f y.
Proof.
intros.
rewrite (sig_eta x).
rewrite (sig_eta y).
destruct x. destruct y as [y H0].
simpl in *.
subst.
assert (l = H0).
apply proof_irrelevance. (* This was tricky to find.
It means two proofs of the same thing are equal themselves.
This makes (exist a b c) (exist a b d) equal,
if c and d prove the same thing. *)
subst.
intuition.
Qed.
(* Main Lemma *)
Lemma f'exists :
exists (ff : nat -> nat), forall x : mnnat, f x = ff (proj1_sig x).
Proof.
assert (n = 0 \/ n > 0).
induction n.
auto.
intuition.
destruct H.
exists (fun m : nat => m).
intuition. destruct x. assert (l' := l). rewrite H in l'. inversion l'.
unfold mnnat in *.
(* I am using the mod-function to map (m : nat) -> {m | m < n} *)
exists (fun m : nat => f (exist (ltn n) (m mod n) (mod_mnnat m H))).
intros.
destruct x.
simpl.
unfold ltn.
assert (l' := l).
apply mod_mnnat' in l'.
assert (proj1_sig (exist (fun m : nat => m < n) x l) = proj1_sig (exist (fun m : nat => m < n) (x mod n) (mod_mnnat x H))).
simpl. rewrite l'.
auto.
apply f_proj1_sig in H0.
auto.
Qed.
Assume the following:
Inductive bin : Set := Z | O.
Fixpoint fib (n : nat) : list bin :=
match n with
| 0 => [Z]
| S k => match k with
| 0 => [O]
| S k' => fib k' ++ fib k
end
end.
I would like to show:
Theorem fib_first : forall n,
Nat.Even n -> n > 3 -> exists w, fib n = Z :: w.
However, by performing induction on n, I get a really useless inductive
hypothesis fixing n, stating that IH : Nat.Even n -> n > 3 -> exists w : list bin, fib n = Z :: w.
What I would ideally have is the following: IH : forall n : nat, Nat.Even n -> n > 3 -> exists w : list bin, fib n = Z :: w. Naturally I cannot assume the original proposition, but it feels like I need to prove something stronger perhaps?
My idea for the inductive reasoning would be made possible by expanding F n = F n-2 . F n-1, we know F n-2 is even iff F n is even, and since neither of F n-2 or F n-1 is empty, we can show the substring is shorter, therefore sufficient for the inductive hypothesis - how does one express this in Coq?
The trick is to unfold the definition of Nat.Even and do induction on n / 2 instead of n:
Theorem fib_first : forall n,
Nat.Even n -> exists w, fib n = Z :: w.
Proof.
intros n [m ->].
induction m as [|m IH].
- now exists nil.
- rewrite <- mult_n_Sm, plus_comm.
generalize (2 * m) IH. clear m IH. simpl.
intros n [w ->].
simpl. eauto.
Qed.
Note that your n > 3 hypothesis is not actually needed.
This should be a straight forward thing to prove, but I keep getting stuck. Would be grateful for help...
Require Import Arith.
Fixpoint At n (l:list nat) :=
match n with
| 0 => match l with nil => None | cons x _ => Some x end
| S n' => match l with nil => None | cons _ l' => At n' l' end
end.
Definition ordered l :=
forall i j, i < j -> j < length l ->
exists x y, At i l = Some x /\ At j l = Some y /\ x <= y.
Lemma ordered_cons:
forall l a b, ordered (cons b l) -> a <= b -> ordered (cons a (cons b l)).
intros l a b H H0 i j Hij Hj.
destruct i,j;
(* solve three of the four cases, and leave one untouched *)
try (inversion Hij; fail);
try (apply H; simpl in *; omega).
EDIT: Here is the solution to finish the proof. I need to consider the two next cases for j.
destruct j;
try (exists a,b; auto; fail).
destruct (H 0 (S j)) as [x [y [Ha [Hb Hc]]]]; auto with arith;
simpl in *; inversion Ha; exists a, y;
repeat split; try tauto; omega.
Qed.