How to simplify lemma - coq

I have problem in solving the lemma list_value.
Destruct command gives complicated situation. How I
can proceed? Any sub_lemma could be
helpful? Function G_value is zero only, when list is empty.
Therefore I have put constraint that list cannot be nil.
current_value function confirms that, all elemnts in
list nat are less or equal to the greatest value determine by G_value.
Definition change_h (n: nat) (l: list nat) : list nat:=
match l with
| nil => l
| h::tl => if n <=? h then l else n::tl
end.
Fixpoint G_value (n: nat) (l: list nat) {struct n}: nat :=
match l with
| nil => 0
| cons s nil => s
| cons h l => match n with
| O => h
| S n' => G_value n' (change_h h l)
end
end.
Theorem list_value :forall(n n0:nat) ( l:list nat),
(length l=?0)=false ->
(length l - length l =? 0)=true ->
(current_value 0 0 (n :: l) <=? n) = true.
Proof.
intros. unfold current_value.
simpl in *.
1 subgoal
n, n0 : nat
l : list nat
H : (length l =? 0) = false
H0 : (length l - length l =? 0) = true
______________________________________(1/1)
( (if
match l with
| [ ] => n
| _ :: _ => G_value (length l) (change_h n l)
end =? 0
then 0
else
match l with
| [ ] => n
| _ :: _ => G_value (length l) (change_h n l)
end) <=? n) = true

Related

Lemma related to the counting of numbers in list

I want to solve a lemma which relate two lists after removing a number from the list with the help of following functions. Here is code
Theorem remove_decr_count: forall (l : list nat),
leb (count 0 (remove_one 0 s)) (count 0 s) = true.
Used functions are
Fixpoint remove_one (v:nat) (l:list nat) : list nat:=
match l with
| [] => []
| h :: t => if beq_nat v h then t else h :: remove_one v t
end.
Fixpoint leb (n m:nat) : bool :=
match n, m with
| O, _ => true
| S _, O => false
| S n', S m' => leb n' m'
end.
Fixpoint count (v:nat) (l:list nat) : nat :=
match l with
| [] => 0
| h :: t => (if beq_nat h v then 1 else 0) + (count v t)
end.
One way to proceed is by induction on the list l (warning: you used s in the theorem's definition, though), and then by case, on whether the head of the list is 0 or not. Rewrites are used to guide the proof.
Using the SSReflect tactics language, the proof could proceed like this (I replaced beq_nat by ==, and added the leb1 lemma, which is also proved by induction, here on n).
From Coq Require Import Init.Prelude Unicode.Utf8.
From mathcomp Require Import all_ssreflect.
Fixpoint remove_one (v:nat) (l:list nat) : list nat:=
match l with
| nil => nil
| cons h t => if v == h then t else cons h (remove_one v t)
end.
Fixpoint count (v:nat) (l:list nat) : nat :=
match l with
| nil => 0
| cons h t => (if h == v then 1 else 0) + (count v t)
end.
Fixpoint leb (n m:nat) : bool :=
match n, m with
| O, _ => true
| S _, O => false
| S n', S m' => leb n' m'
end.
Lemma leb1 (n : nat) : leb n (S n).
Proof. by elim: n. Qed.
Theorem remove_decr_count: forall (l : list nat),
leb (count 0 (remove_one 0 l)) (count 0 l).
Proof.
elim=> [|h t IH] //=.
- have [] := boolP (h == 0) => eqh0.
by rewrite eq_sym eqh0 leb1.
- by rewrite eq_sym ifN //= ifN.
Qed.

Can we ban arguments that don't meet conditions?

I want to partially derive functions whose input is a dependent list.
deriveP has an error because EucAppend fk (pk ::: lk) of length is not always n, but I always expects a list whose length is P.
This is due to the definition of lastk and firstk.
To solve this problem, lastk and firstk must return only Euc k, not Euc n.
I want to ban arguments that n and k don't meet k <= n in lastk and firstk.
I don't know how to do it. Please tell me.
This is dependent list of R.
Require Import Coq.Reals.Reals.
Require Import Coquelicot.Coquelicot.
Inductive Euc:nat -> Type:=
|RO : Euc 0
|Rn : forall {n:nat}, R -> Euc n -> Euc (S n).
Notation "[ ]" := RO.
Notation "[ r1 , .. , r2 ]" := (Rn r1 .. ( Rn r2 RO ) .. ).
Infix ":::" := Rn (at level 60, right associativity).
Basic list operation.
Definition head {n} (v : Euc (S n)) : R :=
match v with
| x ::: _ => x
end.
Definition tail {n} (v : Euc (S n)) : Euc n :=
match v with
| _ ::: v => v
end.
(* extract the last element *)
Fixpoint last {n} : Euc (S n) -> R :=
match n with
| 0%nat => fun v => head v
| S n => fun v => last (tail v)
end.
(* eliminate last element from list *)
Fixpoint but_last {n} : Euc (S n) -> Euc n :=
match n with
| 0%nat => fun _ => []
| S n => fun v => head v ::: but_last (tail v)
end.
(* do the opposite of cons *)
Fixpoint snoc {n} (v : Euc n) (x : R) : Euc (S n) :=
match v with
| [] => [x]
| y ::: v => y ::: snoc v x
end.
(* extract last k elements *)
Fixpoint lastk k : forall n, Euc n -> Euc (Nat.min k n) :=
match k with
| 0%nat => fun _ _ => []
| S k' => fun n =>
match n return Euc n -> Euc (Nat.min (S k') n) with
| 0%nat => fun _ => []
| S n' => fun v =>
snoc (lastk k' _ (but_last v)) (last v)
end
end.
(* extract first k elements *)
Fixpoint firstk k :forall n, Euc n -> Euc (Nat.min k n) :=
match k with
| 0%nat => fun _ _ => []
| S k' => fun n =>
match n return Euc n -> Euc (Nat.min (S k') n) with
| 0%nat => fun _ => []
| S n' => fun v => (head v) ::: firstk k' _ (tail v)
end
end.
(* extract nth element *)
(* 0 origine *)
Fixpoint EucNth (k:nat) :forall n, Euc (S n) -> R:=
match k with
| 0%nat => fun _ e => head e
| S k' => fun n =>
match n return Euc (S n) -> R with
| 0%nat => fun e => head e
| S n' => fun v => EucNth k' n' (tail v)
end
end.
Fixpoint EucAppend {n m} (e:Euc n) (f:Euc m) :Euc (n+m):=
match e with
|[] => f
|e' ::: es => e' ::: (EucAppend es f)
end.
deriveP partially derive fnctions. I (EucAppend fk (pk ::: lk)) is where the error is.
Definition deriveP {n A} (k:nat) (I:Euc n -> Euc A) (p :Euc n) :=
let fk := firstk k P p in
let lk := lastk (P-(k+1)) P p in
(Derive (fun pk => I (EucAppend fk (pk ::: lk)) )) (EucNth k (P-1) p).
You can work with an order relation as you mentioned. My recommendation is to avoid proofs inside your definition (which makes proving after more complex), example :
Fixpoint lastk k n : Euc n -> k < n -> Euc k :=
match n with
|0 => fun _ (H : k < 0) => False_rect _ (Lt.lt_n_O _ H)
|S n => match k with
|S m => fun v H => snoc (lastk (but_last v) (le_S_n _ _ H)) (last v)
|0 => fun _ H => []
end
end.
Fixpoint firstk k n : Euc n -> k < n -> Euc k :=
match n with
|0 => fun _ (H : k < 0) => False_rect _ (Lt.lt_n_O _ H)
|S n => match k with
|S m => fun v H => (head v) ::: firstk (tail v) (le_S_n _ _ H)
|0 => fun _ H => []
end
end.
This definition is transparent which makes it easy to prove after using k n as inductions points.
The vectodef library works with Fin types(finite sequences). You can do a workaround to make it comfortable to extract the definition :
Fixpoint of_nat {n} (x : t n) : nat :=
match x with
|#F1 _ => 0
|#FS _ y => S (of_nat y)
end.
Fixpoint lastk n (H : t n) (v : Euc n) : Euc (of_nat H) :=
match H as t in (t n0) return (Euc n0 -> Euc (of_nat t)) with
| #F1 n0 => fun=> [ ]
| #FS n0 H1 =>
fun H2 : Euc (S n0) => snoc (lastk H1 (but_last H2)) (last H2)
end v.
Theorem of_nat_eq : forall y k (H : k < y), of_nat (of_nat_lt H) = k.
intros y k.
elim/#nat_double_ind : y/k.
intros;inversion H.
intros; auto.
intros; simply.
by rewrite -> (H (Lt.lt_S_n _ _ H0)).
Qed.
Definition last_leb n k (v : Euc n) : k < n -> Euc k.
intros.
rewrite <- (of_nat_eq H).
exact (#lastk _ (of_nat_lt H) v).
Show Proof.
Defined.
But..., as I mentioned this has proofs in the terms.
I think you probably will need another proof for deriveP, but I don't know the definition of Derive, please consider to specify at least the type definition.

Greatest value in natural number list

I have defined a function,which finds greatest value in the list of natural numbers and head of the list save this value. I want to prove that all the elements in the list are less or equal to natural number present at head of the list.I have problem in proving the lemma. I have written two lemmas,I want to know,which would be helpful in solving the problem. Thanks for help and
support .
Require Import Coq.Arith.Arith.
Require Import Coq.Lists.List.
Import ListNotations.
Definition change_variable (n: nat) (l: list nat) : list nat:=
match l with
| nil => l
| h::t => if n <=? h then l else n::t
end.
Fixpoint largest_value (numbers: nat) (l: list nat) {struct numbers}: nat:=
match l with
| nil => 0
| cons b nil => b
| cons h l => match numbers with
| O => h
| S numbers' => largest_value numbers' (change_variable h l)
end
end.
Theorem all_values_less :forall (n c :nat)(l:list nat),
(largest_value (length (c :: l))
(change_variable n (c :: l)) <= n).
First in this way,
Inductive changing : l -> Prop :=
| change_nil : changing nil
| change_1 n : changing (cons n nil)
| change_head n h l :
n <= h ->
changing (cons h l) ->
changing (cons n l).
Lemma head_is_gt l a:
changing l -> forall n, In n l -> n <= hd a l.
Proof.
induction 1. intros k H'.
now exfalso; apply in_nil in H'.
Admitted.
Secondly ,
Definition head_is_greater (l: list nat): nil <> l -> nat.
intros.
destruct l.
destruct (H (#erefl (list nat) nil)).
apply : (largest_value s l).
Defined.
Theorem values_les_n : forall l (H : [] <> l) n, In n l -> n <=
head_is_greater H.
The theorem does not hold, unfortunately. Here is a counterexample:
Require Import Coq.Arith.Arith.
Require Import Coq.Lists.List.
Require Import Lia.
Import ListNotations.
Definition change_variable (n: nat) (l: list nat) : list nat:=
match l with
| nil => l
| h::t => if n <=? h then l else n::t
end.
Fixpoint largest_value (numbers: nat) (l: list nat) {struct numbers}: nat:=
match l with
| nil => 0
| cons b nil => b
| cons h l => match numbers with
| O => h
| S numbers' => largest_value numbers' (change_variable h l)
end
end.
Hypothesis all_values_less :forall (n c :nat)(l:list nat),
(largest_value (length (c :: l))
(change_variable n (c :: l)) <= n).
Theorem contra : False.
Proof.
pose proof (all_values_less 0 1 []).
simpl in *. lia.
Qed.
You probably need to add more hypothesis to your statement to rule out such cases.

Coq: unary to binary convertion

Task: write a function to convert natural numbers to binary numbers.
Inductive bin : Type :=
| Z
| A (n : bin)
| B (n : bin).
(* Division by 2. Returns (quotient, remainder) *)
Fixpoint div2_aux (n accum : nat) : (nat * nat) :=
match n with
| O => (accum, O)
| S O => (accum, S O)
| S (S n') => div2_aux n' (S accum)
end.
Fixpoint nat_to_bin (n: nat) : bin :=
let (q, r) := (div2_aux n 0) in
match q, r with
| O, O => Z
| O, 1 => B Z
| _, O => A (nat_to_bin q)
| _, _ => B (nat_to_bin q)
end.
The 2-nd function gives an error, because it is not structurally recursive:
Recursive call to nat_to_bin has principal argument equal to
"q" instead of a subterm of "n".
What should I do to prove that it always terminates because q is always less then n.
Prove that q is (almost always) less than n:
(* This condition is sufficient, but a "better" one is n <> 0
That makes the actual function slightly more complicated, though *)
Theorem div2_aux_lt {n} (prf : fst (div2_aux n 0) <> 0) : fst (div2_aux n 0) < n.
(* The proof is somewhat involved...
I did it by proving
forall n k, n <> 0 ->
fst (div2_aux n k) < n + k /\ fst (div2_aux (S n) k) < S n + k
by induction on n first *)
Then proceed by well-founded induction on lt:
Require Import Arith.Wf_nat.
Definition nat_to_bin (n : nat) : bin :=
lt_wf_rec (* Recurse down a chain of lts instead of structurally *)
n (fun _ => bin) (* Starting from n and building a bin *)
(fun n rec => (* At each step, we have (n : nat) and (rec : forall m, m < n -> bin) *)
match div2_aux n 0 as qr return (fst qr <> 0 -> fst qr < n) -> _ with (* Take div2_aux_lt as an argument; within the match the (div2_aux_lt n 0) in its type is rewritten in terms of the matched variables *)
| (O, r) => fun _ => if r then Z else B Z (* Commoning up cases for brevity *)
| (S _ as q, r) => (* note: O is "true" and S _ is "false" *)
fun prf => (if r then A else B) (rec q (prf ltac:(discriminate)))
end div2_aux_lt).
I might suggest making div2_aux return nat * bool.
Alternatively, Program Fixpoint supports these kinds of induction, too:
Require Import Program.
(* I don't like the automatic introing in program_simpl and
now/easy can solve some of our obligations. *)
#[local] Obligation Tactic := (now program_simpl) + cbv zeta.
(* {measure n} is short for {measure n lt}, which can replace the
core language {struct arg} when in a Program Fixpoint
(n can be any expression and lt can be any well-founded relation
on the type of that expression) *)
#[program] Fixpoint nat_to_bin (n : nat) {measure n} : bin :=
match div2_aux n 0 with
| (O, O) => Z
| (O, _) => B Z
| (q, O) => A (nat_to_bin q)
| (q, _) => B (nat_to_bin q)
end.
Next Obligation.
intros n _ q [_ mem] prf%(f_equal fst).
simpl in *.
subst.
apply div2_aux_lt.
auto.
Defined.
Next Obligation.
intros n _ q r [mem _] prf%(f_equal fst).
specialize (mem r).
simpl in *.
subst.
apply div2_aux_lt.
auto.
Defined.

Conversion from not equal to equal in nat

I have function,whose output is some natural number.I have proved a lemma,that output of this function cannot be zero. It means output is equal to some natural number S m.I want to convert the above lemma.
Theorem greater:forall (m :nat)(l:list nat),
m=?0=false ->
0=? (f1 + m)=false->
(f1 + m)= S m.
The statement you entered does not type check. Regardless, I don't see how it could hold -- for instance, if by l you mean f1 : nat, then the statement would imply that 3 = 2.
Require Import Coq.Arith.Arith.
Theorem greater:forall (m :nat)(f1:nat),
m=?0=false ->
0=? (f1 + m)=false->
(f1 + m)= S m.
Admitted.
Lemma contra : False.
Proof.
pose proof (greater 1 2 eq_refl eq_refl).
easy.
Qed.
Proving that something that is not zero is a successor can be done as follows:
Require Import Coq.Arith.Arith.
Lemma not_zero_succ :
forall n, n <> 0 ->
exists m, n = S m.
Proof. destruct n as [|n]; eauto; easy. Qed.
Edit The complete statement you wrote below is also contradictory:
Require Import Coq.Arith.Arith.
Require Import Coq.Lists.List.
Import ListNotations.
Fixpoint lt_numb (n: nat) (l: list nat) : nat :=
match l with
| nil => 0
| h::tl =>
if h <? n then S (lt_numb n tl) else lt_numb n tl
end.
Fixpoint greatest (large: nat) (l: list nat) : nat :=
match large with
| O => 0
| S m' => (lt_numb large l) + (greatest m' l)
end.
Definition change (n: nat) (l: list nat) : list nat :=
match l with
| nil => l
| h::tl => if n <? h then l else n::tl
end.
Fixpoint g_value (elements: nat) (l: list nat) : nat :=
match l with
| nil => 0
| [n] => n
| h :: l =>
match elements with
| O => h
| S elements' => g_value elements' (change h l)
end
end.
Theorem no_elements : forall (m n z :nat)(l:list nat),
m=?0=false -> greatest(g_value (length (n :: l)) (n :: l) + m) (n :: l) = (S z).
Proof. Admitted.
Goal False.
pose proof (no_elements 1 0 1 [] eq_refl).
simpl in H.
discriminate.
Qed.