Prove that the number of occurences of x in a list that has n position with valor x = n - coq

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.

Related

Proving theorem in Coq, the number of occurances in a list is <= the lenght of this list

Fixpoint num_occ (x : nat)(xs : list nat) : nat :=
match xs with
| [] => 0
| (y :: ys) => if eq_dec x y
then 1 + num_occ x ys
else num_occ x ys
end.
Theorem exercise2
: forall x xs, num_occ x xs <= length xs.
Proof.
I tried, but i have no idea of how can i prove that, i am iniciating in this language....
i tried this:
intros x xs.
induction xs.
simpl.
reflexivity.
case 1.
simpl.
destruct x.
simpl.
and show this:
2 goals
x, n : nat
______________________________________(1/2)
0 = n
______________________________________(2/2)
num_occ x (n0 :: l) = n
I think case 1 is not necessary. Try this:
Theorem exercise2
: forall x xs, num_occ x xs <= length xs.
Proof.
intros x xs. induction xs; simpl.
- reflexivity.
- destruct (eq_dec x a).
+ apply le_n_S. assumption.
+ apply le_le_succ_r. assumption.
Qed.

Proving a_j ≤ b_j → sum (a_j) ≤ sum (b_j)

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.

How to prove a odd number is the successor of double of nat in coq?

I have the odd number definition as below:
Definition Odd n := exists k, n = 2*k+1.
And I have an oddb define that whether a number is odd or not.
Fixpoint oddb (n : nat) { struct n } : bool :=
match n with
| 0 => false
| 1 => true
| S (S n) => oddb n
end.
I am trying to prove if a number is the successor of a double of nat; then it is a odd number.
Theorem question_1c:
forall n, Odd n -> (oddb n = true).
Proof.
unfold Odd. intros. inversion H.
rewrite H0. simpl. induction x.
- simpl. reflexivity.
- Admitted.
I stuck on the second goal.. it showed that I need to prove Sx.. and the hypothesis I have from now seems like not helpful...
1 subgoal
n : nat
H : exists k : nat, n = 2 * k + 1
x : nat
H0 : n = 2 * S x + 1
IHx : n = 2 * x + 1 -> oddb (x + (x + 0) + 1) = true
______________________________________(1/1)
oddb (S x + (S x + 0) + 1) = true
Can anyone help me?? tHnak you
Standard induction let you jump from n to n+1. Here with your odd function
you need to jump from n to n+2. So what is needed is a stronger induction. One way to do this is to prove:
Theorem question_1c:
forall n m, m <= n -> Odd m -> (oddb m = true).
by standard induction on n (but for all m smaller)

How to prove all proofs of le equal?

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.

Minimum in non-empty, finite set

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.