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.
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.
In my program, I use List.filter to search a list for finding specific elements. I am proving if List.filter finds some elements in a list, then by appenindg another list we still get those elements that were in the first list before appending. I am a bit stuck in provingfilterKeepSameElementsAfterAppending. To make my program shorter, I changed my program's data to customType and mydata.
Require Import List Nat.
Inductive customType : Type :=
|Const1: nat -> customType
|Const2: list nat -> customType.
Inductive mydata : Set :=
|Set1: customType * customType ->mydata
|Set2: customType ->mydata.
Fixpoint custome_Equal (c1 c2:customType) :bool:=
match c1 with
|Const1 nt => match c2 with
|Const1 mt => eqb nt mt
|Const2 (hm::lmt) => eqb nt hm
| _ => false
end
|Const2 (hn::lnt) => match c2 with
|Const1 mt => eqb hn mt
|Const2 (hm:: lmt) => eqb hn hm
| _ => false
end
| _ => false
end.
Fixpoint Search (l: mydata) (t:customType): bool :=
match l with
|Set1 (a1, a2) => if (custome_Equal a2 t) then true else false
| _=>false
end.
Lemma filterKeepSameElementsAfterAppending(l1 l2: list mydata)(x:mydata)(ta:customType):
In x (filter (fun n => Search n ta) (l1)) -> In x (filter (fun n => Search n ta) (l2++ l1)).
Proof.
intro.
The filter_cat lemma should provide you some inspiration:
filter_cat
forall (T : Type) (a : pred T) (s1 s2 : seq T),
[seq x <- s1 ++ s2 | a x] = [seq x <- s1 | a x] ++ [seq x <- s2 | a x]
together with mem_cat should do what you want:
mem_cat
forall (T : eqType) (x : T) (s1 s2 : seq T),
(x \in s1 ++ s2) = (x \in s1) || (x \in s2)
Complete code:
From mathcomp Require Import all_ssreflect.
Lemma mem_filter_cat (T : eqType) p (l1 l2 : seq T) x :
x \in filter p l1 -> x \in filter p (l1 ++ l2).
Proof. by rewrite filter_cat mem_cat => ->. 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.
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)).