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.
Related
Fixpoint n_copies (n x : nat) : list nat :=
match n with
| 0 => []
| S n' => x :: n_copies n' x
end.
Theorem exercise3
: forall x n, num_occ x (n_copies n x) = n.
Proof.
I tried:
intros x n. induction n. simpl.
- congruence.
- destruct (eq_dec x n).
+ induction e.
+
but i cant think a solution for another "+", and i have this notice:
1 goal
x : nat
IHn : num_occ x (n_copies x x) = x
______________________________________(1/1)
num_occ x (n_copies (S x) x) = S x
I think that i have to take of the S of both sides, but i don't know how.
It's strange that you had to compare x and n.
In general, they don't live in the same type:
From Coq Require Import List.
Section A_dec.
Variables (A:Type)(A_eq_dec : forall a b:A, {a = b}+{a <> b}).
Goal forall x n, count_occ A_eq_dec (repeat x n) x = n.
induction n.
(* ... *)
But you didn't share your function num_occ..., perhaps it's buggy ?
You should compare it with stdlib's count_occ.
Please note also that stdlib’s repeat and your n_copies don’t have the same order of arguments.
Here's is a solution (with Aas the type of elements of the list):
Require Import List Arith.
Import ListNotations.
Section A_decl.
Variables (A: Type)(eqdec: forall a b:A, {a = b}+{a <> b}).
Fixpoint n_copies (x:A) (n:nat) : list A :=
match n with
| 0 => []
| S n' => x :: n_copies x n'
end.
Fixpoint num_occ (x : A)(xs : list A) : nat :=
match xs with
| [] => 0
| (y :: ys) => if eqdec x y
then 1 + num_occ x ys
else num_occ x ys
end.
Theorem exercise3
: forall x n, num_occ x (n_copies x n) = n.
Proof.
induction n; simpl.
- reflexivity.
- destruct (eqdec x x) as [e | n0].
+ rewrite IHn; trivial.
+ now destruct n0.
Qed.
End A_decl.
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.
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 have a Contradictory statements in hypothesis. Want to convert it into true=false. Thanks for guidence in advance. Here is code
n < current_value 0 (n :: l)
current_value 0 (n :: l)<= n.
The question could be a lot more complete. What is the type of n? I'll assume that it is nat.
Starting like this:
Lemma manual:
forall current_value n l P,
n < current_value 0 (n :: l) ->
current_value 0 (n :: l) <= n ->
P.
Proof.
intros.
We arrive at a state that looks like this (omitting things we don't need):
H : n < current_value 0 (n :: l)
H0 : current_value 0 (n :: l) ≤ n
-----
P
The strategy will be to prove that H and H0 together lead to a contradiction from which we can prove any statement P.
We know that n < m (if m stands for the expression current_value 0 (n :: l)) and also m <= n. What can we prove from this? You can search for relevant lemmas using the Search command with a pattern that summarizes what you know:
Search (?n < ?m -> ?m <= ?p -> _).
This query means "given that I know that n < m and also m <= p for the same m, what can I deduce?". The named variables in the query need the ? prefix, they can stand for any expressions. They are not related to any variables you might have in the current environment.
One of the search hits is this (in PeanoNat, which you will have to import):
Nat.lt_le_trans:
forall n m p : nat, n < m -> m <= p -> n < p
So given this lemma we should be able to prove n < n and see if we can make progress from there.
{
apply Nat.lt_le_trans with (m := current_value 0 (n :: l)).
auto.
auto.
}
Now we have:
H1 : n < n
-----
P
So now we have a more "obvious" contradiction in an assumption. Do we have a lemma for proving that this is indeed false?
Search (~ ?n < ?n).
This gives:
Nat.lt_irrefl: forall x : nat, ~ x < x
So then:
apply Nat.lt_irrefl in H1.
We arrive at:
H1 : False
-----
P
This is a tautology that we can prove with tauto:
tauto.
Qed.
Doing such simple arithmetic manually can get very tedious, so there is a lot of automation for doing it. Here's a simpler method using the lia tactic:
Require Import Lia.
Lemma automatic:
forall current_value n l P,
n < current_value 0 (n :: l) ->
current_value 0 (n :: l) <= n ->
P.
Proof.
intros.
lia.
Qed.
Internally this will do some sort of similar reasoning, proving a contradiction in the assumptions.
Say I have a slightly different definition of addition, and a slightly different definition of vector appending:
From Coq Require Import Vector.
Definition myAddNat a b := nat_rect _ b (fun _ p => S p) a.
Theorem rewrite_myAddNat a b : myAddNat a b = (a + b)%nat.
Proof.
induction a.
{ reflexivity. }
{
simpl.
congruence.
}
Defined.
Definition myAppend T m n : Vector.t T m -> Vector.t T n -> Vector.t T (myAddNat m n).
rewrite rewrite_myAddNat.
apply Vector.append.
Defined.
I would like to be able to prove the following:
Theorem myAppend_cons_1 T m n h a b :
myAppend T (S m) n (cons T h m a) b =
cons T h (myAddNat m n) (myAppend T m n a b).
Proof.
induction a.
{ reflexivity. }
{
simpl.
unfold myAppend.
(* stuck! *)
}
Abort.
I end up stuck on two terms that are very close to each other, except they each have an equality cast in a different position that I am not sure how to handle.
I have considered changing my theorem statement to:
Theorem myAppend_cons T m n h a b :
existT _ _ (myAppend T (S m) n (cons T h m a) b) =
existT _ _ (cons T h (myAddNat m n) (myAppend T m n a b)).
so as to be able to temporarily make the two sides of the equation have a different type, but have not been able to make much more progress on the proof.
So:
1) Is there a nice way to prove either theorem
or,
2) Should I write myAppend in a different way that will make my life easier?
Here is a quick answer:
Theorem myAppend_cons_1 T m n h a b :
myAppend T (S m) n (cons T h m a) b =
cons T h (myAddNat m n) (myAppend T m n a b).
Proof.
unfold myAppend, eq_rect_r; simpl.
rewrite !eq_trans_refl_l, !eq_sym_map_distr.
now destruct (eq_sym _).
Qed.