I want to prove following lemmas.
Lemma AppendAndSplit {n m}(e:Euc n) (f:Euc m): # (e +++ f) = (e, f).
Proof.
induction e.
reflexivity.
remember (r:::e).
Admitted.
Lemma SplitRule {n m}(e:Euc (n+m)) : (fst (# e)) +++ (snd (# e)) = e.
Proof.
induction n.
reflexivity.
Admitted.
# and +++ are notations of EucAppend and Split_Euc.
I can feel that these hold, but I don't know how prove them.
Please tell me some techniques.
(* There are codes needed below *)
Require Import Coq.Reals.Reals.
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).
Fixpoint EucAppend {n m} (e:Euc n) (f:Euc m) :Euc (n+m):=
match e with
|[] => f
|e' ::: es => e' ::: (EucAppend es f)
end.
Infix "+++" := EucAppend (at level 60, right associativity).
Fixpoint split_Euc {n m : nat} (xi : Euc (n + m)) : Euc n ∧ Euc m.
Proof.
destruct n as [ | n].
- exact (RO, xi).
- inversion_clear xi.
apply split_Euc in H0 as [l r].
exact (Rn H l, r).
Defined.
Notation "# n" := (split_Euc n) (at level 60, right associativity).
The main problem you cannot solve your goals is because of the definitional problem. Split_Euc is defined to perform induction on n, and that's okay however, the definitions perform an inversion on Euc. Inversion is normally a tactic for proofs, once the tactics generate very heavy proofs terms :
Fixpoint split_Euc {n m : nat} (xi : Euc (n + m)) : Euc n * Euc m.
Proof.
destruct n as [ | n].
- exact (RO, xi).
- inversion_clear xi.
Show Proof. (* let see what is actually the problem *)
...
Defined.
You'll see something like that :
eq_rec_r (fun n2 : nat => R -> Euc n2 -> Euc (S n0) * Euc m)
(fun (H6 : R) (H7 : Euc (n0 + m)) =>
?Goal#{n:=n0; H:=H6; H0:=H7}) H5) H3) H1 H H0
Notice your definition uses a proof (induction scheme of equality) term to make the join of the tuple. Proofs terms are not easily normalized and some others don't even get a normalized term (it is the case of Opaque proofs). The solution is to avoid tactics that generate heavy proofs terms and substitute for inductions schemes (like destruct, induction, case...), once they are "free" or almostt of automatic proofs.
Definition rect_euc {n : nat} (v : Euc (S n)) : forall (P : Euc (S n) -> Type) (H : forall ys a, P (a ::: ys)), P v.
refine (
match v with
|#Rn _ _ _ => _
|R0 => _
end).
exact idProp.
intros.
apply : H.
Defined.
Fixpoint split_Euc {n m : nat} (xi : Euc (n + m)) : Euc n * Euc m.
Proof.
destruct n as [ | n].
- exact (RO, xi).
- elim/#rect_euc : xi.
intros.
pose (split_Euc _ _ ys).
exact (Rn a (fst p), (snd p)).
Defined.
Now, as split_euc is defined using induction on n, you should do the same to get a straightforward proof.
Lemma AppendAndSplit {n m}(e:Euc n) (f:Euc m): # (e +++ f) = (e, f).
Proof.
induction n.
- remember 0.
destruct e.
reflexivity.
inversion Heqn.
- apply (rect_euc e).
intros.
assert (forall n (xs ys : Euc n) (x y : R), x = y -> xs = ys -> x ::: xs = y ::: ys).
intros.
rewrite H; rewrite H0; trivial.
pose (IHn ys).
apply : injective_projections.
simpl;apply : H; trivial.
exact (f_equal fst e0).
exact (f_equal snd e0).
Qed.
Lemma SplitRule {n m}(e:Euc (n+m)) : (fst (split_Euc e)) +++ (snd (split_Euc e)) = e.
YOUR_TURN. (* now it's your turn, just do the same and u will get the goal*)
Qed.
Related
I try to prove the following simple Lemma :
Lemma wayBack :
forall (a b n:nat) (input:list nat), a <> n -> implist n (a::b::input) -> implist n input.
were implist is as follows :
Inductive implist : nat -> list nat -> Prop :=
| GSSingle : forall (n:nat), implist n [n]
| GSPairLeft : forall (a b n:nat) (l:list nat), implist n l -> implist n ([a]++[b]++l)
| GSPairRight : forall (a b n:nat) (l:list nat), implist n l -> implist n (l++[a]++[b]).
Any idea how to do this ?
Thank you !!
Here it is:
Require Import Program.Equality.
Lemma wayBack :
forall (a b n:nat) (input:list nat), a <> n -> implist n (a::b::input) -> implist n input.
Proof.
intros.
dependent induction H0.
1: eassumption.
assert (exists l', l = a :: b :: l' /\ input = l' ++ [a0 ; b0]) as [l' [-> ->]].
{
clear - x H0 H.
change (l ++ [a0] ++ [b0]) with (l ++ [a0; b0]) in x.
remember [a0; b0] as t in *.
clear Heqt.
induction H0 in input, t, x, H |- *.
+ cbn in *.
inversion x ; subst.
now destruct H.
+ cbn in *.
inversion x ; subst ; clear x.
eexists ; split.
1: reflexivity.
reflexivity.
+ cbn in x.
rewrite <- app_assoc in x.
edestruct IHimplist as [? []] ; try eassumption.
subst.
eexists ; split.
cbn.
2: rewrite app_assoc.
all: reflexivity.
}
econstructor.
eapply IHimplist ; try eassumption.
reflexivity.
Qed.
There are two main difficulties here: the first is that you want to do an induction on you hypothesis implist n (a::b::input), but since a::b::input is not just a variable, there is a need for some fiddling, that standard induction cannot do, but dependent induction from Program can.
The second difficulty, which actually takes up most of my proof, is to be able to decompose the equality you get in the last case, that where you add values at the beginning rather than at the end of the list.
I am trying to reverse a vector in Coq. My implementation is as follows:
Fixpoint vappend {T : Type} {n m} (v1 : vect T n) (v2 : vect T m)
: vect T (plus n m) :=
match v1 in vect _ n return vect T (plus n m) with
| vnil => v2
| x ::: v1' => x ::: (vappend v1' v2)
end.
Theorem plus_n_S : forall n m, plus n (S m) = S (plus n m).
Proof.
intros. induction n; auto.
- simpl. rewrite <- IHn. auto.
Qed.
Theorem plus_n_O : forall n, plus n O = n.
Proof.
induction n.
- reflexivity.
- simpl. rewrite IHn. reflexivity.
Qed.
Definition vreverse {T : Type} {n} (v : vect T n) : vect T n.
induction v.
- apply [[]].
- rewrite <- plus_n_O. simpl. rewrite <- plus_n_S.
apply (vappend IHv (t ::: [[]])).
Show Proof.
Defined.
The problem is, when I try to compute the function, it produces something like:
match plus_n_O (S (S O)) in (_ = y) return (vect nat y) with
...
and couldn't get further. What's the problem here? How can I fix this?
The problem is that your functions use opaque proofs, plus_n_S and plus_n_O. To compute vreverse, you need to compute these proofs, and if they are opaque, the computation will be blocked.
You can fix this issue by defining the functions transparently. Personally, I prefer not to use proof mode when doing this, since it is easier to see what is going on. (I have used the standard library definition of vectors here.)
Require Import Coq.Vectors.Vector.
Import VectorNotations.
Fixpoint vappend {T : Type} {n m} (v1 : t T n) (v2 : t T m)
: t T (plus n m) :=
match v1 in t _ n return t T (plus n m) with
| [] => v2
| x :: v1' => x :: vappend v1' v2
end.
Fixpoint plus_n_S n m : n + S m = S (n + m) :=
match n with
| 0 => eq_refl
| S n => f_equal S (plus_n_S n m)
end.
Fixpoint plus_n_O n : n + 0 = n :=
match n with
| 0 => eq_refl
| S n => f_equal S (plus_n_O n)
end.
Fixpoint vreverse {T : Type} {n} (v : t T n) : t T n :=
match v in t _ n return t T n with
| [] => []
| x :: v =>
eq_rect _ (t T)
(eq_rect _ (t T) (vappend (vreverse v) [x]) _ (plus_n_S _ 0))
_ (f_equal S ( plus_n_O _))
end.
Compute vreverse (1 :: 2 :: 3 :: []).
I want to partially derive functions whose input is a dependent list.
I tried to define deriveP with proving.
Derive is a function in Coquelicot.Derive.
Definition deriveP {P A B}(k:nat)(I:Euc (S P) -> Euc A -> Euc B)
(input:Euc A)(train:Euc B)(p :Euc (S P))
:(lt k (S P)) -> (lt ((S P)-(k+1)) (S P)) -> R.
intros.
pose fk := firstk k (S P) p H.
pose lk := lastk ((S P)-(k+1)) (S P) p H0.
pose pk := EucNth k p.
apply arith_basic in H.
exact ( Derive (fun PK => EucSum (QuadraticError (I (fk +++ (PK ::: lk)) input) train )) pk ).
I can not apply arith_basic poposed by Tiago because H is used in fk.
I can apply arith_basic to H before I make fk, but then I can not make fk because There is not k < P.+1.
I want to apply arith_basic to H while leaving k < P.+1.
Please help 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 n : Euc n -> (lt k n) -> Euc k :=
match n with
|0%nat => fun _ (H : lt k 0) => False_rect _ (Lt.lt_n_O _ H)
|S n => match k with
|S m => fun v H => snoc (lastk m n (but_last v) (le_S_n _ _ H)) (last v)
|0%nat => fun _ H => []
end
end.
(* extract first k elements *)
Fixpoint firstk k n : Euc n -> (lt k n) -> Euc k :=
match n with
|0%nat => fun _ (H :lt k 0) => False_rect _ (Lt.lt_n_O _ H)
|S n => match k with
|S m => fun v H => (head v) ::: firstk m n (tail v) (le_S_n _ _ H)
|0%nat => fun _ _ => []
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' (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.
Infix "+++" := EucAppend (at level 60, right associativity).
Fixpoint QuadraticError {n : nat} (b : Euc n) : Euc n -> Euc n.
refine (match b in Euc n return Euc n -> Euc n with
|#Rn m x xs => _
|#RO => fun H => []
end).
remember (S m).
intro H; destruct H as [| k y ys].
inversion Heqn0.
inversion Heqn0.
subst; exact ((x - y)^2 ::: QuadraticError _ xs ys).
Defined.
Fixpoint EucSum {A}(e:Euc A) :R:=
match e with
| [] => 0%R
| e' ::: es => e' + (EucSum es)
end.
Your lemma k + S (P - (k + 1)) = P can be solved just with basic algebraic operations.
Particularly you just need two lemmas to make this easier:
Theorem minus_assoc : forall y z, z < y -> z + (y - z) = y.
intro y.
induction y.
intros;inversion H.
intros.
destruct z.
trivial.
rewrite PeanoNat.Nat.sub_succ.
rewrite <- (IHy _ (le_S_n _ _ H)) at 2; trivial.
Qed.
Theorem minus_S : forall x y, y < x -> S (x - (S y)) = x - y.
intro.
induction x.
intros.
inversion H.
intros.
destruct y.
simpl.
rewrite PeanoNat.Nat.sub_0_r; trivial.
rewrite PeanoNat.Nat.sub_succ.
apply IHx.
exact (le_S_n _ _ H).
Qed.
Now you just have to rewrite your goal to a trivial preposition :
Theorem arith_basic : forall k P, k < P -> k + S (P - (k + 1)) = P.
intros.
rewrite PeanoNat.Nat.add_1_r.
rewrite minus_S.
auto.
rewrite minus_assoc.
assumption.
trivial.
Qed.
Most of these kinds of goals can solve by lia tactic which automatically solves arithmetics goals of Z, nat, positive, and N.
Theorem arith_basic : forall k P, k < P -> k + S (P - (k + 1)) = P.
intros;lia.
Qed
Even though I recommend automation, proving by hands can help understand your main goal which may be not able to be solved by only automation.
I have solved on my own.
We can duplicate lemma in the sub-goal with generalize tactic.
Definition deriveP {P A B}(k:nat)(I:Euc (S P) -> Euc A -> Euc B)
(input:Euc A)(train:Euc B)(p :Euc (S P))
:(lt k (S P)) -> (lt ((S P)-(k+1)) (S P)) -> R.
intros.
generalize H.
intro H1.
apply arith_basic in H1.
pose lk := lastk ((S P)-(k+1)) (S P) p H0.
pose fk := firstk k (S P) p H.
pose pk := EucNth k p.
rewrite (_: (P.+1)%nat = (k + (P.+1 - (k + 1)%coq_nat)%coq_nat.+1)%coq_nat) in I.
exact ( Derive (fun PK => EucSum (QuadraticError (I (fk +++ (PK ::: lk)) input) train )) pk ).
apply H1.
Defined.
I defined this function.
Inductive Euc:nat -> Type:=
|RO : Euc 0
|Rn : forall {n:nat}, R -> Euc n -> Euc (S n).
Notation "[ ]" := RO.
Infix ":::" := Rn (at level 60, right associativity).
Fixpoint QE {A}(b c:Euc A) :=
match b,c with
|b':::bs, c'::: cs => (b'+c') ::: QE bs cs
|_, _ => []
end.
I have encountered the error "The term "[]" has type "Euc 0" while it is expected to have type "Euc A" ".
How do I teach Coq that Euc 0 is Euc A?
Coq doesn't know that the only pattern left is the "RO" constructor, therefore you're not able to return an empty Euc.
To fix that just remove the _ and specialize the case :
Fixpoint QE {A}(b c:Euc A) : Euc A.
refine (match b,c with
|RO, RO => _
|H => ????
end).
That forces coq to understand that you're dealing with a specific constructor.
Also, Coq always will instantiate new variables (Types not) of elimination, thus coq may complain that bs and cs have different indexes.
The coq vectordef library has several examples of how to manage this.
A first approach and more mature it is to use elimination schemes, notice you can destruct a non-zero vector using the head and last.
For example :
Definition rect_euc {n : nat} (v : Euc (S n)) :
forall (P : Euc (S n) -> Type) (H : forall ys a, P (a ::: ys)), P v.
refine (match v with
|#Rn _ _ _ => _
|R0 => _
end).
apply idProp.
intros; apply H.
Defined.
Now, you just have to use the scheme to destruct both vectors preserving the length of both :
Fixpoint QE (n : nat) {struct n} : Euc n -> Euc n -> Euc n :=
match n as c return Euc c -> Euc c -> Euc c with
| S m => fun a =>
(#rect_euc _ a _ (fun xs x b =>
(#rect_euc _ b _ (fun ys y => (x + y) ::: #QE m xs ys))))
| 0 => fun xs ys => []
end.
Alternatively you can use the coq tactics to remember that two indexes are equal :
Fixpoint QE' (n : nat) (b : Euc n) : Euc n -> Euc n.
refine (match b in Euc n return Euc n -> Euc n with
|#Rn m x xs => _
|#RO => fun H => []
end).
remember (S m).
intro H; destruct H as [| k y ys].
inversion Heqn0.
inversion Heqn0.
subst; exact ((x + y) ::: QE' _ xs ys).
Defined.
I am using index function to find the value of element at any location in the list nat. Plz guide me in proving the second part of the lemma, which is illustrated below
Fixpoint index(n: nat) (m: nat) (l: list nat) : nat :=
match l with
| nil => 0
| cons h tl => match (eqb n m) with
| true => h
| false => index (succ n) m tl
end
end.
Theorem a_ref:forall (a:nat),
a <= a.
Proof.
intros. eauto.
Qed.
Theorem n_leq_0 :forall (n:nat),
n <= 0.
Proof.
intros. induction n.
+ simpl. apply a_ref.
+ Admitted.
Theorem n_le_index:forall (n:nat) (l:list nat),
n <= index (succ (succ 0)) 0 l.
Proof.
intros. induction l as [| l'].
+ simpl. apply n_leq_0.
+ simpl in *. inversion IHl.
rewrite <- H.
The theorem you want cannot be proved:
Fixpoint index(n: nat) (m: nat) (l: list nat) : nat :=
match l with
| nil => 0
| cons h tl => match (Nat.eqb n m) with
| true => h
| false => index (Nat.succ n) m tl
end
end.
Theorem n_le_index:forall (n:nat) (l:list nat),
n <= index (Nat.succ (Nat.succ 0)) 0 l.
Admitted.
Require Import Omega.
Goal False.
pose proof (n_le_index 10 nil).
simpl in H.
omega.
Qed.