I am trying to make the following work:
Definition gen `{A:Type}
{i o: nat}
(f: nat -> (option nat))
{ibound: forall (n n':nat), f n = Some n' -> n' < i}
(x: svector A i) (t:nat) (ti: t < o): option A
:= match (f t) with
| None => None
| Some t' => Vnth x (ibound t t' _)
end.
In place of last "_" I need an evidence that "f t" is equals to "Some t'". I could not figure out how to get it from the match. Vnth is defined as:
Vnth
: ∀ (A : Type) (n : nat), vector A n → ∀ i : nat, i < n → A
Writing this function requires an instance of what is known as the convoy pattern (see here). I believe the following should work, although I can't test it, since I don't have the rest of your definitions.
Definition gen `{A:Type}
{i o: nat}
(f: nat -> (option nat))
{ibound: forall (n n':nat), f n = Some n' -> n' < i}
(x: svector A i) (t:nat) (ti: t < o): option A
:= match f t as x return f t = x -> option A with
| None => fun _ => None
| Some t' => fun p => Vnth x (ibound t t' p)
end (eq_refl (f t)).
Related
I want last k elements of vector. I wrote this code with reference to Coq.Vectors.VectorDef.
Require Import Coq.Reals.Reals.
(* vector of R *)
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).
(* return length of vector *)
Definition EucLength {n}(e:Euc n) :nat:= n.
Definition rectEuc (P:forall {n}, Euc (S n) -> Type)
(bas: forall a:R, P [a])
(rect: forall {n} a (v: Euc (S n)), P v -> P (a ::: v)) :=
fix rectEuc_fix {n} (v: Euc (S n)) : P v :=
match v with
|#Rn 0 a v' =>
match v' with
|RO => bas a
|_ => fun devil => False_ind (#IDProp) devil
end
|#Rn (S nn') a v' => rect a v' (rectEuc_fix v')
|_ => fun devil => False_ind (#IDProp) devil
end.
(* eliminate last element from vector *)
Definition EucElimLast := #rectEuc (fun n _ => Euc n) (fun a => []) (fun _ a _ H => a ::: H).
(* this function has an error *)
Definition rectEucLastN (P:forall {n}, nat -> Euc n -> Type)
(bas: forall {n} k (e:Euc n), P k e)
(rect: forall {n} k a (e:Euc (S n)), P k e -> P (S k) (a ::: e)) :=
fix rectEuc_fix {n} (k:nat) (e:Euc n): P k e :=
match k,e with
|S k', e' ::: es => rect k' e' (rectEuc_fix k' (EucElimLast ((EucLength e)-1) e))
|0%nat, e' ::: es => bas k e
|_, _ => fun devil => False_ind (#IDProp) devil
end.
rectEucLastN says The type of this term is a product while it is expected to be (P ?n#{n1:=0%nat} ?n0#{k1:=0%nat} ?e#{n1:=0%nat; e1:=[]}).
The problem is the second line from the bottom of the code.
Why does last pattern have an error?
The function term that you see on the branch of rectEuc is how you tell Coq that a pattern-match branch is contradictory. In your first recursive function, for instance, you use it to say that the first v' cannot be a cons because its length is zero. The reason you are getting the error in the last branch is because that case is not contradictory: nothing in the type of your function prevents the case k = 0 and n = 0.
To write dependently typed programs over indexed families, you often need to use the convoy pattern: to refine the type of an argument x after branching on some expression, your match needs to return a function that abstracts over x. For instance, this function computes the last element of a vector by recursion over its length. In the S branch, we need to know that the length of v is connected to n somehow.
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.
Fixpoint last n : Euc (S n) -> R :=
match n with
| 0 => fun v => head 0 v
| S n => fun v => last n (tail _ v)
end.
Here is the code for extracting the last k elements. Note that its type uses the Nat.min function to specify the length of the result: the result cannot be larger than the original vector!
Fixpoint but_last n : Euc (S n) -> Euc n :=
match n with
| 0 => fun _ => []
| S n => fun v => head _ v ::: but_last n (tail _ v)
end.
Fixpoint snoc n (v : Euc n) (x : R) : Euc (S n) :=
match v with
| [] => [x]
| y ::: v => y ::: snoc _ v x
end.
Fixpoint lastk k : forall n, Euc n -> Euc (Nat.min k n) :=
match k with
| 0 => fun _ _ => []
| S k => fun n =>
match n return Euc n -> Euc (Nat.min (S k) n) with
| 0 => fun _ => []
| S n => fun v =>
snoc _ (lastk k _ (but_last _ v)) (last _ v)
end
end.
Personally, I would advise you against programming in this style in Coq, since it makes it difficult to write programs and understand them later. It is usually better to write a program without dependent types and prove after the fact that it has some property that you care about. (E.g. try to show that reversing a list twice yields the same list using vectors!) Of course, there are cases where dependent types are useful, but most of the time they are not needed.
I am currently going through the book 'Computational Type Theory and Interactive Theorem Proving with Coq' by Gert Smolka, and on page 93, the following inductive predicate is defined:
Inductive G (f:nat -> bool) : nat -> Prop :=
| mkG : forall (n:nat), (f n = false -> G f (S n)) -> G f n
.
Then on page 95 it is argued that one can define an eliminator:
Definition elimG : forall (f:nat -> bool) (p:nat -> Type),
(forall (n:nat), (f n = false -> p (S n)) -> p n) ->
forall (n:nat), G f n -> p n.
Proof.
...
The book spells out an expression of a term of this type, namely:
elimG f p g n (mkG _ _ h) := g n (λe. elimG f p g (S n) (h e))
(I have changed a few notations for the purpose of this post)
which I formally translated as:
refine (
fun (f:nat -> bool) (p:nat -> Type) =>
fun (H1:forall (n:nat), (f n = false -> p (S n)) -> p n) =>
fun (n:nat) (H2:G f n) =>
match H2 with
| mkG _ _ H3 => _
end
).
However, Coq will not allow me to carry out the pattern match due to the elim restriction.
The book informally says "Checking that the defining equation of elimG is well-typed is not difficult"
I am posting this in the hope that someone familiar with the book will have an opinion as to whether the author made a mistake, or whether I am missing something.
EDIT:
Having played around with the two answers below, the simplest term expression I have come up with is as follows:
Definition elimG
(f:nat -> bool)
(p:nat -> Type)
(g: forall (n:nat), (f n = false -> p (S n)) -> p n)
: forall (n:nat), G f n -> p n
:= fix k (n:nat) (H:G f n) : p n := g n
(fun e => k (S n)
( match H with
| mkG _ _ H => H
end e)).
This definition is possible, there's just a subtlety here. The G (which is in Prop) is never needed to make a decision here, because it only has one constructor. So you just do the
elimG f p g n h := g n (λe. elimG f p g (S n) _)
"unconditionally" outside of any match on h. That hole now has expected type G f (S n), which now is in Prop, and we can do our match on h there. We also have to do some rewriting shenanigans with the match. Putting everything together, we write
Fixpoint elimG
(f : nat -> bool) (p : nat -> Type)
(g : forall (n:nat), (f n = false -> p (S n)) -> p n)
(n : nat) (H : G f n) {struct H}
: p n :=
g n
(fun e =>
elimG f p g (S n)
(match H in G _ n return f n = false -> G f (S n) with (* in and return clause can be inferred; we're rewriting the n in e's type *)
| mkG _ _ H => H
end e)).
That's a tricky one.
The author is not wrong, it is possible to define such an elimination principle but you have to be careful about how and when you match on your hypothesis.
The error that you get from Coq is that you are matching on a proposition to build an element of a Type. Coq forbid this so that proposition can be erased when extracting code, so you cannot do such a case-analysis of a proposition to build some computationally meaningful object (there are exceptions to this rule for instance for empty propositions).
Since you cannot start by pattern matching on H2, you can try to push this case-analysis as late as possible. Here you only need to do the case analysis in the application (h e) so you could replace it by match H2 with mkG _ n' h -> h e end.
However this does not work because h is of type f' n' = false -> ... whereas e : f n = false and you need to explain to Coq that n and n' are the same. This is achieved through dependent pattern matching, putting the apllication outside of the match and using a return clause in the script below (actually Coq can infer this return clause, I'm just leaving it for explanations).
Inductive G (f:nat -> bool) : nat -> Prop :=
| mkG : forall (n:nat), (f n = false -> G f (S n)) -> G f n
.
Fixpoint elimG (f:nat -> bool) (p:nat -> Type)
(g : forall (n:nat), (f n = false -> p (S n)) -> p n)
(n:nat) (H : G f n) {struct H} : p n.
Proof.
refine (g n (fun e => elimG f p g (S n) _)).
refine (match H in G _ n0 return f n0 = false -> G f (S n0) with mkG _ _ h => h end e).
Qed.
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 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.
I want to define a function compose which composes f : nat ^^ n --> nat with g1 ... gn : nat ^^ m --> nat such that
compose n m f g1 ... gn x1 ... xm
is equal to
f (g1 x1 ... xm) ... (gn x1 ... xm)
Using the standard library for n-ary functions, defining it for the special case n = 1 isn't too hard:
Fixpoint compose_unary (m : nat) (g : nat -> nat) :
(nat ^^ m --> nat) -> (nat ^^ m --> nat) :=
match m return ( (nat ^^ m --> nat) ->
(nat ^^ m --> nat) ) with
| O => fun x => (g x)
| S m' => fun f => fun x
=> compose_unary m' g (f x)
end.
As for the general case, I'm pretty sure the type declaration should be
Fixpoint compose (n m : nat)
(g : nat ^^ n --> nat) :
(nat ^^ m --> nat) ^^ n
--> (nat ^^ m --> nat)
But I'm clueless how to proceed from here. Any suggestions?
Here is what I managed to do, but was not sure it is the easiest way, since I use dependent type and dependent pattern matching to encode the family g1, ... , gn:
Require Import NaryFunctions Vector.
Open Scope type.
First I need a function to apply a function f: A^^n --> B to a n-uplet x: A^^n:
Definition napply {A B:Type} (n :nat) (f: A ^^ n --> B) (x: A ^ n) : B :=
nuncurry A B n f x.
Then here is your compose function:
Fixpoint compose {A B C: Type} (n m: nat) (f: B ^^ m --> C) (gs: Vector.t (A ^^ n --> B) m) (xs: A ^ n) {struct gs } : C :=
match gs in Vector.t _ m' return (B ^^ m' --> C) -> A ^ n -> C with
| nil _ => fun f0 _ => f0
| cons _ hd p tl => fun fs ys => compose n p (fs (napply n hd ys)) tl ys
end f xs
.
This function takes a function f : B^^m --> C and a collection of m functions of type A^^n --> B and builds a real function from A ^ n to C. You can currify it if necessary:
Fixpoint compose_n {A B C: Type} (n m: nat) (f: B ^^ m --> C) (gs: Vector.t (A ^^ n --> B) m) : A ^^ n --> C :=
ncurry _ _ n (compose n m f gs).
Instantiate A B C with nat and you should have what your were looking for.
Cheers,
V.