Top

Module mathcomp.algebra.archimedean

From HB Require Import structures.
From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq choice.
From mathcomp Require Import fintype bigop nmodule order.
From mathcomp Require Import rings_modules_and_algebras divalg decfield poly.
From mathcomp Require Import orderedzmod numdomain numfield ssrint.

                          Archimedean structures

NB: See CONTRIBUTING.md for an introduction to HB concepts and commands.

This file defines some numeric structures extended with the Archimedean
axiom. To use this file, insert "Import Num.Theory." and optionally
"Import Num.Def." before your scripts as in the ssrnum library.
The modules provided by this library subsume those from ssrnum.

This file defines the following structures:

     archiNumDomainType == numDomainType with the Archimedean axiom
                           The HB class is called ArchiNumDomain.
      archiNumFieldType == numFieldType with the Archimedean axiom
                           The HB class is called ArchiNumField.
   archiClosedFieldType == closedFieldType with the Archimedean axiom
                           The HB class is called ArchiClosedField.
    archiRealDomainType == realDomainType with the Archimedean axiom
                           The HB class is called ArchiRealDomain.
     archiRealFieldType == realFieldType with the Archimedean axiom
                           The HB class is called ArchiRealField.
           archiRcfType == rcfType with the Archimedean axiom
                           The HB class is called ArchiRealClosedField.

Over these structures, we have the following operations:
 x \is a Num.int <=> x is an integer, i.e., x = m%:~R for some m : int
 x \is a Num.nat <=> x is a natural number, i.e., x = m%:R for some m : nat
     Num.floor x == the m : int such that m%:~R <= x < (m + 1)%:~R
                    when x \is a Num.real, otherwise 0%Z
      Num.ceil x == the m : int such that (m - 1)%:~R < x <= m%:~R
                    when x \is a Num.real, otherwise 0%Z
    Num.truncn x == the n : nat such that n%:R <= x < n.+1%:R
                    when 0 <= n, otherwise 0%N
     Num.bound x == an upper bound for x, i.e., an n such that `|x| < n%:R

Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

Local Open Scope ring_scope.
Import Order.TTheory GRing.Theory Num.Theory.

Module Num.
Import Num.Def.

HB.mixin Record NumDomain_hasFloorCeilTruncn R & Num.NumDomain R := {
  floor : R -> int;
  ceil : R -> int;
  truncn : R -> nat;
  int_num_subdef : pred R;
  nat_num_subdef : pred R;
  floor_subproof :
    forall x,
      if x \is real_num then (floor x)%:~R <= x < (floor x + 1)%:~R
      else floor x == 0;
  ceil_subproof : forall x, ceil x = - floor (- x);
  truncn_subproof : forall x, truncn x = if floor x is Posz n then n else 0;
  int_num_subproof : forall x, reflect (exists n, x = n%:~R) (int_num_subdef x);
  nat_num_subproof : forall x, reflect (exists n, x = n%:R) (nat_num_subdef x);
}.

#[short(type="archiNumDomainType")]
HB.structure Definition ArchiNumDomain :=
  { R of NumDomain_hasFloorCeilTruncn R & Num.NumDomain R }.

Module ArchiNumDomainExports.
Bind Scope ring_scope with ArchiNumDomain.sort.
End ArchiNumDomainExports.
HB.export ArchiNumDomainExports.

#[short(type="archiNumFieldType")]
HB.structure Definition ArchiNumField :=
  { R of NumDomain_hasFloorCeilTruncn R & Num.NumField R }.

Module ArchiNumFieldExports.
Bind Scope ring_scope with ArchiNumField.sort.
End ArchiNumFieldExports.
HB.export ArchiNumFieldExports.

#[short(type="archiClosedFieldType")]
HB.structure Definition ArchiClosedField :=
  { R of NumDomain_hasFloorCeilTruncn R & Num.ClosedField R }.

Module ArchiClosedFieldExports.
Bind Scope ring_scope with ArchiClosedField.sort.
End ArchiClosedFieldExports.
HB.export ArchiClosedFieldExports.

#[short(type="archiRealDomainType")]
HB.structure Definition ArchiRealDomain :=
  { R of NumDomain_hasFloorCeilTruncn R & Num.RealDomain R }.

Module ArchiRealDomainExports.
Bind Scope ring_scope with ArchiRealDomain.sort.
End ArchiRealDomainExports.
HB.export ArchiRealDomainExports.

#[short(type="archiRealFieldType")]
HB.structure Definition ArchiRealField :=
  { R of NumDomain_hasFloorCeilTruncn R & Num.RealField R }.

Module ArchiRealFieldExports.
Bind Scope ring_scope with ArchiRealField.sort.
End ArchiRealFieldExports.
HB.export ArchiRealFieldExports.

#[short(type="archiRcfType")]
HB.structure Definition ArchiRealClosedField :=
  { R of NumDomain_hasFloorCeilTruncn R & Num.RealClosedField R }.

Module ArchiRealClosedFieldExports.
Bind Scope ring_scope with ArchiRealClosedField.sort.
End ArchiRealClosedFieldExports.
HB.export ArchiRealClosedFieldExports.

Section Def.
Context {R : archiNumDomainType}.

Definition nat_num : qualifier 1 R := [qualify a x : R | nat_num_subdef x].
Definition int_num : qualifier 1 R := [qualify a x : R | int_num_subdef x].
Definition bound (x : R) := (truncn `|x|).+1.

End Def.

Arguments floor {R} : rename, simpl never.
Arguments ceil {R} : rename, simpl never.
Arguments truncn {R} : rename, simpl never.
Arguments nat_num {R} : simpl never.
Arguments int_num {R} : simpl never.

#[deprecated(since="mathcomp 2.4.0", use=truncn)]
Notation trunc := truncn (only parsing).

Module Def.
Export Num.Def.

Notation truncn := truncn.
#[deprecated(since="mathcomp 2.4.0", use=truncn)]
Notation trunc := truncn (only parsing).
Notation floor := floor.
Notation ceil := ceil.
Notation nat_num := nat_num.
Notation int_num := int_num.
Notation archi_bound := bound.

End Def.

Module intArchimedean.
Section intArchimedean.

Implicit Types n : int.

Fact floor_subproof n :
  if n \is real_num then n%:~R <= n < (n + 1)%:~R else n == 0.
Proof.
by rewrite num_real !intz ltzD1 lexx. Qed.

Fact intrP n : reflect (exists m, n = m%:~R) true.
Proof.
by apply: ReflectT; exists n; rewrite intz. Qed.

Fact natrP n : reflect (exists m, n = m%:R) (0 <= n).
Proof.
apply: (iffP idP); last by case=> m ->; rewrite ler0n.
by case: n => // n _; exists n; rewrite natz.
Qed.

End intArchimedean.
End intArchimedean.

#[export]
HB.instance Definition _ :=
  @NumDomain_hasFloorCeilTruncn.Build int id id _ xpredT nneg_num_pred
    intArchimedean.floor_subproof (fun=> esym (opprK _)) (fun=> erefl)
    intArchimedean.intrP intArchimedean.natrP.

Module Import Theory.
Export Num.Theory.

Section ArchiNumDomainTheory.

Variable R : archiNumDomainType.
Implicit Types x y z : R.

Local Notation truncn := (@truncn R).
Local Notation floor := (@floor R).
Local Notation ceil := (@ceil R).
Local Notation nat_num := (@Def.nat_num R).
Local Notation int_num := (@Def.int_num R).

Local Lemma floorP x :
  if x \is real_num then (floor x)%:~R <= x < (floor x + 1)%:~R
  else floor x == 0.
Proof.
exact: floor_subproof. Qed.

Lemma floorNceil x : floor x = - ceil (- x).
Proof.
by rewrite ceil_subproof !opprK. Qed.

Lemma ceilNfloor x : ceil x = - floor (- x).
Proof.
exact: ceil_subproof. Qed.

Lemma truncEfloor x : truncn x = if floor x is Posz n then n else 0.
Proof.
exact: truncn_subproof. Qed.

Lemma natrP x : reflect (exists n, x = n%:R) (x \is a nat_num).
Proof.
exact: nat_num_subproof. Qed.

Lemma intrP x : reflect (exists m, x = m%:~R) (x \is a int_num).
Proof.
exact: int_num_subproof. Qed.


Lemma intr_int m : m%:~R \is a int_num
Proof.
by apply/intrP; exists m. Qed.
Lemma natr_nat n : n%:R \is a nat_num
Proof.
by apply/natrP; exists n. Qed.
#[local] Hint Resolve intr_int natr_nat : core.

Lemma rpred_int_num (S : subringClosed R) x : x \is a int_num -> x \in S.
Proof.
by move=> /intrP[n ->]; rewrite rpred_int. Qed.

Lemma rpred_nat_num (S : semiringClosed R) x : x \is a nat_num -> x \in S.
Proof.
by move=> /natrP[n ->]; apply: rpred_nat. Qed.

Lemma int_num0 : 0 \is a int_num
Proof.
exact: (intr_int 0). Qed.
Lemma int_num1 : 1 \is a int_num
Proof.
exact: (intr_int 1). Qed.
Lemma nat_num0 : 0 \is a nat_num
Proof.
exact: (natr_nat 0). Qed.
Lemma nat_num1 : 1 \is a nat_num
Proof.
exact: (natr_nat 1). Qed.
#[local] Hint Resolve int_num0 int_num1 nat_num0 nat_num1 : core.

Fact int_num_subring : subring_closed int_num.
Proof.
by split=> // _ _ /intrP[n ->] /intrP[m ->]; rewrite -(intrB, intrM).
Qed.
#[export]
HB.instance Definition _ := GRing.isSubringClosed.Build R int_num_subdef
  int_num_subring.

Fact nat_num_semiring : semiring_closed nat_num.
Proof.
by do 2![split] => //= _ _ /natrP[n ->] /natrP[m ->]; rewrite -(natrD, natrM).
Qed.
#[export]
HB.instance Definition _ := GRing.isSemiringClosed.Build R nat_num_subdef
  nat_num_semiring.

Lemma Rreal_nat : {subset nat_num <= real_num}.
Proof.
exact: rpred_nat_num. Qed.

Lemma intr_nat : {subset nat_num <= int_num}.
Proof.
by move=> _ /natrP[n ->]; rewrite pmulrn intr_int. Qed.

Lemma Rreal_int : {subset int_num <= real_num}.
Proof.
exact: rpred_int_num. Qed.

Lemma intrE x : (x \is a int_num) = (x \is a nat_num) || (- x \is a nat_num).
Proof.
apply/idP/orP => [/intrP[[n|n] ->]|[]/intr_nat]; rewrite ?rpredN //.
  by left; apply/natrP; exists n.
by rewrite NegzE intrN opprK; right; apply/natrP; exists n.+1.
Qed.

Lemma natr_int n : n%:R \is a int_num.
Proof.
by rewrite intrE natr_nat. Qed.
#[local] Hint Resolve natr_int : core.

Lemma intr_normK x : x \is a int_num -> `|x| ^+ 2 = x ^+ 2.
Proof.
by move/Rreal_int/real_normK. Qed.

Lemma natr_normK x : x \is a nat_num -> `|x| ^+ 2 = x ^+ 2.
Proof.
by move/Rreal_nat/real_normK. Qed.

Lemma natr_norm_int x : x \is a int_num -> `|x| \is a nat_num.
Proof.
by move=> /intrP[m ->]; rewrite -intr_norm rpred_nat_num ?natr_nat. Qed.

Lemma natr_ge0 x : x \is a nat_num -> 0 <= x.
Proof.
by move=> /natrP[n ->]; apply: ler0n. Qed.

Lemma natr_gt0 x : x \is a nat_num -> (0 < x) = (x != 0).
Proof.
by move/natr_ge0; case: comparableP. Qed.

Lemma natrEint x : (x \is a nat_num) = (x \is a int_num) && (0 <= x).
Proof.
apply/idP/andP=> [Nx | [Zx x_ge0]]; first by rewrite intr_nat ?natr_ge0.
by rewrite -(ger0_norm x_ge0) natr_norm_int.
Qed.

Lemma intrEge0 x : 0 <= x -> (x \is a int_num) = (x \is a nat_num).
Proof.
by rewrite natrEint andbC => ->. Qed.

Lemma intrEsign x : x \is a int_num -> x = (-1) ^+ (x < 0)%R * `|x|.
Proof.
by move/Rreal_int/realEsign. Qed.

Lemma norm_natr x : x \is a nat_num -> `|x| = x.
Proof.
by move/natr_ge0/ger0_norm. Qed.

Lemma natr_exp_even x n : ~~ odd n -> x \is a int_num -> x ^+ n \is a nat_num.
Proof.
move=> n_oddF x_intr.
by rewrite natrEint rpredX //= real_exprn_even_ge0 // Rreal_int.
Qed.

Lemma norm_intr_ge1 x : x \is a int_num -> x != 0 -> 1 <= `|x|.
Proof.
rewrite -normr_eq0 => /natr_norm_int/natrP[n ->].
by rewrite pnatr_eq0 ler1n lt0n.
Qed.

Lemma sqr_intr_ge1 x : x \is a int_num -> x != 0 -> 1 <= x ^+ 2.
Proof.
by move=> Zx nz_x; rewrite -intr_normK // expr_ge1 ?normr_ge0 ?norm_intr_ge1.
Qed.

Lemma intr_ler_sqr x : x \is a int_num -> x <= x ^+ 2.
Proof.
move=> Zx; have [-> | nz_x] := eqVneq x 0; first by rewrite expr0n.
apply: le_trans (_ : `|x| <= _); first by rewrite real_ler_norm ?Rreal_int.
by rewrite -intr_normK // ler_eXnr // norm_intr_ge1.
Qed.


Lemma real_floor_itv x :
  x \is real_num -> (floor x)%:~R <= x < (floor x + 1)%:~R.
Proof.
by case: ifP (floorP x). Qed.

Lemma real_floor_le x : x \is real_num -> (floor x)%:~R <= x.
Proof.
by case/real_floor_itv/andP. Qed.

Lemma real_floorD1_gt x : x \is real_num -> x < (floor x + 1)%:~R.
Proof.
by case/real_floor_itv/andP. Qed.

Lemma floor_def x m : m%:~R <= x < (m + 1)%:~R -> floor x = m.
Proof.
case/andP=> lemx ltxm1; apply/eqP; rewrite eq_le -!ltzD1.
move: (ger_real lemx); rewrite realz => /real_floor_itv/andP[lefx ltxf1].
by rewrite -!(ltr_int R) 2?(@le_lt_trans _ _ x).
Qed.

Lemma real_floor_ge_int x n : x \is real_num -> (n <= floor x) = (n%:~R <= x).
Proof.
move=> /real_floor_itv /andP[lefx ltxf1]; apply/idP/idP => lenx.
  by apply: le_trans lefx; rewrite ler_int.
by rewrite -ltzD1 -(ltr_int R); apply: le_lt_trans ltxf1.
Qed.

Lemma real_floor_lt_int x n : x \is real_num -> (floor x < n) = (x < n%:~R).
Proof.
by move=> ?; rewrite [RHS]real_ltNge ?realz -?real_floor_ge_int -?ltNge.
Qed.

Lemma real_floor_eq x n : x \is real_num ->
  (floor x == n) = (n%:~R <= x < (n + 1)%:~R).
Proof.
by move=> xr; apply/eqP/idP => [<-|]; [exact: real_floor_itv|exact: floor_def].
Qed.

Lemma le_floor : {homo floor : x y / x <= y}.
Proof.
move=> x y lexy; move: (floorP x) (floorP y); rewrite (ger_real lexy).
case: ifP => [_ /andP[lefx _] /andP[_] | _ /eqP-> /eqP-> //].
by move=> /(le_lt_trans lexy) /(le_lt_trans lefx); rewrite ltr_int ltzD1.
Qed.

Lemma intrKfloor : cancel intr floor.
Proof.
by move=> m; apply: floor_def; rewrite lexx rmorphD ltrDl ltr01. Qed.

Lemma intrEfloor x : (x \is a int_num) = ((floor x)%:~R == x).
Proof.
by apply/intrP/eqP => [[n ->] | <-]; [rewrite intrKfloor | exists (floor x)].
Qed.

Lemma floorK : {in int_num, cancel floor intr}.
Proof.
by move=> z; rewrite intrEfloor => /eqP. Qed.

Lemma floor0 : floor 0 = 0
Proof.
exact: intrKfloor 0. Qed.
Lemma floor1 : floor 1 = 1
Proof.
exact: intrKfloor 1. Qed.
#[local] Hint Resolve floor0 floor1 : core.

Lemma real_floorDzr : {in int_num & real_num, {morph floor : x y / x + y}}.
Proof.
move=> _ y /intrP[m ->] Ry; apply: floor_def.
by rewrite -addrA 2!rmorphD /= intrKfloor lerD2l ltrD2l real_floor_itv.
Qed.

Lemma real_floorDrz : {in real_num & int_num, {morph floor : x y / x + y}}.
Proof.
by move=> x y xr yz; rewrite addrC real_floorDzr // addrC. Qed.

Lemma floorN : {in int_num, {morph floor : x / - x}}.
Proof.
by move=> _ /intrP[m ->]; rewrite -rmorphN !intrKfloor. Qed.

Lemma floorM : {in int_num &, {morph floor : x y / x * y}}.
Proof.
by move=> _ _ /intrP[m1 ->] /intrP[m2 ->]; rewrite -rmorphM !intrKfloor.
Qed.

Lemma floorX n : {in int_num, {morph floor : x / x ^+ n}}.
Proof.
by move=> _ /intrP[m ->]; rewrite -rmorphXn !intrKfloor. Qed.

Lemma real_floor_ge0 x : x \is real_num -> (0 <= floor x) = (0 <= x).
Proof.
by move=> ?; rewrite real_floor_ge_int. Qed.

Lemma floor_lt0 x : (floor x < 0) = (x < 0).
Proof.
case: ifP (floorP x) => [xr _ | xr /eqP <-]; first by rewrite real_floor_lt_int.
by rewrite ltxx; apply/esym/(contraFF _ xr)/ltr0_real.
Qed.

Lemma real_floor_le0 x : x \is real_num -> (floor x <= 0) = (x < 1).
Proof.
by move=> ?; rewrite -ltzD1 add0r real_floor_lt_int. Qed.

Lemma floor_gt0 x : (floor x > 0) = (x >= 1).
Proof.
case: ifP (floorP x) => [xr _ | xr /eqP->].
  by rewrite gtz0_ge1 real_floor_ge_int.
by rewrite ltxx; apply/esym/(contraFF _ xr)/ger1_real.
Qed.

Lemma floor_neq0 x : (floor x != 0) = (x < 0) || (x >= 1).
Proof.
case: ifP (floorP x) => [xr _ | xr /eqP->]; rewrite ?eqxx/=.
  by rewrite neq_lt floor_lt0 floor_gt0.
by apply/esym/(contraFF _ xr) => /orP[/ltr0_real|/ger1_real].
Qed.

Lemma floorpK : {in polyOver int_num, cancel (map_poly floor) (map_poly intr)}.
Proof.
move=> p /(all_nthP 0) Zp; apply/polyP=> i.
rewrite coef_map coef_map_id0 //= -[p]coefK coef_poly.
by case: ifP => [/Zp/floorK // | _]; rewrite floor0.
Qed.

Lemma floorpP (p : {poly R}) :
  p \is a polyOver int_num -> {q | p = map_poly intr q}.
Proof.
by exists (map_poly floor p); rewrite floorpK. Qed.


Lemma real_ceil_itv x : x \is real_num -> (ceil x - 1)%:~R < x <= (ceil x)%:~R.
Proof.

Lemma real_ceilB1_lt x : x \is real_num -> (ceil x - 1)%:~R < x.
Proof.
by case/real_ceil_itv/andP. Qed.

Lemma real_ceil_ge x : x \is real_num -> x <= (ceil x)%:~R.
Proof.
by case/real_ceil_itv/andP. Qed.

Lemma ceil_def x m : (m - 1)%:~R < x <= m%:~R -> ceil x = m.
Proof.
rewrite -ltrN2 -lerN2 andbC -!intrN opprD opprK ceilNfloor.
by move=> /floor_def ->; rewrite opprK.
Qed.

Lemma real_ceil_le_int x n : x \is real_num -> (ceil x <= n) = (x <= n%:~R).
Proof.
rewrite ceilNfloor lerNl -realN => /real_floor_ge_int ->.
by rewrite intrN lerN2.
Qed.

Lemma real_ceil_gt_int x n : x \is real_num -> (n < ceil x) = (n%:~R < x).
Proof.
by move=> ?; rewrite [RHS]real_ltNge ?realz -?real_ceil_le_int ?ltNge.
Qed.

Lemma real_ceil_eq x n : x \is real_num ->
  (ceil x == n) = ((n - 1)%:~R < x <= n%:~R).
Proof.
by move=> xr; apply/eqP/idP => [<-|]; [exact: real_ceil_itv|exact: ceil_def].
Qed.

Lemma le_ceil : {homo ceil : x y / x <= y}.
Proof.
by move=> x y lexy; rewrite !ceilNfloor lerN2 le_floor ?lerN2. Qed.

Lemma intrKceil : cancel intr ceil.
Proof.
by move=> m; rewrite ceilNfloor -intrN intrKfloor opprK. Qed.

Lemma intrEceil x : (x \is a int_num) = ((ceil x)%:~R == x).
Proof.

Lemma ceilK : {in int_num, cancel ceil intr}.
Proof.
by move=> z; rewrite intrEceil => /eqP. Qed.

Lemma ceil0 : ceil 0 = 0
Proof.
exact: intrKceil 0. Qed.
Lemma ceil1 : ceil 1 = 1
Proof.
exact: intrKceil 1. Qed.
#[local] Hint Resolve ceil0 ceil1 : core.

Lemma real_ceilDzr : {in int_num & real_num, {morph ceil : x y / x + y}}.
Proof.
move=> x y x_int y_real.
by rewrite ceilNfloor opprD real_floorDzr ?rpredN // opprD -!ceilNfloor.
Qed.

Lemma real_ceilDrz : {in real_num & int_num, {morph ceil : x y / x + y}}.
Proof.
by move=> x y xr yz; rewrite addrC real_ceilDzr // addrC. Qed.

Lemma ceilN : {in int_num, {morph ceil : x / - x}}.
Proof.
by move=> ? ?; rewrite !ceilNfloor !opprK floorN. Qed.

Lemma ceilM : {in int_num &, {morph ceil : x y / x * y}}.
Proof.
by move=> _ _ /intrP[m1 ->] /intrP[m2 ->]; rewrite -rmorphM !intrKceil.
Qed.

Lemma ceilX n : {in int_num, {morph ceil : x / x ^+ n}}.
Proof.
by move=> _ /intrP[m ->]; rewrite -rmorphXn !intrKceil. Qed.

Lemma real_ceil_ge0 x : x \is real_num -> (0 <= ceil x) = (-1 < x).
Proof.
by move=> ?; rewrite ceilNfloor oppr_ge0 real_floor_le0 ?realN 1?ltrNl.
Qed.

Lemma ceil_lt0 x : (ceil x < 0) = (x <= -1).
Proof.

Lemma real_ceil_le0 x : x \is real_num -> (ceil x <= 0) = (x <= 0).
Proof.
by move=> ?; rewrite real_ceil_le_int. Qed.

Lemma ceil_gt0 x : (ceil x > 0) = (x > 0).
Proof.

Lemma ceil_neq0 x : (ceil x != 0) = (x <= -1) || (x > 0).
Proof.

Lemma real_ceil_floor x : x \is real_num ->
  ceil x = floor x + (x \isn't a int_num).
Proof.
case Ix: (x \is a int_num) => Rx /=.
  by apply/eqP; rewrite addr0 ceilNfloor eqr_oppLR floorN.
apply/ceil_def; rewrite addrK; move: (real_floor_itv Rx).
by rewrite le_eqVlt -intrEfloor Ix /= => /andP[-> /ltW].
Qed.


Lemma truncn_floor x : truncn x = if 0 <= x then `|floor x|%N else 0%N.
Proof.
move: (floorP x); rewrite truncEfloor realE.
have [/le_floor|_]/= := boolP (0 <= x); first by rewrite floor0; case: floor.
by case: ifP => [/le_floor|_ /eqP->//]; rewrite floor0; case: floor => [[]|].
Qed.


Local Lemma truncnP x :
  if 0 <= x then (truncn x)%:R <= x < (truncn x).+1%:R else truncn x == 0%N.
Proof.
rewrite truncn_floor.
case: (boolP (0 <= x)) => //= /[dup] /le_floor + /ger0_real/real_floor_itv.
by rewrite floor0; case: (floor x) => // n _; rewrite absz_nat addrC -intS.
Qed.

Lemma truncn_itv x : 0 <= x -> (truncn x)%:R <= x < (truncn x).+1%:R.
Proof.
by move=> x_ge0; move: (truncnP x); rewrite x_ge0. Qed.

Lemma truncn_le x : ((truncn x)%:R <= x) = (0 <= x).
Proof.
by case: ifP (truncnP x) => [+ /andP[] | + /eqP->//]. Qed.

Lemma real_truncnS_gt x : x \is real_num -> x < (truncn x).+1%:R.
Proof.
by move/real_ge0P => [/truncn_itv/andP[]|/lt_le_trans->]. Qed.

Lemma truncn_def x n : n%:R <= x < n.+1%:R -> truncn x = n.
Proof.
case/andP=> lemx ltxm1; apply/eqP; rewrite eqn_leq -ltnS -[(n <= _)%N]ltnS.
have/truncn_itv/andP[lefx ltxf1]: 0 <= x by apply: le_trans lemx; apply: ler0n.
by rewrite -!(ltr_nat R) 2?(@le_lt_trans _ _ x).
Qed.

Lemma truncn_ge_nat x n : 0 <= x -> (n <= truncn x)%N = (n%:R <= x).
Proof.
move=> /truncn_itv /andP[letx ltxt1]; apply/idP/idP => lenx.
  by apply: le_trans letx; rewrite ler_nat.
by rewrite -ltnS -(ltr_nat R); apply: le_lt_trans ltxt1.
Qed.

Lemma truncn_gt_nat x n : (n < truncn x)%N = (n.+1%:R <= x).
Proof.
case: ifP (truncnP x) => [x0 _ | x0 /eqP->]; first by rewrite truncn_ge_nat.
by rewrite ltn0; apply/esym/(contraFF _ x0)/le_trans.
Qed.

Lemma truncn_lt_nat x n : 0 <= x -> (truncn x < n)%N = (x < n%:R).
Proof.
by move=> ?; rewrite real_ltNge ?ger0_real// ltnNge truncn_ge_nat. Qed.

Lemma real_truncn_le_nat x n :
  x \is real_num -> (truncn x <= n)%N = (x < n.+1%:R).
Proof.
by move=> ?; rewrite real_ltNge// leqNgt truncn_gt_nat. Qed.

Lemma truncn_eq x n : 0 <= x -> (truncn x == n) = (n%:R <= x < n.+1%:R).
Proof.
by move=> xr; apply/eqP/idP => [<-|]; [exact: truncn_itv|exact: truncn_def].
Qed.

Lemma le_truncn : {homo truncn : x y / x <= y >-> (x <= y)%N}.
Proof.
move=> x y lexy; move: (truncnP x) (truncnP y).
case: ifP => [x0 /andP[letx _] | x0 /eqP->//].
case: ifP => [y0 /andP[_] | y0 /eqP->]; [|by rewrite (le_trans x0 lexy) in y0].
by move=> /(le_lt_trans lexy) /(le_lt_trans letx); rewrite ltr_nat ltnS.
Qed.

Lemma natrK : cancel (GRing.natmul 1) truncn.
Proof.
by move=> m; apply: truncn_def; rewrite ler_nat ltr_nat ltnS leqnn. Qed.

Lemma natrEtruncn x : (x \is a nat_num) = ((truncn x)%:R == x).
Proof.
by apply/natrP/eqP => [[n ->]|<-]; [rewrite natrK | exists (truncn x)].
Qed.

Lemma archi_boundP x : 0 <= x -> x < (bound x)%:R.
Proof.
move=> x_ge0; case/truncn_itv/andP: (normr_ge0 x) => _.
exact/le_lt_trans/real_ler_norm/ger0_real.
Qed.

Lemma truncnK : {in nat_num, cancel truncn (GRing.natmul 1)}.
Proof.
by move=> x; rewrite natrEtruncn => /eqP. Qed.

Lemma truncn0 : truncn 0 = 0%N
Proof.
exact: natrK 0%N. Qed.
Lemma truncn1 : truncn 1 = 1%N
Proof.
exact: natrK 1%N. Qed.
#[local] Hint Resolve truncn0 truncn1 : core.

Lemma truncnD :
  {in nat_num & nneg_num, {morph truncn : x y / x + y >-> (x + y)%N}}.
Proof.
move=> _ y /natrP[n ->] y_ge0; apply: truncn_def.
by rewrite -addnS !natrD !natrK lerD2l ltrD2l truncn_itv.
Qed.

Lemma truncnM : {in nat_num &, {morph truncn : x y / x * y >-> (x * y)%N}}.
Proof.
by move=> _ _ /natrP[n1 ->] /natrP[n2 ->]; rewrite -natrM !natrK. Qed.

Lemma truncnX n : {in nat_num, {morph truncn : x / x ^+ n >-> (x ^ n)%N}}.
Proof.
by move=> _ /natrP[n1 ->]; rewrite -natrX !natrK. Qed.

Lemma truncn_gt0 x : (0 < truncn x)%N = (1 <= x).
Proof.
case: ifP (truncnP x) => [x0 | x0 /eqP<-]; first by rewrite truncn_ge_nat.
by rewrite ltnn; apply/esym/(contraFF _ x0)/le_trans.
Qed.

Lemma truncn0Pn x : reflect (truncn x = 0%N) (~~ (1 <= x)).
Proof.
by rewrite -truncn_gt0 -eqn0Ngt; apply: eqP. Qed.

Lemma sum_truncnK I r (P : pred I) F : (forall i, P i -> F i \is a nat_num) ->
  (\sum_(i <- r | P i) truncn (F i))%:R = \sum_(i <- r | P i) F i.
Proof.
by rewrite natr_sum => natr; apply: eq_bigr => i /natr /truncnK. Qed.

Lemma prod_truncnK I r (P : pred I) F : (forall i, P i -> F i \is a nat_num) ->
  (\prod_(i <- r | P i) truncn (F i))%:R = \prod_(i <- r | P i) F i.
Proof.
by rewrite natr_prod => natr; apply: eq_bigr => i /natr /truncnK. Qed.

Lemma natr_sum_eq1 (I : finType) (P : pred I) (F : I -> R) :
     (forall i, P i -> F i \is a nat_num) -> \sum_(i | P i) F i = 1 ->
   {i : I | [/\ P i, F i = 1 & forall j, j != i -> P j -> F j = 0]}.
Proof.
move=> natF /eqP; rewrite -sum_truncnK// -[1]/1%:R eqr_nat => /sum_nat_eq1 exi.
have [i /and3P[Pi /eqP f1 /forallP a]] : {i : I | [&& P i, truncn (F i) == 1
    & [forall j : I, ((j != i) ==> P j ==> (truncn (F j) == 0))]]}.
  apply/sigW; have [i [Pi /eqP f1 a]] := exi; exists i; apply/and3P; split=> //.
  by apply/forallP => j; apply/implyP => ji; apply/implyP => Pj; apply/eqP/a.
exists i; split=> [//||j ji Pj]; rewrite -[LHS]truncnK ?natF ?f1//; apply/eqP.
by rewrite -[0]/0%:R eqr_nat; apply: implyP Pj; apply: implyP ji; apply: a.
Qed.

Lemma natr_mul_eq1 x y :
  x \is a nat_num -> y \is a nat_num -> (x * y == 1) = (x == 1) && (y == 1).
Proof.
by do 2!move/truncnK <-; rewrite -natrM !pnatr_eq1 muln_eq1. Qed.

Lemma natr_prod_eq1 (I : finType) (P : pred I) (F : I -> R) :
    (forall i, P i -> F i \is a nat_num) -> \prod_(i | P i) F i = 1 ->
  forall i, P i -> F i = 1.
Proof.
move=> natF /eqP; rewrite -prod_truncnK// -[1]/1%:R eqr_nat prod_nat_seq_eq1.
move/allP => a i Pi; apply/eqP; rewrite -[F i]truncnK ?natF// eqr_nat.
by apply: implyP Pi; apply: a; apply: mem_index_enum.
Qed.

Variables (U V : lmodType R) (f : {additive U -> V}).

Lemma raddfZ_nat a u : a \is a nat_num -> f (a *: u) = a *: f u.
Proof.
by move=> /natrP[n ->]; apply: raddfZnat. Qed.

Lemma rpredZ_nat (S : addrClosed V) :
  {in nat_num & S, forall z u, z *: u \in S}.
Proof.
by move=> _ u /natrP[n ->]; apply: rpredZnat. Qed.

Lemma raddfZ_int a u : a \is a int_num -> f (a *: u) = a *: f u.
Proof.
by move=> /intrP[m ->]; rewrite !scaler_int raddfMz. Qed.

Lemma rpredZ_int (S : zmodClosed V) :
  {in int_num & S, forall z u, z *: u \in S}.
Proof.
by move=> _ u /intrP[m ->] ?; rewrite scaler_int rpredMz. Qed.

Implicit Type nu : {rmorphism R -> R}.

Lemma aut_natr nu : {in nat_num, nu =1 id}.
Proof.
by move=> _ /natrP[n ->]; apply: rmorph_nat. Qed.

Lemma aut_intr nu : {in int_num, nu =1 id}.
Proof.
by move=> _ /intrP[m ->]; apply: rmorph_int. Qed.

End ArchiNumDomainTheory.

#[deprecated(since="mathcomp 2.4.0", use=truncn_itv)]
Notation trunc_itv := truncn_itv (only parsing).
#[deprecated(since="mathcomp 2.4.0", use=truncn_def)]
Notation trunc_def := truncn_def (only parsing).
#[deprecated(since="mathcomp 2.4.0", use=truncnK)]
Notation truncK := truncnK (only parsing).
#[deprecated(since="mathcomp 2.4.0", use=truncn0)]
Notation trunc0 := truncn0 (only parsing).
#[deprecated(since="mathcomp 2.4.0", use=truncn1)]
Notation trunc1 := truncn1 (only parsing).
#[deprecated(since="mathcomp 2.4.0", use=truncnD)]
Notation truncD := truncnD (only parsing).
#[deprecated(since="mathcomp 2.4.0", use=truncnM)]
Notation truncM := truncnM (only parsing).
#[deprecated(since="mathcomp 2.4.0", use=truncnX)]
Notation truncX := truncnX (only parsing).
#[deprecated(since="mathcomp 2.4.0", use=truncn_gt0)]
Notation trunc_gt0 := truncn_gt0 (only parsing).
#[deprecated(since="mathcomp 2.4.0", use=truncn0Pn)]
Notation trunc0Pn := truncn0Pn (only parsing).
#[deprecated(since="mathcomp 2.4.0", use=sum_truncnK)]
Notation sum_truncK := sum_truncnK (only parsing).
#[deprecated(since="mathcomp 2.4.0", use=prod_truncnK)]
Notation prod_truncK := prod_truncnK (only parsing).
#[deprecated(since="mathcomp 2.4.0", use=truncn_floor)]
Notation trunc_floor := truncn_floor (only parsing).
#[deprecated(since="mathcomp 2.4.0", use=real_floor_le)]
Notation real_ge_floor := real_floor_le (only parsing).
#[deprecated(since="mathcomp 2.4.0", use=real_floorD1_gt)]
Notation real_lt_succ_floor := real_floorD1_gt (only parsing).
#[deprecated(since="mathcomp 2.4.0", use=real_ceilB1_lt)]
Notation real_gt_pred_ceil := real_floorD1_gt (only parsing).
#[deprecated(since="mathcomp 2.4.0", use=real_ceil_ge)]
Notation real_le_ceil := real_ceil_ge (only parsing).
#[deprecated(since="mathcomp 2.4.0", use=le_ceil)]
Notation ceil_le := le_ceil (only parsing).
#[deprecated(since="mathcomp 2.4.0", use=natrEtruncn)]
Notation natrE := natrEtruncn (only parsing).

#[deprecated(since="mathcomp 2.5.0", use=le_ceil)]
Notation le_ceil_tmp := le_ceil (only parsing).
#[deprecated(since="mathcomp 2.5.0", use=real_floor_ge_int)]
Notation real_floor_ge_int_tmp := real_floor_ge_int (only parsing).
#[deprecated(since="mathcomp 2.5.0", use=real_ceil_le_int)]
Notation real_ceil_le_int_tmp := real_ceil_le_int (only parsing).

Arguments natrK {R} _%_N.
Arguments intrKfloor {R}.
Arguments intrKceil {R}.
Arguments natrP {R x}.
Arguments intrP {R x}.
#[global] Hint Resolve truncn0 truncn1 : core.
#[global] Hint Resolve floor0 floor1 : core.
#[global] Hint Resolve ceil0 ceil1 : core.
#[global] Hint Extern 0 (is_true (_%:R \is a nat_num)) => apply: natr_nat : core.
#[global] Hint Extern 0 (is_true (_%:R \in nat_num_subdef)) => apply: natr_nat : core.
#[global] Hint Extern 0 (is_true (_%:~R \is a int_num)) => apply: intr_int : core.
#[global] Hint Extern 0 (is_true (_%:~R \in int_num_subdef)) => apply: intr_int : core.
#[global] Hint Extern 0 (is_true (_%:R \is a int_num)) => apply: natr_int : core.
#[global] Hint Extern 0 (is_true (_%:R \in int_num_subdef)) => apply: natr_int : core.
#[global] Hint Extern 0 (is_true (0 \is a nat_num)) => apply: nat_num0 : core.
#[global] Hint Extern 0 (is_true (0 \in nat_num_subdef)) => apply: nat_num0 : core.
#[global] Hint Extern 0 (is_true (1 \is a nat_num)) => apply: nat_num1 : core.
#[global] Hint Extern 0 (is_true (1 \in int_num_subdef)) => apply: nat_num1 : core.
#[global] Hint Extern 0 (is_true (0 \is a int_num)) => apply: int_num0 : core.
#[global] Hint Extern 0 (is_true (0 \in int_num_subdef)) => apply: int_num0 : core.
#[global] Hint Extern 0 (is_true (1 \is a int_num)) => apply: int_num1 : core.
#[global] Hint Extern 0 (is_true (1 \in int_num_subdef)) => apply: int_num1 : core.

Section ArchiRealDomainTheory.

Variables (R : archiRealDomainType).
Implicit Type x : R.

Lemma upper_nthrootP x i : (bound x <= i)%N -> x < 2%:R ^+ i.
Proof.
case/truncn_itv/andP: (normr_ge0 x) => _ /ltr_normlW xlt le_b_i.
by rewrite (lt_le_trans xlt) // -natrX ler_nat (ltn_trans le_b_i) // ltn_expl.
Qed.

Lemma truncnS_gt x : x < (truncn x).+1%:R.
Proof.
exact: real_truncnS_gt. Qed.

Lemma truncn_le_nat x n : (truncn x <= n)%N = (x < n.+1%:R).
Proof.
exact: real_truncn_le_nat. Qed.

Lemma floor_itv x : (floor x)%:~R <= x < (floor x + 1)%:~R.
Proof.
exact: real_floor_itv. Qed.

Lemma floor_le x : (floor x)%:~R <= x
Proof.
exact: real_floor_le. Qed.

Lemma floorD1_gt x : x < (floor x + 1)%:~R.
Proof.
exact: real_floorD1_gt. Qed.

Lemma floor_ge_int x n : (n <= floor x) = (n%:~R <= x).
Proof.
exact: real_floor_ge_int. Qed.

Lemma floor_lt_int x n : (floor x < n) = (x < n%:~R).
Proof.
exact: real_floor_lt_int. Qed.

Lemma floor_eq x n : (floor x == n) = (n%:~R <= x < (n + 1)%:~R).
Proof.
exact: real_floor_eq. Qed.

Lemma floorDzr : {in @int_num R, {morph floor : x y / x + y}}.
Proof.
by move=> x xz y; apply/real_floorDzr/num_real. Qed.

Lemma floorDrz x y : y \is a int_num -> floor (x + y) = floor x + floor y.
Proof.
by move=> yz; apply/real_floorDrz/yz/num_real. Qed.

Lemma floor_ge0 x : (0 <= floor x) = (0 <= x).
Proof.
exact: real_floor_ge0. Qed.

Lemma floor_le0 x : (floor x <= 0) = (x < 1).
Proof.
exact: real_floor_le0. Qed.

Lemma ceil_itv x : (ceil x - 1)%:~R < x <= (ceil x)%:~R.
Proof.
exact: real_ceil_itv. Qed.

Lemma ceilB1_lt x : (ceil x - 1)%:~R < x.
Proof.
exact: real_ceilB1_lt. Qed.

Lemma ceil_ge x : x <= (ceil x)%:~R
Proof.
exact: real_ceil_ge. Qed.

Lemma ceil_le_int x n : (ceil x <= n) = (x <= n%:~R).
Proof.
exact: real_ceil_le_int. Qed.

Lemma ceil_gt_int x n : (n < ceil x) = (n%:~R < x).
Proof.
exact: real_ceil_gt_int. Qed.

Lemma ceil_eq x n : (ceil x == n) = ((n - 1)%:~R < x <= n%:~R).
Proof.
exact: real_ceil_eq. Qed.

Lemma ceilDzr : {in @int_num R, {morph ceil : x y / x + y}}.
Proof.
by move=> x xz y; apply/real_ceilDzr/num_real. Qed.

Lemma ceilDrz x y : y \is a int_num -> ceil (x + y) = ceil x + ceil y.
Proof.
by move=> yz; apply/real_ceilDrz/yz/num_real. Qed.

Lemma ceil_ge0 x : (0 <= ceil x) = (-1 < x).
Proof.
exact: real_ceil_ge0. Qed.

Lemma ceil_le0 x : (ceil x <= 0) = (x <= 0).
Proof.
exact: real_ceil_le0. Qed.

Lemma ceil_floor x : ceil x = floor x + (x \isn't a int_num).
Proof.
exact: real_ceil_floor. Qed.

End ArchiRealDomainTheory.

#[deprecated(since="mathcomp 2.4.0", use=floor_le)]
Notation ge_floor := floor_le (only parsing).
#[deprecated(since="mathcomp 2.4.0", use=floorD1_gt)]
Notation lt_succ_floor := floorD1_gt (only parsing).
#[deprecated(since="mathcomp 2.4.0", use=ceilB1_lt)]
Notation gt_pred_ceil := ceilB1_lt (only parsing).

#[deprecated(since="mathcomp 2.5.0", use=floor_le)]
Notation floor_le_tmp := floor_le (only parsing).
#[deprecated(since="mathcomp 2.5.0", use=floor_ge_int)]
Notation floor_ge_int_tmp := floor_ge_int (only parsing).
#[deprecated(since="mathcomp 2.5.0", use=ceil_le_int)]
Notation ceil_le_int_tmp := ceil_le_int (only parsing).

Section ArchiNumFieldTheory.

Variables (R : archiNumFieldType) (nu : {rmorphism R -> R}).

Lemma natr_aut x : (nu x \is a nat_num) = (x \is a nat_num).
Proof.
by apply/idP/idP=> /[dup] ? /(aut_natr nu) => [/fmorph_inj <-| ->]. Qed.

Lemma intr_aut x : (nu x \is a int_num) = (x \is a int_num).
Proof.
by rewrite !intrE -rmorphN !natr_aut. Qed.

End ArchiNumFieldTheory.

Section ArchiClosedFieldTheory.

Variable R : archiClosedFieldType.

Implicit Type x : R.

Lemma conj_natr x : x \is a nat_num -> x^* = x.
Proof.
by move/Rreal_nat/CrealP. Qed.

Lemma conj_intr x : x \is a int_num -> x^* = x.
Proof.
by move/Rreal_int/CrealP. Qed.

End ArchiClosedFieldTheory.

Section ZnatPred.

Lemma Znat_def (n : int) : (n \is a nat_num) = (0 <= n).
Proof.
by []. Qed.

Lemma ZnatP (m : int) : reflect (exists n : nat, m = n) (m \is a nat_num).
Proof.
by case: m => m; constructor; [exists m | case]. Qed.

End ZnatPred.

End Theory.


HB.factory Record NumDomain_hasTruncn R & Num.NumDomain R := {
  truncn : R -> nat;
  nat_num : pred R;
  int_num : pred R;
  truncn_subproof : forall x,
    if 0 <= x then (truncn x)%:R <= x < (truncn x).+1%:R else truncn x == 0;
  natrE : forall x, nat_num x = ((truncn x)%:R == x);
  intrE : forall x, int_num x = nat_num x || nat_num (- x);
}.

#[deprecated(since="mathcomp 2.4.0", use=NumDomain_hasTruncn)]
Notation NumDomain_isArchimedean R := (NumDomain_hasTruncn R) (only parsing).

Module NumDomain_isArchimedean.
#[deprecated(since="mathcomp 2.4.0", use=NumDomain_hasTruncn.Build)]
Notation Build T U := (NumDomain_hasTruncn.Build T U) (only parsing).
End NumDomain_isArchimedean.

HB.builders Context R & NumDomain_hasTruncn R.

Fact truncn_itv x : 0 <= x -> (truncn x)%:R <= x < (truncn x).+1%:R.
Proof.
by move=> x_ge0; move: (truncn_subproof x); rewrite x_ge0. Qed.

Definition floor (x : R) : int :=
  if 0 <= x then Posz (truncn x)
  else if x < 0 then - Posz (truncn (- x) + ~~ int_num x) else 0.

Fact floor_subproof x :
  if x \is real_num then (floor x)%:~R <= x < (floor x + 1)%:~R else floor x == 0.
Proof.
rewrite /floor intrE !natrE negb_or realE.
case: (comparableP x 0) (@truncn_itv x) => //=;
  try by rewrite -PoszD addn1 -pmulrn => _ ->.
move=> x_lt0 _; move: (truncn_subproof x); rewrite lt_geF // => /eqP ->.
rewrite gt_eqF //=; move: x_lt0.
rewrite [_ + 1]addrC -opprB !intrN lerNl ltrNr andbC -oppr_gt0.
move: {x}(- x) => x x_gt0; rewrite PoszD -addrA -PoszD.
have ->: Posz ((truncn x)%:R != x) - 1 = - Posz ((truncn x)%:R == x).
  by case: eqP.
have := truncn_itv (ltW x_gt0); rewrite le_eqVlt.
case: eqVneq => /=; last first.
  by rewrite subr0 addn1 -!pmulrn => _ /andP[-> /ltW ->].
by rewrite intrB mulr1z addn0 -!pmulrn => -> _; rewrite gtrBl lexx andbT.
Qed.

Fact truncnE x : truncn x = if floor x is Posz n then n else 0.
Proof.
rewrite /floor.
case: (comparableP x 0) (truncn_subproof x) => [+ /eqP ->| |_ /eqP ->|] //=.
by case: (_ + _)%N.
Qed.

Fact truncn_def x n : n%:R <= x < n.+1%:R -> truncn x = n.
Proof.
case/andP=> lemx ltxm1; apply/eqP; rewrite eqn_leq -ltnS -[(n <= _)%N]ltnS.
have/truncn_itv/andP[lefx ltxf1]: 0 <= x by apply: le_trans lemx; apply: ler0n.
by rewrite -!(ltr_nat R) 2?(@le_lt_trans _ _ x).
Qed.

Fact natrK : cancel (GRing.natmul 1) truncn.
Proof.
by move=> m; apply: truncn_def; rewrite ler_nat ltr_nat ltnS leqnn. Qed.

Fact intrP x : reflect (exists n, x = n%:~R) (int_num x).
Proof.
rewrite intrE !natrE; apply: (iffP idP) => [|[n ->]]; last first.
  by case: n => n; rewrite ?NegzE ?opprK natrK eqxx // orbT.
rewrite -eqr_oppLR !pmulrn -intrN.
by move=> /orP[] /eqP<-; [exists (truncn x) | exists (- Posz (truncn (- x)))].
Qed.

Fact natrP x : reflect (exists n, x = n%:R) (nat_num x).
Proof.
rewrite natrE.
by apply: (iffP eqP) => [<-|[n ->]]; [exists (truncn x) | rewrite natrK].
Qed.

HB.instance Definition _ :=
  @NumDomain_hasFloorCeilTruncn.Build R floor _ truncn int_num nat_num
    floor_subproof (fun=> erefl) truncnE intrP natrP.

HB.end.

HB.factory Record NumDomain_bounded_isArchimedean R & Num.NumDomain R := {
  archi_bound_subproof : Num.archimedean_axiom R
}.

HB.builders Context R & NumDomain_bounded_isArchimedean R.

Implicit Type x : R.

Definition bound x := sval (sigW (archi_bound_subproof x)).

Fact boundP x : 0 <= x -> x < (bound x)%:R.
Proof.
by move/ger0_norm=> {1}<-; rewrite /bound; case: (sigW _). Qed.

Fact truncn_sig x : {m | 0 <= x -> m%:R <= x < m.+1%:R}.
Proof.
have [Rx | _] := boolP (0 <= x); last by exists 0%N.
have/ex_minnP[n lt_x_n1 min_n]: exists n, x < n.+1%:R.
  by exists (bound x); rewrite (lt_trans (boundP Rx)) ?ltr_nat.
exists n => _; rewrite {}lt_x_n1 andbT; case: n min_n => //= n min_n.
rewrite real_leNgt ?rpred_nat ?ger0_real //; apply/negP => /min_n.
by rewrite ltnn.
Qed.

Definition truncn x := if 0 <= x then sval (truncn_sig x) else 0%N.

Fact truncn_subproof x :
  if 0 <= x then (truncn x)%:R <= x < (truncn x).+1%:R else truncn x == 0%N.
Proof.
rewrite /truncn; case: truncn_sig => // n hn.
by case: ifP => x_ge0; rewrite ?(ifT _ _ x_ge0) ?(ifF _ _ x_ge0) // hn.
Qed.

HB.instance Definition _ := NumDomain_hasTruncn.Build R
  truncn_subproof (fun => erefl) (fun => erefl).

HB.end.

Module Exports. HB.reexport. End Exports.

Notation nat := nat_num.
Notation int := int_num.

#[deprecated(since="mathcomp 2.3.0", use=Num.ArchiRealDomain)]
Notation ArchiDomain T := (ArchiRealDomain T) (only parsing).
Module ArchiDomain.
#[deprecated(since="mathcomp 2.3.0", use=Num.ArchiRealDomain.type)]
Notation type := ArchiRealDomain.type (only parsing).
#[deprecated(since="mathcomp 2.3.0", use=Num.ArchiRealDomain.copy)]
Notation copy T C := (ArchiRealDomain.copy T C) (only parsing).
#[deprecated(since="mathcomp 2.3.0", use=Num.ArchiRealDomain.on)]
Notation on T := (ArchiRealDomain.on T) (only parsing).
End ArchiDomain.
#[deprecated(since="mathcomp 2.3.0", use=Num.ArchiRealField)]
Notation ArchiField T := (ArchiRealField T) (only parsing).
Module ArchiField.
#[deprecated(since="mathcomp 2.3.0", use=Num.ArchiRealField.type)]
Notation type := ArchiRealField.type (only parsing).
#[deprecated(since="mathcomp 2.3.0", use=Num.ArchiRealField.copy)]
Notation copy T C := (ArchiRealField.copy T C) (only parsing).
#[deprecated(since="mathcomp 2.3.0", use=Num.ArchiRealField.on)]
Notation on T := (ArchiRealField.on T) (only parsing).
End ArchiField.

#[deprecated(since="mathcomp 2.3.0", use=real_floorDzr)]
Notation floorD := real_floorDzr (only parsing).
#[deprecated(since="mathcomp 2.3.0", use=real_ceilDzr)]
Notation ceilD := real_ceilDzr (only parsing).
#[deprecated(since="mathcomp 2.3.0", use=real_ceilDzr)]
Notation real_ceilD := real_ceilDzr (only parsing).

End Num.

Export Num.Exports.

#[deprecated(since="mathcomp 2.3.0", use=archiRealDomainType)]
Notation archiDomainType := archiRealDomainType (only parsing).
#[deprecated(since="mathcomp 2.3.0", use=archiRealFieldType)]
Notation archiFieldType := archiRealFieldType (only parsing).