Compare sums ssreflect - coq

I am aiming to say that if we have
sum(a) = sum(b)
then
a = b.
What would be the suitable tactic to do this, if the goal looks like this:
\big[Radd_comoid/0]_(i <- fin_img (A:=U) (B:=R_eqType) X)
Radd_comoid
(Pr P F * (i * Pr P (finset (T:=U) (preim X (pred1 i)) :&: F) / Pr P F))
(Pr P (~: F) *
(i * Pr P (finset (T:=U) (preim X (pred1 i)) :&: ~: F) / Pr P (~: F))) =
\sum_(u in U) X u * `p_ X u
Editted.
The context contains:
X: {RV (P) -> (R)}
F: {set U}
H: 0 < Pr P F
H0: Pr P F < 1
The goal after rewrite /=. looks like this:
\big[Rplus/0]_(i <- fin_img (A:=U) (B:=R_eqType) X)
(Pr P F * (i * Pr P (finset (T:=U) (preim X (pred1 i)) :&: F) / Pr P F) +
Pr P (~: F) *
(i * Pr P (finset (T:=U) (preim X (pred1 i)) :&: ~: F) / Pr P (~: F))) =
\sum_(u in U) X u * `p_ X u

If it is true, you probably need to use sum_parti_finType on the right hand side and try to identify the general terms of the summation using eq_bigr. The general term of the left hand side can be simplified using mulrC mulfVK (or something like this) on both sides of the +. And then identify a sum of probabilities with the probability of the disjoint union.
Anyway, it's not just "a tactic"...

Related

Can I use destruct here given the constraint I have for index range of a list?

I’m trying to prove that for a list of bytes a, all bytes are x01 from index 2 to (n-m-2), where n is the length of a:
(forall (i : nat), ((i >= 2) /\ (i < ((n - m) - 1))) -> ((nth_error a i) = (Some x01)))
and I do have this in the context:
H : nth_error a ?j =
nth_error ([x00; x00] ++ repeat x01 (n - m - 2) ++ repeat x00 m)%list ?j
So, after intros i i_range. I have:
i : nat
i_range : is_true (1 < i) /\ is_true (i < n - m - 1)
H : nth_error a ?j =
nth_error ([x00; x00] ++ repeat x01 (n - m - 2) ++ repeat x00 m)%list ?j
______________________________________(1/1)
nth_error a i = Some x01
Is this a right approach to destruct the RHS of H to eliminate the first two bytes and the last m bytes? If so, how can I do that with respect to i_range? Let me know if my proof strategy is flawed.
Thanks in advance for any suggestion.
Edit:
The last goal's typo is fixed. It was nth_error buff i = Some x01 first and I changed to nth_error a i = Some x01.
If you can ensure H starts with “forall j,”, the goal should be provable. I am not sure I understand the strategy you suggests, but I’d rewrite ntherror (prefix ++ foo ++ bar) i to ntherror foo (i - 2) (using suitable lemmas, either existing or provable), then since foo is defined using repeat, rewrite ntherror (repeat baz x01) to x01. All these lemmas have arithmetic side conditions that should hold.

coq field tactic fails to simplify, yeilds "m <> 0%R"

I'm new to Coq. I've been working through Pierce's Logical Foundations. I'm stepping into new ground.
I'm trying use of the field tactic for the first time. I use it thrice in the below theorem. Twice it fails, yielding m <> 0%R where m is a term in context.
I'm sure I just fail to understand proper use. May someone enlighten me? (I tried reading this doc page but didn't gain much understanding!)
From Coq Require Import Reals.Reals.
Require Import Field.
Definition simple_compound (A r n m : R) : R :=
A * (Rpower (1 + r / m) (m * n)).
Definition continuous_compound (A r n: R) : R :=
A * (exp (r * n)).
Definition simple_to_continuous_interest (Rs n m: R) : R :=
m * ln (1 + Rs / m).
Definition continuous_to_simple_interest (Rc n m: R) : R :=
m * ((exp (Rc / m)) - 1).
Theorem continuous_to_simple_works : forall (A Rc n m : R),
continuous_compound A Rc n = simple_compound A (continuous_to_simple_interest Rc n m) n m.
Proof.
intros A Rc n m.
unfold continuous_compound. unfold simple_compound. unfold continuous_to_simple_interest.
unfold Rpower. apply f_equal.
assert (H: (m * (exp (Rc / m) - 1) / m)%R = (exp (Rc / m) - 1)%R). {
field. admit.
}
rewrite -> H.
assert (H2: (1 + (exp (Rc / m) - 1))%R = (exp (Rc / m))%R). {
field.
}
rewrite -> H2.
assert (H3: (m * n * ln (exp (Rc / m)))%R = (ln (exp (Rc / m)) * m * n)%R). {
rewrite -> Rmult_comm. rewrite -> Rmult_assoc. reflexivity.
}
rewrite -> H3.
rewrite -> ln_exp.
assert (H4: (Rc / m * m)%R = Rc%R). {
field. admit.
}
rewrite -> H4.
reflexivity.
Admitted.
That is expected. Your first use of field is on a goal akin to (m * x) / m = x. There is absolutely no way of defining the division over real numbers so that this equality holds for all real numbers x when m is equal to 0. So, the field tactic is able to prove this equality only if you are able to prove m <> 0. Your third use of field is on an equality (x / m) * m = x, and again, it can only hold for any x if you know that m is nonzero.

Distributing subtraction over bigop

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.

Folding only applications

The fold tactic replaces all occurrence of a term with another, so fold (id f) tries to replace all occurrences of f with (id f).
However, I want to only fold f if it occurs in the context (f [ ]), not if it occurs in the context ([ ] f). In particular repeat myfold (id f), should not loop.
Is there a general way to do this type of folding? The best I have right now is
repeat match goal with
| |- context [(f ?x)] => change (f x) with ((id f) x)
end
But the above does not work for contexts of the form forall x, f x = f x.
You can use an intermediate value not containing f. Something like
let f' := fresh in
pose (id f) as f';
change f with f'
change (id f') with f'; (* undo the change in locations where we've already added id *)
subst f'.
Edit
If you actually want to just fold things in applicative contexts, you can use three intermediate values, like this:
(* Copyright 2018 Google LLC.
SPDX-License-Identifier: Apache-2.0 *)
Ltac myfold_id f :=
let id_f := fresh in
let id_f_good := fresh in
let f' := fresh in
pose (id f) as id_f;
pose (id f) as id_f_good;
pose f as f';
repeat (change f with id_f at 1;
lazymatch goal with
| [ |- context[id_f _] ] => change id_f with id_f_good
| _ => change id_f with f'
end);
subst id_f id_f_good f'.
Goal let f := id in (f = f, f 0) = (f = f, f 0).
Proof.
intro f.
(* (f = f, f 0) = (f = f, f 0) *)
myfold_id f.
(* (f = f, id f 0) = (f = f, id f 0) *)

Can XOR be expressed using SKI combinators?

I have question about SKI-Combinators.
Can XOR (exclusive or) be expressed using S and K combinators only?
I have
True = Cancel
False = (Swap Cancel)
where
Cancel x y = K x y = x
Swap: ff x y = S ff x y = ff y x
Booleans
Your question is a bit unclear on the details, but it seems that what you mean is that you have the following representation of booleans:
T := K
F := S K
This works because it means the following reductions hold:
T t e => t
F t e => e
in other words, b t e can be interpreted as IF b THEN t ELSE e.
XOR in terms of IF _ THEN _ ELSE _
So given this framework, how do we implement XOR? We can formulate XOR as an IF expression:
xor x y := IF x THEN (not y) ELSE y = (IF x THEN not ELSE id) y
which can be eta-reduced to
XOR x := IF x THEN not ELSE id = x not id
Some function combinators
We have id = SKK as standard, and not can be expressed as flip, since flip b t e = b e t = IF b THEN e ELSE t = IF (not b) THEN t ELSE e. flip it self is quite involved but doable as
flip := S (S (K (S (KS) K)) S) (KK)
Now we just need to figure out a way to write a function that takes x and applies it on the two terms NOT and ID. To get there, we first note that if we set
app := id
then
app f x = (id f) x = f x
and so,
(flip app) x f = f x
We are almost there, since everything so far shows that
((flip app) id) ((flip app) not x) = ((flip app) not x) id = (x not) id = x not id
The last step is to make that last line point-free on x. We can do that with a function composition operator:
((flip app) id) ((flip app) not x) = compose ((flip app) id) ((flip app) not) x
where the requirement on compose is that
compose f g x = f (g x)
which we can get by setting
compose f g := S (K f) g
Putting it all together
To summarize, we got
xor := compose ((flip app) id) ((flip app) not)
or, fully expanded:
xor = S (K ((flip app) id)) ((flip app) not)
= S (K ((flip app) (SKK))) ((flip app) flip)
= S (K ((flip SKK) (SKK))) ((flip SKK) flip)
= S (K (((S (S (K (S (KS) K)) S) (KK)) SKK) (SKK))) (((S (S (K (S (KS) K)) S) (KK)) SKK) (S (S (K (S (KS) K)) S) (KK)))