Section Prod2List.
Variable A : Type.
Variable f : A -> nat.
(* In the product the sum of the leaves is multiplied by the integer and added to the weight of the tree *)
Definition prod2list l1 l2 :=
fold_left plus
(map2 (fun a b => a * sum_leaves f b + weight_tree f b) l1 l2) 0.
Proof using.
intros l1 l2 l3 l4 H; unfold prod2list in |- *.
rewrite map2_app; auto.
rewrite fold_left_app.
rewrite plus_comm.
apply sym_equal.
repeat
rewrite
fold_left_eta with (f := plus) (f1 := fun a b : nat => a + (fun x => x) b);
auto.
apply sym_equal; rewrite <- fold_plus_split with (f := fun x : nat => x);
auto.
apply plus_comm.
Qed.
Proof using.
intros a b c d l1 l2 l3 l4 l5 l6 H H0 H1 H2 H3;
change
(prod2list (l1 ++ (a :: nil) ++ l2 ++ (b :: nil) ++ l3)
(l4 ++ (d :: nil) ++ l5 ++ (c :: nil) ++ l6) <=
prod2list (l1 ++ (a :: nil) ++ l2 ++ (b :: nil) ++ l3)
(l4 ++ (c :: nil) ++ l5 ++ (d :: nil) ++ l6))
in |- *.
repeat rewrite prod2list_app; auto.
apply plus_le_compat; auto with arith.
repeat rewrite plus_assoc; apply plus_le_compat; auto.
repeat rewrite (fun x y z => plus_comm (prod2list (x :: y) z)).
repeat rewrite plus_assoc_reverse; apply plus_le_compat; auto.
unfold prod2list in |- *; simpl in |- *.
rewrite le_plus_minus with (1 := H3); auto.
rewrite le_plus_minus with (1 := H2); auto.
replace
(a * (sum_leaves f c + (sum_leaves f d - sum_leaves f c)) + weight_tree f d +
((a + (b - a)) * sum_leaves f c + weight_tree f c)) with
(a * sum_leaves f c + weight_tree f c +
(a * (sum_leaves f d - sum_leaves f c) + (a + (b - a)) * sum_leaves f c +
weight_tree f d)); [ idtac | ring ].
apply plus_le_compat; auto with arith.
apply plus_le_compat; auto with arith.
repeat rewrite mult_plus_distr_l || rewrite mult_plus_distr_r;
auto with arith.
replace
(a * (sum_leaves f d - sum_leaves f c) +
(a * sum_leaves f c + (b - a) * sum_leaves f c)) with
(a * sum_leaves f c + (b - a) * sum_leaves f c +
(a * (sum_leaves f d - sum_leaves f c) + 0)); [ auto with arith | ring ].
Qed.
Proof using.
intros a b c d l1 l2 l3 l4 l5 l6 H H0 H1 H2 H3;
change
(prod2list (l1 ++ (a :: nil) ++ l2 ++ (b :: nil) ++ l3)
(l4 ++ (d :: nil) ++ l5 ++ (c :: nil) ++ l6) <=
prod2list (l1 ++ (a :: nil) ++ l2 ++ (b :: nil) ++ l3)
(l4 ++ (c :: nil) ++ l5 ++ (d :: nil) ++ l6))
in |- *.
repeat rewrite prod2list_app; auto.
apply plus_le_compat; auto with arith.
repeat rewrite plus_assoc; apply plus_le_compat; auto.
repeat rewrite (fun x y z => plus_comm (prod2list (x :: y) z)).
repeat rewrite plus_assoc_reverse; apply plus_le_compat; auto.
unfold prod2list in |- *; simpl in |- *.
rewrite le_plus_minus with (1 := H3); auto.
rewrite le_plus_minus with (1 := H2); auto.
replace
((b + (a - b)) * (sum_leaves f d + (sum_leaves f c - sum_leaves f d)) +
weight_tree f c + (b * sum_leaves f d + weight_tree f d)) with
((b + (a - b)) * sum_leaves f d + weight_tree f d +
((b + (a - b)) * (sum_leaves f c - sum_leaves f d) + b * sum_leaves f d +
weight_tree f c)); [ idtac | ring ].
apply plus_le_compat; auto with arith.
apply plus_le_compat; auto with arith.
repeat rewrite mult_plus_distr_l || rewrite mult_plus_distr_r;
auto with arith.
replace (b * sum_leaves f d + b * (sum_leaves f c - sum_leaves f d)) with
(b * (sum_leaves f c - sum_leaves f d) + 0 + b * sum_leaves f d);
[ auto with arith | ring ].
Qed.

(* Permuting two choosen elements with same integer does not change the product *)
Theorem prod2list_eq :
forall a b c l1 l2 l3 l4 l5 l6,
length l1 = length l4 ->
length l2 = length l5 ->
length l3 = length l6 ->
prod2list (l1 ++ a :: l2 ++ a :: l3) (l4 ++ b :: l5 ++ c :: l6) =
prod2list (l1 ++ a :: l2 ++ a :: l3) (l4 ++ c :: l5 ++ b :: l6).