(* $Id: Q_COrdField.v,v 1.7 2000/11/01 15:54:56 milad Exp $ *)

Require Export Q_CField. 
Require Export COrdFields.
Load Transparent_algebra.


(* Summary:
  1- Definition of Order on Q.
  2_ proving that Q is a COrdField.
  3- Q is archemaedian.
*)


Definition Qlt:=[x,y:Q]
   `(numerator x)*((denominator y)+1)<(numerator y)*((denominator x)+1)`.


Lemma Zgt_mult_conv_absorb_l: (a,x,y:Z)`a<0`->`a*x>a*y`->`x<y`.
Intros.
Case (dec_eq x y).
Intro.
Apply False_ind.
Rewrite H1 in H0.
Cut (`a*y=a*y`).
Change (`a*y<>a*y`).
Apply Zgt_not_eq.
Assumption.
Trivial.

Intro.
Case (not_Zeq x y H1).
Trivial.

Intro.
Apply False_ind.
Cut (`a*y>a*x`).
Apply Zgt_not_sym with m:=`a*y` n:=`a*x`.
Assumption.
Apply Zlt_conv_mult_l.
Assumption.
Assumption.
Qed.

Lemma Zgt_mult_reg_absorb_l:(a,x,y:Z)`a>0`->`a*x>a*y`->`x>y`.
Intros.
Cut (`(Zopp (Zopp a))>(Zopp (Zopp 0))`).
Intro.
Cut (`(-a)<(Zopp 0)`).
Simpl.
Intro.
Replace x with (Zopp (Zopp x)).
Replace y with (Zopp (Zopp y)).
Apply Zlt_opp.
Apply Zgt_mult_conv_absorb_l with a:=`-a` x:=`-x`.
Assumption.
Rewrite Zmult_Zopp_Zopp.
Rewrite Zmult_Zopp_Zopp.
Assumption.
Apply Zopp_Zopp.
Apply Zopp_Zopp.
Apply Zgt_lt.
Apply Zlt_opp.
Apply Zgt_lt.
Assumption.
Simpl.
Rewrite Zopp_Zopp.
Assumption.
Qed.


Lemma ajib:(m,n,p:nat;a,b,c:Z)`a*(n+1)<b*(m+1)`->`b*(p+1)=c*(n+1)`->
`a*(p+1)<c*(m+1)`.
Intros.
Case (dec_eq b `0`).
Intro.
Rewrite H1 in H0.
Simpl in H0.
Cut (`c=0`).
Intro.
Rewrite H2.
Rewrite H1 in H.
Simpl in H.
Simpl.
Apply Zgt_lt.
Cut (`a*0>a*(p+1)`).
Intro.
Rewrite Zero_mult_right in H3.
Assumption.
Apply Zlt_conv_mult_l.
Apply Zgt_lt.
Cut ( `(Zopp 0) > (Zopp (Zopp a))`).
Simpl.
Rewrite Zopp_Zopp.
Trivial.
Apply Zlt_opp.
Apply Zmult_lt with x:=`(n+1)`.
Change (`(Zs n) > 0`).
Rewrite <- inj_S.
Change (`(inject_nat (S n)) > (inject_nat O)`).
Apply inj_gt.
Apply gt_Sn_O.
Apply Zgt_lt.
Rewrite Zopp_Zmult.
Cut (`(-(a*(n+1))) > (Zopp 0)`).
Simpl.
Trivial.
Apply Zlt_opp.
Assumption.
Change (`0 < (Zs p)`).
Rewrite <- inj_S.
Change (`(inject_nat O) < (inject_nat (S p))`).
Apply inj_lt.
Apply lt_O_Sn.
Apply Zmult_eq with x:=`(n+1)`.
Apply Zgt_not_eq.
Change (`(Zs n) > (inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.
Apply sym_eq.
Assumption.

Intro.
Case (not_Zeq b `0` H1).

(* y<0 *)
Intro.
Cut (`b*(p+1)<0`).
Intro.
Cut (`b*(p+1)*
     (a*(n+1)) > 
     b*(p+1)*
     (b*(m+1))`).
Intro.
Cut ( `b*(p+1)*(a*
       (n+1)) > c*
       (n+1)*(b*
       (m+1))`).
Intro.
Apply Zgt_lt.
Apply Zgt_mult_reg_absorb_l with a:=`n+1`.
Change (`(Zs n)>(inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.
Apply Zlt_gt.
Apply Zgt_mult_conv_absorb_l with a:=b.
Assumption.

Rewrite Zmult_permute with m:=a.
Rewrite Zmult_sym with x:=`(n+1)`.
Rewrite Zmult_permute with n:=a.
Rewrite Zmult_assoc.
Rewrite Zmult_assoc with z:=`(m+1)`.
Rewrite Zmult_assoc with z:=`(m+1)`.
Rewrite Zmult_permute with p:=c.
Rewrite Zmult_sym with y:=c.
Rewrite Zmult_permute with m:=c.
Rewrite Zmult_assoc with x:=c.
Rewrite <- Zmult_assoc with y:=b.
Assumption.

Rewrite <- H0.
Rewrite <- Zmult_assoc with x:=b.
Rewrite <- Zmult_assoc with x:=b.
Apply Zlt_conv_mult_l with x:=b.
Assumption.

Apply Zlt_reg_mult_l with x:=`(p+1)`. 
Change (`(Zs p) > (inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.
Assumption.

Rewrite <- Zmult_assoc with x:=b.
Rewrite <- Zmult_assoc with x:=b.
Apply Zlt_conv_mult_l with x:=b.
Assumption.

Apply Zlt_reg_mult_l with x:=`(p+1)`. 
Change (`(Zs p) > (inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.
Assumption.

Apply Zgt_lt.
Replace `0` with `b*0`.
Apply Zlt_conv_mult_l with x:=b.
Assumption.

Apply Zgt_lt.
Change (`(Zs p) > (inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.

Rewrite Zero_mult_right.
Trivial.

(* y>0 *)
Intro.
Cut (`b*(p+1)>0`).
Intro.
Cut (`b*(p+1)*
     (a*(n+1)) < 
     b*(p+1)*
     (b*(m+1))`).
Intro.
Cut ( `b*(p+1)*(a*
       (n+1)) < c*
       (n+1)*(b*
       (m+1))`).
Intro.
Apply Zgt_lt.
Apply Zgt_mult_reg_absorb_l with a:=`n+1`.
Change (`(Zs n)>(inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.
Apply Zgt_mult_reg_absorb_l with a:=b.
Apply Zlt_gt.
Assumption.

Apply Zlt_gt.
Rewrite Zmult_permute with m:=a.
Rewrite Zmult_sym with x:=`(n+1)`.
Rewrite Zmult_permute with n:=a.
Rewrite Zmult_assoc.
Rewrite Zmult_assoc with z:=`(m+1)`.
Rewrite Zmult_assoc with z:=`(m+1)`.
Rewrite Zmult_permute with p:=c.
Rewrite Zmult_sym with y:=c.
Rewrite Zmult_permute with m:=c.
Rewrite Zmult_assoc with x:=c.
Rewrite <- Zmult_assoc with y:=b.
Assumption.

Rewrite <- H0.
Rewrite <- Zmult_assoc with x:=b.
Rewrite <- Zmult_assoc with x:=b.
Apply Zlt_reg_mult_l with x:=b.
Apply Zlt_gt.
Assumption.

Apply Zlt_reg_mult_l with x:=`(p+1)`. 
Change (`(Zs p) > (inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.
Assumption.

Rewrite <- Zmult_assoc with x:=b.
Rewrite <- Zmult_assoc with x:=b.
Apply Zlt_reg_mult_l with x:=b.
Apply Zlt_gt.
Assumption.

Apply Zlt_reg_mult_l with x:=`(p+1)`. 
Change (`(Zs p) > (inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.
Assumption.

Apply Zlt_gt.
Replace `0` with `b*0`.
Apply Zlt_reg_mult_l with x:=b.
Apply Zlt_gt.
Assumption.

Apply Zgt_lt.
Change (`(Zs p) > (inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.

Rewrite Zero_mult_right.
Trivial.
Qed.




Remark Qlt_is_well_defined_right:(rel_well_def_rht Q_as_CSetoid  Qlt).
Red.
Intros.

Red in H.

Red.
Apply ajib with a:=(numerator x) b:=(numerator y) c:=(numerator z) 
              m:=(denominator x) n:=(denominator y) p:=(denominator z).
Assumption.
Change (EqQ y z).
Simpl in H0.
Assumption.
Qed.



Remark Qlt_is_well_defined_left:(rel_well_def_lft Q_as_CSetoid Qlt).
Red.
Intros.
Simpl in H0.
Red in H.
Red in H0.
Red.
Rewrite <- Zopp_Zopp with x:=`(numerator z)*((inject_nat (denominator
y))+1)`.
Rewrite <- Zopp_Zopp with x:=`(numerator y)*((inject_nat (denominator
z))+1)`.
Apply Zgt_lt.
Apply Zlt_opp.
Rewrite <- Zopp_Zmult with x:=(numerator y) 
                           y:=`(inject_nat (denominator z))+1`.
Rewrite <- Zopp_Zmult with x:=(numerator z) 
                           y:=`(inject_nat (denominator y))+1`.
Apply ajib with a:=`-(numerator y)` b:=`-(numerator x)` c:=`-(numerator
z)`
           m:=(denominator y) n:=(denominator x) p:=(denominator z).
Apply Zgt_lt.
Rewrite Zopp_Zmult.
Rewrite Zopp_Zmult.
Apply Zlt_opp.
Assumption.
Rewrite Zopp_Zmult.
Rewrite Zopp_Zmult.
Apply (f_equal Z Z Zopp `((numerator x)*((inject_nat (denominator z))+1))`
                        `((numerator z)*((inject_nat (denominator
x))+1))`).
Assumption.
Qed.

Remark Qlt_is_extensional:(rel_strong_ext Q_as_CSetoid Qlt).
Red.
Intros.
Case (dec_EqQ x2 y2).
Intro.
Right.
Case (dec_EqQ y2 y1).
Intro.
Left.
Simpl.
Intro.
Cut (EqQ x1 y2).
Intro.
Cut (Qlt y2 y1).
Intro.
Red in H1.
Red in H4.
Exact (Zlt_not_eq `(numerator y2)*((inject_nat (denominator y1))+1)`  
                  `(numerator y1)*((inject_nat (denominator y2))+1)` H4
H1).
Cut (rel_well_def_lft Q_as_CSetoid Qlt).
Intro.
Red in H4.
Apply H4 with x:=x1 y:=y1 z:=y2.
Assumption.
Assumption.
Exact Qlt_is_well_defined_left.
Apply trans_equalQ with y:=x2.
Assumption.
Assumption.
Intro.
Right.
Simpl.
Apply ap_Q2.
Assumption.
Intro.
Unfold EqQ in H0.
Case (not_Zeq `(numerator x2)*((inject_nat (denominator y2))+1)`
              `(numerator y2)*((inject_nat (denominator x2))+1)` H0).
Intro.
Change (Qlt x2 y2) in H1.
Left.
Assumption.
Intro.
Right.
Case (dec_EqQ y1 y2).
Intro.
Left.
Cut (Qlt x1 y2).
Intro.
Cut (Qlt x1 x2).
Intro.
Red in H4.
Simpl.
Intro.
Unfold EqQ in H5.
Exact (Zlt_not_eq `(numerator x1)*((inject_nat (denominator x2))+1)`
                  `(numerator x2)*((inject_nat (denominator x1))+1)` H4
H5).
Red in H3.
Red.
Case (dec_eq (numerator x1) `0`). 


(* x1=0 *)

Intro.
Rewrite H4.
Simpl.
Rewrite H4 in H3.
Simpl in H3.
Rewrite <- Zero_mult_right with x:=`((inject_nat (denominator x1))+1)`.
Rewrite Zmult_sym with x:=(numerator x2).
Apply Zlt_reg_mult_l.

Change (`(Zs (inject_nat (denominator x1))) >(inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.

Apply Zgt_lt.
Apply Zgt_mult_reg_absorb_l with a:=`((inject_nat (denominator y2))+1)`.


Change (`(Zs (inject_nat (denominator y2))) >(inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.

Rewrite Zmult_sym.
Rewrite Zero_mult_right.
Apply Zgt_trans with m:=`(numerator y2)*((inject_nat (denominator
x2))+1)`.

Apply Zlt_gt.
Assumption.

Rewrite Zmult_sym.
Apply Zlt_gt.
Rewrite <- Zero_mult_right with x:=`((inject_nat (denominator x2))+1)`.
Apply Zlt_reg_mult_l.

Change (`(Zs (inject_nat (denominator x2))) >(inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.

Apply Zgt_lt.
Apply Zgt_mult_reg_absorb_l with a:=`((inject_nat (denominator x1))+1)`.

Change (`(Zs (inject_nat (denominator x1))) >(inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.

Rewrite Zero_mult_right.
Apply Zlt_gt.
Rewrite Zmult_sym.
Assumption.

Intro.
Case (not_Zeq (numerator x1) `0` H4).

(* x1 < 0 *)
Intro.
Case (dec_eq (numerator x2) `0`).

 (* x1 < 0 , x2 = 0 *)
Intro.
Rewrite H6.
Simpl.
Rewrite <- Zero_mult_right with x:=(numerator x1).
Apply Zgt_lt.
Apply Zlt_conv_mult_l.

Assumption.

Change (`(inject_nat O) < (Zs (inject_nat (denominator x2)))`).
Rewrite <- inj_S.
Apply inj_lt.
Apply lt_O_Sn.

Intro.
Case (not_Zeq (numerator x2) `0` H6).

 (* x1 < 0 , x2 < 0 *)
Intro.
Apply Zgt_mult_conv_absorb_l with a:=(numerator y2). 
Apply Zgt_lt.
Apply Zgt_mult_reg_absorb_l with a:=`((inject_nat (denominator x2))+1)`.

Change (`(Zs (inject_nat (denominator x2))) >(inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.

Apply Zgt_trans with m:=`(numerator x2)*((inject_nat (denominator
y2))+1)`.
Rewrite Zero_mult_right.
Apply Zlt_gt.
Rewrite <- Zero_mult_right with x:=`((inject_nat (denominator y2))+1)`.
Rewrite Zmult_sym.
Apply Zlt_reg_mult_l.

Change (`(Zs (inject_nat (denominator y2))) >(inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.

Assumption.

Apply Zlt_gt.
Rewrite Zmult_sym.
Assumption.

Apply Zgt_trans with m:=`(numerator x1)*(numerator x2)
                        *((inject_nat (denominator y2))+1)`.
Rewrite Zmult_assoc.
Rewrite Zmult_sym with x:=(numerator y2).
Rewrite <- Zmult_assoc.
Rewrite <- Zmult_assoc.
Apply Zlt_conv_mult_l.

Assumption.

Assumption.

Rewrite Zmult_sym with x:=(numerator x1).
Rewrite Zmult_assoc.
Rewrite Zmult_sym with x:=(numerator y2).
Rewrite <- Zmult_assoc.
Rewrite <- Zmult_assoc.
Apply Zlt_conv_mult_l.

Assumption.

Assumption.

 (* x1 < 0 , x2 > 0 *)

Intro.
Apply Zgt_lt.
Apply Zgt_trans with m:=`0`.
Apply Zlt_gt.
Rewrite Zmult_sym.
Rewrite <- Zero_mult_right with x:=`((inject_nat (denominator x1))+1)`.
Apply Zlt_reg_mult_l.

Change (`(Zs (inject_nat (denominator x1))) >(inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.

Assumption.

Rewrite Zmult_sym.
Rewrite <- Zero_mult_right with x:=`((inject_nat (denominator x2))+1)`.
Apply Zlt_gt.
Apply Zlt_reg_mult_l.

Change (`(Zs (inject_nat (denominator x2))) >(inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.

Assumption.

(* x1 > 0 *)
Intro.
Apply Zgt_lt.
Apply Zgt_mult_reg_absorb_l with a:=(numerator y2).
Apply Zgt_mult_reg_absorb_l with a:=`((inject_nat (denominator x1))+1)`.

Change (`(Zs (inject_nat (denominator x1))) >(inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.

Apply Zgt_trans with m:=`(numerator x1)*((inject_nat (denominator
y2))+1)`.

Rewrite Zmult_sym.
Apply Zlt_gt.
Assumption.

Rewrite Zero_mult_right.
Rewrite <- Zero_mult_right with x:=`((inject_nat (denominator y2))+1)`.
Rewrite Zmult_sym.
Apply Zlt_gt.
Apply Zlt_reg_mult_l.

Change (`(Zs (inject_nat (denominator y2))) >(inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.

Assumption.

Apply Zgt_trans with m:=`(numerator x1)*(numerator x2)
                        *((inject_nat (denominator y2))+1)`.
Rewrite Zmult_assoc.
Rewrite Zmult_sym with x:=(numerator y2).
Rewrite Zmult_sym with x:=(numerator x1).
Rewrite <- Zmult_assoc.
Rewrite <- Zmult_assoc.
Apply Zlt_gt.
Apply Zlt_reg_mult_l.

Apply Zgt_mult_reg_absorb_l with a:=`((inject_nat (denominator y2))+1)`.

Change (`(Zs (inject_nat (denominator y2))) >(inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.

Apply Zgt_trans with m:=`(numerator y2)*((inject_nat (denominator
x2))+1)`.

Rewrite Zmult_sym.
Apply Zlt_gt.
Assumption.

Rewrite Zero_mult_right.
Rewrite <- Zero_mult_right with x:=`((inject_nat (denominator x2))+1)`.
Rewrite Zmult_sym.
Apply Zlt_gt.
Apply Zlt_reg_mult_l.

Change (`(Zs (inject_nat (denominator x2))) >(inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.

Apply Zgt_lt.
Apply Zgt_mult_reg_absorb_l with a:=`((inject_nat (denominator x1))+1)`.

Change (`(Zs (inject_nat (denominator x1))) >(inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.

Apply Zgt_trans with m:=`(numerator x1)*((inject_nat (denominator
y2))+1)`.

Rewrite Zmult_sym.
Apply Zlt_gt.
Assumption.

Rewrite Zero_mult_right.
Rewrite <- Zero_mult_right with x:=`((inject_nat (denominator y2))+1)`.
Rewrite Zmult_sym.
Apply Zlt_gt.
Apply Zlt_reg_mult_l.

Change (`(Zs (inject_nat (denominator y2))) >(inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.

Assumption.

Assumption.

Rewrite Zmult_assoc.
Rewrite Zmult_sym with x:=(numerator y2).
Rewrite <- Zmult_assoc.
Rewrite <- Zmult_assoc.
Apply Zlt_gt.
Apply Zlt_reg_mult_l.

Apply Zlt_gt.
Assumption.

Assumption.

Cut (rel_well_def_rht Q_as_CSetoid Qlt).
Intro.
Red in H3.
Apply H3 with x:=x1 y:=y1 z:=y2.
Assumption.
Assumption.
Exact Qlt_is_well_defined_right.
Intro.
Right.
Assumption.
Qed.



Definition Qlt_is_CSetoid_relation :=(!Build_CSetoid_relation Q_as_CSetoid 
Qlt Qlt_is_well_defined_right Qlt_is_well_defined_left
Qlt_is_extensional).

(*
Definition Q_as_COrdField_sig:=(!Build_COrdField_sig Q_as_CField 
                                 Qlt_is_CSetoid_relation).
*)
(* We made the signature for our order structure, now we prove the
properties 
   of order *)

Remark Qlt_is_transitive:(transitive Q Qlt).
Red.
Intros.
Red.
Red in H.
Red in H0.
Case (dec_eq (numerator x) `0`). 


(* x=0 *)

Intro.
Rewrite H1.
Simpl.
Rewrite H1 in H.
Simpl in H.
Rewrite <- Zero_mult_right with x:=`((inject_nat (denominator x))+1)`.
Rewrite Zmult_sym with x:=(numerator z).
Apply Zlt_reg_mult_l.

Change (`(Zs (inject_nat (denominator x))) >(inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.

Apply Zgt_lt.
Apply Zgt_mult_reg_absorb_l with a:=`((inject_nat (denominator y))+1)`.


Change (`(Zs (inject_nat (denominator y))) >(inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.

Rewrite Zmult_sym.
Rewrite Zero_mult_right.
Apply Zgt_trans with m:=`(numerator y)*((inject_nat (denominator z))+1)`.

Apply Zlt_gt.
Assumption.

Rewrite Zmult_sym.
Apply Zlt_gt.
Rewrite <- Zero_mult_right with x:=`((inject_nat (denominator z))+1)`.
Apply Zlt_reg_mult_l.

Change (`(Zs (inject_nat (denominator z))) >(inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.

Apply Zgt_lt.
Apply Zgt_mult_reg_absorb_l with a:=`((inject_nat (denominator x))+1)`.

Change (`(Zs (inject_nat (denominator x))) >(inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.

Rewrite Zero_mult_right.
Apply Zlt_gt.
Rewrite Zmult_sym.
Assumption.

Intro.
Case (not_Zeq (numerator x) `0` H1).

(* x < 0 *)
Intro.
Case (dec_eq (numerator z) `0`).

 (* x < 0 , z = 0 *)
Intro.
Rewrite H3.
Simpl.
Rewrite <- Zero_mult_right with x:=(numerator x).
Apply Zgt_lt.
Apply Zlt_conv_mult_l.

Assumption.

Change (`(inject_nat O) < (Zs (inject_nat (denominator z)))`).
Rewrite <- inj_S.
Apply inj_lt.
Apply lt_O_Sn.

Intro.
Case (not_Zeq (numerator z) `0` H3).

 (* x < 0 , z < 0 *)
Intro.
Apply Zgt_mult_conv_absorb_l with a:=(numerator y). 
Apply Zgt_lt.
Apply Zgt_mult_reg_absorb_l with a:=`((inject_nat (denominator z))+1)`.

Change (`(Zs (inject_nat (denominator z))) >(inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.

Apply Zgt_trans with m:=`(numerator z)*((inject_nat (denominator y))+1)`.
Rewrite Zero_mult_right.
Apply Zlt_gt.
Rewrite <- Zero_mult_right with x:=`((inject_nat (denominator y))+1)`.
Rewrite Zmult_sym.
Apply Zlt_reg_mult_l.

Change (`(Zs (inject_nat (denominator y))) >(inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.

Assumption.

Apply Zlt_gt.
Rewrite Zmult_sym.
Assumption.

Apply Zgt_trans with m:=`(numerator x)*(numerator z)
                        *((inject_nat (denominator y))+1)`.
Rewrite Zmult_assoc.
Rewrite Zmult_sym with x:=(numerator y).
Rewrite <- Zmult_assoc.
Rewrite <- Zmult_assoc.
Apply Zlt_conv_mult_l.

Assumption.

Assumption.

Rewrite Zmult_sym with x:=(numerator x).
Rewrite Zmult_assoc.
Rewrite Zmult_sym with x:=(numerator y).
Rewrite <- Zmult_assoc.
Rewrite <- Zmult_assoc.
Apply Zlt_conv_mult_l.

Assumption.

Assumption.

 (* x < 0 , z > 0 *)

Intro.
Apply Zgt_lt.
Apply Zgt_trans with m:=`0`.
Apply Zlt_gt.
Rewrite Zmult_sym.
Rewrite <- Zero_mult_right with x:=`((inject_nat (denominator x))+1)`.
Apply Zlt_reg_mult_l.

Change (`(Zs (inject_nat (denominator x))) >(inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.

Assumption.

Rewrite Zmult_sym.
Rewrite <- Zero_mult_right with x:=`((inject_nat (denominator z))+1)`.
Apply Zlt_gt.
Apply Zlt_reg_mult_l.

Change (`(Zs (inject_nat (denominator z))) >(inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.

Assumption.

(* x > 0 *)
Intro.
Apply Zgt_lt.
Apply Zgt_mult_reg_absorb_l with a:=(numerator y).
Apply Zgt_mult_reg_absorb_l with a:=`((inject_nat (denominator x))+1)`.

Change (`(Zs (inject_nat (denominator x))) >(inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.

Apply Zgt_trans with m:=`(numerator x)*((inject_nat (denominator y))+1)`.

Rewrite Zmult_sym.
Apply Zlt_gt.
Assumption.

Rewrite Zero_mult_right.
Rewrite <- Zero_mult_right with x:=`((inject_nat (denominator y))+1)`.
Rewrite Zmult_sym.
Apply Zlt_gt.
Apply Zlt_reg_mult_l.

Change (`(Zs (inject_nat (denominator y))) >(inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.

Assumption.

Apply Zgt_trans with m:=`(numerator x)*(numerator z)
                        *((inject_nat (denominator y))+1)`.
Rewrite Zmult_assoc.
Rewrite Zmult_sym with x:=(numerator y).
Rewrite Zmult_sym with x:=(numerator x).
Rewrite <- Zmult_assoc.
Rewrite <- Zmult_assoc.
Apply Zlt_gt.
Apply Zlt_reg_mult_l.

Apply Zgt_mult_reg_absorb_l with a:=`((inject_nat (denominator y))+1)`.

Change (`(Zs (inject_nat (denominator y))) >(inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.

Apply Zgt_trans with m:=`(numerator y)*((inject_nat (denominator z))+1)`.

Rewrite Zmult_sym.
Apply Zlt_gt.
Assumption.

Rewrite Zero_mult_right.
Rewrite <- Zero_mult_right with x:=`((inject_nat (denominator z))+1)`.
Rewrite Zmult_sym.
Apply Zlt_gt.
Apply Zlt_reg_mult_l.

Change (`(Zs (inject_nat (denominator z))) >(inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.

Apply Zgt_lt.
Apply Zgt_mult_reg_absorb_l with a:=`((inject_nat (denominator x))+1)`.

Change (`(Zs (inject_nat (denominator x))) >(inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.

Apply Zgt_trans with m:=`(numerator x)*((inject_nat (denominator y))+1)`.

Rewrite Zmult_sym.
Apply Zlt_gt.
Assumption.

Rewrite Zero_mult_right.
Rewrite <- Zero_mult_right with x:=`((inject_nat (denominator y))+1)`.
Rewrite Zmult_sym.
Apply Zlt_gt.
Apply Zlt_reg_mult_l.

Change (`(Zs (inject_nat (denominator y))) >(inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.

Assumption.

Assumption.

Rewrite Zmult_assoc.
Rewrite Zmult_sym with x:=(numerator y).
Rewrite <- Zmult_assoc.
Rewrite <- Zmult_assoc.
Apply Zlt_gt.
Apply Zlt_reg_mult_l.

Apply Zlt_gt.
Assumption.

Assumption.

Qed.

Remark Qlt_is_irreflexive:(irreflexive Qlt).
Red.
Intros.
Unfold Qlt.
Intro.
Cut ( `(numerator x)*((inject_nat (denominator x))+1) > (numerator x)*
      ((inject_nat (denominator x))+1)`).
Apply Zgt_antirefl with n:= `(numerator x)*((inject_nat (denominator
x))+1)`.
Apply Zlt_gt.
Assumption.
Qed.


Remark Qlt_is_antisymmetric:(antisymmetric Qlt).
Red.
Intros.
Intro.
Cut (Qlt x x).
Apply Qlt_is_irreflexive with x:=x.
Apply Qlt_is_transitive with x:=x y:=y z:=x.
Assumption.
Assumption.
Qed.


Definition Qlt_is_strict_order:=(!Build_strictorder Q Qlt
Qlt_is_transitive
  Qlt_is_antisymmetric).


Lemma Zmult_Sm_Sn:(m,n:Z)`(m+1)*(n+1)=m*n+(m+n)+1`.
Intros.
Ring.
Qed.


Remark Qplusresp_Qlt:(x,y:Q_as_CField)(Qlt x y)->
                          (z:Q_as_CField)(Qlt x[+]z y[+]z).
Intros.
Simpl in H.
Simpl.
Red in H.
Simpl.
Red.
Unfold Qplus.
Unfold 1 numerator.
Unfold 3 denominator.
Unfold 3 numerator.
Unfold 9 denominator.
Rewrite inj_plus.
Rewrite inj_plus.
Rewrite inj_mult.
Rewrite inj_plus.
Rewrite inj_plus.
Rewrite inj_mult.
Rewrite <- Zmult_Sm_Sn with m:=(inject_nat (denominator y)) 
			 n:=(inject_nat (denominator z)).
Rewrite <- Zmult_Sm_Sn with m:=(inject_nat (denominator x)) 
		            n:=(inject_nat (denominator z)).
Rewrite Zmult_assoc.
Rewrite Zmult_assoc.
Rewrite Zmult_sym with y:= `((inject_nat (denominator z))+1)`.
Rewrite Zmult_sym with y:= `((inject_nat (denominator z))+1)`
 x:=` ((numerator y)*((inject_nat (denominator z))+1)+(numerator z)*
   ((inject_nat (denominator y))+1))*((inject_nat (denominator x))+1)`.
Apply Zlt_reg_mult_l.

Change (`(Zs (inject_nat (denominator z))) >(inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.

Rewrite Zmult_sym.
Rewrite Zmult_sym with y:=`((inject_nat (denominator x))+1)`
  x:=` ((numerator y)*((inject_nat (denominator z))+1)+(numerator z)*
   ((inject_nat (denominator y))+1))`.
Rewrite Zmult_plus_distr_r with x:=`((inject_nat (denominator y))+1)`.
Rewrite Zmult_plus_distr_r with x:=`((inject_nat (denominator x))+1)`.
Rewrite Zmult_permute with m:=(numerator z).
Rewrite Zmult_permute with m:=(numerator z).
Rewrite Zmult_sym with x:=`(inject_nat (denominator x))+1`
                       y:=`(inject_nat (denominator y))+1`.
Apply Zgt_lt.
Rewrite Zplus_sym with y:=`(numerator z)*
   (((inject_nat (denominator y))+1)*((inject_nat (denominator x))+1))`.
Rewrite Zplus_sym with y:=`(numerator z)*
   (((inject_nat (denominator y))+1)*((inject_nat (denominator x))+1))`.
Apply Zgt_reg_l.
Rewrite Zmult_assoc.
Rewrite Zmult_assoc.
Rewrite Zmult_sym with y:=`((inject_nat (denominator z))+1)`.
Rewrite Zmult_sym with y:=`((inject_nat (denominator z))+1)`.
Apply Zlt_gt.
Apply Zlt_reg_mult_l.

Change (`(Zs (inject_nat (denominator z))) >(inject_nat O)`).
Rewrite <- inj_S.
Apply inj_gt.
Apply gt_Sn_O.

Rewrite Zmult_sym.
Rewrite Zmult_sym with y:=(numerator y).
Assumption.
Qed.



Remark Qmult_resp_pos_Qlt:(x,y:Q_as_CField)(Qlt (Zero::Q_as_CField) x)->
(Qlt (Zero::Q_as_CField) y)->(Qlt (Zero::Q_as_CField) x[*]y).
Intros x y.
Intro.
Intro.
Simpl in H.
Simpl in H0.
Simpl.

Red in H.
Simpl.
Unfold ZEROQ.
Unfold Qlt.
Unfold 1 numerator.
Unfold 2 denominator. 
Unfold 2 inject_nat.
Simpl.

Rewrite Zmult_n_1.
Simpl in H.
Simpl.
Rewrite Zmult_n_1 in H.

Simpl in H0.
Unfold Qlt in H0.
Unfold ZEROQ in H0.
Unfold 1 numerator in H0.
Unfold 2 denominator in H0.
Unfold 2 inject_nat in H0.
Simpl in H0.
Rewrite Zmult_n_1 in H0.

Rewrite <- Zero_mult_right with x:=(numerator x).
Apply Zlt_reg_mult_l.
Apply Zlt_gt.
Assumption.
Assumption.
Qed.


Remark Qlt_gives_apartness:(x,y:Q_as_CField)
       (x [#] y)<-> ((Qlt x y) \/ (Qlt y x)).
Intros.
Red.
Split.
Simpl.
Intro.
Unfold ap_Q in H.
Unfold EqQ in H.
Case (not_Zeq `(numerator x)*((inject_nat (denominator y))+1)`
             `(numerator y)*((inject_nat (denominator x))+1)` H).
Intro.
Left.
Assumption.
Intro.
Right.
Assumption.

Simpl.
Intro.
Intro.
Cut (Qlt x x).
Apply Qlt_is_irreflexive with x:=x.
Apply or_ind with A:=(Qlt x y) B:=(Qlt y x).
Intro.
Cut (EqQ y x).
Intro.
Apply Qlt_is_well_defined_right with x:=x y:=y z:=x.
Assumption.
Assumption.
Apply sym_equalQ.
Assumption.

Intro.
Cut (EqQ y x).
Intro.
Apply Qlt_is_well_defined_left with x:=y y:=x z:=x.
Assumption.
Assumption.
Apply sym_equalQ.
Assumption.
Assumption.
Qed.

Definition Q_is_COrdField:=(!Build_is_COrdField Q_as_CField 
Qlt_is_CSetoid_relation Qlt_is_strict_order Qplusresp_Qlt 
Qmult_resp_pos_Qlt Qlt_gives_apartness).

Definition Q_as_COrdField:=(!Build_COrdField Q_as_CField 
Qlt_is_CSetoid_relation Q_is_COrdField).


Lemma injz_plus:(m,n:Z)(inject_Z `m+n`)[=]
		(inject_Z m)::Q_as_COrdField[+](inject_Z n).
 Intros.
 Unfold inject_Z.
 Simpl.
 Unfold EqQ.
 Unfold 1 numerator.
 Unfold 2 denominator. 
 Ring `(numerator (Qplus (Build_Q m O) (Build_Q n O)))*((inject_nat O)+1)`.
 Unfold 2 inject_nat.
 Ring `0*(numerator (Qplus (Build_Q m O) (Build_Q n O)))`.
 Ring ` 0+(numerator (Qplus (Build_Q m O) (Build_Q n O)))`.
 Unfold Qplus.
 Simpl.
 Ring.
Qed.

Lemma injZ_One:(inject_Z One::Z_as_CRing)::Q_as_COrdField[=]One.
 Unfold inject_Z.
 Change ((Build_Q One::Z_as_CRing (0))::Q_as_COrdField[=](Build_Q One::Z_as_CRing (0))).
 Apply eq_reflexive_unfolded.
Qed.

Lemma injz_Nring:(n:nat)(nring Q_as_COrdField n)[=]
		(inject_Z (nring Z_as_CRing n)).
 Intro.
 Induction n.
 Change (Zero::Q_as_COrdField[=]Zero).
 Apply eq_reflexive_unfolded.
 Change ( (nring (Q_as_COrdField) n)[+]One [=]
   (inject_Z ((nring Z_as_CRing n)[+]One))).
 Step_final (inject_Z ((nring Z_as_CRing n)))::Q_as_COrdField[+]One.
 Step  (inject_Z ((nring Z_as_CRing n)))::Q_as_COrdField[+](inject_Z One::Z_as_CRing).
 Apply eq_symmetric_unfolded.
 Apply injz_plus.
Qed.

Lemma injZ_eq:(x,y:Z)`x=y`->((inject_Z x)::Q_as_COrdField[=](inject_Z y)).
 Intros.
 Unfold inject_Z.
 Simpl. 
 Red.
 Simpl.
 Ring.
 Assumption.
Qed.

Lemma nring_Q:(n:nat)(nring Q_as_COrdField n)[=](inject_Z `n`).
 Intro.
 Induction n.
 Change (EqQ (Build_Q `0` O) (Build_Q `0` O)).
 Apply refl_equalQ.

 Change ((nring Q_as_COrdField n)[+] One [=] (inject_Z (S n))).
 Step_final (inject_Z n)::Q_as_COrdField[+]One::Q_as_COrdField.
 Step (inject_Z `n`)::Q_as_COrdField[+](inject_Z `1`).
 Step (inject_Z `n+1`).
 Simpl.
 Red.
 Unfold Qplus.
 Simpl.
 Ring.
 Apply injZ_eq.
 Apply sym_equal.
 Change ((inject_nat (S n))=(Zs (inject_nat n))). 
 Apply inj_S.
Qed.


Theorem Q_is_archemaedian:(x:Q_as_COrdField)(Ex [n:nat](x[:<](Nring n))).
 Intros.
 Case x.
 Intros p q.
 
 Exists (S (absolu `p`)). 
 Step_less_rht (inject_Z (S (absolu p))).

 Unfold inject_Z.
 Unfold zring.
 Simpl.
 Red.
 Unfold 1 numerator. 
 Unfold denominator. 
 Change  `p*(0+1)
   < (numerator (Build_Q (inject_nat (S (absolu p))) O))*
   ((inject_nat q)+1)`.
 Unfold numerator.
 Ring `p*(0+1)`.
 Induction q.
 Unfold 2 inject_nat.
 Ring `(inject_nat (S (absolu p)))*(0+1)`.
 Case p.
 Simpl.
 Apply Zgt_lt.
 Rewrite <- Zero_right with x:=`1`.
 Rewrite Zplus_sym.
 Apply Zgt_Sn_n with n:=`1`.

 Intro w.
 Simpl.  
 
 Red.
 Simpl.
 Apply convert_compare_INFERIEUR.
 Rewrite bij1 with m:=(convert w).
 Apply lt_n_Sn.
 
 Intro w.
 Simpl.
 Red.
 Simpl.
 Reflexivity.

 Apply Zgt_lt.
 Apply Zgt_trans with m:=`(inject_nat (S (absolu p)))*1`.
 Apply Zlt_gt.
 Apply Zlt_reg_mult_l.
 Change  `(inject_nat (S (absolu p))) > (inject_nat O)`.
 Apply Zlt_gt.
 Apply inj_lt.
 Apply lt_O_Sn.
 Apply Zsimpl_lt_plus_l with p:=`-1`.
 Ring `(-1)+1`.
 Ring ` (-1)+((inject_nat (S q))+1)`.
 Change `(inject_nat O)<(inject_nat (S q))`.
 Apply inj_lt.
 Apply lt_O_Sn.
 Ring  `(inject_nat (S (absolu p)))*1`.

 Apply Zlt_gt.
 Case p.
 Simpl.
 Apply Zgt_lt.
 Rewrite <- Zero_right with x:=`1`.
 Rewrite Zplus_sym.
 Apply Zgt_Sn_n with n:=`1`.

 Intro w.
 Simpl.  
 
 Red.
 Simpl.
 Apply convert_compare_INFERIEUR.
 Rewrite bij1 with m:=(convert w).
 Apply lt_n_Sn.
 
 Intro w.
 Simpl.
 Red.
 Simpl.
 Reflexivity.
 
 Apply eq_symmetric_unfolded. 
 Apply nring_Q.
Qed.




