(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
(* Distributed under the terms of CeCILL-B.                                  *)
(******************************************************************************)
(* This file defines a datatype for rational numbers and equips it with a     *)
(* structure of archimedean, real field, with int and nat declared as closed  *)
(* subrings.                                                                  *)
(*          rat == the type of rational number, with single constructor Rat   *)
(*         n%:Q == explicit cast from int to rat, ie. the specialization to   *)
(*                 rationals of the generic ring morphism n%:~R               *)
(*       numq r == numerator of (r : rat)                                     *)
(*       denq r == denominator of (r : rat)                                   *)
(* x \is a Qint == x is an element of rat whose denominator is equal to 1     *)
(* x \is a Qnat == x is a non-negative element of rat whose denominator       *)
(*                 is equal to 1                                              *)
(*       ratr r == generic embedding of (r : rat) into an arbitrary unitring. *)
(* [rat x // y] == smart constructor for rationals, definitionally equal      *)
(*                 to x / y for concrete values, intended for printing only   *)
(*                 of normal forms. The parsable notation is for debugging.   *)
(******************************************************************************)
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.
Reserved Notation "[ 'rat' x // y ]" (format "[ 'rat'  x  //  y ]", at level 0).
Reserved Notation "n %:Q" (at level 2, left associativity, format "n %:Q").
Local Open Scope ring_scope.
Local Notation sgr := Num.sg.
Record rat : Set := Rat {
valq : (int * int);
_ : (0 < valq.2) && coprime `|valq.1| `|valq.2|
}.
Bind Scope ring_scope with rat.
Delimit Scope rat_scope with Q.
Definition ratz (n : int) := @Rat (n, 1) (coprimen1 _).
(* Coercion ratz (n : int) := @Rat (n, 1) (coprimen1 _). *)
Canonical rat_subType := Eval hnf in [subType for valq].
Definition rat_eqMixin := [eqMixin of rat by <:].
Canonical rat_eqType := EqType rat rat_eqMixin.
Definition rat_choiceMixin := [choiceMixin of rat by <:].
Canonical rat_choiceType := ChoiceType rat rat_choiceMixin.
Definition rat_countMixin := [countMixin of rat by <:].
Canonical rat_countType := CountType rat rat_countMixin.
Canonical rat_subCountType := [subCountType of rat].
Definition numq x := nosimpl ((valq x).1).
Definition denq x := nosimpl ((valq x).2).
Fact fracq_subproof x (y := fracq_opt_subdef x) :
(0 < y.2) && (coprime `|y.1| `|y.2|).
(* We use a match expression in order to "lock" the definition of fracq.   *)
(* Indeed, the kernel will try to reduce a fracq only when applied to      *)
(* a term which has "enough" constructors: i.e. it reduces to a pair of    *)
(* a Posz or Negz on the first component, and a Posz of 0 or S, or a Negz  *)
(* on the second component. See issue #698.                                *)
(* Additionally, we use fracq_opt_subdef to precompute the normal form     *)
(* before we use fracq_subproof in order to make sure the proof will be    *)
(* independent from the input of fracq. This ensure reflexivity of any     *)
(* computation involving rationals as long as all operators use fracq.     *)
(* As a consequence val (fracq x) = fracq_opt_subdef (fracq_opt_subdef x)) *)
Definition fracq '((n', d')) : rat :=
match d', n' with
| Posz 0 as d, _ as n => Rat (fracq_subproof (1, 0))
| _ as d, Posz _ as n | _ as d, _ as n =>
Rat (fracq_subproof (fracq_opt_subdef (n, d)))
end.
Arguments fracq : simpl never.
Fact valqK x : fracq (valq x) = x.
Definition scalq '(n, d) := sgr d * (gcdn `|n| `|d|)%:Z.
Definition zeroq := fracq (0, 1).
Definition oneq := fracq (1, 1).
Fact frac0q x : fracq (0, x) = zeroq.
Fact fracq0  x : fracq (x, 0) = zeroq. Proof. exact/eqP. Qed.
Variant fracq_spec (x : int * int) : int * int -> rat -> Type :=
| FracqSpecN of x.2 = 0 : fracq_spec x (x.1, 0) zeroq
| FracqSpecP k fx of k != 0 : fracq_spec x (k * numq fx, k * denq fx) fx.
Fact fracqP x : fracq_spec x x (fracq x).
Fact fracq_eq x y : x.2 != 0 -> y.2 != 0 ->
(fracq x == fracq y) = (x.1 * y.2 == y.1 * x.2).
Fact fracq_eq0 x : (fracq x == zeroq) = (x.1 == 0) || (x.2 == 0).
Fact fracqMM x n d : x != 0 -> fracq (x * n, x * d) = fracq (n, d).
(* We "lock" the definition of addq, oppq, mulq and invq, using a match on    *)
(* the constructor Rat for both arguments, so that it may only be reduced     *)
(* when applied to explicit rationals. Since fracq is also "locked" in a      *)
(* similar way, fracq will not reduce to a Rat x xP unless it is also applied *)
(* to "enough" constructors. This preserves the reduction on gound elements   *)
(* while it suspends it when applied to at least one variable at the leaf of  *)
(* the arithmetic operation.                                                  *)
(* Moreover we optimize addition when one or both arguments are integers,     *)
(* in which case we presimplify the output, this shortens the size of the hnf *)
(* of terms of the form N%:Q when N is a concrete natural number.             *)
Definition addq_subdef (x y : int * int) :=
let: (x1, x2) := x in
let: (y1, y2) := y in
match x2, y2 with
| Posz 1, Posz 1   =>
match x1, y1 with
| Posz 0, _ => (y1, 1)
| _, Posz 0 => (x1, 1)
| Posz n, Posz 1 => (Posz n.+1, 1)
| Posz 1, Posz n => (Posz n.+1, 1)
| _, _ => (x1 + y1, 1)
end
| Posz 1, _  => (x1 * y2 + y1, y2)
| _, Posz 1  => (x1 + y1 * x2, x2)
| _, _       => (x1 * y2 + y1 * x2, x2 * y2)
end.
Definition addq '(Rat x xP) '(Rat y yP) := fracq (addq_subdef x y).
Definition oppq_subdef (x : int * int) := (- x.1, x.2).
Definition oppq '(Rat x xP) := fracq (oppq_subdef x).
Definition oppq_def x : oppq x = fracq (oppq_subdef (valq x)).
Fact addq_frac x y : x.2 != 0 -> y.2 != 0 ->
(addq (fracq x) (fracq y)) = fracq (addq_subdef x y).
Fact ratzD : {morph ratz : x y / x + y >-> addq x y}.
Fact ratzN : {morph ratz : x / - x >-> oppq x}.
Fact add0q : left_id zeroq addq.
Fact addNq : left_inverse (fracq (0, 1)) oppq addq.
Definition rat_ZmodMixin := ZmodMixin addqA addqC add0q addNq.
Canonical rat_ZmodType := ZmodType rat rat_ZmodMixin.
Definition mulq_subdef (x y : int * int) :=
let: (x1, x2) := x in
let: (y1, y2) := y in
match x2, y2 with
| Posz 1, Posz 1 => (x1 * y1, 1)
| Posz 1, _      => (x1 * y1, y2)
| _, Posz 1      => (x1 * y1, x2)
| _, _           => (x1 * y1, x2 * y2)
end.
Definition mulq '(Rat x xP) '(Rat y yP) := fracq (mulq_subdef x y).
Fact mulq_subdefC : commutative mulq_subdef.
Fact ratzM : {morph ratz : x y / x * y >-> mulq x y}.
Fact mul1q : left_id oneq mulq.
Fact mulq_addl : left_distributive mulq addq.
Fact nonzero1q : oneq != zeroq. Proof. by []. Qed.
Definition rat_comRingMixin :=
ComRingMixin mulqA mulqC mul1q mulq_addl nonzero1q.
Canonical rat_Ring := Eval hnf in RingType rat rat_comRingMixin.
Canonical rat_comRing := Eval hnf in ComRingType rat mulqC.
Fact mulVq x : x != 0 -> mulq (invq x) x = 1.
Fact invq0 : invq 0 = 0. Proof. exact/eqP. Qed.
Definition RatFieldUnitMixin := FieldUnitMixin mulVq invq0.
Canonical rat_unitRing :=
Eval hnf in UnitRingType rat RatFieldUnitMixin.
Canonical rat_comUnitRing := Eval hnf in [comUnitRingType of rat].
Fact rat_field_axiom : GRing.Field.mixin_of rat_unitRing. Proof. exact. Qed.
Definition RatFieldIdomainMixin := (FieldIdomainMixin rat_field_axiom).
Canonical rat_idomainType :=
Eval hnf in IdomainType rat (FieldIdomainMixin rat_field_axiom).
Canonical rat_fieldType := FieldType rat rat_field_axiom.
Canonical rat_countZmodType := [countZmodType of rat].
Canonical rat_countRingType := [countRingType of rat].
Canonical rat_countComRingType := [countComRingType of rat].
Canonical rat_countUnitRingType := [countUnitRingType of rat].
Canonical rat_countComUnitRingType := [countComUnitRingType of rat].
Canonical rat_countIdomainType := [countIdomainType of rat].
Canonical rat_countFieldType := [countFieldType of rat].

Lemma numq_eq0 x : (numq x == 0) = (x == 0).