(* Ugly tacty to resolve sign condition for R *)
Require Export RGroundTac.
(* Theorems to simplify the goal 0 ? x * y and x * y ? 0 where ? is < > <= >= *)
intros x y H; apply Rmult_le_pos; auto with real.
Qed.
intros x y H1 H2; replace (x * y)%R with (-x * -y)%R; auto with real; try ring.
apply Rmult_le_pos; auto with real.
Qed.
intros x H; rewrite <- (Ropp_involutive 0);  rewrite <- (Ropp_involutive x); auto with real.
apply Ropp_le_contravar; auto with real.
rewrite Ropp_0; auto with real.
Qed.
intros x y H1 H2; apply Rle_pos_neg; replace (- (x * y))%R with (x * (- y))%R; auto with real; try ring.
apply Rmult_le_pos; auto with real.
Qed.
intros x y H1 H2; apply Rle_pos_neg; replace (- (x * y))%R with (-x * y)%R; auto with real; try ring.
apply Rmult_le_pos; auto with real.
Qed.
intros; apply Rmult_lt_0_compat; auto with real.
Qed.
intros x y H1 H2; replace (x * y)%R with (-x * -y)%R; auto with real; try ring.
apply Rmult_lt_0_compat; auto with real.
Qed.
intros x H; rewrite <- (Ropp_involutive 0);  rewrite <- (Ropp_involutive x); auto with real.
apply Ropp_lt_contravar; auto with real.
rewrite Ropp_0; auto with real.
Qed.
intros x y H1 H2; apply Rlt_pos_neg; replace (- (x * y))%R with (x * (- y))%R; auto with real; try ring.
apply Rmult_lt_0_compat; auto.
replace 0%R with (-0)%R; auto with real.
Qed.
intros x y H1 H2; apply Rlt_pos_neg; replace (- (x * y))%R with (-x * y)%R; auto with real; try ring.
apply Rmult_lt_0_compat; auto with real.
Qed.
intros; apply Rle_ge; apply Rle_sign_neg_neg; auto with real.
Qed.
intros; apply Rle_ge; apply Rle_sign_pos_pos; auto with real.
Qed.
intros x H; rewrite <- (Ropp_involutive 0);  rewrite <- (Ropp_involutive x); auto with real.
apply Rle_ge;apply Ropp_le_contravar; auto with real.
rewrite Ropp_0; auto with real.
Qed.
intros; apply Rle_ge; apply Rle_sign_neg_pos; auto with real.
Qed.
intros; apply Rle_ge; apply Rle_sign_pos_neg; auto with real.
Qed.
intros; red;  apply Rlt_sign_neg_neg; auto with real.
Qed.
intros; red; apply Rlt_sign_pos_pos; auto with real.
Qed.
intros x H; rewrite <- (Ropp_involutive 0);  rewrite <- (Ropp_involutive x); auto with real.
red;apply Ropp_lt_contravar; auto with real.
rewrite Ropp_0; auto with real.
Qed.
intros; red; apply Rlt_sign_neg_pos; auto with real.
Qed.
intros; red; apply Rlt_sign_pos_neg; auto with real.
Qed.
(* Theorems to simplify the hyp 0 ? x * y and x * y ? 0 where ? is < > <= >= *)
intros x y H1 H2; case (Rle_or_lt 0 y); auto with real.
intros H3; absurd (0 <= x * y)%R; auto with real.
apply Rlt_not_le;apply Rlt_sign_pos_neg; auto.
Qed.
intros x y H1 H2; case (Rle_or_lt y  0); auto with real.
intros H3; absurd (0 <= x * y)%R; auto with real.
apply Rlt_not_le;apply Rlt_sign_neg_pos; auto.
Qed.
intros x y H1 H2; case (Rle_or_lt y 0); auto with real.
intros H3; absurd (x * y <= 0)%R; auto with real.
apply Rlt_not_le;apply Rlt_sign_pos_pos; auto.
Qed.
intros x y H1 H2; case (Rle_or_lt 0 y); auto with real.
intros H3; absurd (x * y <= 0)%R; auto with real.
apply Rlt_not_le;apply Rlt_sign_neg_neg; auto.
Qed.
intros x y H1 H2; apply Rle_ge; apply Rle_sign_pos_pos_rev with x; auto with real.
Qed.
intros x y H1 H2; apply Rle_ge; apply Rle_sign_neg_neg_rev with x; auto with real.
Qed.
intros x y H1 H2; apply Rle_ge; apply Rle_sign_pos_neg_rev with x; auto with real.
Qed.
intros x y H1 H2; apply Rle_ge; apply Rle_sign_neg_pos_rev with x; auto with real.
Qed.
intros x y H1 H2; case (Rle_or_lt y 0); auto with real.
intros H3; absurd (0 < x * y)%R; auto with real.
apply Rle_not_lt;apply Rle_sign_pos_neg; auto with real.
Qed.
intros x y H1 H2; case (Rle_or_lt 0 y); auto with real.
intros H3; absurd (0 < x * y)%R; auto with real.
apply Rle_not_lt;apply Rle_sign_neg_pos; auto with real.
Qed.
intros x y H1 H2; case (Rle_or_lt 0 y); auto with real.
intros H3; absurd (x * y < 0)%R; auto with real.
apply Rle_not_lt;apply Rle_sign_pos_pos; auto with real.
Qed.
intros x y H1 H2; case (Rle_or_lt y 0); auto with real.
intros H3; absurd (x * y < 0)%R; auto with real.
apply Rle_not_lt;apply Rle_sign_neg_neg; auto with real.
Qed.
intros x y H1 H2; red; apply Rlt_sign_pos_pos_rev with x; auto with real.
Qed.
intros x y H1 H2; red; apply Rlt_sign_neg_neg_rev with x; auto with real.
Qed.
intros x y H1 H2; red; apply Rlt_sign_pos_neg_rev with x; auto with real.
Qed.
intros x y H1 H2; red; apply Rlt_sign_neg_pos_rev with x; auto with real.
Qed.
(* Theorem to simplify x * y ? x * z where ? is < > <= >= *)
auto with real.
Qed.
intros n m p H1 H2; replace (p * n)%R with (-(-p * n))%R; auto with real; try ring.
replace (p * m)%R with (-(-p * m))%R; auto with real; try ring.
Qed.
auto with real.
Qed.
intros n m p H1 H2; replace (p * n)%R with (-(-p * n))%R; auto with real; try ring.
replace (p * m)%R with (-(-p * m))%R; auto with real; try ring.
Qed.
auto with real.
Qed.
intros n m p H H1; apply Rle_ge; auto with real.
Qed.
intros n m p H1 H2; replace (p * n)%R with (-(-p * n))%R; auto with real; try ring.
replace (p * m)%R with (-(-p * m))%R; auto with real;try ring.
Qed.
auto with real.
Qed.
unfold Rgt; auto with real.
Qed.
intros n m p H1 H2; replace (p * n)%R with (-(-p * n))%R; auto with real; try ring.
replace (p * m)%R with (-(-p * m))%R; auto with real; try ring.
Qed.
(* Theorem to simplify a hyp x * y ? x * z where ? is < > <= >= *)
intros n m p H H1; case (Rle_or_lt n m); auto; intros H2.
absurd (p * n <= p * m)%R; auto with real.
apply Rlt_not_le; apply Rmult_lt_compat_l; auto.
Qed.
intros n m p H H1; case (Rle_or_lt m n); auto; intros H2.
absurd (p * n <= p * m)%R; auto with real.
apply Rlt_not_le; apply Rmult_lt_neg_compat_l; auto.
Qed.
intros n m p H H1; case (Rle_or_lt m n); auto; intros H2.
absurd (p * n < p * m)%R; auto with real.
apply Rle_not_lt; apply Rmult_le_compat_l; auto with real.
Qed.
intros n m p H H1; case (Rle_or_lt n m); auto; intros H2.
absurd (p * n < p * m)%R; auto with real.
apply Rle_not_lt; apply Rmult_le_neg_compat_l; auto with real.
Qed.
intros n m p H H1;
apply Rle_ge; apply Rmult_le_compat_l_rev with p; auto with real.
Qed.

Theorem Rmult_ge_neg_compat_l_rev:
forall n m p : R, (0 > p)%R -> (p * n >= p * m)%R -> (m >= n)%R.