(* 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                                                     *)
(** General Facts About Q and Qpositive, the functions Qpositive_c and Qpositive_i and the operations Qmult, Qpositive, Qlt *)
Require Export Qpositive.
Require Export Q_field.
Require Export Q_order.
Require Export Zaux.
(* An auxiliary lemma about [Z] *)
(** For decoding and encoing elements of Q: binary sequneces versus pairs of integers. *)
(*** Building the rational number m/n *)
Definition make_Q (m n : Z) :=
match m, n with
| Zpos _, Zpos _ =>
Qpos (Qpositive_c (Z.abs_nat m) (Z.abs_nat n) (Z.abs_nat m + Z.abs_nat n))
| Zneg _, Zneg _ =>
Qpos (Qpositive_c (Z.abs_nat m) (Z.abs_nat n) (Z.abs_nat m + Z.abs_nat n))
| Z0, _ => Zero
| _, Z0 => Zero (* dummy *)
| _, _ =>
Qneg (Qpositive_c (Z.abs_nat m) (Z.abs_nat n) (Z.abs_nat m + Z.abs_nat n))
end.
(*** decoding a sequnce consisting of dL and nR and ending in One. *)
Definition decode_Q (q : Q) :=
match q with
| Qpos p =>
(Z_of_nat (fst (Qpositive_i p)), Z_of_nat (snd (Qpositive_i p)))
| Qneg p =>
((- Z_of_nat (fst (Qpositive_i p)))%Z, Z_of_nat (snd (Qpositive_i p)))
| Zero => (0%Z, 1%Z)
end.
Definition numerator (q:Q) :Z := fst (decode_Q q).
Definition denominator (q:Q) :Z := snd (decode_Q q).
(** Definition of various functions *)
Definition Z_to_Qpositive : forall x : Z, (0 < x)%Z -> Qpositive.
intros [| p| p].
intros H; abstract discriminate H.
intro.
exact (Qpositive_c (nat_of_P p) 1 (S (nat_of_P p))).
intro; abstract discriminate H.
Defined.
Definition Z_to_Q (x : Z) : Q :=
match x with
| Z0 => Zero
| Zpos p => Qpos (Qpositive_c (nat_of_P p) 1 (S (nat_of_P p)))
| Zneg p => Qneg (Qpositive_c (nat_of_P p) 1 (S (nat_of_P p)))
end.
Definition Qpositive_tail (z : Qpositive) :=
match z with
| nR p => p
| dL p => p
| One => One
end.
Definition Q_tail (z : Q) :=
match z with
| Zero => One
| Qpos p => p
| Qneg p => p
end.
Definition Qsgn (q : Q) :=
match q with
| Zero => 0%Z
| Qpos _ => 1%Z
| Qneg _ => (-1)%Z
end.
(** These two only consider the length, we won't use them further *)
Fixpoint length_of_Qpositive_to_positive (qp : Qpositive) : positive :=
match qp with
| One => 1%positive
| dL qp' => Pos.succ (length_of_Qpositive_to_positive qp')
| nR qp' => Pos.succ (length_of_Qpositive_to_positive qp')
end.
Fixpoint length_of_Qpositive (qp : Qpositive) : Z :=
match qp with
| One => 0%Z
| dL qp' => (1 + length_of_Qpositive qp')%Z
| nR qp' => (1 + length_of_Qpositive qp')%Z
end.
(** This is the oredr preserving projection from Q to Z *)
Fixpoint Qpositive_to_Z (qp : Qpositive) : Z :=
match qp with
| One => 1%Z
| dL qp' => 0%Z
| nR qp' => (1 + Qpositive_to_Z qp')%Z
end.
Definition Q_to_Z (x : Q) : Z :=
match x with
| Zero => 0%Z
| Qpos qp => Qpositive_to_Z qp
| Qneg qp => (- Qpositive_to_Z qp)%Z
end.
Coercion Z_to_Q : Z >-> Q.
Definition Qlt (x y : Q) : Prop := Qgt y x.
Definition Qle (x y : Q) : Prop := ~ Qlt y x.
unfold Qlt in |- *; auto with *.
Qed.
Hint Resolve Qlt_neg_pos Qlt_neg_zero Qlt_zero_pos.
Ltac QltCleanAbsurdCases :=
match goal with
| id1:(Qlt Zero (Qneg _)) |- _ => inversion id1
| id1:(Qlt (Qpos _) Zero) |- _ =>
inversion id1
| id1:(Qlt (Qpos _) (Qneg _)) |- _ =>
inversion id1
| id1:(Qle Zero (Qneg _)) |- _ =>
apply False_ind; apply id1; auto with *
| id1:(Qle (Qpos _) Zero) |- _ =>
apply False_ind; apply id1; auto with *
| id1:(Qle (Qpos _) (Qneg _)) |- _ =>
apply False_ind; apply id1; auto with *
end.
(* Hints Unfold Qle.*)
(** Properties of  Qpositive_c *)
Functional Scheme Qpositive_c_ind := Induction for Qpositive_c Sort Prop.
Functional Scheme Qpositive_i_ind := Induction for Qpositive_i Sort Prop.
Functional Scheme Qpositive_plus_ind := Induction for Qpositive_plus Sort Prop.
Functional Scheme Qpositive_mult_ind := Induction for Qpositive_mult Sort Prop.
(** mappings between Q and Z *)
Functional Scheme Z_to_Q_ind := Induction for Z_to_Q Sort Prop.
Functional Scheme Qpositive_le_bool_ind :=
Induction for Qpositive_le_bool Sort Prop.
Hint Resolve Qlt_irreflexive.
Hint Resolve Qlt_not_eq.
Hint Resolve Qmult_resp_nonzero.
Hint Resolve Qlt_mult_pos_pos Qlt_mult_neg_pos.
Hint Resolve Qlt_plus_pos_pos.
Hint Resolve Qlt_zero_one.
Hint Resolve Qplus_zero_right Qlt_le_reg_pos Qle_lt_reg_pos Qlt_le_reg
Qle_lt_reg Qlt_le_weak Qlt_le_reg_neg Qle_lt_reg_neg Qle_plus_pos_pos
Qle_plus_neg_neg Qle_mult_nonneg_nonneg Qle_mult_nonneg_nonpos
Qle_mult_nonpos_nonneg Qle_mult_nonpos_pos Qle_mult_neg_nonneg
Qle_reflexive.
intros x y; case Qpositive_le_dec with x y; intro H'; [left;intro H; inversion H; contradiction | right;unfold Qlt; constructor; trivial].
Qed.
Declare Left Step Qlt_stepl.
Declare Right Step Qlt_stepr.
Declare Left Step Qle_stepl.
Declare Right Step Qle_stepr.
Declare Left Step Qneq_stepl.
Declare Right Step Qneq_stepr.
(** Properties of Qsgn *)

Lemma Qsgn_15 : forall x y : Q, Qsgn (Qmult x y) = (Qsgn x * Qsgn y)%Z.