It looks definitely simple task until I actually try to work on it. My method is to use twin pointers to avoid asking the length of the list ahead of time, but the difficulties come from the implication that I know for sure one list is "no emptier" than another. Specifically, in pseudo-coq:
Definition twin_ptr (heads, tail, rem : list nat) :=
match tail, rem with
| _, [] => (rev heads, tail)
| _, [_] => (rev heads, tail)
| t :: tl, _ :: _ :: rm => twin_ptr (t :: heads) tl rm
end.
Definition split (l : list nat) := twin_ptr [] l l
But definitely it's not going to compile because the match cases are incomplete. However, the missing case by construction doesn't exist.
What's your way of implementing it?
I you are not afraid of dependent types, you can add a proof that rem is shorter than tail as an argument of twin_ptr. Using Program to help manage these dependent types, this could give the following.
Require Import List. Import ListNotations.
Require Import Program.
Require Import Arith.
Require Import Omega.
Program Fixpoint twin_ptr
(heads tail rem : list nat)
(H:List.length rem <= List.length tail) :=
match tail, rem with
| a1, [] => (rev heads, tail)
| a2, [a3] => (rev heads, tail)
| t :: tl, _ :: _ :: rm => twin_ptr (t :: heads) tl rm _
| [], _::_::_ => !
end.
Next Obligation.
simpl in H. omega.
Qed.
Next Obligation.
simpl in H. omega.
Qed.
Definition split (l : list nat) := twin_ptr [] l l (le_n _).
The exclamation mark means that a branch is unreachable.
You can then prove lemmas about twin_ptr and deduce the properties of split from them. For example,
Lemma twin_ptr_correct : forall head tail rem H h t,
twin_ptr head tail rem H = (h, t) ->
h ++ t = rev head ++ tail.
Proof.
Admitted.
Lemma split_correct : forall l h t,
split l = (h, t) ->
h ++ t = l.
Proof.
intros. apply twin_ptr_correct in H. assumption.
Qed.
Personally, I dislike to use dependent types in functions, as resulting objects are more difficult to manipulate. Instead, I prefer defining total functions and give them the right hypotheses in the lemmas.
You do not need to maintain the invariant that the second list is bigger than the third. Here is a possible solution:
Require Import Coq.Arith.PeanoNat.
Require Import Coq.Arith.Div2.
Require Import Coq.Lists.List.
Import ListNotations.
Section Split.
Variable A : Type.
Fixpoint split_aux (hs ts l : list A) {struct l} : list A * list A :=
match l with
| [] => (rev hs, ts)
| [_] => (rev hs, ts)
| _ :: _ :: l' =>
match ts with
| [] => (rev hs, [])
| h :: ts => split_aux (h :: hs) ts l'
end
end.
Lemma split_aux_spec hs ts l n :
n = div2 (length l) ->
split_aux hs ts l = (rev (rev (firstn n ts) ++ hs), skipn n ts).
Proof.
revert hs ts l.
induction n as [|n IH].
- intros hs ts [|x [|y l]]; easy.
- intros hs ts [|x [|y l]]; simpl; try easy.
intros Hn.
destruct ts as [|h ts]; try easy.
rewrite IH; try congruence.
now simpl; rewrite <- app_assoc.
Qed.
Definition split l := split_aux [] l l.
Lemma split_spec l :
split l = (firstn (div2 (length l)) l, skipn (div2 (length l)) l).
Proof.
unfold split.
rewrite (split_aux_spec [] l l (div2 (length l))); trivial.
now rewrite app_nil_r, rev_involutive.
Qed.
End Split.
May I suggest going via a more precise type? The main idea is to define a function splitting a Vector.t whose nat index has the shape m + n into a Vector.t of size m and one of size n.
Require Import Vector.
Definition split_vector : forall a m n,
Vector.t a (m + n) -> (Vector.t a m * Vector.t a n).
Proof.
intros a m n; induction m; intro v.
- firstorder; constructor.
- destruct (IHm (tl v)) as [xs ys].
firstorder; constructor; [exact (hd v)|assumption].
Defined.
Once you have this, you've reduced your problem to defining the floor and ceil of n / 2 and proving that they sum to n.
Fixpoint div2_floor_ceil (n : nat) : (nat * nat) := match n with
| O => (O , O)
| S O => (O , S O)
| S (S n') => let (p , q) := div2_floor_ceil n'
in (S p, S q)
end.
Definition div2_floor (n : nat) := fst (div2_floor_ceil n).
Definition div2_ceil (n : nat) := snd (div2_floor_ceil n).
Lemma plus_div2_floor_ceil : forall n, div2_floor n + div2_ceil n = n.
Proof.
refine
(fix ih n := match n with
| O => _
| S O => _
| S (S n') => _
end); try reflexivity.
unfold div2_floor, div2_ceil in *; simpl.
destruct (div2_floor_ceil n') as [p q] eqn: eq.
simpl.
replace p with (div2_floor n') by (unfold div2_floor ; rewrite eq ; auto).
replace q with (div2_ceil n') by (unfold div2_ceil ; rewrite eq ; auto).
rewrite <- plus_n_Sm; do 2 f_equal.
apply ih.
Qed.
Indeed, you can then convert length xs into ceil (length xs / 2) + floor (length xs / 2) and use split_vector to get each part.
Definition split_list a (xs : list a) : (list a * list a).
Proof.
refine
(let v := of_list xs in
let (p , q) := split_vector a (div2_floor _) (div2_ceil _) _ in
(to_list p, to_list q)).
rewrite plus_div2_floor_ceil; exact v.
Defined.
Related
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.
I'm having a great difficulty trying to prove even very simple lemmas about a function I defined. This is my definition:
Require Import List.
Require Export Omega.
Require Export FunInd.
Require Export Recdef.
Notation "A :: B" := (cons A B).
Notation "[]" := nil.
Notation "[[ A ]]" := (A :: nil).
Inductive tm :=
| E: nat -> tm
| L: list tm -> tm.
Definition T := list tm.
Fixpoint add_list (l: list nat) : nat :=
match l with
| [] => 0
| n :: l' => n + (add_list l')
end.
Fixpoint depth (t: tm) : nat :=
match t with
| E _ => 1
| L l => 1 + (add_list (map depth l))
end.
Definition sum_depth (l: T) := add_list (map depth l).
Function sum_total (l: T) {measure sum_depth l} : nat :=
match l with
| [] => 0
| [[E n]] => n
| [[L li]] => sum_total li
| E n :: l' => n + (sum_total l')
| L li :: l' => (sum_total li) + (sum_total l')
end.
Proof.
- auto.
- intros; unfold sum_depth; subst. simpl; omega.
- intros; subst; unfold sum_depth; simpl; omega.
- intros; subst; unfold sum_depth; simpl; omega.
Defined.
The inductive type can't be changed.
I can prove simple propositions like Lemma test : forall n, sum_total [[E n]] = n. using the compute tactic, but another trivial lemma like Lemma test2 : forall l, sum_total [[L l]] = sum_total l. hangs.
First, it seems OK that the compute tactic "hangs" on the goal you mention (because when using the Function … Proof. … Defined. definition methodology, your function sum_total incorporates some proof terms, which are not intended to be computed − all the more on an arbitrary argument l; maybe a tactic such as simpl or cbn would be more suitable in this context).
Independently of my comment on list notations, I had a closer look on your formalization and it seems the Function command is unneeded in your case, because sum_total is essentially structural, so you could use a mere Fixpoint, provided the inductive type you are looking at is slightly rephrased to be defined in one go as a mutually-defined inductive type (see the corresponding doc of the Inductive command in Coq's refman which gives a similar, typical example of "tree / forest").
To elaborate on your example, you may want to adapt your definition (if it is possible for your use case) like this:
Inductive tm :=
| E: nat -> tm
| L: T -> tm
with T :=
Nil : T
| Cons : forall (e : tm) (l : T), T.
Notation "[[ A ]]" := (Cons A Nil).
Fixpoint sum_total (l: T) {struct l} : nat :=
match l with
| Nil => 0
| [[E n]] => n
| [[L li]] => sum_total li
| Cons (E n) l' => n + (sum_total l')
| Cons (L li) l' => (sum_total li) + (sum_total l')
end.
(* and the lemma you were talking about is immediate *)
Lemma test2 : forall l, sum_total [[L l]] = sum_total l.
reflexivity.
Qed.
Otherwise (if you cannot rephrase your tm inductive like this), another solution would be to use another strategy than Function to define your sum_total function, e.g. Program Fixpoint, or the Equations plugin (which are much more flexible and robust than Function when dealing with non-structural recursion / dependently-typed pattern matching).
Edit: as the OP mentions the inductive type itself can't be changed, there is a direct solution, even when using the mere Function machinery: relying on the "equation lemma" that is automatically generated by the definition.
To be more precise, if you take your script as is, then you get the following lemma "for free":
Search sum_total "equation".
(*
sum_total_equation:
forall l : T,
sum_total l =
match l with
| [] => 0
| [[E n]] => n
| E n :: (_ :: _) as l' => n + sum_total l'
| [[L li]] => sum_total li
| L li :: (_ :: _) as l' => sum_total li + sum_total l'
end
*)
So you could easily state and prove the lemma you are interested in by doing:
Lemma test2 : forall l, sum_total [[L l]] = sum_total l.
intros l.
rewrite sum_total_equation.
reflexivity.
Qed.
Here is an answer that doesn't require changing the inductive type.
There is a simple definition of sum_total that is both comparatively easy to understand and gives (almost) the lemma you are looking for by compute.
Fixpoint sum_tm (t : tm) : nat :=
match t with
| E n => n
| L li => list_sum (map sum_tm li)
end.
Definition sum_total (l : T) : nat := list_sum (map sum_tm l).
Lemma test2 : forall l, sum_total [[L l]] = sum_total l + 0.
reflexivity.
Qed.
(list_sum comes from the List module.)
Notice how the definition of sum_tm and sum_total exactly follows the structure of the definition of term and T, with list_sum (composed with map) corresponding to the use of list. This pattern is in general effective for these problems with nested inductives.
If you want to get rid of the + 0, you can define a different version of list_sum that includes a case for the singleton list (and you can fuse this with map if you want, though it is not necessary).
That would look like replacing list_sum with list_sum_alt defined as
Fixpoint list_sum_alt (l : list nat) : nat :=
match l with
| [] => 0
| [[n]] => n
| n :: li => n + list_sum_alt li
end.
With this definition, test2 holds by compute.
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.
I have defined a function, which finds the greatest value from the natural number list and move this value to head position of the list. I am sure, all the elements in the list are less or equal to the value at head location. Then I defined index_value function,to find value in the list at any index.For clarification [4,7,11,9,11] list become [11,7,9,11].I have a problem in proving the following lemma. Plz guide me.
` Require Import Coq.Arith.PeanoNat.
Require Import Lia.
Fixpoint index_value (index: nat) (l: list nat) : nat :=
match l with
| nil => 0
| cons h t => match (Nat.eqb index 0) with
| true => h
| false => index_value (index - 1) t
end
end.
Theorem head_value : forall ( n':nat) (l:list nat),
(index_value 0 l)<= n'.
Proof.
Admitted.
Theorem index_value1:forall (n s2:nat) (l:list nat),
index_value (S s2) (n :: l) <=
index_value 0 (n :: l) \/
index_value (S s2) (n :: l) > 0.
Proof.
intros. simpl in *. left . induction s2. simpl.
appply head_value . simpl in *. auto with arith.`
I think your statements do not quite mean what you think they mean. The first one is contradictory, and the second one is trivial: you do not need the definition of index_value at all:
Require Import Coq.Arith.PeanoNat.
Require Import Lia.
Require Import Coq.Lists.List.
Import ListNotations.
Fixpoint index_value (index: nat) (l: list nat) : nat :=
match l with
| nil => 0
| cons h t => match (Nat.eqb index 0) with
| true => h
| false => index_value (index - 1) t
end
end.
Theorem not_head_value :
~ forall ( n':nat) (l:list nat),
(index_value 0 l)<= n'.
Proof.
intros contra.
specialize (contra 0 (1 :: nil)).
simpl in *. lia.
Qed.
Theorem index_value1:forall (n s2:nat) (l:list nat),
index_value (S s2) (n :: l) <=
index_value 0 (n :: l) \/
index_value (S s2) (n :: l) > 0.
Proof. intros n s2 l. lia. Qed.
I want to declare a function that yeilds the element (b, n) that the b is equal to true.
Require Export List.
Import Coq.Lists.List.ListNotations.
Definition lstest := list (bool * nat).
Fixpoint existbool (l : lstest) : option (bool * nat) :=
match l with
| [] => None
| (b, n) :: l' => if b then Some (b, n) else existbool l'
end.
The function always get the first element satisfyting b = true. I want to express that there exists an element satisfyting b = true and returns the element. How can I define such a function?
In the following function the type of existbool_ex tells you that we output a pair contained in the list with its first element true (assuming we output a Some).
(* These are all from the standard library *)
Locate "{ _ : _ | _ }".
Print sig.
Print In.
Print fst.
(* Defining Property here to shorten code for exist *)
Definition P l (x : bool * nat) := fst x = true /\ In x l.
Fixpoint existbool_ex (l : list (bool * nat)) :
option {x : bool * nat | fst x = true /\ In x l} :=
match l return option {x : bool * nat | P l x} with
| [] => None
| x' :: l' =>
match x' with
| (true,n) as ans =>
Some (exist (P (ans :: l')) ans (conj eq_refl (or_introl eq_refl)))
| (false,n) =>
match existbool_ex l' with
| None => None
| Some (exist _ x a) =>
match a with
| conj Heq Hin =>
Some (exist (P ((false, n) :: l')) x (conj Heq (or_intror Hin)))
end
end
end
end.
(* Note the as pattern got desugared into a let binding. *)
Print existbool_ex.
(* However we have a somewhat sane extraction, (tail recursive) *)
Require Extraction.
Extraction existbool_ex.
You could write a function get_number that requires a proof that the list has a true value somewhere.
Definition has_true (l : lstest):= exists n, In (true, n) l.
get_number is defined with the help of refine which lets us leave 'holes' (written _) in the proof term to fill in later. Here we have two holes; one for the absurd case when the list is [], and one where we construct the proof term for the recursive call.
Fixpoint get_number (l:lstest) (H: has_true l) : nat.
refine (
match l as l' return l' = _ -> nat with
| (true, n)::_ => fun L => n
| (false, _)::l' => fun L => get_number l' _
| [] => fun L => _
end eq_refl).
now exfalso; subst l; inversion H.
now subst l; inversion H; inversion H0;
[congruence | eexists; eauto].
Defined.
The function uses the convoy pattern so that the match statement does not forget the shape of l in the different branches.
If you want to, you can prove rewriting lemmas to make it easier to use.
Lemma get_number_false l m H: exists H', get_number ((false, m)::l) H = get_number l H'.
Proof. eexists; reflexivity. Qed.
Lemma get_number_true l m H: get_number ((true, m)::l) H = m.
Proof. reflexivity. Qed.
Lemma get_number_nil H m: get_number [] H <> m.
Proof. now inversion H. Qed.
Lemma get_number_proof_irrel l H1 H2: get_number l H1 = get_number l H2.
Proof. induction l as [ | [[|] ?] l']; eauto; now inversion H1. Qed.