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.
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 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.
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.