summaryrefslogtreecommitdiff
path: root/theories/ZArith/Zcompare.v
diff options
context:
space:
mode:
Diffstat (limited to 'theories/ZArith/Zcompare.v')
-rw-r--r--theories/ZArith/Zcompare.v501
1 files changed, 501 insertions, 0 deletions
diff --git a/theories/ZArith/Zcompare.v b/theories/ZArith/Zcompare.v
new file mode 100644
index 00000000..714abfc4
--- /dev/null
+++ b/theories/ZArith/Zcompare.v
@@ -0,0 +1,501 @@
+(************************************************************************)
+(* v * The Coq Proof Assistant / The Coq Development Team *)
+(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
+(* \VV/ **************************************************************)
+(* // * This file is distributed under the terms of the *)
+(* * GNU Lesser General Public License Version 2.1 *)
+(************************************************************************)
+
+(*i $$ i*)
+
+Require Export BinPos.
+Require Export BinInt.
+Require Import Lt.
+Require Import Gt.
+Require Import Plus.
+Require Import Mult.
+
+Open Local Scope Z_scope.
+
+(**********************************************************************)
+(** Binary Integers (Pierre Crégut, CNET, Lannion, France) *)
+(**********************************************************************)
+
+(**********************************************************************)
+(** Comparison on integers *)
+
+Lemma Zcompare_refl : forall n:Z, (n ?= n) = Eq.
+Proof.
+intro x; destruct x as [| p| p]; simpl in |- *;
+ [ reflexivity | apply Pcompare_refl | rewrite Pcompare_refl; reflexivity ].
+Qed.
+
+Lemma Zcompare_Eq_eq : forall n m:Z, (n ?= m) = Eq -> n = m.
+Proof.
+intros x y; destruct x as [| x'| x']; destruct y as [| y'| y']; simpl in |- *;
+ intro H; reflexivity || (try discriminate H);
+ [ rewrite (Pcompare_Eq_eq x' y' H); reflexivity
+ | rewrite (Pcompare_Eq_eq x' y');
+ [ reflexivity
+ | destruct ((x' ?= y')%positive Eq); reflexivity || discriminate ] ].
+Qed.
+
+Lemma Zcompare_Eq_iff_eq : forall n m:Z, (n ?= m) = Eq <-> n = m.
+Proof.
+intros x y; split; intro E;
+ [ apply Zcompare_Eq_eq; assumption | rewrite E; apply Zcompare_refl ].
+Qed.
+
+Lemma Zcompare_antisym : forall n m:Z, CompOpp (n ?= m) = (m ?= n).
+Proof.
+intros x y; destruct x; destruct y; simpl in |- *;
+ reflexivity || discriminate H || rewrite Pcompare_antisym;
+ reflexivity.
+Qed.
+
+Lemma Zcompare_Gt_Lt_antisym : forall n m:Z, (n ?= m) = Gt <-> (m ?= n) = Lt.
+Proof.
+intros x y; split; intro H;
+ [ change Lt with (CompOpp Gt) in |- *; rewrite <- Zcompare_antisym;
+ rewrite H; reflexivity
+ | change Gt with (CompOpp Lt) in |- *; rewrite <- Zcompare_antisym;
+ rewrite H; reflexivity ].
+Qed.
+
+(** Transitivity of comparison *)
+
+Lemma Zcompare_Gt_trans :
+ forall n m p:Z, (n ?= m) = Gt -> (m ?= p) = Gt -> (n ?= p) = Gt.
+Proof.
+intros x y z; case x; case y; case z; simpl in |- *;
+ try (intros; discriminate H || discriminate H0); auto with arith;
+ [ intros p q r H H0; apply nat_of_P_gt_Gt_compare_complement_morphism;
+ unfold gt in |- *; apply lt_trans with (m := nat_of_P q);
+ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1;
+ assumption
+ | intros p q r; do 3 rewrite <- ZC4; intros H H0;
+ apply nat_of_P_gt_Gt_compare_complement_morphism;
+ unfold gt in |- *; apply lt_trans with (m := nat_of_P q);
+ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1;
+ assumption ].
+Qed.
+
+(** Comparison and opposite *)
+
+Lemma Zcompare_opp : forall n m:Z, (n ?= m) = (- m ?= - n).
+Proof.
+intros x y; case x; case y; simpl in |- *; auto with arith; intros;
+ rewrite <- ZC4; trivial with arith.
+Qed.
+
+Hint Local Resolve Pcompare_refl.
+
+(** Comparison first-order specification *)
+
+Lemma Zcompare_Gt_spec :
+ forall n m:Z, (n ?= m) = Gt -> exists h : positive, n + - m = Zpos h.
+Proof.
+intros x y; case x; case y;
+ [ simpl in |- *; intros H; discriminate H
+ | simpl in |- *; intros p H; discriminate H
+ | intros p H; exists p; simpl in |- *; auto with arith
+ | intros p H; exists p; simpl in |- *; auto with arith
+ | intros q p H; exists (p - q)%positive; unfold Zplus, Zopp in |- *;
+ unfold Zcompare in H; rewrite H; trivial with arith
+ | intros q p H; exists (p + q)%positive; simpl in |- *; trivial with arith
+ | simpl in |- *; intros p H; discriminate H
+ | simpl in |- *; intros q p H; discriminate H
+ | unfold Zcompare in |- *; intros q p; rewrite <- ZC4; intros H;
+ exists (q - p)%positive; simpl in |- *; rewrite (ZC1 q p H);
+ trivial with arith ].
+Qed.
+
+(** Comparison and addition *)
+
+Lemma weaken_Zcompare_Zplus_compatible :
+ (forall (n m:Z) (p:positive), (Zpos p + n ?= Zpos p + m) = (n ?= m)) ->
+ forall n m p:Z, (p + n ?= p + m) = (n ?= m).
+Proof.
+intros H x y z; destruct z;
+ [ reflexivity
+ | apply H
+ | rewrite (Zcompare_opp x y); rewrite Zcompare_opp;
+ do 2 rewrite Zopp_plus_distr; rewrite Zopp_neg;
+ apply H ].
+Qed.
+
+Hint Local Resolve ZC4.
+
+Lemma weak_Zcompare_Zplus_compatible :
+ forall (n m:Z) (p:positive), (Zpos p + n ?= Zpos p + m) = (n ?= m).
+Proof.
+intros x y z; case x; case y; simpl in |- *; auto with arith;
+ [ intros p; apply nat_of_P_lt_Lt_compare_complement_morphism; apply ZL17
+ | intros p; ElimPcompare z p; intros E; rewrite E; auto with arith;
+ apply nat_of_P_gt_Gt_compare_complement_morphism;
+ rewrite nat_of_P_minus_morphism;
+ [ unfold gt in |- *; apply ZL16 | assumption ]
+ | intros p; ElimPcompare z p; intros E; auto with arith;
+ apply nat_of_P_gt_Gt_compare_complement_morphism;
+ unfold gt in |- *; apply ZL17
+ | intros p q; ElimPcompare q p; intros E; rewrite E;
+ [ rewrite (Pcompare_Eq_eq q p E); apply Pcompare_refl
+ | apply nat_of_P_lt_Lt_compare_complement_morphism;
+ do 2 rewrite nat_of_P_plus_morphism; apply plus_lt_compat_l;
+ apply nat_of_P_lt_Lt_compare_morphism with (1 := E)
+ | apply nat_of_P_gt_Gt_compare_complement_morphism; unfold gt in |- *;
+ do 2 rewrite nat_of_P_plus_morphism; apply plus_lt_compat_l;
+ exact (nat_of_P_gt_Gt_compare_morphism q p E) ]
+ | intros p q; ElimPcompare z p; intros E; rewrite E; auto with arith;
+ apply nat_of_P_gt_Gt_compare_complement_morphism;
+ rewrite nat_of_P_minus_morphism;
+ [ unfold gt in |- *; apply lt_trans with (m := nat_of_P z);
+ [ apply ZL16 | apply ZL17 ]
+ | assumption ]
+ | intros p; ElimPcompare z p; intros E; rewrite E; auto with arith;
+ simpl in |- *; apply nat_of_P_lt_Lt_compare_complement_morphism;
+ rewrite nat_of_P_minus_morphism; [ apply ZL16 | assumption ]
+ | intros p q; ElimPcompare z q; intros E; rewrite E; auto with arith;
+ simpl in |- *; apply nat_of_P_lt_Lt_compare_complement_morphism;
+ rewrite nat_of_P_minus_morphism;
+ [ apply lt_trans with (m := nat_of_P z); [ apply ZL16 | apply ZL17 ]
+ | assumption ]
+ | intros p q; ElimPcompare z q; intros E0; rewrite E0; ElimPcompare z p;
+ intros E1; rewrite E1; ElimPcompare q p; intros E2;
+ rewrite E2; auto with arith;
+ [ absurd ((q ?= p)%positive Eq = Lt);
+ [ rewrite <- (Pcompare_Eq_eq z q E0);
+ rewrite <- (Pcompare_Eq_eq z p E1); rewrite (Pcompare_refl z);
+ discriminate
+ | assumption ]
+ | absurd ((q ?= p)%positive Eq = Gt);
+ [ rewrite <- (Pcompare_Eq_eq z q E0);
+ rewrite <- (Pcompare_Eq_eq z p E1); rewrite (Pcompare_refl z);
+ discriminate
+ | assumption ]
+ | absurd ((z ?= p)%positive Eq = Lt);
+ [ rewrite (Pcompare_Eq_eq z q E0); rewrite <- (Pcompare_Eq_eq q p E2);
+ rewrite (Pcompare_refl q); discriminate
+ | assumption ]
+ | absurd ((z ?= p)%positive Eq = Lt);
+ [ rewrite (Pcompare_Eq_eq z q E0); rewrite E2; discriminate
+ | assumption ]
+ | absurd ((z ?= p)%positive Eq = Gt);
+ [ rewrite (Pcompare_Eq_eq z q E0); rewrite <- (Pcompare_Eq_eq q p E2);
+ rewrite (Pcompare_refl q); discriminate
+ | assumption ]
+ | absurd ((z ?= p)%positive Eq = Gt);
+ [ rewrite (Pcompare_Eq_eq z q E0); rewrite E2; discriminate
+ | assumption ]
+ | absurd ((z ?= q)%positive Eq = Lt);
+ [ rewrite (Pcompare_Eq_eq z p E1); rewrite (Pcompare_Eq_eq q p E2);
+ rewrite (Pcompare_refl p); discriminate
+ | assumption ]
+ | absurd ((p ?= q)%positive Eq = Gt);
+ [ rewrite <- (Pcompare_Eq_eq z p E1); rewrite E0; discriminate
+ | apply ZC2; assumption ]
+ | simpl in |- *; rewrite (Pcompare_Eq_eq q p E2);
+ rewrite (Pcompare_refl (p - z)); auto with arith
+ | simpl in |- *; rewrite <- ZC4;
+ apply nat_of_P_gt_Gt_compare_complement_morphism;
+ rewrite nat_of_P_minus_morphism;
+ [ rewrite nat_of_P_minus_morphism;
+ [ unfold gt in |- *; apply plus_lt_reg_l with (p := nat_of_P z);
+ rewrite le_plus_minus_r;
+ [ rewrite le_plus_minus_r;
+ [ apply nat_of_P_lt_Lt_compare_morphism; assumption
+ | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
+ assumption ]
+ | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
+ assumption ]
+ | apply ZC2; assumption ]
+ | apply ZC2; assumption ]
+ | simpl in |- *; rewrite <- ZC4;
+ apply nat_of_P_lt_Lt_compare_complement_morphism;
+ rewrite nat_of_P_minus_morphism;
+ [ rewrite nat_of_P_minus_morphism;
+ [ apply plus_lt_reg_l with (p := nat_of_P z);
+ rewrite le_plus_minus_r;
+ [ rewrite le_plus_minus_r;
+ [ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1;
+ assumption
+ | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
+ assumption ]
+ | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
+ assumption ]
+ | apply ZC2; assumption ]
+ | apply ZC2; assumption ]
+ | absurd ((z ?= q)%positive Eq = Lt);
+ [ rewrite (Pcompare_Eq_eq q p E2); rewrite E1; discriminate
+ | assumption ]
+ | absurd ((q ?= p)%positive Eq = Lt);
+ [ cut ((q ?= p)%positive Eq = Gt);
+ [ intros E; rewrite E; discriminate
+ | apply nat_of_P_gt_Gt_compare_complement_morphism;
+ unfold gt in |- *; apply lt_trans with (m := nat_of_P z);
+ [ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; assumption
+ | apply nat_of_P_lt_Lt_compare_morphism; assumption ] ]
+ | assumption ]
+ | absurd ((z ?= q)%positive Eq = Gt);
+ [ rewrite (Pcompare_Eq_eq z p E1); rewrite (Pcompare_Eq_eq q p E2);
+ rewrite (Pcompare_refl p); discriminate
+ | assumption ]
+ | absurd ((z ?= q)%positive Eq = Gt);
+ [ rewrite (Pcompare_Eq_eq z p E1); rewrite ZC1;
+ [ discriminate | assumption ]
+ | assumption ]
+ | absurd ((z ?= q)%positive Eq = Gt);
+ [ rewrite (Pcompare_Eq_eq q p E2); rewrite E1; discriminate
+ | assumption ]
+ | absurd ((q ?= p)%positive Eq = Gt);
+ [ rewrite ZC1;
+ [ discriminate
+ | apply nat_of_P_gt_Gt_compare_complement_morphism;
+ unfold gt in |- *; apply lt_trans with (m := nat_of_P z);
+ [ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; assumption
+ | apply nat_of_P_lt_Lt_compare_morphism; assumption ] ]
+ | assumption ]
+ | simpl in |- *; rewrite (Pcompare_Eq_eq q p E2); apply Pcompare_refl
+ | simpl in |- *; apply nat_of_P_gt_Gt_compare_complement_morphism;
+ unfold gt in |- *; rewrite nat_of_P_minus_morphism;
+ [ rewrite nat_of_P_minus_morphism;
+ [ apply plus_lt_reg_l with (p := nat_of_P p);
+ rewrite le_plus_minus_r;
+ [ rewrite plus_comm; apply plus_lt_reg_l with (p := nat_of_P q);
+ rewrite plus_assoc; rewrite le_plus_minus_r;
+ [ rewrite (plus_comm (nat_of_P q)); apply plus_lt_compat_l;
+ apply nat_of_P_lt_Lt_compare_morphism;
+ assumption
+ | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
+ apply ZC1; assumption ]
+ | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
+ apply ZC1; assumption ]
+ | assumption ]
+ | assumption ]
+ | simpl in |- *; apply nat_of_P_lt_Lt_compare_complement_morphism;
+ rewrite nat_of_P_minus_morphism;
+ [ rewrite nat_of_P_minus_morphism;
+ [ apply plus_lt_reg_l with (p := nat_of_P q);
+ rewrite le_plus_minus_r;
+ [ rewrite plus_comm; apply plus_lt_reg_l with (p := nat_of_P p);
+ rewrite plus_assoc; rewrite le_plus_minus_r;
+ [ rewrite (plus_comm (nat_of_P p)); apply plus_lt_compat_l;
+ apply nat_of_P_lt_Lt_compare_morphism;
+ apply ZC1; assumption
+ | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
+ apply ZC1; assumption ]
+ | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
+ apply ZC1; assumption ]
+ | assumption ]
+ | assumption ] ] ].
+Qed.
+
+Lemma Zcompare_plus_compat : forall n m p:Z, (p + n ?= p + m) = (n ?= m).
+Proof.
+exact (weaken_Zcompare_Zplus_compatible weak_Zcompare_Zplus_compatible).
+Qed.
+
+Lemma Zplus_compare_compat :
+ forall (r:comparison) (n m p q:Z),
+ (n ?= m) = r -> (p ?= q) = r -> (n + p ?= m + q) = r.
+Proof.
+intros r x y z t; case r;
+ [ intros H1 H2; elim (Zcompare_Eq_iff_eq x y); elim (Zcompare_Eq_iff_eq z t);
+ intros H3 H4 H5 H6; rewrite H3;
+ [ rewrite H5;
+ [ elim (Zcompare_Eq_iff_eq (y + t) (y + t)); auto with arith
+ | auto with arith ]
+ | auto with arith ]
+ | intros H1 H2; elim (Zcompare_Gt_Lt_antisym (y + t) (x + z)); intros H3 H4;
+ apply H3; apply Zcompare_Gt_trans with (m := y + z);
+ [ rewrite Zcompare_plus_compat; elim (Zcompare_Gt_Lt_antisym t z);
+ auto with arith
+ | do 2 rewrite <- (Zplus_comm z); rewrite Zcompare_plus_compat;
+ elim (Zcompare_Gt_Lt_antisym y x); auto with arith ]
+ | intros H1 H2; apply Zcompare_Gt_trans with (m := x + t);
+ [ rewrite Zcompare_plus_compat; assumption
+ | do 2 rewrite <- (Zplus_comm t); rewrite Zcompare_plus_compat;
+ assumption ] ].
+Qed.
+
+Lemma Zcompare_succ_Gt : forall n:Z, (Zsucc n ?= n) = Gt.
+Proof.
+intro x; unfold Zsucc in |- *; pattern x at 2 in |- *;
+ rewrite <- (Zplus_0_r x); rewrite Zcompare_plus_compat;
+ reflexivity.
+Qed.
+
+Lemma Zcompare_Gt_not_Lt : forall n m:Z, (n ?= m) = Gt <-> (n ?= m + 1) <> Lt.
+Proof.
+intros x y; split;
+ [ intro H; elim_compare x (y + 1);
+ [ intro H1; rewrite H1; discriminate
+ | intros H1; elim Zcompare_Gt_spec with (1 := H); intros h H2;
+ absurd ((nat_of_P h > 0)%nat /\ (nat_of_P h < 1)%nat);
+ [ unfold not in |- *; intros H3; elim H3; intros H4 H5;
+ absurd (nat_of_P h > 0)%nat;
+ [ unfold gt in |- *; apply le_not_lt; apply le_S_n; exact H5
+ | assumption ]
+ | split;
+ [ elim (ZL4 h); intros i H3; rewrite H3; apply gt_Sn_O
+ | change (nat_of_P h < nat_of_P 1)%nat in |- *;
+ apply nat_of_P_lt_Lt_compare_morphism;
+ change ((Zpos h ?= 1) = Lt) in |- *; rewrite <- H2;
+ rewrite <- (fun m n:Z => Zcompare_plus_compat m n y);
+ rewrite (Zplus_comm x); rewrite Zplus_assoc;
+ rewrite Zplus_opp_r; simpl in |- *; exact H1 ] ]
+ | intros H1; rewrite H1; discriminate ]
+ | intros H; elim_compare x (y + 1);
+ [ intros H1; elim (Zcompare_Eq_iff_eq x (y + 1)); intros H2 H3;
+ rewrite (H2 H1); exact (Zcompare_succ_Gt y)
+ | intros H1; absurd ((x ?= y + 1) = Lt); assumption
+ | intros H1; apply Zcompare_Gt_trans with (m := Zsucc y);
+ [ exact H1 | exact (Zcompare_succ_Gt y) ] ] ].
+Qed.
+
+(** Successor and comparison *)
+
+Lemma Zcompare_succ_compat : forall n m:Z, (Zsucc n ?= Zsucc m) = (n ?= m).
+Proof.
+intros n m; unfold Zsucc in |- *; do 2 rewrite (fun t:Z => Zplus_comm t 1);
+ rewrite Zcompare_plus_compat; auto with arith.
+Qed.
+
+(** Multiplication and comparison *)
+
+Lemma Zcompare_mult_compat :
+ forall (p:positive) (n m:Z), (Zpos p * n ?= Zpos p * m) = (n ?= m).
+Proof.
+intros x; induction x as [p H| p H| ];
+ [ intros y z; cut (Zpos (xI p) = Zpos p + Zpos p + 1);
+ [ intros E; rewrite E; do 4 rewrite Zmult_plus_distr_l;
+ do 2 rewrite Zmult_1_l; apply Zplus_compare_compat;
+ [ apply Zplus_compare_compat; apply H | trivial with arith ]
+ | simpl in |- *; rewrite (Pplus_diag p); trivial with arith ]
+ | intros y z; cut (Zpos (xO p) = Zpos p + Zpos p);
+ [ intros E; rewrite E; do 2 rewrite Zmult_plus_distr_l;
+ apply Zplus_compare_compat; apply H
+ | simpl in |- *; rewrite (Pplus_diag p); trivial with arith ]
+ | intros y z; do 2 rewrite Zmult_1_l; trivial with arith ].
+Qed.
+
+
+(** Reverting [x ?= y] to trichotomy *)
+
+Lemma rename :
+ forall (A:Set) (P:A -> Prop) (x:A), (forall y:A, x = y -> P y) -> P x.
+Proof.
+auto with arith.
+Qed.
+
+Lemma Zcompare_elim :
+ forall (c1 c2 c3:Prop) (n m:Z),
+ (n = m -> c1) ->
+ (n < m -> c2) ->
+ (n > m -> c3) -> match n ?= m with
+ | Eq => c1
+ | Lt => c2
+ | Gt => c3
+ end.
+Proof.
+intros c1 c2 c3 x y; intros.
+apply rename with (x := x ?= y); intro r; elim r;
+ [ intro; apply H; apply (Zcompare_Eq_eq x y); assumption
+ | unfold Zlt in H0; assumption
+ | unfold Zgt in H1; assumption ].
+Qed.
+
+Lemma Zcompare_eq_case :
+ forall (c1 c2 c3:Prop) (n m:Z),
+ c1 -> n = m -> match n ?= m with
+ | Eq => c1
+ | Lt => c2
+ | Gt => c3
+ end.
+Proof.
+intros c1 c2 c3 x y; intros.
+rewrite H0; rewrite Zcompare_refl.
+assumption.
+Qed.
+
+(** Decompose an egality between two [?=] relations into 3 implications *)
+
+Lemma Zcompare_egal_dec :
+ forall n m p q:Z,
+ (n < m -> p < q) ->
+ ((n ?= m) = Eq -> (p ?= q) = Eq) ->
+ (n > m -> p > q) -> (n ?= m) = (p ?= q).
+Proof.
+intros x1 y1 x2 y2.
+unfold Zgt in |- *; unfold Zlt in |- *; case (x1 ?= y1); case (x2 ?= y2);
+ auto with arith; symmetry in |- *; auto with arith.
+Qed.
+
+(** Relating [x ?= y] to [Zle], [Zlt], [Zge] or [Zgt] *)
+
+Lemma Zle_compare :
+ forall n m:Z,
+ n <= m -> match n ?= m with
+ | Eq => True
+ | Lt => True
+ | Gt => False
+ end.
+Proof.
+intros x y; unfold Zle in |- *; elim (x ?= y); auto with arith.
+Qed.
+
+Lemma Zlt_compare :
+ forall n m:Z,
+ n < m -> match n ?= m with
+ | Eq => False
+ | Lt => True
+ | Gt => False
+ end.
+Proof.
+intros x y; unfold Zlt in |- *; elim (x ?= y); intros;
+ discriminate || trivial with arith.
+Qed.
+
+Lemma Zge_compare :
+ forall n m:Z,
+ n >= m -> match n ?= m with
+ | Eq => True
+ | Lt => False
+ | Gt => True
+ end.
+Proof.
+intros x y; unfold Zge in |- *; elim (x ?= y); auto with arith.
+Qed.
+
+Lemma Zgt_compare :
+ forall n m:Z,
+ n > m -> match n ?= m with
+ | Eq => False
+ | Lt => False
+ | Gt => True
+ end.
+Proof.
+intros x y; unfold Zgt in |- *; elim (x ?= y); intros;
+ discriminate || trivial with arith.
+Qed.
+
+(**********************************************************************)
+(* Other properties *)
+
+
+Lemma Zmult_compare_compat_l :
+ forall n m p:Z, p > 0 -> (n ?= m) = (p * n ?= p * m).
+Proof.
+intros x y z H; destruct z.
+ discriminate H.
+ rewrite Zcompare_mult_compat; reflexivity.
+ discriminate H.
+Qed.
+
+Lemma Zmult_compare_compat_r :
+ forall n m p:Z, p > 0 -> (n ?= m) = (n * p ?= m * p).
+Proof.
+intros x y z H; rewrite (Zmult_comm x z); rewrite (Zmult_comm y z);
+ apply Zmult_compare_compat_l; assumption.
+Qed.
+