What is the best way to rewrite \sum_(i...) (F i - G i) as (\sum_(i...) F i - \sum_(i...) G i) on ordinals with bigop, assuming that underflows are properly managed?
More precisely, regarding these underflows, I'm interested in the following lemma:
Lemma big_split_subn (n : nat) (P : 'I_n -> bool) (F G : 'I_n -> nat) :
(forall i : 'I_n, P i -> G i <= F i) ->
\sum_(i < n | P i) (F i - G i) = \sum_(i < n | P i) F i - \sum_(i < n | P i) G i.
It seems that big_split should work for an addition (or subtraction in Z, using big_distrl with -1), but I need to use it for a subtraction on (bounded) naturals.
Thanks in advance for any suggestion.
Bye,
Pierre
Here is a shorter proof with a more general statement, I will add it to the library.
Lemma sumnB I r (P : pred I) (E1 E2 : I -> nat) :
(forall i, P i -> E1 i <= E2 i) ->
\sum_(i <- r | P i) (E2 i - E1 i) =
\sum_(i <- r | P i) E2 i - \sum_(i <- r | P i) E1 i.
Proof. by move=> /(_ _ _)/subnK-/(eq_bigr _)<-; rewrite big_split addnK. Qed.
EDIT: actually, there was even a one liner.
Here is the explanation for the intro pattern, starting with move=>
/(_ _ _) fills the two arguments of the hypothesis forall i, P i -> E1 i <= E2 i) with two meta-variables (let's name the first ?i),
then /subnK chains it to turn the comparison into E2 ?i - E1 ?i + E1 ?i = E2 ?i.
- discharges the meta-variables, turning the top hypothesis into forall i, P i -> E2 i - E1 i + E1 i = E2 i
/(eq_bigr _)<- chains with the congruence lemma, using _ as a first
arguments (which is supposed to be the shape of the right hand side which
we do not want to provide), this leads to the hypothesis
forall idx op P l, \big[op/idx]_(i <- l | P i) (E2 i - E1 i + E1 i) = \big[op/idx]_(i <- l | P i) E2 i) which we can use to rewrite right to
left using <-.
We conclude with the usual big_split and cancel with addnK.
Here is a nice answer written by Emilio Gallego Arias (user:1955696) (thanks, Emilio).
Lemma big_split_subn (P : 'I_k -> bool) F1 F2
(H : forall s : 'I_k, P s -> F2 s <= F1 s) :
\sum_(s < k | P s) (F1 s - F2 s) =
\sum_(s < k | P s) F1 s - \sum_(s < k | P s) F2 s.
Proof.
suff:
\sum_(s < k | P s) (F1 s - F2 s) =
\sum_(s < k | P s) F1 s - \sum_(s < k | P s) F2 s /\
\sum_(s < k | P s) F2 s <= \sum_(s < k | P s) F1 s by case.
pose K x y z := x = y - z /\ z <= y.
apply: (big_rec3 K); first by []; rewrite {}/K.
move=> i b_x b_y b_z /H Pi [] -> Hz; split; last exact: leq_add.
by rewrite addnBA ?addnBAC ?subnDA.
Qed.
If I correctly parse your question, you focus on the following equality:
forall (n : nat) (F G : 'I_n -> nat),
\sum_(i < n) (F i - G i) = \sum_(i < n) F i - \sum_(i < n) G i.
Obviously, given the behavior of the truncated subtraction (_ - _)%N, this statement doesn't hold as is, we need an hypothesis saying that no (F i - G i) cancels, in order to prove the equality.
Hence the following statement:
From mathcomp Require Import ssreflect ssrbool ssrfun eqtype ssrnat fintype bigop.
Lemma question (n : nat) (F G : 'I_n -> nat) :
(forall i : 'I_n, G i <= F i) ->
\sum_(i < n) (F i - G i) = \sum_(i < n) F i - \sum_(i < n) G i.
Then you're right that big_split is not applicable as is, and moreover starting over from the proof of big_split can't be successful, as we get:
Proof.
move=> Hmain.
elim/big_rec3: _ => [//|i x y z _ ->].
(* 1 subgoal
n : nat
F, G : 'I_n -> nat
Hmain : forall i : 'I_n, G i <= F i
i : ordinal_finType n
x, y, z : nat
============================
F i - G i + (y - x) = F i + y - (G i + x)
*)
and we are stuck because there is no hypothesis on (y - x).
However, it is possible to prove the lemma by relying on a "manual induction", combined with the following lemmas:
Check big_ord_recl.
(*
big_ord_recl :
forall (R : Type) (idx : R) (op : R -> R -> R) (n : nat) (F : 'I_n.+1 -> R),
\big[op/idx]_(i < n.+1) F i =
op (F ord0) (\big[op/idx]_(i < n) F (lift ord0 i))
*)
Search _ addn subn in ssrnat.
(see also https://github.com/math-comp/math-comp/wiki/Search)
In particular, here is a possible proof of that result:
Lemma question (n : nat) (F G : 'I_n -> nat) :
(forall i : 'I_n, G i <= F i) ->
\sum_(i < n) (F i - G i) = \sum_(i < n) F i - \sum_(i < n) G i.
Proof.
elim: n F G => [|n IHn] F G Hmain; first by rewrite !big_ord0.
rewrite !big_ord_recl IHn // addnBAC // subnDA //.
rewrite -subnDA [in X in _ = _ - X]addnC subnDA.
congr subn; rewrite addnBA //.
exact: leq_sum.
Qed.
EDIT: the generalization could indeed be done using this lemma:
reindex
: forall (R : Type) (idx : R) (op : Monoid.com_law idx) (I J : finType)
(h : J -> I) (P : pred I) (F : I -> R),
{on [pred i | P i], bijective h} ->
\big[op/idx]_(i | P i) F i = \big[op/idx]_(j | P (h j)) F (h j)
however it appears not as straightforward as I expected: FYI below is an almost-complete script − where the two remaining admits deal with the bijection property of the reindexation functions, hoping that this helps (also it seems a few lemmas, such asmem_enumT and filter_predI, might be added in MathComp, so I'll probably open a PR to propose that):
From mathcomp Require Import all_ssreflect.
Lemma mem_enumT (T : finType) (x : T) : (x \in enum T).
Proof. by rewrite enumT mem_index_enum. Qed.
Lemma predII T (P : pred T) :
predI P P =1 P.
Proof. by move=> x; rewrite /predI /= andbb. Qed.
Lemma filter_predI T (s : seq T) (P1 P2 : pred T) :
filter P1 (filter P2 s) = filter (predI P1 P2) s.
Proof.
elim: s => [//|x s IHs] /=.
case: (P2 x); rewrite ?andbT /=.
{ by rewrite IHs. }
by case: (P1 x) =>/=; rewrite IHs.
Qed.
Lemma nth_filter_enum
(I : finType) (P : pred I) (s := filter P (enum I)) (j : 'I_(size s)) x0 :
P (nth x0 [seq x <- enum I | P x] j).
Proof.
suff: P (nth x0 s j) && (nth x0 s j \in s) by case/andP.
rewrite -mem_filter /s /= filter_predI.
under [filter (predI P P) _]eq_filter do rewrite predII. (* needs Coq 8.10+ *)
exact: mem_nth.
Qed.
Lemma big_split_subn (n : nat) (P : 'I_n -> bool) (F G : 'I_n -> nat) :
(forall i : 'I_n, P i -> G i <= F i) ->
\sum_(i < n | P i) (F i - G i) =
\sum_(i < n | P i) F i - \sum_(i < n | P i) G i.
Proof.
move=> Hmain.
(* Prepare the reindexation on the indices satisfying the pred. P *)
set s := filter P (enum 'I_n).
set t := in_tuple s.
(* We need to exclude the case where the sums are empty *)
case Es: s => [|x0 s'].
{ suff Hpred0: forall i : 'I_n, P i = false by rewrite !big_pred0 //.
move: Es; rewrite /s; move/eqP.
rewrite -[_ == [::]]negbK -has_filter => /hasPn HP i.
move/(_ i) in HP.
apply: negbTE; apply: HP; exact: mem_enumT.
}
(* Coercions to go back and forth betwen 'I_(size s) and 'I_(size s).-1.+1 *)
have Hsize1 : (size s).-1.+1 = size s by rewrite Es.
have Hsize2 : size s = (size s).-1.+1 by rewrite Es.
pose cast1 i := ecast n 'I_n Hsize1 i.
pose cast2 i := ecast n 'I_n Hsize2 i.
set inj := fun (i : 'I_(size s).-1.+1) => tnth t (cast1 i).
have Hinj1 : forall i : 'I_(size s).-1.+1, P (inj i).
{ move=> j.
rewrite /inj (tnth_nth (tnth t (cast1 j)) t (cast1 j)) /t /s in_tupleE /=.
exact: nth_filter_enum. }
have Hinj : {on [pred i | P i], bijective inj}.
{ (* example inverse function; not the only possible definition *)
pose inj' :=
(fun n : 'I_n => if ~~ P n then #ord0 (size s).-1 (* dummy value *)
else #inord (size s).-1 (index n (filter P s))).
exists inj'; move=> x Hx; rewrite /inj /inj'.
admit. admit. (* exercise left to the reader :) *)
}
(* Perform the reindexation *)
rewrite !(reindex inj).
do ![under [\sum_(_ | P _) _]eq_bigl do rewrite Hinj1]. (* needs Coq 8.10+ *)
apply: question => i; exact: Hmain.
all: exact: Hinj.
Admitted.
Related
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 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'd like to remove tcast in a "lemma" such as the following one. But this doesn't even typecheck, due to dependent-typing "constraints".
Lemma foo : forall {T} m n (tc : n = m) (f : m.-tuple T -> 'I_n -> nat) (x : n.-tuple T),
[seq f (tcast tc x) j | j <- enum 'I_n] =
[seq f x j | j <- enum 'I_n].
In fact, a more significant example for the application I have in mind, and which does typecheck, would be the following lemma:
Lemma bar n1 n2 n (tc : n1 + n2 = n) (l1 : n1.-tuple nat) (l2 : n2.-tuple nat) :
\sum_(i < n) tnth (tcast tc [tuple of (l1 ++ l2)]) i =
\sum_(i < n1) tnth l1 i + \sum_(i < n2) tnth l2 i.
This would be simple on seq, but here I cannot find how to proceed using lemmas in tuple.v or fintype.v.
So what is the proper way to address such tcast expressions when they don't seem to be amenable to treatment via val_inj and case analysis (see previous post)? Do I have, in the first example, to introduce two versions of f, later proved to be equal over sequences (and if so, what would be the best way to proceed)?
Thanks in advance for any suggestion.
Pierre
In the case you post, you can remove the casts using the standard trick:
Lemma val_tcast {T} m n (tc : n = m) (x : n.-tuple T) :
val (tcast tc x) = val x.
Proof. by case: m / tc. Qed.
Lemma sum_tuple n (t : n.-tuple nat) :
\sum_(i < n) tnth t i = \sum_(i < n) nth 0 (val t) i.
Proof. by apply: eq_bigr => ? ?; rewrite (tnth_nth 0). Qed.
Lemma bar n1 n2 n (tc : n1 + n2 = n) (l1 : n1.-tuple nat) (l2 : n2.-tuple nat) :
\sum_(i < n) tnth (tcast tc [tuple of (l1 ++ l2)]) i =
\sum_(i < n1) tnth l1 i + \sum_(i < n2) tnth l2 i.
Proof.
rewrite !sum_tuple val_tcast /=.
Tho there is a direct proof:
Lemma bar' n1 n2 n (tc : n1 + n2 = n) (l1 : n1.-tuple nat) (l2 : n2.-tuple nat) :
\sum_(i < n) tnth (tcast tc [tuple of (l1 ++ l2)]) i =
\sum_(i < n1) tnth l1 i + \sum_(i < n2) tnth l2 i.
Proof. by rewrite -!(big_tuple _ _ _ predT id) val_tcast big_cat. Qed.