intros w w'; make_fraction w ipattern:(p) ipattern:(q) ipattern:(Heq);
make_fraction w' ipattern:(p') ipattern:(q') ipattern:(Heq').
intros H H1; generalize (Qpositive_le_to_Qpositive_le' _ _ H1); clear H1.
unfold Qpositive_le', Qpositive_plus, Qpositive_sub in |- *; rewrite Heq;
rewrite Heq'.
intros Hle.
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:(p2) ipattern:(q2)
ipattern:(Heq1) ipattern:(Heq2) ipattern:(Heq3).
rewrite <- (construct_correct _ _ _ (S p + S q) Heq).
apply construct_correct4'; try (simpl in |- *; auto with arith; fail).
apply mult_reg_l with d.
rewrite mult_plus_distr_r.
rewrite <- (mult_assoc (S p2)); rewrite (mult_comm (S p2));
rewrite <- (mult_assoc (S p')); repeat rewrite (mult_comm (S q2));
repeat rewrite (mult_comm (S d)); rewrite mult_plus_distr_r;
repeat rewrite <- mult_assoc.
rewrite <- Heq2; rewrite <- Heq3.
rewrite (mult_assoc (S p) (S q')); rewrite (mult_assoc (S p') (S q)).
rewrite (mult_assoc (S q') (S q)).
rewrite (mult_comm (S q') (S q)); repeat rewrite (mult_comm (S q * S q')).
rewrite <- mult_plus_distr_r.
apply f_equal with (f := fun x : nat => x * (S q * S q')).
symmetry  in |- *.
rewrite plus_comm.
apply le_plus_minus.
assumption.
auto.
apply lt_le_S.
case le_lt_or_eq with (1 := Hle).
omega.
intros Heq1; elim H;
rewrite <- construct_correct with (n := S p + S q) (1 := Heq);
auto.
rewrite <- construct_correct with (n := S p' + S q') (1 := Heq'); auto.
apply construct_correct4'; auto with *.
apply plus_le_compat_r.
eapply le_trans; [ eapply le_minus | apply le_plus_l ].
Qed.

Theorem Qpositive_sub_le :
forall w w' : Qpositive,
w <> w' -> Qpositive_le w' w -> Qpositive_le (Qpositive_sub w w') w.