aboutsummaryrefslogtreecommitdiffstats
path: root/flocq/Core/Fcore_rnd.v
diff options
context:
space:
mode:
authorGuillaume Melquiond <guillaume.melquiond@inria.fr>2019-02-13 18:53:17 +0100
committerXavier Leroy <xavierleroy@users.noreply.github.com>2019-03-27 11:38:25 +0100
commit0f919eb26c68d3882e612a1b3a9df45bee6d3624 (patch)
treeb8bcf57e06d761be09b8d2cf2f80741acb1e4949 /flocq/Core/Fcore_rnd.v
parentd5c0b4054c8490bda3b3d191724c58d5d4002e58 (diff)
downloadcompcert-0f919eb26c68d3882e612a1b3a9df45bee6d3624.tar.gz
compcert-0f919eb26c68d3882e612a1b3a9df45bee6d3624.zip
Upgrade embedded version of Flocq to 3.1.
Main changes to CompCert outside of Flocq are as follows: - Minimal supported version of Coq is now 8.7, due to Flocq requirements. - Most modifications are due to Z2R being dropped in favor of IZR and to the way Flocq now handles NaNs. - CompCert now correctly handles NaNs for the Risc-V architecture (hopefully).
Diffstat (limited to 'flocq/Core/Fcore_rnd.v')
-rw-r--r--flocq/Core/Fcore_rnd.v1392
1 files changed, 0 insertions, 1392 deletions
diff --git a/flocq/Core/Fcore_rnd.v b/flocq/Core/Fcore_rnd.v
deleted file mode 100644
index e5091684..00000000
--- a/flocq/Core/Fcore_rnd.v
+++ /dev/null
@@ -1,1392 +0,0 @@
-(**
-This file is part of the Flocq formalization of floating-point
-arithmetic in Coq: http://flocq.gforge.inria.fr/
-
-Copyright (C) 2010-2013 Sylvie Boldo
-#<br />#
-Copyright (C) 2010-2013 Guillaume Melquiond
-
-This library 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 3 of the License, or (at your option) any later version.
-
-This library 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
-COPYING file for more details.
-*)
-
-(** * Roundings: properties and/or functions *)
-Require Import Fcore_Raux.
-Require Import Fcore_defs.
-
-Section RND_prop.
-
-Open Scope R_scope.
-
-Theorem round_val_of_pred :
- forall rnd : R -> R -> Prop,
- round_pred rnd ->
- forall x, { f : R | rnd x f }.
-Proof.
-intros rnd (H1,H2) x.
-specialize (H1 x).
-(* . *)
-assert (H3 : bound (rnd x)).
-destruct H1 as (f, H1).
-exists f.
-intros g Hg.
-now apply H2 with (3 := Rle_refl x).
-(* . *)
-exists (proj1_sig (completeness _ H3 H1)).
-destruct completeness as (f1, (H4, H5)).
-simpl.
-destruct H1 as (f2, H1).
-assert (f1 = f2).
-apply Rle_antisym.
-apply H5.
-intros f3 H.
-now apply H2 with (3 := Rle_refl x).
-now apply H4.
-now rewrite H.
-Qed.
-
-Theorem round_fun_of_pred :
- forall rnd : R -> R -> Prop,
- round_pred rnd ->
- { f : R -> R | forall x, rnd x (f x) }.
-Proof.
-intros rnd H.
-exists (fun x => proj1_sig (round_val_of_pred rnd H x)).
-intros x.
-now destruct round_val_of_pred as (f, H1).
-Qed.
-
-Theorem round_unicity :
- forall rnd : R -> R -> Prop,
- round_pred_monotone rnd ->
- forall x f1 f2,
- rnd x f1 ->
- rnd x f2 ->
- f1 = f2.
-Proof.
-intros rnd Hr x f1 f2 H1 H2.
-apply Rle_antisym.
-now apply Hr with (3 := Rle_refl x).
-now apply Hr with (3 := Rle_refl x).
-Qed.
-
-Theorem Rnd_DN_pt_monotone :
- forall F : R -> Prop,
- round_pred_monotone (Rnd_DN_pt F).
-Proof.
-intros F x y f g (Hx1,(Hx2,_)) (Hy1,(_,Hy2)) Hxy.
-apply Hy2.
-apply Hx1.
-now apply Rle_trans with (2 := Hxy).
-Qed.
-
-Theorem Rnd_DN_pt_unicity :
- forall F : R -> Prop,
- forall x f1 f2 : R,
- Rnd_DN_pt F x f1 -> Rnd_DN_pt F x f2 ->
- f1 = f2.
-Proof.
-intros F.
-apply round_unicity.
-apply Rnd_DN_pt_monotone.
-Qed.
-
-Theorem Rnd_DN_unicity :
- forall F : R -> Prop,
- forall rnd1 rnd2 : R -> R,
- Rnd_DN F rnd1 -> Rnd_DN F rnd2 ->
- forall x, rnd1 x = rnd2 x.
-Proof.
-intros F rnd1 rnd2 H1 H2 x.
-now eapply Rnd_DN_pt_unicity.
-Qed.
-
-Theorem Rnd_UP_pt_monotone :
- forall F : R -> Prop,
- round_pred_monotone (Rnd_UP_pt F).
-Proof.
-intros F x y f g (Hx1,(_,Hx2)) (Hy1,(Hy2,_)) Hxy.
-apply Hx2.
-apply Hy1.
-now apply Rle_trans with (1 := Hxy).
-Qed.
-
-Theorem Rnd_UP_pt_unicity :
- forall F : R -> Prop,
- forall x f1 f2 : R,
- Rnd_UP_pt F x f1 -> Rnd_UP_pt F x f2 ->
- f1 = f2.
-Proof.
-intros F.
-apply round_unicity.
-apply Rnd_UP_pt_monotone.
-Qed.
-
-Theorem Rnd_UP_unicity :
- forall F : R -> Prop,
- forall rnd1 rnd2 : R -> R,
- Rnd_UP F rnd1 -> Rnd_UP F rnd2 ->
- forall x, rnd1 x = rnd2 x.
-Proof.
-intros F rnd1 rnd2 H1 H2 x.
-now eapply Rnd_UP_pt_unicity.
-Qed.
-
-Theorem Rnd_DN_UP_pt_sym :
- forall F : R -> Prop,
- ( forall x, F x -> F (- x) ) ->
- forall x f : R,
- Rnd_DN_pt F x f -> Rnd_UP_pt F (-x) (-f).
-Proof.
-intros F HF x f H.
-repeat split.
-apply HF.
-apply H.
-apply Ropp_le_contravar.
-apply H.
-intros g Hg.
-rewrite <- (Ropp_involutive g).
-intros Hxg.
-apply Ropp_le_contravar.
-apply H.
-now apply HF.
-now apply Ropp_le_cancel.
-Qed.
-
-Theorem Rnd_UP_DN_pt_sym :
- forall F : R -> Prop,
- ( forall x, F x -> F (- x) ) ->
- forall x f : R,
- Rnd_UP_pt F x f -> Rnd_DN_pt F (-x) (-f).
-Proof.
-intros F HF x f H.
-repeat split.
-apply HF.
-apply H.
-apply Ropp_le_contravar.
-apply H.
-intros g Hg.
-rewrite <- (Ropp_involutive g).
-intros Hxg.
-apply Ropp_le_contravar.
-apply H.
-now apply HF.
-now apply Ropp_le_cancel.
-Qed.
-
-Theorem Rnd_DN_UP_sym :
- forall F : R -> Prop,
- ( forall x, F x -> F (- x) ) ->
- forall rnd1 rnd2 : R -> R,
- Rnd_DN F rnd1 -> Rnd_UP F rnd2 ->
- forall x, rnd1 (- x) = - rnd2 x.
-Proof.
-intros F HF rnd1 rnd2 H1 H2 x.
-rewrite <- (Ropp_involutive (rnd1 (-x))).
-apply f_equal.
-apply (Rnd_UP_unicity F (fun x => - rnd1 (-x))) ; trivial.
-intros y.
-pattern y at 1 ; rewrite <- Ropp_involutive.
-apply Rnd_DN_UP_pt_sym.
-apply HF.
-apply H1.
-Qed.
-
-Theorem Rnd_DN_UP_pt_split :
- forall F : R -> Prop,
- forall x d u,
- Rnd_DN_pt F x d ->
- Rnd_UP_pt F x u ->
- forall f, F f ->
- (f <= d) \/ (u <= f).
-Proof.
-intros F x d u Hd Hu f Hf.
-destruct (Rle_or_lt f x).
-left.
-now apply Hd.
-right.
-assert (H' := Rlt_le _ _ H).
-now apply Hu.
-Qed.
-
-Theorem Rnd_DN_pt_refl :
- forall F : R -> Prop,
- forall x : R, F x ->
- Rnd_DN_pt F x x.
-Proof.
-intros F x Hx.
-repeat split.
-exact Hx.
-apply Rle_refl.
-now intros.
-Qed.
-
-Theorem Rnd_DN_pt_idempotent :
- forall F : R -> Prop,
- forall x f : R,
- Rnd_DN_pt F x f -> F x ->
- f = x.
-Proof.
-intros F x f (_,(Hx1,Hx2)) Hx.
-apply Rle_antisym.
-exact Hx1.
-apply Hx2.
-exact Hx.
-apply Rle_refl.
-Qed.
-
-Theorem Rnd_UP_pt_refl :
- forall F : R -> Prop,
- forall x : R, F x ->
- Rnd_UP_pt F x x.
-Proof.
-intros F x Hx.
-repeat split.
-exact Hx.
-apply Rle_refl.
-now intros.
-Qed.
-
-Theorem Rnd_UP_pt_idempotent :
- forall F : R -> Prop,
- forall x f : R,
- Rnd_UP_pt F x f -> F x ->
- f = x.
-Proof.
-intros F x f (_,(Hx1,Hx2)) Hx.
-apply Rle_antisym.
-apply Hx2.
-exact Hx.
-apply Rle_refl.
-exact Hx1.
-Qed.
-
-Theorem Only_DN_or_UP :
- forall F : R -> Prop,
- forall x fd fu f : R,
- Rnd_DN_pt F x fd -> Rnd_UP_pt F x fu ->
- F f -> (fd <= f <= fu)%R ->
- f = fd \/ f = fu.
-Proof.
-intros F x fd fu f Hd Hu Hf [Hdf Hfu].
-destruct (Rle_or_lt x f) ; [right|left].
-apply Rle_antisym with (1 := Hfu).
-now apply Hu.
-apply Rlt_le in H.
-apply Rle_antisym with (2 := Hdf).
-now apply Hd.
-Qed.
-
-Theorem Rnd_ZR_abs :
- forall (F : R -> Prop) (rnd: R-> R),
- Rnd_ZR F rnd ->
- forall x : R, (Rabs (rnd x) <= Rabs x)%R.
-Proof.
-intros F rnd H x.
-assert (F 0%R).
-replace 0%R with (rnd 0%R).
-eapply H.
-apply Rle_refl.
-destruct (H 0%R) as (H1, H2).
-apply Rle_antisym.
-apply H1.
-apply Rle_refl.
-apply H2.
-apply Rle_refl.
-(* . *)
-destruct (Rle_or_lt 0 x).
-(* positive *)
-rewrite Rabs_right.
-rewrite Rabs_right; auto with real.
-now apply (proj1 (H x)).
-apply Rle_ge.
-now apply (proj1 (H x)).
-(* negative *)
-rewrite Rabs_left1.
-rewrite Rabs_left1 ; auto with real.
-apply Ropp_le_contravar.
-apply (proj2 (H x)).
-auto with real.
-apply (proj2 (H x)) ; auto with real.
-Qed.
-
-Theorem Rnd_ZR_pt_monotone :
- forall F : R -> Prop, F 0 ->
- round_pred_monotone (Rnd_ZR_pt F).
-Proof.
-intros F F0 x y f g (Hx1, Hx2) (Hy1, Hy2) Hxy.
-destruct (Rle_or_lt 0 x) as [Hx|Hx].
-(* . *)
-apply Hy1.
-now apply Rle_trans with x.
-now apply Hx1.
-apply Rle_trans with (2 := Hxy).
-now apply Hx1.
-(* . *)
-apply Rlt_le in Hx.
-destruct (Rle_or_lt 0 y) as [Hy|Hy].
-apply Rle_trans with 0.
-now apply Hx2.
-now apply Hy1.
-apply Rlt_le in Hy.
-apply Hx2.
-exact Hx.
-now apply Hy2.
-apply Rle_trans with (1 := Hxy).
-now apply Hy2.
-Qed.
-
-Theorem Rnd_N_pt_DN_or_UP :
- forall F : R -> Prop,
- forall x f : R,
- Rnd_N_pt F x f ->
- Rnd_DN_pt F x f \/ Rnd_UP_pt F x f.
-Proof.
-intros F x f (Hf1,Hf2).
-destruct (Rle_or_lt x f) as [Hxf|Hxf].
-(* . *)
-right.
-repeat split ; try assumption.
-intros g Hg Hxg.
-specialize (Hf2 g Hg).
-rewrite 2!Rabs_pos_eq in Hf2.
-now apply Rplus_le_reg_r with (-x)%R.
-now apply Rle_0_minus.
-now apply Rle_0_minus.
-(* . *)
-left.
-repeat split ; try assumption.
-now apply Rlt_le.
-intros g Hg Hxg.
-specialize (Hf2 g Hg).
-rewrite 2!Rabs_left1 in Hf2.
-generalize (Ropp_le_cancel _ _ Hf2).
-intros H.
-now apply Rplus_le_reg_r with (-x)%R.
-now apply Rle_minus.
-apply Rlt_le.
-now apply Rlt_minus.
-Qed.
-
-Theorem Rnd_N_pt_DN_or_UP_eq :
- forall F : R -> Prop,
- forall x fd fu f : R,
- Rnd_DN_pt F x fd -> Rnd_UP_pt F x fu ->
- Rnd_N_pt F x f ->
- f = fd \/ f = fu.
-Proof.
-intros F x fd fu f Hd Hu Hf.
-destruct (Rnd_N_pt_DN_or_UP F x f Hf) as [H|H].
-left.
-apply Rnd_DN_pt_unicity with (1 := H) (2 := Hd).
-right.
-apply Rnd_UP_pt_unicity with (1 := H) (2 := Hu).
-Qed.
-
-Theorem Rnd_N_pt_sym :
- forall F : R -> Prop,
- ( forall x, F x -> F (- x) ) ->
- forall x f : R,
- Rnd_N_pt F (-x) (-f) -> Rnd_N_pt F x f.
-Proof.
-intros F HF x f (H1,H2).
-rewrite <- (Ropp_involutive f).
-repeat split.
-apply HF.
-apply H1.
-intros g H3.
-rewrite Ropp_involutive.
-replace (f - x)%R with (-(-f - -x))%R by ring.
-replace (g - x)%R with (-(-g - -x))%R by ring.
-rewrite 2!Rabs_Ropp.
-apply H2.
-now apply HF.
-Qed.
-
-Theorem Rnd_N_pt_monotone :
- forall F : R -> Prop,
- forall x y f g : R,
- Rnd_N_pt F x f -> Rnd_N_pt F y g ->
- x < y -> f <= g.
-Proof.
-intros F x y f g (Hf,Hx) (Hg,Hy) Hxy.
-apply Rnot_lt_le.
-intros Hgf.
-assert (Hfgx := Hx g Hg).
-assert (Hgfy := Hy f Hf).
-clear F Hf Hg Hx Hy.
-destruct (Rle_or_lt x g) as [Hxg|Hgx].
-(* x <= g < f *)
-apply Rle_not_lt with (1 := Hfgx).
-rewrite 2!Rabs_pos_eq.
-now apply Rplus_lt_compat_r.
-apply Rle_0_minus.
-apply Rlt_le.
-now apply Rle_lt_trans with (1 := Hxg).
-now apply Rle_0_minus.
-assert (Hgy := Rlt_trans _ _ _ Hgx Hxy).
-destruct (Rle_or_lt f y) as [Hfy|Hyf].
-(* g < f <= y *)
-apply Rle_not_lt with (1 := Hgfy).
-rewrite (Rabs_left (g - y)).
-2: now apply Rlt_minus.
-rewrite Rabs_left1.
-apply Ropp_lt_contravar.
-now apply Rplus_lt_compat_r.
-now apply Rle_minus.
-(* g < x < y < f *)
-rewrite Rabs_left, Rabs_pos_eq, Ropp_minus_distr in Hgfy.
-rewrite Rabs_pos_eq, Rabs_left, Ropp_minus_distr in Hfgx.
-apply Rle_not_lt with (1 := Rplus_le_compat _ _ _ _ Hfgx Hgfy).
-apply Rminus_lt.
-ring_simplify.
-apply Rlt_minus.
-apply Rmult_lt_compat_l.
-now apply (Z2R_lt 0 2).
-exact Hxy.
-now apply Rlt_minus.
-apply Rle_0_minus.
-apply Rlt_le.
-now apply Rlt_trans with (1 := Hxy).
-apply Rle_0_minus.
-now apply Rlt_le.
-now apply Rlt_minus.
-Qed.
-
-Theorem Rnd_N_pt_unicity :
- forall F : R -> Prop,
- forall x d u f1 f2 : R,
- Rnd_DN_pt F x d ->
- Rnd_UP_pt F x u ->
- x - d <> u - x ->
- Rnd_N_pt F x f1 ->
- Rnd_N_pt F x f2 ->
- f1 = f2.
-Proof.
-intros F x d u f1 f2 Hd Hu Hdu.
-assert (forall f1 f2, Rnd_N_pt F x f1 -> Rnd_N_pt F x f2 -> f1 < f2 -> False).
-clear f1 f2. intros f1 f2 Hf1 Hf2 H12.
-destruct (Rnd_N_pt_DN_or_UP F x f1 Hf1) as [Hd1|Hu1] ;
- destruct (Rnd_N_pt_DN_or_UP F x f2 Hf2) as [Hd2|Hu2].
-apply Rlt_not_eq with (1 := H12).
-now apply Rnd_DN_pt_unicity with (1 := Hd1).
-apply Hdu.
-rewrite Rnd_DN_pt_unicity with (1 := Hd) (2 := Hd1).
-rewrite Rnd_UP_pt_unicity with (1 := Hu) (2 := Hu2).
-rewrite <- (Rabs_pos_eq (x - f1)).
-rewrite <- (Rabs_pos_eq (f2 - x)).
-rewrite Rabs_minus_sym.
-apply Rle_antisym.
-apply Hf1. apply Hf2.
-apply Hf2. apply Hf1.
-apply Rle_0_minus.
-apply Hu2.
-apply Rle_0_minus.
-apply Hd1.
-apply Rlt_not_le with (1 := H12).
-apply Rle_trans with x.
-apply Hd2.
-apply Hu1.
-apply Rgt_not_eq with (1 := H12).
-now apply Rnd_UP_pt_unicity with (1 := Hu2).
-intros Hf1 Hf2.
-now apply Rle_antisym ; apply Rnot_lt_le ; refine (H _ _ _ _).
-Qed.
-
-Theorem Rnd_N_pt_refl :
- forall F : R -> Prop,
- forall x : R, F x ->
- Rnd_N_pt F x x.
-Proof.
-intros F x Hx.
-repeat split.
-exact Hx.
-intros g _.
-unfold Rminus at 1.
-rewrite Rplus_opp_r, Rabs_R0.
-apply Rabs_pos.
-Qed.
-
-Theorem Rnd_N_pt_idempotent :
- forall F : R -> Prop,
- forall x f : R,
- Rnd_N_pt F x f -> F x ->
- f = x.
-Proof.
-intros F x f (_,Hf) Hx.
-apply Rminus_diag_uniq.
-destruct (Req_dec (f - x) 0) as [H|H].
-exact H.
-elim Rabs_no_R0 with (1 := H).
-apply Rle_antisym.
-replace 0 with (Rabs (x - x)).
-now apply Hf.
-unfold Rminus.
-rewrite Rplus_opp_r.
-apply Rabs_R0.
-apply Rabs_pos.
-Qed.
-
-Theorem Rnd_N_pt_0 :
- forall F : R -> Prop,
- F 0 ->
- Rnd_N_pt F 0 0.
-Proof.
-intros F HF.
-split.
-exact HF.
-intros g _.
-rewrite 2!Rminus_0_r, Rabs_R0.
-apply Rabs_pos.
-Qed.
-
-Theorem Rnd_N_pt_pos :
- forall F : R -> Prop, F 0 ->
- forall x f, 0 <= x ->
- Rnd_N_pt F x f ->
- 0 <= f.
-Proof.
-intros F HF x f [Hx|Hx] Hxf.
-eapply Rnd_N_pt_monotone ; try eassumption.
-now apply Rnd_N_pt_0.
-right.
-apply sym_eq.
-apply Rnd_N_pt_idempotent with F.
-now rewrite Hx.
-exact HF.
-Qed.
-
-Theorem Rnd_N_pt_neg :
- forall F : R -> Prop, F 0 ->
- forall x f, x <= 0 ->
- Rnd_N_pt F x f ->
- f <= 0.
-Proof.
-intros F HF x f [Hx|Hx] Hxf.
-eapply Rnd_N_pt_monotone ; try eassumption.
-now apply Rnd_N_pt_0.
-right.
-apply Rnd_N_pt_idempotent with F.
-now rewrite <- Hx.
-exact HF.
-Qed.
-
-Theorem Rnd_N_pt_abs :
- forall F : R -> Prop,
- F 0 ->
- ( forall x, F x -> F (- x) ) ->
- forall x f : R,
- Rnd_N_pt F x f -> Rnd_N_pt F (Rabs x) (Rabs f).
-Proof.
-intros F HF0 HF x f Hxf.
-unfold Rabs at 1.
-destruct (Rcase_abs x) as [Hx|Hx].
-rewrite Rabs_left1.
-apply Rnd_N_pt_sym.
-exact HF.
-now rewrite 2!Ropp_involutive.
-apply Rnd_N_pt_neg with (3 := Hxf).
-exact HF0.
-now apply Rlt_le.
-rewrite Rabs_pos_eq.
-exact Hxf.
-apply Rnd_N_pt_pos with (3 := Hxf).
-exact HF0.
-now apply Rge_le.
-Qed.
-
-Theorem Rnd_DN_UP_pt_N :
- forall F : R -> Prop,
- forall x d u f : R,
- F f ->
- Rnd_DN_pt F x d ->
- Rnd_UP_pt F x u ->
- (Rabs (f - x) <= x - d)%R ->
- (Rabs (f - x) <= u - x)%R ->
- Rnd_N_pt F x f.
-Proof.
-intros F x d u f Hf Hxd Hxu Hd Hu.
-split.
-exact Hf.
-intros g Hg.
-destruct (Rnd_DN_UP_pt_split F x d u Hxd Hxu g Hg) as [Hgd|Hgu].
-(* g <= d *)
-apply Rle_trans with (1 := Hd).
-rewrite Rabs_left1.
-rewrite Ropp_minus_distr.
-apply Rplus_le_compat_l.
-now apply Ropp_le_contravar.
-apply Rle_minus.
-apply Rle_trans with (1 := Hgd).
-apply Hxd.
-(* u <= g *)
-apply Rle_trans with (1 := Hu).
-rewrite Rabs_pos_eq.
-now apply Rplus_le_compat_r.
-apply Rle_0_minus.
-apply Rle_trans with (2 := Hgu).
-apply Hxu.
-Qed.
-
-Theorem Rnd_DN_pt_N :
- forall F : R -> Prop,
- forall x d u : R,
- Rnd_DN_pt F x d ->
- Rnd_UP_pt F x u ->
- (x - d <= u - x)%R ->
- Rnd_N_pt F x d.
-Proof.
-intros F x d u Hd Hu Hx.
-assert (Hdx: (Rabs (d - x) = x - d)%R).
-rewrite Rabs_minus_sym.
-apply Rabs_pos_eq.
-apply Rle_0_minus.
-apply Hd.
-apply Rnd_DN_UP_pt_N with (2 := Hd) (3 := Hu).
-apply Hd.
-rewrite Hdx.
-apply Rle_refl.
-now rewrite Hdx.
-Qed.
-
-Theorem Rnd_UP_pt_N :
- forall F : R -> Prop,
- forall x d u : R,
- Rnd_DN_pt F x d ->
- Rnd_UP_pt F x u ->
- (u - x <= x - d)%R ->
- Rnd_N_pt F x u.
-Proof.
-intros F x d u Hd Hu Hx.
-assert (Hux: (Rabs (u - x) = u - x)%R).
-apply Rabs_pos_eq.
-apply Rle_0_minus.
-apply Hu.
-apply Rnd_DN_UP_pt_N with (2 := Hd) (3 := Hu).
-apply Hu.
-now rewrite Hux.
-rewrite Hux.
-apply Rle_refl.
-Qed.
-
-Definition Rnd_NG_pt_unicity_prop F P :=
- forall x d u,
- Rnd_DN_pt F x d -> Rnd_N_pt F x d ->
- Rnd_UP_pt F x u -> Rnd_N_pt F x u ->
- P x d -> P x u -> d = u.
-
-Theorem Rnd_NG_pt_unicity :
- forall (F : R -> Prop) (P : R -> R -> Prop),
- Rnd_NG_pt_unicity_prop F P ->
- forall x f1 f2 : R,
- Rnd_NG_pt F P x f1 -> Rnd_NG_pt F P x f2 ->
- f1 = f2.
-Proof.
-intros F P HP x f1 f2 (H1a,H1b) (H2a,H2b).
-destruct H1b as [H1b|H1b].
-destruct H2b as [H2b|H2b].
-destruct (Rnd_N_pt_DN_or_UP _ _ _ H1a) as [H1c|H1c] ;
- destruct (Rnd_N_pt_DN_or_UP _ _ _ H2a) as [H2c|H2c].
-eapply Rnd_DN_pt_unicity ; eassumption.
-now apply (HP x f1 f2).
-apply sym_eq.
-now apply (HP x f2 f1 H2c H2a H1c H1a).
-eapply Rnd_UP_pt_unicity ; eassumption.
-now apply H2b.
-apply sym_eq.
-now apply H1b.
-Qed.
-
-Theorem Rnd_NG_pt_monotone :
- forall (F : R -> Prop) (P : R -> R -> Prop),
- Rnd_NG_pt_unicity_prop F P ->
- round_pred_monotone (Rnd_NG_pt F P).
-Proof.
-intros F P HP x y f g (Hf,Hx) (Hg,Hy) [Hxy|Hxy].
-now apply Rnd_N_pt_monotone with F x y.
-apply Req_le.
-rewrite <- Hxy in Hg, Hy.
-eapply Rnd_NG_pt_unicity ; try split ; eassumption.
-Qed.
-
-Theorem Rnd_NG_pt_refl :
- forall (F : R -> Prop) (P : R -> R -> Prop),
- forall x, F x -> Rnd_NG_pt F P x x.
-Proof.
-intros F P x Hx.
-split.
-now apply Rnd_N_pt_refl.
-right.
-intros f2 Hf2.
-now apply Rnd_N_pt_idempotent with F.
-Qed.
-
-Theorem Rnd_NG_pt_sym :
- forall (F : R -> Prop) (P : R -> R -> Prop),
- ( forall x, F x -> F (-x) ) ->
- ( forall x f, P x f -> P (-x) (-f) ) ->
- forall x f : R,
- Rnd_NG_pt F P (-x) (-f) -> Rnd_NG_pt F P x f.
-Proof.
-intros F P HF HP x f (H1,H2).
-split.
-now apply Rnd_N_pt_sym.
-destruct H2 as [H2|H2].
-left.
-rewrite <- (Ropp_involutive x), <- (Ropp_involutive f).
-now apply HP.
-right.
-intros f2 Hxf2.
-rewrite <- (Ropp_involutive f).
-rewrite <- H2 with (-f2).
-apply sym_eq.
-apply Ropp_involutive.
-apply Rnd_N_pt_sym.
-exact HF.
-now rewrite 2!Ropp_involutive.
-Qed.
-
-Theorem Rnd_NG_unicity :
- forall (F : R -> Prop) (P : R -> R -> Prop),
- Rnd_NG_pt_unicity_prop F P ->
- forall rnd1 rnd2 : R -> R,
- Rnd_NG F P rnd1 -> Rnd_NG F P rnd2 ->
- forall x, rnd1 x = rnd2 x.
-Proof.
-intros F P HP rnd1 rnd2 H1 H2 x.
-now apply Rnd_NG_pt_unicity with F P x.
-Qed.
-
-Theorem Rnd_NA_NG_pt :
- forall F : R -> Prop,
- F 0 ->
- forall x f,
- Rnd_NA_pt F x f <-> Rnd_NG_pt F (fun x f => Rabs x <= Rabs f) x f.
-Proof.
-intros F HF x f.
-destruct (Rle_or_lt 0 x) as [Hx|Hx].
-(* *)
-split ; intros (H1, H2).
-(* . *)
-assert (Hf := Rnd_N_pt_pos F HF x f Hx H1).
-split.
-exact H1.
-destruct (Rnd_N_pt_DN_or_UP _ _ _ H1) as [H3|H3].
-(* . . *)
-right.
-intros f2 Hxf2.
-specialize (H2 _ Hxf2).
-destruct (Rnd_N_pt_DN_or_UP _ _ _ Hxf2) as [H4|H4].
-eapply Rnd_DN_pt_unicity ; eassumption.
-apply Rle_antisym.
-rewrite Rabs_pos_eq with (1 := Hf) in H2.
-rewrite Rabs_pos_eq in H2.
-exact H2.
-now apply Rnd_N_pt_pos with F x.
-apply Rle_trans with x.
-apply H3.
-apply H4.
-(* . . *)
-left.
-rewrite Rabs_pos_eq with (1 := Hf).
-rewrite Rabs_pos_eq with (1 := Hx).
-apply H3.
-(* . *)
-split.
-exact H1.
-intros f2 Hxf2.
-destruct H2 as [H2|H2].
-assert (Hf := Rnd_N_pt_pos F HF x f Hx H1).
-assert (Hf2 := Rnd_N_pt_pos F HF x f2 Hx Hxf2).
-rewrite 2!Rabs_pos_eq ; trivial.
-rewrite 2!Rabs_pos_eq in H2 ; trivial.
-destruct (Rnd_N_pt_DN_or_UP _ _ _ Hxf2) as [H3|H3].
-apply Rle_trans with (2 := H2).
-apply H3.
-apply H3.
-apply H1.
-apply H2.
-rewrite (H2 _ Hxf2).
-apply Rle_refl.
-(* *)
-assert (Hx' := Rlt_le _ _ Hx).
-clear Hx. rename Hx' into Hx.
-split ; intros (H1, H2).
-(* . *)
-assert (Hf := Rnd_N_pt_neg F HF x f Hx H1).
-split.
-exact H1.
-destruct (Rnd_N_pt_DN_or_UP _ _ _ H1) as [H3|H3].
-(* . . *)
-left.
-rewrite Rabs_left1 with (1 := Hf).
-rewrite Rabs_left1 with (1 := Hx).
-apply Ropp_le_contravar.
-apply H3.
-(* . . *)
-right.
-intros f2 Hxf2.
-specialize (H2 _ Hxf2).
-destruct (Rnd_N_pt_DN_or_UP _ _ _ Hxf2) as [H4|H4].
-apply Rle_antisym.
-apply Rle_trans with x.
-apply H4.
-apply H3.
-rewrite Rabs_left1 with (1 := Hf) in H2.
-rewrite Rabs_left1 in H2.
-now apply Ropp_le_cancel.
-now apply Rnd_N_pt_neg with F x.
-eapply Rnd_UP_pt_unicity ; eassumption.
-(* . *)
-split.
-exact H1.
-intros f2 Hxf2.
-destruct H2 as [H2|H2].
-assert (Hf := Rnd_N_pt_neg F HF x f Hx H1).
-assert (Hf2 := Rnd_N_pt_neg F HF x f2 Hx Hxf2).
-rewrite 2!Rabs_left1 ; trivial.
-rewrite 2!Rabs_left1 in H2 ; trivial.
-apply Ropp_le_contravar.
-apply Ropp_le_cancel in H2.
-destruct (Rnd_N_pt_DN_or_UP _ _ _ Hxf2) as [H3|H3].
-apply H3.
-apply H1.
-apply H2.
-apply Rle_trans with (1 := H2).
-apply H3.
-rewrite (H2 _ Hxf2).
-apply Rle_refl.
-Qed.
-
-Theorem Rnd_NA_pt_unicity_prop :
- forall F : R -> Prop,
- F 0 ->
- Rnd_NG_pt_unicity_prop F (fun a b => (Rabs a <= Rabs b)%R).
-Proof.
-intros F HF x d u Hxd1 Hxd2 Hxu1 Hxu2 Hd Hu.
-apply Rle_antisym.
-apply Rle_trans with x.
-apply Hxd1.
-apply Hxu1.
-destruct (Rle_or_lt 0 x) as [Hx|Hx].
-apply Hxu1.
-apply Hxd1.
-rewrite Rabs_pos_eq with (1 := Hx) in Hd.
-rewrite Rabs_pos_eq in Hd.
-exact Hd.
-now apply Hxd1.
-apply Hxd1.
-apply Hxu1.
-rewrite Rabs_left with (1 := Hx) in Hu.
-rewrite Rabs_left1 in Hu.
-now apply Ropp_le_cancel.
-apply Hxu1.
-apply HF.
-now apply Rlt_le.
-Qed.
-
-Theorem Rnd_NA_pt_unicity :
- forall F : R -> Prop,
- F 0 ->
- forall x f1 f2 : R,
- Rnd_NA_pt F x f1 -> Rnd_NA_pt F x f2 ->
- f1 = f2.
-Proof.
-intros F HF x f1 f2 H1 H2.
-apply (Rnd_NG_pt_unicity F _ (Rnd_NA_pt_unicity_prop F HF) x).
-now apply -> Rnd_NA_NG_pt.
-now apply -> Rnd_NA_NG_pt.
-Qed.
-
-Theorem Rnd_NA_N_pt :
- forall F : R -> Prop,
- F 0 ->
- forall x f : R,
- Rnd_N_pt F x f ->
- (Rabs x <= Rabs f)%R ->
- Rnd_NA_pt F x f.
-Proof.
-intros F HF x f Rxf Hxf.
-split.
-apply Rxf.
-intros g Rxg.
-destruct (Rabs_eq_Rabs (f - x) (g - x)) as [H|H].
-apply Rle_antisym.
-apply Rxf.
-apply Rxg.
-apply Rxg.
-apply Rxf.
-(* *)
-replace g with f.
-apply Rle_refl.
-apply Rplus_eq_reg_r with (1 := H).
-(* *)
-assert (g = 2 * x - f)%R.
-replace (2 * x - f)%R with (x - (f - x))%R by ring.
-rewrite H.
-ring.
-destruct (Rle_lt_dec 0 x) as [Hx|Hx].
-(* . *)
-revert Hxf.
-rewrite Rabs_pos_eq with (1 := Hx).
-rewrite 2!Rabs_pos_eq ; try ( apply (Rnd_N_pt_pos F HF x) ; assumption ).
-intros Hxf.
-rewrite H0.
-apply Rplus_le_reg_r with f.
-ring_simplify.
-apply Rmult_le_compat_l with (2 := Hxf).
-now apply (Z2R_le 0 2).
-(* . *)
-revert Hxf.
-apply Rlt_le in Hx.
-rewrite Rabs_left1 with (1 := Hx).
-rewrite 2!Rabs_left1 ; try ( apply (Rnd_N_pt_neg F HF x) ; assumption ).
-intros Hxf.
-rewrite H0.
-apply Ropp_le_contravar.
-apply Rplus_le_reg_r with f.
-ring_simplify.
-apply Rmult_le_compat_l.
-now apply (Z2R_le 0 2).
-now apply Ropp_le_cancel.
-Qed.
-
-Theorem Rnd_NA_unicity :
- forall (F : R -> Prop),
- F 0 ->
- forall rnd1 rnd2 : R -> R,
- Rnd_NA F rnd1 -> Rnd_NA F rnd2 ->
- forall x, rnd1 x = rnd2 x.
-Proof.
-intros F HF rnd1 rnd2 H1 H2 x.
-now apply Rnd_NA_pt_unicity with F x.
-Qed.
-
-Theorem Rnd_NA_pt_monotone :
- forall F : R -> Prop,
- F 0 ->
- round_pred_monotone (Rnd_NA_pt F).
-Proof.
-intros F HF x y f g Hxf Hyg Hxy.
-apply (Rnd_NG_pt_monotone F _ (Rnd_NA_pt_unicity_prop F HF) x y).
-now apply -> Rnd_NA_NG_pt.
-now apply -> Rnd_NA_NG_pt.
-exact Hxy.
-Qed.
-
-Theorem Rnd_NA_pt_refl :
- forall F : R -> Prop,
- forall x : R, F x ->
- Rnd_NA_pt F x x.
-Proof.
-intros F x Hx.
-split.
-now apply Rnd_N_pt_refl.
-intros f Hxf.
-apply Req_le.
-apply f_equal.
-now apply Rnd_N_pt_idempotent with (1 := Hxf).
-Qed.
-
-Theorem Rnd_NA_pt_idempotent :
- forall F : R -> Prop,
- forall x f : R,
- Rnd_NA_pt F x f -> F x ->
- f = x.
-Proof.
-intros F x f (Hf,_) Hx.
-now apply Rnd_N_pt_idempotent with F.
-Qed.
-
-Theorem round_pred_ge_0 :
- forall P : R -> R -> Prop,
- round_pred_monotone P ->
- P 0 0 ->
- forall x f, P x f -> 0 <= x -> 0 <= f.
-Proof.
-intros P HP HP0 x f Hxf Hx.
-now apply (HP 0 x).
-Qed.
-
-Theorem round_pred_gt_0 :
- forall P : R -> R -> Prop,
- round_pred_monotone P ->
- P 0 0 ->
- forall x f, P x f -> 0 < f -> 0 < x.
-Proof.
-intros P HP HP0 x f Hxf Hf.
-apply Rnot_le_lt.
-intros Hx.
-apply Rlt_not_le with (1 := Hf).
-now apply (HP x 0).
-Qed.
-
-Theorem round_pred_le_0 :
- forall P : R -> R -> Prop,
- round_pred_monotone P ->
- P 0 0 ->
- forall x f, P x f -> x <= 0 -> f <= 0.
-Proof.
-intros P HP HP0 x f Hxf Hx.
-now apply (HP x 0).
-Qed.
-
-Theorem round_pred_lt_0 :
- forall P : R -> R -> Prop,
- round_pred_monotone P ->
- P 0 0 ->
- forall x f, P x f -> f < 0 -> x < 0.
-Proof.
-intros P HP HP0 x f Hxf Hf.
-apply Rnot_le_lt.
-intros Hx.
-apply Rlt_not_le with (1 := Hf).
-now apply (HP 0 x).
-Qed.
-
-Theorem Rnd_DN_pt_equiv_format :
- forall F1 F2 : R -> Prop,
- forall a b : R,
- F1 a ->
- ( forall x, a <= x <= b -> (F1 x <-> F2 x) ) ->
- forall x f, a <= x <= b -> Rnd_DN_pt F1 x f -> Rnd_DN_pt F2 x f.
-Proof.
-intros F1 F2 a b Ha HF x f Hx (H1, (H2, H3)).
-split.
-apply -> HF.
-exact H1.
-split.
-now apply H3.
-now apply Rle_trans with (1 := H2).
-split.
-exact H2.
-intros k Hk Hl.
-destruct (Rlt_or_le k a) as [H|H].
-apply Rlt_le.
-apply Rlt_le_trans with (1 := H).
-now apply H3.
-apply H3.
-apply <- HF.
-exact Hk.
-split.
-exact H.
-now apply Rle_trans with (1 := Hl).
-exact Hl.
-Qed.
-
-Theorem Rnd_UP_pt_equiv_format :
- forall F1 F2 : R -> Prop,
- forall a b : R,
- F1 b ->
- ( forall x, a <= x <= b -> (F1 x <-> F2 x) ) ->
- forall x f, a <= x <= b -> Rnd_UP_pt F1 x f -> Rnd_UP_pt F2 x f.
-Proof.
-intros F1 F2 a b Hb HF x f Hx (H1, (H2, H3)).
-split.
-apply -> HF.
-exact H1.
-split.
-now apply Rle_trans with (2 := H2).
-now apply H3.
-split.
-exact H2.
-intros k Hk Hl.
-destruct (Rle_or_lt k b) as [H|H].
-apply H3.
-apply <- HF.
-exact Hk.
-split.
-now apply Rle_trans with (2 := Hl).
-exact H.
-exact Hl.
-apply Rlt_le.
-apply Rle_lt_trans with (2 := H).
-now apply H3.
-Qed.
-
-(** ensures a real number can always be rounded *)
-Inductive satisfies_any (F : R -> Prop) :=
- Satisfies_any :
- F 0 -> ( forall x : R, F x -> F (-x) ) ->
- round_pred_total (Rnd_DN_pt F) -> satisfies_any F.
-
-Theorem satisfies_any_eq :
- forall F1 F2 : R -> Prop,
- ( forall x, F1 x <-> F2 x ) ->
- satisfies_any F1 ->
- satisfies_any F2.
-Proof.
-intros F1 F2 Heq (Hzero, Hsym, Hrnd).
-split.
-now apply -> Heq.
-intros x Hx.
-apply -> Heq.
-apply Hsym.
-now apply <- Heq.
-intros x.
-destruct (Hrnd x) as (f, (H1, (H2, H3))).
-exists f.
-split.
-now apply -> Heq.
-split.
-exact H2.
-intros g Hg Hgx.
-apply H3.
-now apply <- Heq.
-exact Hgx.
-Qed.
-
-Theorem satisfies_any_imp_DN :
- forall F : R -> Prop,
- satisfies_any F ->
- round_pred (Rnd_DN_pt F).
-Proof.
-intros F (_,_,Hrnd).
-split.
-apply Hrnd.
-apply Rnd_DN_pt_monotone.
-Qed.
-
-Theorem satisfies_any_imp_UP :
- forall F : R -> Prop,
- satisfies_any F ->
- round_pred (Rnd_UP_pt F).
-Proof.
-intros F Hany.
-split.
-intros x.
-destruct (proj1 (satisfies_any_imp_DN F Hany) (-x)) as (f, Hf).
-exists (-f).
-rewrite <- (Ropp_involutive x).
-apply Rnd_DN_UP_pt_sym.
-apply Hany.
-exact Hf.
-apply Rnd_UP_pt_monotone.
-Qed.
-
-Theorem satisfies_any_imp_ZR :
- forall F : R -> Prop,
- satisfies_any F ->
- round_pred (Rnd_ZR_pt F).
-Proof.
-intros F Hany.
-split.
-intros x.
-destruct (Rle_or_lt 0 x) as [Hx|Hx].
-(* positive *)
-destruct (proj1 (satisfies_any_imp_DN F Hany) x) as (f, Hf).
-exists f.
-split.
-now intros _.
-intros Hx'.
-(* zero *)
-assert (x = 0).
-now apply Rle_antisym.
-rewrite H in Hf |- *.
-clear H Hx Hx'.
-rewrite Rnd_DN_pt_idempotent with (1 := Hf).
-apply Rnd_UP_pt_refl.
-apply Hany.
-apply Hany.
-(* negative *)
-destruct (proj1 (satisfies_any_imp_UP F Hany) x) as (f, Hf).
-exists f.
-split.
-intros Hx'.
-elim (Rlt_irrefl 0).
-now apply Rle_lt_trans with x.
-now intros _.
-(* . *)
-apply Rnd_ZR_pt_monotone.
-apply Hany.
-Qed.
-
-Definition NG_existence_prop (F : R -> Prop) (P : R -> R -> Prop) :=
- forall x d u, ~F x -> Rnd_DN_pt F x d -> Rnd_UP_pt F x u -> P x u \/ P x d.
-
-Theorem satisfies_any_imp_NG :
- forall (F : R -> Prop) (P : R -> R -> Prop),
- satisfies_any F ->
- NG_existence_prop F P ->
- round_pred_total (Rnd_NG_pt F P).
-Proof.
-intros F P Hany HP x.
-destruct (proj1 (satisfies_any_imp_DN F Hany) x) as (d, Hd).
-destruct (proj1 (satisfies_any_imp_UP F Hany) x) as (u, Hu).
-destruct (total_order_T (Rabs (u - x)) (Rabs (d - x))) as [[H|H]|H].
-(* |up(x) - x| < |dn(x) - x| *)
-exists u.
-split.
-(* - . *)
-split.
-apply Hu.
-intros g Hg.
-destruct (Rle_or_lt x g) as [Hxg|Hxg].
-rewrite 2!Rabs_pos_eq.
-apply Rplus_le_compat_r.
-now apply Hu.
-now apply Rle_0_minus.
-apply Rle_0_minus.
-apply Hu.
-apply Rlt_le in Hxg.
-apply Rlt_le.
-apply Rlt_le_trans with (1 := H).
-do 2 rewrite <- (Rabs_minus_sym x).
-rewrite 2!Rabs_pos_eq.
-apply Rplus_le_compat_l.
-apply Ropp_le_contravar.
-now apply Hd.
-now apply Rle_0_minus.
-apply Rle_0_minus.
-apply Hd.
-(* - . *)
-right.
-intros f Hf.
-destruct (Rnd_N_pt_DN_or_UP_eq F x _ _ _ Hd Hu Hf) as [K|K] ; rewrite K.
-elim Rlt_not_le with (1 := H).
-rewrite <- K.
-apply Hf.
-apply Hu.
-apply refl_equal.
-(* |up(x) - x| = |dn(x) - x| *)
-destruct (Req_dec x d) as [He|Hne].
-(* - x = d = u *)
-exists x.
-split.
-apply Rnd_N_pt_refl.
-rewrite He.
-apply Hd.
-right.
-intros.
-apply Rnd_N_pt_idempotent with (1 := H0).
-rewrite He.
-apply Hd.
-assert (Hf : ~F x).
-intros Hf.
-apply Hne.
-apply sym_eq.
-now apply Rnd_DN_pt_idempotent with (1 := Hd).
-destruct (HP x _ _ Hf Hd Hu) as [H'|H'].
-(* - u >> d *)
-exists u.
-split.
-split.
-apply Hu.
-intros g Hg.
-destruct (Rle_or_lt x g) as [Hxg|Hxg].
-rewrite 2!Rabs_pos_eq.
-apply Rplus_le_compat_r.
-now apply Hu.
-now apply Rle_0_minus.
-apply Rle_0_minus.
-apply Hu.
-apply Rlt_le in Hxg.
-rewrite H.
-rewrite 2!Rabs_left1.
-apply Ropp_le_contravar.
-apply Rplus_le_compat_r.
-now apply Hd.
-now apply Rle_minus.
-apply Rle_minus.
-apply Hd.
-now left.
-(* - d >> u *)
-exists d.
-split.
-split.
-apply Hd.
-intros g Hg.
-destruct (Rle_or_lt x g) as [Hxg|Hxg].
-rewrite <- H.
-rewrite 2!Rabs_pos_eq.
-apply Rplus_le_compat_r.
-now apply Hu.
-now apply Rle_0_minus.
-apply Rle_0_minus.
-apply Hu.
-apply Rlt_le in Hxg.
-rewrite 2!Rabs_left1.
-apply Ropp_le_contravar.
-apply Rplus_le_compat_r.
-now apply Hd.
-now apply Rle_minus.
-apply Rle_minus.
-apply Hd.
-now left.
-(* |up(x) - x| > |dn(x) - x| *)
-exists d.
-split.
-split.
-apply Hd.
-intros g Hg.
-destruct (Rle_or_lt x g) as [Hxg|Hxg].
-apply Rlt_le.
-apply Rlt_le_trans with (1 := H).
-rewrite 2!Rabs_pos_eq.
-apply Rplus_le_compat_r.
-now apply Hu.
-now apply Rle_0_minus.
-apply Rle_0_minus.
-apply Hu.
-apply Rlt_le in Hxg.
-rewrite 2!Rabs_left1.
-apply Ropp_le_contravar.
-apply Rplus_le_compat_r.
-now apply Hd.
-now apply Rle_minus.
-apply Rle_minus.
-apply Hd.
-right.
-intros f Hf.
-destruct (Rnd_N_pt_DN_or_UP_eq F x _ _ _ Hd Hu Hf) as [K|K] ; rewrite K.
-apply refl_equal.
-elim Rlt_not_le with (1 := H).
-rewrite <- K.
-apply Hf.
-apply Hd.
-Qed.
-
-Theorem satisfies_any_imp_NA :
- forall F : R -> Prop,
- satisfies_any F ->
- round_pred (Rnd_NA_pt F).
-Proof.
-intros F Hany.
-split.
-assert (H : round_pred_total (Rnd_NG_pt F (fun a b => (Rabs a <= Rabs b)%R))).
-apply satisfies_any_imp_NG.
-apply Hany.
-intros x d u Hf Hd Hu.
-destruct (Rle_lt_dec 0 x) as [Hx|Hx].
-left.
-rewrite Rabs_pos_eq with (1 := Hx).
-rewrite Rabs_pos_eq.
-apply Hu.
-apply Rle_trans with (1 := Hx).
-apply Hu.
-right.
-rewrite Rabs_left with (1 := Hx).
-rewrite Rabs_left1.
-apply Ropp_le_contravar.
-apply Hd.
-apply Rlt_le in Hx.
-apply Rle_trans with (2 := Hx).
-apply Hd.
-intros x.
-destruct (H x) as (f, Hf).
-exists f.
-apply <- Rnd_NA_NG_pt.
-apply Hf.
-apply Hany.
-apply Rnd_NA_pt_monotone.
-apply Hany.
-Qed.
-
-End RND_prop.