(************************************************************************)
(*         *   The Coq Proof Assistant / The Coq Development Team       *)
(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
(* <O___,, *       (see CREDITS file for the list of authors)           *)
(*   \VV/  **************************************************************)
(*    //   *    This file is distributed under the terms of the         *)
(*         *     GNU Lesser General Public License Version 2.1          *)
(*         *     (see LICENSE file for the text of the license)         *)
(************************************************************************)
Require Export ZArith.
Require Export ZArithRing.
Require Export Morphisms Setoid Bool.
(** * Definition of [Q] and basic properties *)
(** Rationals are pairs of [Z] and [positive] numbers. *)
Record Q : Set := Qmake {Qnum : Z; Qden : positive}.
Declare Scope Q_scope.
Delimit Scope Q_scope with Q.
Bind Scope Q_scope with Q.
Arguments Qmake _%Z _%positive.
Open Scope Q_scope.
Ltac simpl_mult := rewrite ?Pos2Z.inj_mul.
(** [a#b] denotes the fraction [a] over [b]. *)
Notation "a # b" := (Qmake a b) (at level 55, no associativity) : Q_scope.
Definition of_decimal (d:Decimal.decimal) : Q :=
let '(i, f, e) :=
match d with
| Decimal.Decimal i f => (i, f, Decimal.Pos Decimal.Nil)
| Decimal.DecimalExp i f e => (i, f, e)
end in
let num := Z.of_int (Decimal.app_int i f) in
let e := Z.sub (Z.of_int e) (Z.of_nat (Decimal.nb_digits f)) in
match e with
| Z0 => Qmake num 1
| Zpos e => Qmake (Pos.iter (Z.mul 10) num e) 1
| Zneg e => Qmake num (Pos.iter (Pos.mul 10) 1%positive e)
end.
Definition to_decimal (q:Q) : option Decimal.decimal :=
let num := Z.to_int (Qnum q) in
let (den, e_den) := Decimal.nztail (Pos.to_uint (Qden q)) in
match den with
| Decimal.D1 Decimal.Nil =>
match Z.of_nat e_den with
| Z0 => Some (Decimal.Decimal num Decimal.Nil)
| e => Some (Decimal.DecimalExp num Decimal.Nil (Z.to_int (Z.opp e)))
end
| _ => None
end.
Numeral Notation Q of_decimal to_decimal : Q_scope.
Definition inject_Z (x : Z) := Qmake x 1.
Arguments inject_Z x%Z.
Notation QDen p := (Zpos (Qden p)).
Definition Qeq (p q : Q) := (Qnum p * QDen q)%Z = (Qnum q * QDen p)%Z.
Definition Qle (x y : Q) := (Qnum x * QDen y <= Qnum y * QDen x)%Z.
Definition Qlt (x y : Q) := (Qnum x * QDen y < Qnum y * QDen x)%Z.
Notation Qgt a b := (Qlt b a) (only parsing).
Notation Qge a b := (Qle b a) (only parsing).
Infix "==" := Qeq (at level 70, no associativity) : Q_scope.
Infix "<" := Qlt : Q_scope.
Infix "<=" := Qle : Q_scope.
Notation "x > y" := (Qlt y x)(only parsing) : Q_scope.
Notation "x >= y" := (Qle y x)(only parsing) : Q_scope.
Notation "x <= y <= z" := (x<=y/\y<=z) : Q_scope.
(** injection from Z is injective. *)
(** Another approach : using Qcompare for defining order relations. *)
Definition Qcompare (p q : Q) := (Qnum p * QDen q ?= Qnum q * QDen p)%Z.
Notation "p ?= q" := (Qcompare p q) : Q_scope.
Hint Unfold Qeq Qlt Qle : qarith.
Hint Extern 5 (?X1 <> ?X2) => intro; discriminate: qarith.
(** * Properties of equality. *)
Hint Immediate Qeq_sym : qarith.
Hint Resolve Qeq_refl Qeq_trans : qarith.
(** In a word, [Qeq] is a setoid equality. *)
Instance Q_Setoid : Equivalence Qeq.
Hint Resolve Qnot_eq_sym : qarith.
(** * Addition, multiplication and opposite *)
(** The addition, multiplication and opposite are defined in the straightforward way: *)
Definition Qplus (x y : Q) :=
(Qnum x * QDen y + Qnum y * QDen x) # (Qden x * Qden y).
Definition Qmult (x y : Q) := (Qnum x * Qnum y) # (Qden x * Qden y).
Definition Qopp (x : Q) := (- Qnum x) # (Qden x).
Definition Qminus (x y : Q) := Qplus x (Qopp y).
Definition Qinv (x : Q) :=
match Qnum x with
| Z0 => 0
| Zpos p => (QDen x)#p
| Zneg p => (Zneg (Qden x))#p
end.
Definition Qdiv (x y : Q) := Qmult x (Qinv y).
Infix "+" := Qplus : Q_scope.
Notation "- x" := (Qopp x) : Q_scope.
Infix "-" := Qminus : Q_scope.
Infix "*" := Qmult : Q_scope.
Notation "/ x" := (Qinv x) : Q_scope.
Infix "/" := Qdiv : Q_scope.
(** A light notation for [Zpos] *)
(** * Setoid compatibility results *)
Instance Qplus_comp : Proper (Qeq==>Qeq==>Qeq) Qplus.
Instance Qopp_comp : Proper (Qeq==>Qeq) Qopp.
Instance Qminus_comp : Proper (Qeq==>Qeq==>Qeq) Qminus.
Instance Qmult_comp : Proper (Qeq==>Qeq==>Qeq) Qmult.
Instance Qinv_comp : Proper (Qeq==>Qeq) Qinv.
Instance Qdiv_comp : Proper (Qeq==>Qeq==>Qeq) Qdiv.
Instance Qcompare_comp : Proper (Qeq==>Qeq==>eq) Qcompare.
Instance Qle_comp : Proper (Qeq==>Qeq==>iff) Qle.
Instance Qlt_compat : Proper (Qeq==>Qeq==>iff) Qlt.
Instance Qeqb_comp : Proper (Qeq==>Qeq==>eq) Qeq_bool.
Instance Qleb_comp : Proper (Qeq==>Qeq==>eq) Qle_bool.
(** [0] and [1] are apart *)
(** * Properties of [Qadd] *)
(** Addition is associative: *)
(** [0] is a neutral element for addition: *)
(** Commutativity of addition: *)
(** * Properties of [Qopp] *)
(** Injectivity of addition (uses theory about Qopp above): *)
(** * Properties of [Qmult] *)
(** Multiplication is associative: *)
(** multiplication and zero *)
(** [1] is a neutral element for multiplication: *)
(** Commutativity of multiplication *)
(** Distributivity over [Qadd] *)
(** Integrality *)
(** * inject_Z is a ring homomorphism: *)
(** Injectivity of Qmult (requires theory about Qinv above): *)
(** * Properties of order upon Q. *)
Hint Resolve Qle_trans : qarith.
(** Large = strict or equal *)
(** [x<y] iff [~(y<=x)] *)
Hint Resolve Qle_not_lt Qlt_not_le Qnot_le_lt Qnot_lt_le
Qlt_le_weak Qlt_not_eq Qle_antisym Qle_refl: qarith.
(** Some decidability results about orders. *)
Hint Resolve Qopp_le_compat : qarith.

Lemma Qplus_lt_le_compat :
forall x y z t, x<y -> z<=t -> x+z < y+t.