Require Export realbasis. Require Export proof_utils. Require Export real_facts. Require Export real_value. Require Export Zwf. Require Wellfounded. Open Scope Z_scope. Record affine_data : Set := {m_a : Z; m_a' : Z; m_b : Z; m_b' : Z; m_c : Z; m_c' : Z; m_x : stream idigit; m_y : stream idigit}. Definition positive_coefficients (x:affine_data) := 0 <= m_a x /\ 0 < m_a' x /\ 0 <= m_b x /\ 0 < m_b' x /\ 0 <= m_c x /\ 0 < m_c' x. Definition af_real_value (x:affine_data) : Rdefinitions.R := (IZR (m_a x)/IZR (m_a' x) * (real_value (m_x x)) + IZR (m_b x)/IZR (m_b' x) * (real_value (m_y x)) + IZR (m_c x)/IZR (m_c' x))%R. (* I use modularity mostly to re-arrange the order of announcements of and their proofs. Thus, I promise in this file to produce a function axbyc and a companion theorem asserting its correctness, as they are described in the following module type. *) Module Type axbyc_type. Parameter axbyc : forall x: affine_data, positive_coefficients x -> stream idigit. Parameter axbyc_correct : forall x:affine_data, forall H :positive_coefficients x, (0 <= af_real_value x <= 1)%R -> real_value (axbyc x H) = af_real_value x. End axbyc_type. (* The following definitions should be shared between modules, but doing so with manifest types would mean a lot of duplication. For this reason I place them in the "open space". *) Definition axbyc_consume (x:affine_data) : affine_data := let (a,a',b,b',c,c',v1,v2) := x in let (d1,v1') := v1 in let (d2,v2') := v2 in let (c1,c1') := match d1,d2 with | L,L => (c, c') | L,R => (b*c'+2*c*b', 2*b'*c') | R,L => (a*c'+2*c*a', 2*a'*c') | L,C => (b*c'+4*c*b', 4*b'*c') | C,L => (a*c'+4*c*a', 4*a'*c') | R,C => (2*a*b'*c'+b*a'*c'+4*c*a'*b', 4*a'*b'*c') | C,R => (2*b*a'*c'+a*b'*c'+4*c*b'*a', 4*b'*a'*c') | R,R => (a*b'*c'+b*a'*c'+2*c*a'*b', 2*a'*b'*c') | C,C => (b*a'*c'+a*b'*c'+4*c*b'*a', 4*b'*a'*c') end in Build_affine_data a (2*a') b (2*b') c1 c1' v1' v2'. Definition affine_measure (x:affine_data) := Zmax 0 (Zmax (8 * m_a x - m_a' x) (8 * m_b x - m_b' x)). Definition order : affine_data -> affine_data -> Prop := fun x y => Zwf 0 (affine_measure x) (affine_measure y). Definition prod_R x := Build_affine_data (2*m_a x) (m_a' x) (2*m_b x) (m_b' x) (2*m_c x-m_c' x) (m_c' x) (m_x x) (m_y x). Definition prod_L x := Build_affine_data (2*m_a x) (m_a' x) (2*m_b x) (m_b' x) (2*m_c x) (m_c' x) (m_x x) (m_y x). Definition prod_C x := Build_affine_data (2*m_a x) (m_a' x) (2*m_b x) (m_b' x) (4*m_c x-m_c' x) (2*m_c' x) (m_x x) (m_y x). Definition same_value (a b:affine_data) : Prop := af_real_value a = af_real_value b. (* The following module contains the types of intermediate lemmas and functions that are used in our development of axbyc. *) Module Type axbyc_proofs. Parameter axbyc_test : forall x, positive_coefficients x -> {m_c' x <= 2*m_c x}+ {2*(m_a x*m_b' x*m_c' x + m_b x*m_a' x*m_c' x + m_a' x*m_b' x*m_c x)<= m_a' x*m_b' x*m_c' x}+ {4*(m_a x*m_b' x*m_c' x + m_b x*m_a' x*m_c' x + m_a' x*m_b' x*m_c x)<= 3*m_a' x*m_b' x*m_c' x /\ m_c' x <= 4*m_c x}+ {m_a' x < 8*m_a x \/ m_b' x < 8*m_b x}. Parameter order_wf : well_founded order. Parameter axbyc_consume_decrease : forall x, positive_coefficients x -> m_a' x < 8*m_a x \/ m_b' x < 8*m_b x -> order (axbyc_consume x) x. Parameter axbyc_consume_pos : forall x, positive_coefficients x -> positive_coefficients (axbyc_consume x). Parameter prod_R_pos : forall x, positive_coefficients x -> m_c' x <= 2*m_c x -> positive_coefficients (prod_R x). Parameter prod_L_pos : forall x, positive_coefficients x -> positive_coefficients (prod_L x). Parameter prod_C_pos : forall x, positive_coefficients x -> m_c' x <= 4*m_c x -> positive_coefficients (prod_C x). Parameter axbyc_consume_same_value : forall x, positive_coefficients x -> same_value x (axbyc_consume x). Parameter prod_R_in_bound : forall x, positive_coefficients x -> (0 <= af_real_value x <= 1)%R -> m_c' x <= 2 * m_c x -> (0 <= af_real_value (prod_R x) <= 1)%R. Parameter prod_R_expand : forall x, positive_coefficients x -> (lift R (af_real_value (prod_R x)) = af_real_value x). Parameter prod_L_in_bound : forall x, positive_coefficients x -> (0 <= af_real_value x <= 1)%R -> 2 * (m_a x * m_b' x * m_c' x + m_b x * m_a' x * m_c' x + m_a' x * m_b' x * m_c x) <= m_a' x * m_b' x * m_c' x -> (0 <= af_real_value (prod_L x) <= 1)%R. Parameter prod_L_expand : forall x, positive_coefficients x -> (lift L (af_real_value (prod_L x)) = af_real_value x)%R. Parameter prod_C_in_bound : forall x, positive_coefficients x -> (0 <= af_real_value x <= 1)%R -> 4 * (m_a x * m_b' x * m_c' x + m_b x * m_a' x * m_c' x + m_a' x * m_b' x * m_c x) <= 3 * m_a' x * m_b' x * m_c' x -> m_c' x <= 4 * m_c x -> (0 <= af_real_value (prod_C x) <= 1)%R. Parameter prod_C_expand : forall x, positive_coefficients x -> (lift C (af_real_value (prod_C x)) = af_real_value x)%R. End axbyc_proofs. (* The following functor contains the definition of the main function and its proof of correctness. *) (* Module axbyc_def(A:axbyc_proofs) : axbyc_type. Inductive decision_data (ref:affine_data) : Set := caseR : forall x:affine_data, positive_coefficients x -> m_c' x <= 2*m_c x -> same_value ref x -> decision_data ref | caseL : forall x:affine_data, positive_coefficients x -> 2*(m_a x*m_b' x*m_c' x + m_b x*m_a' x*m_c' x + m_a' x*m_b' x*m_c x)<= m_a' x*m_b' x*m_c' x -> same_value ref x -> decision_data ref | caseC : forall x:affine_data, positive_coefficients x -> 4*(m_a x*m_b' x*m_c' x + m_b x*m_a' x*m_c' x + m_a' x*m_b' x*m_c x)<= 3*m_a' x*m_b' x*m_c' x -> m_c' x <= 4*m_c x -> same_value ref x -> decision_data ref. Theorem axbyc_consume_same_value2 : forall x b, positive_coefficients x -> same_value (axbyc_consume x) b -> same_value x b. unfold same_value; intros x b Hpos Hs1; generalize (A.axbyc_consume_same_value x Hpos); unfold same_value; intros Hs2; rewrite Hs2; exact Hs1. Qed. Definition axbyc_rec_aux (x:affine_data) : (forall y, order y x -> positive_coefficients y -> decision_data y)-> positive_coefficients x -> decision_data x := fun f Hp => match A.axbyc_test x Hp with inleft (inleft (left H)) => caseR x x Hp H (refl_equal (af_real_value x)) | inleft (inleft (right H)) => caseL x x Hp H (refl_equal (af_real_value x)) | inleft (inright (conj H1 H2)) => caseC x x Hp H1 H2 (refl_equal (af_real_value x)) | inright H => match f (axbyc_consume x) (A.axbyc_consume_decrease x Hp H) (A.axbyc_consume_pos x Hp) with | caseR b Hp' Hc Hsame => caseR x b Hp' Hc (axbyc_consume_same_value2 x b Hp Hsame) | caseL b Hp' Hc Hsame => caseL x b Hp' Hc (axbyc_consume_same_value2 x b Hp Hsame) | caseC b Hp' Hc1 Hc2 Hsame => caseC x b Hp' Hc1 Hc2 (axbyc_consume_same_value2 x b Hp Hsame) end end. Definition axbyc_rec := well_founded_induction A.order_wf (fun x => positive_coefficients x -> decision_data x) axbyc_rec_aux. CoFixpoint axbyc (x:affine_data) (h:positive_coefficients x):stream idigit := match axbyc_rec x h with caseR y Hpos Hc _ => R::(axbyc (prod_R y) (A.prod_R_pos y Hpos Hc)) | caseL y Hpos _ _ => L::(axbyc (prod_L y) (A.prod_L_pos y Hpos)) | caseC y Hpos H1 H2 _ => C::(axbyc (prod_C y) (A.prod_C_pos y Hpos H2)) end. Theorem axbyc_correct_aux : forall x:affine_data, forall H :positive_coefficients x, (0 <= (af_real_value x) <= 1)%R -> represents (axbyc x H) (af_real_value x). cofix. intros x H Hint; rewrite (str_dec_thm (axbyc x H)); simpl. destruct (axbyc_rec x H) as [v Hp Hc Hs | v Hp Hc Hs | v Hp Hc1 Hc2 Hs]. rewrite Hs; rewrite <- A.prod_R_expand. assert (0 <= (af_real_value (prod_R v)) <= 1)%R. apply A.prod_R_in_bound; auto. rewrite <- Hs; exact Hint. constructor. apply axbyc_correct_aux; assumption. assumption. assumption. rewrite Hs; rewrite <- A.prod_L_expand. assert (0 <= (af_real_value (prod_L v)) <= 1)%R. apply A.prod_L_in_bound; auto. rewrite <- Hs; exact Hint. constructor. apply axbyc_correct_aux; assumption. assumption. assumption. rewrite Hs; rewrite <- A.prod_C_expand. assert (0 <= (af_real_value (prod_C v)) <= 1)%R. apply A.prod_C_in_bound; auto. rewrite <- Hs; exact Hint. constructor. apply axbyc_correct_aux; assumption. assumption. assumption. Qed. Theorem axbyc_correct : forall x:affine_data, forall H :positive_coefficients x, (0 <= af_real_value x <= 1)%R -> real_value (axbyc x H) = af_real_value x. intros x H Hint; apply represents_equal; apply axbyc_correct_aux; assumption. Qed. End axbyc_def. *) (* The following contains all the proofs of the intermediate lemmas. This is pushed to the end of the file so that only readers interested in the details need to go beyond this line. *) Module done_proofs : axbyc_proofs. Theorem prod_R_in_bound_sup : forall x, (0 <= x <= 1)%R -> (2*x-1 <= 1)%R. intros x [H1 H2]; fourier. Qed. Theorem prod_C_expand : forall x, positive_coefficients x -> (lift C (af_real_value (prod_C x)) = af_real_value x)%R. intros [a a' b b' c c' v1 v2]; unfold positive_coefficients, af_real_value, prod_C, m_a, m_a', m_b, m_b', m_c, m_c', m_x, m_y. intros H; decompose [and] H; repeat (rewrite mult_IZR || rewrite <- Z_R_minus). simpl (IZR 2). simpl (IZR 4). unfold lift, alpha; field. repeat (apply prod_neq_R0|| apply prod_lt_neq_0|| apply Rlt_neq_0 || apply (IZR_lt 0)); auto. fourier. fourier. fourier. Qed. Theorem prod_L_expand : forall x, positive_coefficients x -> (lift L (af_real_value (prod_L x)) = af_real_value x)%R. intros [a a' b b' c c' v1 v2]; unfold positive_coefficients, af_real_value, prod_L, m_a, m_a', m_b, m_b', m_c, m_c', m_x, m_y. intros H; decompose [and] H; repeat (rewrite mult_IZR || rewrite <- Z_R_minus). simpl (IZR 2). unfold lift, alpha; field. repeat (apply prod_neq_R0|| apply prod_lt_neq_0|| apply Rlt_neq_0 || apply (IZR_lt 0)); auto. fourier. Qed. Theorem prod_C_in_bound_sup : forall a b, 0 < b -> 4*a <= 3*b -> (((4*IZR a)/IZR b -1)/IZR 2 <= 1)%R. intros a b Hneq Hle; apply Rmult_le_reg_l with (2*IZR b)%R. apply Rmult_lt_0_compat. fourier. apply (IZR_lt 0); assumption. replace ((2*IZR b)*1)%R with (2*IZR b)%R. replace ((2*IZR b)*((4*IZR a/IZR b -1)/IZR 2))%R with (4*IZR a - IZR b)%R. replace 4%R with (IZR 4). replace 2%R with (IZR 2). repeat (rewrite Z_R_minus || rewrite <- mult_IZR). apply IZR_le; omega. simpl IZR;field. simpl IZR;field. simpl (IZR 2). field. apply prod_neq_R0. apply Rlt_neq_0; apply (IZR_lt 0);assumption. apply (not_O_IZR 2); omega. field. Qed. Theorem prod_L_in_bound_sup : forall a b, 0 < b -> 2*a <= b -> ((2*IZR a)/IZR b <= 1)%R. intros a b Hneq Hle; apply Rmult_le_reg_l with (IZR b). apply (IZR_lt 0); assumption. replace (IZR b * 1)%R with (IZR b). replace (IZR b*((2 *IZR a)/IZR b))%R with (IZR (2*a)). apply IZR_le;assumption. rewrite mult_IZR;simpl (IZR 2). field. apply Rlt_neq_0; apply (IZR_lt 0);assumption. field. Qed. Theorem prod_R_expand : forall x, positive_coefficients x -> (lift R (af_real_value (prod_R x)) = af_real_value x)%R. intros [a a' b b' c c' v1 v2]; unfold positive_coefficients, af_real_value, prod_R, m_a, m_a', m_b, m_b', m_c, m_c', m_x, m_y. intros H; decompose [and] H; repeat (rewrite mult_IZR || rewrite <- Z_R_minus). simpl (IZR 2). unfold lift, alpha; field. repeat (apply prod_neq_R0|| apply prod_lt_neq_0|| apply Rlt_neq_0 || apply (IZR_lt 0)); auto. fourier. Qed. Theorem prod_C_in_bound : forall x, positive_coefficients x -> (0 <= af_real_value x <= 1)%R -> 4 * (m_a x * m_b' x * m_c' x + m_b x * m_a' x * m_c' x + m_a' x * m_b' x * m_c x) <= 3 * m_a' x * m_b' x * m_c' x -> m_c' x <= 4 * m_c x -> (0 <= af_real_value (prod_C x) <= 1)%R. intros [a a' b b' c c' v1 v2]; unfold positive_coefficients, af_real_value, prod_C, m_a, m_a', m_b, m_b', m_c, m_c', m_x, m_y. intros H Hint Hc1 Hc2; decompose [and] H. generalize (real_value_in01 v1);intros H'; destruct H'. generalize (real_value_in01 v2);intros H'; destruct H'. assert (IZR a' <> 0)%R. apply Rlt_neq_0; apply (IZR_lt 0); assumption. assert (IZR b' <> 0)%R. apply Rlt_neq_0; apply (IZR_lt 0); assumption. assert (IZR c' <> 0)%R. apply Rlt_neq_0; apply (IZR_lt 0); assumption. assert (IZR a'*IZR b'*IZR c' <> 0)%R. repeat apply prod_neq_R0;auto. repeat (rewrite (mult_IZR 2) || rewrite <- Z_R_minus || rewrite (mult_IZR 4) || rewrite <- Rmult_div_assoc || rewrite Rmult_assoc || rewrite <- Rmult_plus_distr_l);auto. split. unfold Rdiv. repeat (assumption || apply Rplus_le_le_0_compat || apply Rmult_le_pos || apply (IZR_le 0) || (apply Rlt_le ; apply Rinv_0_lt_compat; apply (IZR_lt 0)) || omega). rewrite <- mult_IZR; rewrite Z_R_minus; apply (IZR_le 0); omega. apply Rlt_le; apply Rinv_0_lt_compat; apply Rmult_lt_0_compat;apply (IZR_lt 0). omega. assumption. apply Rle_trans with ((4*IZR(a * b' * c' + b * a' * c' + a' * b' * c)/IZR(a'*b'*c')-1)/IZR 2)%R. match goal with |- (?x <= _)%R => replace x with ((4* (IZR(a*b'*c')*real_value v1 +(IZR (b*a'*c')*real_value v2)+ IZR(a'*b'*c))/IZR(a'*b'*c') -1)/IZR 2)%R end. unfold Rdiv; apply Rmult_le_compat_r. apply Rlt_le; apply Rinv_0_lt_compat; apply (IZR_lt 0);omega. unfold Rminus. apply Rplus_le_compat_r. apply Rmult_le_compat_r. apply Rlt_le; apply Rinv_0_lt_compat. apply (IZR_lt 0); repeat apply Zmult_lt_O_compat; auto. apply Rmult_le_compat_l. fourier. repeat (rewrite plus_IZR). repeat apply Rplus_le_compat. match goal with |- (_ <= ?x)%R => pattern x at 2; rewrite <- Rmult_1_r end. apply Rmult_le_compat_l. repeat (rewrite plus_IZR || rewrite mult_IZR); simpl (IZR 2); simpl (IZR 4). repeat (apply Rmult_le_pos || (apply Rlt_le;apply (IZR_lt 0);assumption) || (apply (IZR_le 0); assumption)). assumption. match goal with |- (_ <= ?x)%R => pattern x at 2; rewrite <- Rmult_1_r end. apply Rmult_le_compat_l. repeat (rewrite plus_IZR || rewrite mult_IZR); simpl (IZR 2); simpl (IZR 4). repeat (apply Rmult_le_pos || (apply Rlt_le;apply (IZR_lt 0);assumption) || (apply (IZR_le 0); assumption)). assumption. fourier. repeat (rewrite plus_IZR || rewrite mult_IZR); simpl (IZR 2); simpl (IZR 4). field. repeat (assumption || apply prod_neq_R0 || (apply (not_O_IZR 2);omega)). apply prod_C_in_bound_sup. repeat apply Zmult_lt_O_compat; auto. repeat rewrite Zmult_assoc; auto. Qed. Theorem prod_L_in_bound : forall x, positive_coefficients x -> (0 <= af_real_value x <= 1)%R -> 2 * (m_a x * m_b' x * m_c' x + m_b x * m_a' x * m_c' x + m_a' x * m_b' x * m_c x) <= m_a' x * m_b' x * m_c' x -> (0 <= af_real_value (prod_L x) <= 1)%R. intros [a a' b b' c c' v1 v2]; unfold positive_coefficients, af_real_value, prod_L, m_a, m_a', m_b, m_b', m_c, m_c', m_x, m_y. intros H Hint Hc; decompose [and] H. generalize (real_value_in01 v1);intros H'; destruct H'. generalize (real_value_in01 v2);intros H'; destruct H'. assert (IZR a' <> 0)%R. apply Rlt_neq_0; apply (IZR_lt 0); assumption. assert (IZR b' <> 0)%R. apply Rlt_neq_0; apply (IZR_lt 0); assumption. assert (IZR c' <> 0)%R. apply Rlt_neq_0; apply (IZR_lt 0); assumption. assert (IZR a'*IZR b'*IZR c' <> 0)%R. repeat apply prod_neq_R0;auto. repeat rewrite (mult_IZR 2). split. repeat (apply Rplus_le_le_0_compat||apply Rmult_le_pos|| apply Rdiv_le_0_compat|| apply (IZR_le 0)|| apply (IZR_lt 0)); fourier || (try omega). simpl (IZR 2). repeat (rewrite <- Rmult_div_assoc|| rewrite Rmult_assoc || rewrite <- Rmult_plus_distr_l);auto. assert (Hprodpos: 0 < a'*b'*c'). repeat (apply Zmult_lt_O_compat);assumption. generalize (prod_L_in_bound_sup _ _ Hprodpos Hc). intros Hn. apply Rle_trans with (2 := Hn). match goal with |- (2*?x <= _ )%R => replace x with ((IZR a *IZR b'*IZR c' * real_value v1 + IZR b *IZR a'*IZR c' * real_value v2 + IZR a' *IZR b' *IZR c)/ (IZR a' *IZR b' * IZR c'))%R end. repeat (rewrite mult_IZR || rewrite plus_IZR). unfold Rdiv. repeat rewrite Rmult_assoc. apply Rmult_le_compat_l. fourier. apply Rmult_le_compat_r. repeat rewrite <- mult_IZR. assert (0 < /IZR (a' * (b' * c')))%R. apply Rinv_0_lt_compat;apply (IZR_lt 0). rewrite Zmult_assoc; auto. fourier. apply Rplus_le_compat_r. apply Rplus_le_compat. repeat apply Rmult_le_compat_l; match goal with |- (0 <= IZR ?x)%R => (apply (IZR_le 0);assumption) || (assert (0 < IZR x)%R;[ apply (IZR_lt 0);assumption | fourier]) | |- _ => idtac end. pattern (IZR c') at 2; replace (IZR c') with ((IZR c')*1)%R. apply Rmult_le_compat_l. assert (0 < IZR c')%R;[apply (IZR_lt 0); assumption | fourier]. auto. field. repeat apply Rmult_le_compat_l; match goal with |- (0 <= IZR ?x)%R => (apply (IZR_le 0);assumption) || (assert (0 < IZR x)%R;[ apply (IZR_lt 0);assumption | fourier]) | |- _ => idtac end. pattern (IZR c') at 2; replace (IZR c') with ((IZR c')*1)%R. apply Rmult_le_compat_l;auto. assert (0 < IZR c')%R;[apply (IZR_lt 0); assumption | fourier]. field. field. repeat apply prod_neq_R0;apply Rlt_neq_0;apply (IZR_lt 0);assumption. Qed. Theorem prod_R_in_bound : forall x, positive_coefficients x -> (0 <= af_real_value x <= 1)%R -> m_c' x <= 2 * m_c x -> (0 <= af_real_value (prod_R x) <= 1)%R. intros [a a' b b' c c' v1 v2]; unfold positive_coefficients, af_real_value, prod_R, m_a, m_a', m_b, m_b', m_c, m_c', m_x, m_y. intros H Hint Hc; decompose [and] H. repeat rewrite (mult_IZR 2). split. repeat (apply Rplus_le_le_0_compat||apply Rmult_le_pos|| apply Rdiv_le_0_compat|| apply (IZR_le 0)|| apply (IZR_lt 0)); fourier || (try omega). generalize (real_value_in01 v1);intros [H' H''];assumption. generalize (real_value_in01 v2);intros [H' H''];assumption. match goal with id : (0 <= ?x <= 1)%R |- (?y <= 1)%R => replace y with (2*x-1)%R end. apply prod_R_in_bound_sup;auto. rewrite <- Z_R_minus. rewrite mult_IZR; simpl (IZR 2). field. repeat apply prod_neq_R0; apply Rlt_neq_0; apply (IZR_lt 0);assumption. Qed. Theorem axbyc_consume_decrease : forall x, positive_coefficients x -> m_a' x < 8*m_a x \/ m_b' x < 8*m_b x -> order (axbyc_consume x) x. intros x; case x. unfold positive_coefficients, axbyc_consume, order, affine_measure, m_a, m_a', m_b, m_b', m_c, m_c', m_x, m_y. intros a a' b b' c c' [[ | | ] v1'] [[ | | ] v2'] [Ha [Ha' [Hb [Hb' [Hc Hc']]]]] [Hlt | Hlt]; case (Z_le_gt_dec (8*a-a')(8*b-b')); intros H1; case (Z_le_gt_dec (8*a-2*a')(8*b-2*b')); intros H2; ((rewrite (Zmax_le1 (8*a-a') (8*b-b'));[idtac | omega])|| (try (rewrite (Zmax_le2 (8*a-a')(8*b-b'));[idtac | omega]))); ((rewrite (Zmax_le1 (8*a-2*a') (8*b-2*b'));[idtac | omega])|| (try (rewrite (Zmax_le2 (8*a-2*a')(8*b-2*b'));[idtac | omega]))); match goal with |- Zwf 0 (Zmax 0 ?v) _ => case (Z_le_gt_dec 0 v); intros H3; (rewrite (Zmax_le1 0 v); [idtac | omega]) || (rewrite (Zmax_le2 0 v); [idtac | omega]) end; (rewrite Zmax_le1;[idtac | omega]) || (rewrite Zmax_le2;[idtac | omega]); unfold Zwf; omega. Qed. Theorem formulas_condition1 : forall a a' b b' c c', 0 <= a -> 0 < a' -> 0 <= b -> 0 < b' -> 0 <= c -> 0 < c' -> 8*a <= a' -> 8*b <= b' -> 4*c < c' -> 2*(a*b'*c'+b*a'*c'+a'*b'*c) <= a'*b'*c'. intros a a' b b' c c' Ha Ha' Hb Hb' Hc Hc' H8a H8b H4c. assert (4*(a'*b'*c) <= a'*b'*c'). replace (4*(a'*b'*c)) with (a'*b'*(4*c)). auto with zarith. ring. assert (8*(a*b'*c') <= a'*b'*c'). replace (8*(a*b'*c')) with (8*a*b'*c'). auto with zarith. ring. assert (8*(b*a'*c') <= a'*b'*c'). replace (a'*b'*c') with (b'*a'*c'). replace (8*(b*a'*c')) with (8*b*a'*c'). auto with zarith. ring. ring. assert (4*(a*b'*c'+b*a'*c') <= a'*b'*c'). omega. omega. Qed. Theorem formulas_condition2 : forall a a' b b' c c', 0 <= a -> 0 < a' -> 0 <= b -> 0 < b' -> 0 <= c -> 0 < c' -> 8*a <= a' -> 8*b <= b' -> 4*(a*b'*c'+b*a'*c'+a'*b'*c) > 3*a'*b'*c' -> c' <= 2*c. intros a a' b b' c c' Ha Ha' Hb Hb' Hc Hc' H8a H8b Hbig. case (Z_le_gt_dec c' (2*c)). auto. intros Hc'gt2c. assert (2*a'*b'*c <= a'*b'*c'). replace (2*a'*b'*c) with ((a'*b')*(2*c)). auto with zarith. ring. assert (8*(a*b'*c') <= a'*b'*c'). replace (8*(a*b'*c')) with (8*a*b'*c'). auto with zarith. ring. assert (8*(b*a'*c') <= a'*b'*c'). replace (8*(b*a'*c')) with (8*b*a'*c'). replace (a'*b'*c') with (b'*a'*c'). auto with zarith. ring. ring. assert (4*a*b'*c'+4*b*a'*c' <= a'*b'*c'). replace (4*a*b'*c') with (4*(a*b'*c')). replace (4*b*a'*c') with (4*(b*a'*c')). omega. ring. ring. assert (4*(a*b'*c'+b*a'*c'+a'*b'*c) <= 3*a'*b'*c'). replace (4*(a*b'*c'+b*a'*c'+a'*b'*c)) with ((4*(a*b'*c')+4*(b*a'*c'))+2*(2*a'*b'*c)). replace (3*a'*b'*c') with (a'*b'*c'+2*(a'*b'*c')). omega. ring. ring. omega. Qed. Definition axbyc_test (x:affine_data) : positive_coefficients x -> {m_c' x <= 2*m_c x}+ {2*(m_a x*m_b' x*m_c' x + m_b x*m_a' x*m_c' x + m_a' x*m_b' x*m_c x)<= m_a' x*m_b' x*m_c' x}+ {4*(m_a x*m_b' x*m_c' x + m_b x*m_a' x*m_c' x + m_a' x*m_b' x*m_c x)<= 3*m_a' x*m_b' x*m_c' x /\ m_c' x <= 4*m_c x}+ {m_a' x < 8*m_a x \/ m_b' x < 8*m_b x}. intros x; case x. unfold m_a, m_a', m_b, m_b', m_c, m_c'. intros a a' b b' c c' v1 v2 [Ha [Ha' [Hb [Hb' [Hc Hc']]]]]. case (Z_le_gt_dec c' (2*c)). intros; left; left; left;assumption. intros H2cltc'. case (Z_le_gt_dec (2*(a*b'*c'+ b*a'*c'+a'*b'*c)) (a'*b'*c')). intros; left; left; right; assumption. intros Hdenlt2num. case (Z_le_gt_dec (4*(a*b'*c'+b*a'*c'+a'*b'*c)) (3*a'*b'*c')). intros H4numle3den. case (Z_le_gt_dec c' (4*c)). intros Hc'le4c;left;right;split;assumption. intros H4cltc';right. case (Z_le_gt_dec (8*a) a'). intros H8alea'. case (Z_le_gt_dec (8*b) b'). intros H8bleb'. assert (2*(a*b'*c'+b*a'*c'+a'*b'*c) <= a'*b'*c'). apply formulas_condition1; auto with zarith. omega. intros H8bgtb';right;omega. intros H8agta';left;omega. intros H3denlt4num;right. case (Z_le_gt_dec (8*a) a'). intros H8alea'. case (Z_le_gt_dec (8*b) b'). intros H8bleb'. assert (c' <= 2*c). apply formulas_condition2 with (9:=H3denlt4num);auto with zarith. omega. intros;omega. intros;omega. Qed. Theorem order_wf : well_founded order. exact (wf_inverse_image affine_data Z (Zwf 0) affine_measure (Zwf_well_founded 0)). Qed. Theorem prod_R_pos : forall x, positive_coefficients x -> m_c' x <= 2*m_c x -> positive_coefficients (prod_R x). intros x; case x. unfold positive_coefficients, prod_R, m_a, m_a', m_b, m_b', m_c, m_c'. intros a a' b b' c c' v1 v2 [Ha [Ha' [Hb [Hb' [Hc Hc']]]]] Hle. omega. Qed. Theorem prod_L_pos : forall x, positive_coefficients x -> positive_coefficients (prod_L x). intros x; case x. unfold positive_coefficients, prod_L, m_a, m_a', m_b, m_b', m_c, m_c'. intros a a' b b' c c' [Ha [Ha' [Hb [Hb' [Hc Hc']]]]] Hle. omega. Qed. Theorem prod_C_pos : forall x, positive_coefficients x -> m_c' x <= 4*m_c x -> positive_coefficients (prod_C x). intros x; case x. unfold positive_coefficients, prod_C, m_a, m_a', m_b, m_b', m_c, m_c'. intros a a' b b' c c' v1 v2 [Ha [Ha' [Hb [Hb' [Hc Hc']]]]] Hle. omega. Qed. Theorem axbyc_consume_pos : forall x, positive_coefficients x -> positive_coefficients (axbyc_consume x). intros x; case x. unfold positive_coefficients, axbyc_consume, m_a, m_a', m_b, m_b', m_c, m_c', m_x, m_y. intros a a' b b' c c' [[ | | ] v1'] [[ | | ] v2'] Hpos. repeat (apply conj);try omega. repeat (apply conj);try omega. auto with zarith;fail. repeat (apply Zmult_lt_O_compat); auto with zarith;fail. repeat (apply conj);try omega. repeat (apply Zmult_lt_O_compat); auto with zarith;fail. repeat (apply Zmult_lt_O_compat); auto with zarith;fail. repeat (apply conj);try omega. auto with zarith;fail. repeat (apply Zmult_lt_O_compat); auto with zarith;fail. repeat (apply conj);try omega. auto with zarith;fail. repeat (apply Zmult_lt_O_compat); auto with zarith;fail. repeat (apply conj);try omega. repeat (apply conj);try omega. auto with zarith;fail. repeat (apply Zmult_lt_O_compat); auto with zarith;fail. repeat (apply conj);try omega. auto with zarith;fail. repeat (apply Zmult_lt_O_compat); auto with zarith;fail. repeat (apply conj);try omega. auto with zarith;fail. repeat (apply Zmult_lt_O_compat); auto with zarith;fail. repeat (apply conj);try omega. auto with zarith;fail. repeat (apply Zmult_lt_O_compat); auto with zarith;fail. Qed. Theorem axbyc_consume_same_value : forall x, positive_coefficients x -> same_value x (axbyc_consume x). idtac "starting last proof". assert (H2nonzero : (2 <> 0)%R). apply (not_O_IZR 2); omega. intros [a a' b b' c c' [[ | | ] x] [[ | | ] y]]; unfold positive_coefficients, same_value, af_real_value, axbyc_consume, m_a, m_a', m_b, m_b', m_c, m_c', m_x, m_y; repeat rewrite real_value_lift; unfold lift, alpha; intros Hpos; decompose [and] Hpos; repeat (rewrite mult_IZR || rewrite plus_IZR); replace (IZR 2) with 2%R;try assumption; replace (IZR 4) with 4%R;try apply IZR4; field; repeat apply prod_neq_R0; (apply not_O_IZR; omega) || (try assumption). Qed. End done_proofs.