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 :: []).
Related
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.
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.
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.
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 am struggling with seemingly simple lemma which involves 2 fixpoint definitions. The following two are axially definitions from CoLoR library:
From Coq Require Import Vector Program.
Import VectorNotations.
Program Fixpoint Vnth {A:Type} {n} (v : t A n) : forall i, i < n -> A :=
match v with
| nil _ => fun i ip => !
| cons _ x _ v' => fun i =>
match i with
| 0 => fun _ => x
| S j => fun H => Vnth v' j _
end
end.
Admit Obligations.
Fixpoint Vmap {A B : Type} (f: A -> B) n (v : t A n) : t B n :=
match v with
| nil _ => nil _
| cons _ a _ v' => cons _ (f a) _ (Vmap f _ v')
end.
The actual problem:
Fixpoint Ind (n:nat) {A:Type} (f:A -> A -> A)
(initial: A) (v: A) {struct n} : t A n
:=
match n with
| O => []
| S p => cons _ initial _ (Vmap (fun x => f x v) _ (Ind p f initial v))
end.
Lemma Foo {A: Type} (n : nat) (f : A -> A -> A) (initial v : A)
(b : nat) (bc : S b < n) (bc1 : b < n)
: Vnth (Ind n f initial v) _ bc = f (Vnth (Ind n f initial v) _ bc1) v.
Proof.
Qed.
Normally I would proceed by induction on n here but this does not gets me much further. I feel like I am missing something here. I also tried program induction here.
You need simplification of Vnth_vmap and a generalized induction to achieve this:
From Coq Require Import Vector Program.
Import VectorNotations.
Program Fixpoint Vnth {A:Type} {n} (v : t A n) : forall i, i < n -> A :=
match v with
| nil _ => fun i ip => !
| cons _ x _ v' => fun i =>
match i with
| 0 => fun _ => x
| S j => fun H => Vnth v' j _
end
end.
Admit Obligations.
Fixpoint Vmap {A B : Type} (f: A -> B) n (v : t A n) : t B n :=
match v with
| nil _ => nil _
| cons _ a _ v' => cons _ (f a) _ (Vmap f _ v')
end.
Lemma Vnth_vmap {A B i n p} (v : t A n) f : Vnth (Vmap (B:=B) f n v) i p = f (Vnth v i p).
Proof.
induction i in n, p, v |- *. destruct v. inversion p.
simpl. reflexivity.
destruct v. simpl. bang.
simpl.
rewrite IHi. f_equal. f_equal.
(* Applies proof-irrelevance, might also be directly provable when giving the proofs in Vnth *) pi.
Qed.
Fixpoint Ind (n:nat) {A:Type} (f:A -> A -> A)
(initial: A) (v: A) {struct n} : t A n
:=
match n with
| O => []
| S p => cons _ initial _ (Vmap (fun x => f x v) _ (Ind p f initial v))
end.
Lemma Foo {A: Type} (n : nat) (f : A -> A -> A) (initial v : A)
(b : nat) (bc : S b < n) (bc1 : b < n)
: Vnth (Ind n f initial v) _ bc = f (Vnth (Ind n f initial v) _ bc1) v.
Proof.
induction n in b, bc, bc1 |- *; simpl.
- bang.
- rewrite Vnth_vmap. f_equal.
destruct b.
+ destruct n. simpl. bang. simpl. reflexivity.
+ rewrite Vnth_vmap. apply IHn.
Qed.