(* This program is free software; you can redistribute it and/or      *)
(* modify it under the terms of the GNU Lesser General Public License *)
(* as published by the Free Software Foundation; either version 2.1   *)
(* of the License, or (at your option) any later version.             *)
(*                                                                    *)
(* This program is distributed in the hope that it will be useful,    *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of     *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the      *)
(* GNU General Public License for more details.                       *)
(*                                                                    *)
(* You should have received a copy of the GNU Lesser General Public   *)
(* License along with this program; if not, write to the Free         *)
(* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *)
(* 02110-1301 USA                                                     *)
Require Export Qpositive_order.
Definition Qpositive_sub (w w' : Qpositive) :=
let (p, q) := Qpositive_i w in
let (p', q') := Qpositive_i w' in
Qpositive_c (p * q' - p' * q) (q * q') (p * q' + p' * q + q * q').
intros x y z.
elim (le_or_lt z y).
intros H;
generalize ((fun m n p : nat => mult_le_compat_l p n m) (S x) _ _ H).
intros H1 H2; elim (le_not_gt _ _ H1); auto.
auto.
Qed.
intros w w'.
elim (interp_non_zero w); intros p Hex; elim Hex; intros q Heq; clear Hex.
elim (interp_non_zero w'); intros p' Hex; elim Hex; intros q' Heq'; clear Hex.
unfold Qpositive_sub, Qpositive_plus in |- *.
rewrite Heq; rewrite Heq'.
elim
(construct_correct2' (S p * S q' + S p' * S q + S q * S q')
(S p * S q' + S p' * S q) (S q * S q')).
intros d;
elim
(interp_non_zero
(Qpositive_c (S p * S q' + S p' * S q) (S q * S q')
(S p * S q' + S p' * S q + S q * S q'))); intros p3 Hex;
elim Hex; intros q3 Heq3; rewrite Heq3; intros (Heq1, Heq2);
clear Hex.
rewrite <- (construct_correct _ _ _ (S p + S q) Heq).
apply construct_correct4'; try (simpl in |- *; auto with arith; fail).
unfold fst, snd in Heq1, Heq2.
apply lt_le_S.
apply lt_mult_conv with d.
rewrite <- mult_n_O.
unfold lt in |- *.
rewrite (mult_comm (S d)).
rewrite mult_minus_distr_r.
rewrite (mult_comm (S p3)); repeat rewrite <- mult_assoc.
rewrite <- Heq2; rewrite <- Heq1.
rewrite (mult_comm (S q')); rewrite mult_plus_distr_r.
rewrite plus_comm.
rewrite <- mult_assoc.
rewrite minus_plus.
simpl in |- *; auto with arith.
apply plus_le_compat_r.
apply le_plus_trans.
apply le_minus.
unfold fst, snd in Heq1, Heq2.
apply mult_reg_l with d.
rewrite mult_minus_distr_r; rewrite (mult_comm (S d));
repeat
(rewrite (mult_comm (S q3)) || rewrite (mult_comm (S p3));
repeat rewrite <- mult_assoc); repeat rewrite mult_minus_distr_r.
repeat rewrite (mult_comm (S d)); repeat rewrite <- mult_assoc.
rewrite <- Heq1; rewrite <- Heq2.
rewrite (mult_comm (S q)); rewrite (mult_comm (S q'));
repeat rewrite mult_plus_distr_r.
repeat rewrite mult_assoc.
rewrite plus_comm; apply minus_plus.
auto.
simpl in |- *; auto with arith.
simpl in |- *; auto with arith.
auto.
Qed.
intros a b c H; generalize c; clear c; elim H.
rewrite <- minus_n_n; auto with arith.
intros a' Hle Hrec c H1.
inversion H1.
intros H2; rewrite (le_minus_O _ _ H2).
auto with arith.
auto with *.
Qed.
intros a b c H; generalize c; clear c; elim H.
rewrite <- minus_n_n; simpl in |- *; auto with arith.
intros b' Hle Hrec c H1; inversion H1; clear H1.
intros H2; rewrite (le_minus_O _ _ H2); auto with arith.
repeat rewrite <- minus_Sn_m; auto with arith.
Qed.
intros w w' w''; make_fraction w ipattern:(p) ipattern:(q) ipattern:(Heq);
make_fraction w' ipattern:(p') ipattern:(q') ipattern:(Heq');
make_fraction w'' ipattern:(p'') ipattern:(q'') ipattern:(Heq'');
intros Hneq1 Hneq2.
intros H H1 H2; apply Qpositive_le'_to_Qpositive_le;
generalize (Qpositive_le_to_Qpositive_le' _ _ H)
(Qpositive_le_to_Qpositive_le' _ _ H1)
(Qpositive_le_to_Qpositive_le' _ _ H2); clear H H1 H2.
unfold Qpositive_le', Qpositive_sub in |- *; simpl in |- *; rewrite Heq;
rewrite Heq'; rewrite Heq''.
intros Hle Hle1 Hle2.
expand (S p'' * S q - S p * S q'') (S q'' * S q)
(S p'' * S q + S p * S q'' + S q'' * S q) ipattern:(d) ipattern:(p3) ipattern:(q3)
ipattern:(Heq3) ipattern:(Heq1) ipattern:(Heq2).
expand (S p'' * S q' - S p' * S q'') (S q'' * S q')
(S p'' * S q' + S p' * S q'' + S q'' * S q') ipattern:(d') ipattern:(p4)
ipattern:(q4) ipattern:(Heq4) ipattern:(Heq5) ipattern:(Heq6).
apply mult_S_le_reg_l with d'.
repeat rewrite (mult_comm (S d')); rewrite (mult_comm (S p4));
repeat rewrite <- mult_assoc.
rewrite <- Heq5; rewrite <- Heq6.
apply mult_S_le_reg_l with d; repeat rewrite mult_assoc;
repeat rewrite (mult_comm (S d)).
rewrite <- Heq1; rewrite <- Heq2.
rewrite mult_comm.
rewrite <- mult_assoc.
repeat rewrite mult_minus_distr_r.
repeat rewrite (mult_comm (S q'')).
repeat rewrite <- (mult_assoc (S p'')).
rewrite (mult_assoc (S q')).
rewrite (mult_assoc (S q)).
rewrite (mult_comm (S q) (S q')).
apply le_minus_left.
rewrite <- (mult_assoc (S q')).
rewrite (mult_assoc (S p'')).
repeat rewrite <- (mult_comm (S q * S q'')).
replace (S q * S q'') with (S (q'' + q * S q'')).
apply (fun m n p : nat => mult_le_compat_l p n m).
exact Hle1.
auto.
repeat rewrite <- (mult_comm (S q')) || rewrite mult_assoc.
repeat rewrite <- mult_assoc;
apply (fun m n p : nat => mult_le_compat_l p n m).
repeat rewrite mult_assoc; repeat rewrite <- (mult_comm (S q''));
apply (fun m n p : nat => mult_le_compat_l p n m).
rewrite (mult_comm (S q'')); exact Hle.
repeat rewrite mult_assoc; repeat rewrite <- (mult_comm (S q''));
apply (fun m n p : nat => mult_le_compat_l p n m).
repeat rewrite <- mult_assoc;
apply (fun m n p : nat => mult_le_compat_l p n m).
exact Hle2.
case (le_gt_dec (S p'' * S q') (S p' * S q'')).
intros l; try assumption.
elim Hneq2.
rewrite <- (construct_correct w' (S p') (S q') (S p' + S q')); auto with *.
rewrite <- (construct_correct w'' (S p'') (S q'') (S p'' + S q''));
auto with *.
apply construct_correct4'; auto with arith.
CaseEq (S p'' * S q' - S p' * S q'').
intros Dummy Dummy2; generalize (minus_O_le _ _ Dummy); intros Dummy1;
elim (le_not_gt _ _ Dummy1 Dummy2).
auto with arith.
apply plus_le_compat_r.
eapply le_trans; [ eapply minus_le | auto with arith ].
case (le_gt_dec (S p'' * S q) (S p * S q'')).
intros l; try assumption.
elim Hneq1.
rewrite <- (construct_correct w (S p) (S q) (S p + S q)); auto with *.
rewrite <- (construct_correct w'' (S p'') (S q'') (S p'' + S q''));
auto with *.
apply construct_correct4'; auto with arith.
CaseEq (S p'' * S q - S p * S q'').
intros Dummy Dummy2; generalize (minus_O_le _ _ Dummy); intros Dummy1;
elim (le_not_gt _ _ Dummy1 Dummy2).
auto with arith.
apply plus_le_compat_r.
eapply le_trans; [ eapply minus_le | auto with arith ].
Qed.
intros w w' w''; make_fraction w ipattern:(p) ipattern:(q) ipattern:(Heq);
make_fraction w' ipattern:(p') ipattern:(q') ipattern:(Heq');
make_fraction w'' ipattern:(p'') ipattern:(q'') ipattern:(Heq'');
intros Hneq1 Hneq2.
intros H H1 H2; apply Qpositive_le'_to_Qpositive_le;
generalize (Qpositive_le_to_Qpositive_le' _ _ H)
(Qpositive_le_to_Qpositive_le' _ _ H1)
(Qpositive_le_to_Qpositive_le' _ _ H2); clear H H1 H2.
unfold Qpositive_le', Qpositive_sub in |- *; simpl in |- *; rewrite Heq;
rewrite Heq'; rewrite Heq''.
intros Hle Hle1 Hle2.
expand (S p * S q'' - S p'' * S q) (S q * S q'')
(S p * S q'' + S p'' * S q + S q * S q'') ipattern:(d) ipattern:(p3) ipattern:(q3)
ipattern:(Heq3) ipattern:(Heq1) ipattern:(Heq2).
expand (S p' * S q'' - S p'' * S q') (S q' * S q'')
(S p' * S q'' + S p'' * S q' + S q' * S q'') ipattern:(d') ipattern:(p4)
ipattern:(q4) ipattern:(Heq4) ipattern:(Heq5) ipattern:(Heq6).
apply mult_S_le_reg_l with d'.
repeat rewrite (mult_comm (S d')); rewrite (mult_comm (S p4));
repeat rewrite <- mult_assoc.
rewrite <- Heq5; rewrite <- Heq6.
apply mult_S_le_reg_l with d; repeat rewrite mult_assoc;
repeat rewrite (mult_comm (S d)).
rewrite <- Heq1; rewrite <- Heq2.
repeat rewrite mult_minus_distr_r.
rewrite (mult_comm (S q * S q'')).
rewrite mult_minus_distr_r.
replace (S p'' * S q * S q' * S q'') with (S p'' * S q' * (S q * S q'')).
apply le_minus_right.
repeat rewrite <- (mult_comm (S q')); repeat rewrite <- mult_assoc;
apply (fun m n p : nat => mult_le_compat_l p n m).
repeat rewrite mult_assoc; repeat rewrite <- (mult_comm (S q''));
apply (fun m n p : nat => mult_le_compat_l p n m).
rewrite <- (mult_comm (S p)); assumption.
repeat rewrite <- (mult_comm (S q * S q''));
apply (fun m n p : nat => mult_le_compat_l p n m);
assumption.
repeat rewrite mult_assoc; repeat rewrite <- (mult_comm (S q''));
apply (fun m n p : nat => mult_le_compat_l p n m).
repeat rewrite <- mult_assoc;
apply (fun m n p : nat => mult_le_compat_l p n m).
assumption.
ring.
elim (le_gt_dec (S p' * S q'') (S p'' * S q')).
intros a; try assumption.
elim Hneq2.
rewrite <- (construct_correct w' (S p') (S q') (S p' + S q')); auto with *.
rewrite <- (construct_correct w'' (S p'') (S q'') (S p'' + S q''));
auto with *.
apply construct_correct4'; auto with arith.
CaseEq (S p' * S q'' - S p'' * S q').
intros Dummy Dummy2; generalize (minus_O_le _ _ Dummy); intros Dummy1;
elim (le_not_gt _ _ Dummy1 Dummy2).
auto with arith.
apply plus_le_compat_r.
eapply le_trans; [ eapply minus_le | auto with arith ].
case (le_gt_dec (S p * S q'') (S p'' * S q)).
intros l; try assumption.
elim Hneq1.
rewrite <- (construct_correct w (S p) (S q) (S p + S q)); auto with *.
rewrite <- (construct_correct w'' (S p'') (S q'') (S p'' + S q''));
auto with *.
apply construct_correct4'; auto with arith.
CaseEq (S p * S q'' - S p'' * S q).
intros Dummy Dummy2; generalize (minus_O_le _ _ Dummy); intros Dummy1;
elim (le_not_gt _ _ Dummy1 Dummy2).
auto with arith.
apply plus_le_compat_r.
eapply le_trans; [ eapply minus_le | auto with arith ].
Qed.

Theorem Qpositive_mult_minus_distr :
forall w w' w'' : Qpositive,
w <> w' ->
Qpositive_le w w' ->
Qpositive_mult (Qpositive_sub w' w) w'' =
Qpositive_sub (Qpositive_mult w' w'') (Qpositive_mult w w'').