Set Implicit Arguments.
Plus List Permutation Arith Relations RelationClasses Morphisms
arith_lems util list_utils nat_seqs Omega.
(* sum *)
Fixpoint sum (l: list nat): nat :=
match l with
| nil => 0
| h :: t => h + sum t
end.
Open Scope R_scope.
(* Rsum *)
Definition Rsum: list R -> R := fold_right Rplus 0.
Proof with auto.
induction l...
simpl.
intros.
rewrite plus_INR.
rewrite H...
rewrite IHl...
Qed.
Instance Rsum_Permutation: Proper (Permutation ==> eq) Rsum.
Proof with auto.
intros x y p.
induction p...
simpl.
rewrite IHp...
simpl.
do 2 rewrite <- Rplus_assoc.
rewrite (Rplus_comm y)...
rewrite IHp1...
Qed.
Proof with auto with real.
induction x...
simpl.
intros.
rewrite IHx...
Qed.
Proof with auto.
induction l; intros.
simpl.
field.
simpl Rsum.
simpl @length.
rewrite IHl.
rewrite (H a).
rewrite S_INR.
field.
left...
intros.
apply H.
right...
Qed.
Proof with auto with real.
induction l...
simpl @length.
intros.
simpl Rsum.
apply Rle_trans with (a + INR (length l) * r).
apply Rplus_le_compat_l.
apply IHl.
intros.
apply H.
right...
apply Rle_trans with (r + INR (length l) * r).
apply Rplus_le_compat_r.
firstorder.
simpl @length.
rewrite S_INR.
rewrite Rmult_plus_distr_r.
rewrite Rmult_1_l...
Qed.
Proof with auto with real.
induction l; intros.
simpl.
rewrite Rmult_0_l...
simpl @length.
simpl Rsum.
rewrite S_INR.
rewrite Rmult_plus_distr_r.
rewrite Rmult_1_l.
rewrite Rplus_comm.
apply Rplus_le_compat.
apply H.
left...
apply IHl.
intros.
apply H.
right...
Qed.
Proof with try field.
induction l; simpl...
rewrite IHl...
Qed.
Proof with auto with real.
intros.
rewrite map_app.
rewrite Rsum_app.
rewrite Rsum_map_plus.
do 2 rewrite map_map.
reflexivity.
Qed.
Instance elemsR_le_Rsum: Proper (elemsR Rle ==> Rle) Rsum.
Proof with auto with real.
repeat intro.
induction H...
simpl...
Qed.
Proof with field.
unfold ext_eq, Basics.compose.
induction n; intros.
simpl...
simpl Rsum.
rewrite S_INR.
rewrite IHn...
Qed.
Proof with auto with real.
induction l...
simpl.
rewrite Rsum_app.
congruence.
Qed.
(* Things like the three lemmas above are more elegantly stated as extensional equalities on function compositions, but stated that way they cannot be easily rewritten with.. *)
Proof with auto with real.
induction l...
intros.
simpl.
apply Rplus_le_le_0_compat; intuition.
Qed.
Proof with auto.
unfold RsumOver.
intros.
rewrite <- (map_length f l).
apply Rsum_le...
intros.
destruct (In_map_inv H0).
destruct H1.
subst...
Qed.
Proof with auto.
induction b; simpl; intros.
induction (nats b' w)...
simpl.
rewrite <- IHl...
rewrite nats_Sb.
rewrite IHb.
rewrite map_map...
Qed.
Proof with auto.
intros.
replace b with ((b + 0)%nat)...
rewrite nats_plusb.
unfold RsumOver.
rewrite map_map...
f_equal.
unfold compose.
apply map_ext...
Qed.
Proof with auto with real.
unfold RsumOver.
intros.
induction l...
simpl.
apply Rplus_le_compat.
apply H.
left...
apply IHl.
intros.
apply H.
right...
Qed.
Proof with auto.
unfold compose.
unfold RsumOver.
induction l.
simpl.
apply Rmult_0_r.
simpl.
rewrite <- IHl.
apply Rmult_plus_distr_l.
Qed.
Proof with auto with arith.
unfold compose.
unfold RsumOver...
intros.
apply Rsum_Permutation.
rewrite <- (map_map (minus d) f).
apply Permutation_map.
apply NoDup_incl_Permutation.
rewrite map_length.
repeat rewrite nats_length...
apply NoDup_map.
intros.
apply minus_eq_inv_r with d...
destruct (In_nats_inv _ _ _ H0)...
apply le_trans with ((b + w)%nat)...
destruct (In_nats_inv _ _ _ H1).
apply le_trans with ((b + w)%nat)...
apply NoDup_nats.
intro.
intro.
destruct (In_map_inv H0).
destruct H1.
destruct (In_nats_inv _ _ _ H2).
subst.
apply In_nats; omega.
Qed.
(* Ravg *)
Definition Ravg (l: list R): R := Rsum l / INR (length l).
Proof with auto.
unfold Ravg.
simpl.
unfold Rdiv.
rewrite Rmult_0_l...
Qed.
Instance Ravg_Permutation: Proper (Permutation ==> eq) Ravg.
Proof with auto with real.
induction l.
simpl.
rewrite Ravg_nil...
intros.
rewrite Ravg_cons.
unfold Rdiv.
apply Rmult_le_pos...
apply Rplus_le_le_0_compat.
firstorder.
apply Rmult_le_pos...
firstorder.
Qed.
Proof with auto.
induction l.
rewrite Ravg_nil...
intros.
rewrite Ravg_cons.
rewrite IHl.
rewrite Rmult_0_l.
rewrite (H a).
rewrite Rplus_0_l.
unfold Rdiv.
rewrite Rmult_0_l...
left...
intros.
apply H.
right...
Qed.
(* Ravg_0 and Ravg_0_le cannot be generalized to arbitrary constant resp. lower bound, because Ravg nil = 0 *)
Proof with auto with real.
induction x; intros.
simpl.
rewrite Ravg_nil.
rewrite Rmult_0_l.
rewrite Rplus_0_l.
rewrite Rmult_comm.
rewrite Rmult_assoc.
destruct y.
rewrite Ravg_nil.
rewrite Rmult_0_l...
rewrite Rinv_r...
simpl @length...
simpl @length.
simpl app.
do 2 rewrite Ravg_cons.
rewrite IHx.
rewrite app_length.
unfold Rdiv.
rewrite (Rmult_assoc (a + Ravg x * INR (length x)) ).
rewrite (Rmult_comm (/ INR (S (length x)))).
rewrite Rinv_r...
rewrite Rmult_1_r.
simpl plus.
rewrite Rmult_comm.
apply Rmult_eq_compat_l.
rewrite Rplus_assoc.
apply Rplus_eq_compat_l.
case_eq ((length x + length y)%nat); intros.
destruct x.
destruct y.
simpl.
repeat rewrite Rmult_0_r...
elimtype False.
simpl in H.
discriminate.
elimtype False.
simpl in H.
discriminate.
rewrite Rmult_comm.
rewrite <- Rmult_assoc.
rewrite Rinv_r...
Qed.
Proof with auto with real.
induction l.
intros.
inversion H1.
simpl.
rewrite Ravg_cons.
unfold Rdiv.
intros.
destruct (Rmult_0_inv H).
Focus 2.
elimtype False.
apply (Rinv_neq_0_compat (INR (S (length l))))...
assert (0 <= a).
apply H0...
assert (0 <= Ravg l).
apply Ravg_0_le...
assert (0 <= Ravg l * INR (length l)).
apply Rmult_le_pos...
destruct H1.
subst.
apply (Rplus_eq_0_l x (Ravg l * INR (length l)) H3 H5 H2).
apply IHl...
rewrite Rplus_comm in H2.
cset (Rplus_eq_0_l (Ravg l * INR (length l)) a H5 H3 H2).
destruct (Rmult_0_inv H6)...
destruct l.
inversion H1.
simpl @length in H7.
elimtype False.
apply (INR_S_ne_0 (length l))...
Qed.
Hint Resolve not_0_INR.
Proof with auto.
intros.
rewrite <- map_map_comp.
rewrite (filter_perms p t).
rewrite map_concat_map.
set (((fact (length (filter (negb ∘ p) t)) * length (merges (filter p t) (filter (negb ∘ p) t))))%nat).
assert (n <> 0%nat).
subst n.
apply mult_ne_0.
apply fact_neq_0.
pose proof (merges_ne_nil (filter p t) (filter (negb ∘ p) t)).
destruct @merges...
discriminate.
clearbody n.
rewrite (map_ext_eq_mor (repeat_map_comm f n)).
set (perms (filter p t)).
assert (l <> nil).
subst l.
intro.
pose proof (length_perms (filter p t)).
rewrite H0 in H1.
simpl in H1.
apply (fact_neq_0 (length (filter p t)))...
clearbody l.
unfold Ravg.
rewrite map_length.
rewrite length_concat.
rewrite map_map_comp.
rewrite Rsum_concat.
rewrite map_map_comp.
rewrite (@add_same n).
rewrite map_length.
rewrite <- Combinators.compose_assoc.
rewrite <- map_map_comp.
rewrite (map_ext_eq_mor (Rsum_repeat n)).
rewrite Rsum_map_mult.
rewrite mult_INR.
field.
split...
destruct l...
simpl @length.
auto with arith.
intros.
apply in_map_iff in H1. destruct H1. destruct H1. subst...
apply length_repeat.
Qed.

Lemma Ravg_comp_map X
(f: X -> R) (m: list X -> R) (g: R -> R):
(forall a b, g (a * b) = g a * b) ->
(forall l, g (Rsum l) = Rsum (map g l)) ->
(forall l: list X, Ravg (map f l) = g (m l)) -> forall u,
Ravg (map (fun l => Ravg (map f l)) u) = g (Ravg (map m u)).