From f766162861ffdf441e71d58021015f189c1e2888 Mon Sep 17 00:00:00 2001 From: Pierre Roux Date: Sun, 10 Nov 2024 18:14:26 +0100 Subject: [PATCH 01/19] Remove unused imports of signed.v --- theories/cantor.v | 2 +- theories/exp.v | 2 +- theories/homotopy_theory/continuous_path.v | 2 +- theories/homotopy_theory/wedge_sigT.v | 2 +- theories/showcase/summability.v | 2 +- theories/topology_theory/bool_topology.v | 2 +- theories/topology_theory/nat_topology.v | 2 +- theories/topology_theory/one_point_compactification.v | 2 +- 8 files changed, 8 insertions(+), 8 deletions(-) diff --git a/theories/cantor.v b/theories/cantor.v index 6160b1552..e4f4344b5 100644 --- a/theories/cantor.v +++ b/theories/cantor.v @@ -3,7 +3,7 @@ From HB Require Import structures. From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum interval rat. From mathcomp Require Import finmap. From mathcomp Require Import mathcomp_extra boolp classical_sets functions. -From mathcomp Require Import cardinality reals signed. +From mathcomp Require Import cardinality reals. From mathcomp Require Import topology function_spaces separation_axioms. (**md**************************************************************************) diff --git a/theories/exp.v b/theories/exp.v index cb7d2b8b7..3b8e397da 100644 --- a/theories/exp.v +++ b/theories/exp.v @@ -62,7 +62,7 @@ Fact is_cvg_pseries_inside_norm f (x z : R) : cvgn (pseries (fun i => `|f i|) z). Proof. move=> Cx zLx; have [K [Kreal Kf]] := cvg_series_bounded Cx. -have Kzxn n : 0 <= `|K + 1| * `|z ^+ n| / `|x ^+ n| by rewrite !mulr_ge0. +have Kzxn n : 0 <= `|K + 1| * `|z ^+ n| / `|x ^+ n| by rewrite !mulr_ge0. apply: normed_cvg. apply: series_le_cvg Kzxn _ _ => [//=| /= n|]. rewrite (_ : `|_ * _| = `|f n * x ^+ n| * `|z ^+ n| / `|x ^+ n|); last first. diff --git a/theories/homotopy_theory/continuous_path.v b/theories/homotopy_theory/continuous_path.v index e11e80938..e66a3a4d9 100644 --- a/theories/homotopy_theory/continuous_path.v +++ b/theories/homotopy_theory/continuous_path.v @@ -2,7 +2,7 @@ From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra finmap generic_quotient. From mathcomp Require Import mathcomp_extra boolp classical_sets functions. -From mathcomp Require Import cardinality fsbigop reals signed topology. +From mathcomp Require Import cardinality fsbigop reals topology. From mathcomp Require Import function_spaces wedge_sigT. (**md**************************************************************************) diff --git a/theories/homotopy_theory/wedge_sigT.v b/theories/homotopy_theory/wedge_sigT.v index 86822e545..21b9dd659 100644 --- a/theories/homotopy_theory/wedge_sigT.v +++ b/theories/homotopy_theory/wedge_sigT.v @@ -2,7 +2,7 @@ From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra finmap generic_quotient. From mathcomp Require Import mathcomp_extra boolp classical_sets functions. -From mathcomp Require Import cardinality fsbigop reals signed topology. +From mathcomp Require Import cardinality fsbigop reals topology. From mathcomp Require Import separation_axioms function_spaces. (**md**************************************************************************) diff --git a/theories/showcase/summability.v b/theories/showcase/summability.v index dae60a5b9..801b6b9b9 100644 --- a/theories/showcase/summability.v +++ b/theories/showcase/summability.v @@ -3,7 +3,7 @@ From HB Require Import structures. From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum finmap matrix. From mathcomp Require Import interval zmodp. From mathcomp Require Import boolp classical_sets. -From mathcomp Require Import ereal reals signed topology normedtype. +From mathcomp Require Import ereal reals topology normedtype. (**md**************************************************************************) (* This file proposes a replacement for the definition `summable` (file *) diff --git a/theories/topology_theory/bool_topology.v b/theories/topology_theory/bool_topology.v index 5950ac34e..df8f74f0d 100644 --- a/theories/topology_theory/bool_topology.v +++ b/theories/topology_theory/bool_topology.v @@ -1,7 +1,7 @@ (* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra all_classical. -From mathcomp Require Import signed reals topology_structure uniform_structure. +From mathcomp Require Import reals topology_structure uniform_structure. From mathcomp Require Import pseudometric_structure order_topology compact. From mathcomp Require Import discrete_topology. diff --git a/theories/topology_theory/nat_topology.v b/theories/topology_theory/nat_topology.v index 0885f8c05..79bc3a1b3 100644 --- a/theories/topology_theory/nat_topology.v +++ b/theories/topology_theory/nat_topology.v @@ -2,7 +2,7 @@ From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra archimedean. From mathcomp Require Import all_classical. -From mathcomp Require Import signed reals topology_structure uniform_structure. +From mathcomp Require Import reals topology_structure uniform_structure. From mathcomp Require Import pseudometric_structure order_topology. From mathcomp Require Import discrete_topology. diff --git a/theories/topology_theory/one_point_compactification.v b/theories/topology_theory/one_point_compactification.v index 7c970d03f..737e524b3 100644 --- a/theories/topology_theory/one_point_compactification.v +++ b/theories/topology_theory/one_point_compactification.v @@ -1,6 +1,6 @@ From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra all_classical. -From mathcomp Require Import signed topology_structure uniform_structure. +From mathcomp Require Import topology_structure uniform_structure. From mathcomp Require Import pseudometric_structure compact weak_topology. (**md**************************************************************************) From 68b08386d88dee37bccfe78f601307b00579aeda Mon Sep 17 00:00:00 2001 From: Pierre Roux Date: Sat, 16 Nov 2024 20:28:35 +0100 Subject: [PATCH 02/19] Generalize EFin_min and EFin_max Generalized from realDomainType to numDomainType --- CHANGELOG_UNRELEASED.md | 3 +++ reals/constructive_ereal.v | 12 ++++++------ 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index 07a817111..f51f159f2 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -181,6 +181,9 @@ - in `normedtype.v`: + lemmas `not_near_at_rightP`, `not_near_at_leftP` +- in `constructive_ereal.v`: + + generalized from `realDomainType` to `numDomainType` + * lemmas `EFin_min` and `EFin_max` - in `Rstruct.v`: + lemma `RsqrtE` diff --git a/reals/constructive_ereal.v b/reals/constructive_ereal.v index 02d92318b..13666f615 100644 --- a/reals/constructive_ereal.v +++ b/reals/constructive_ereal.v @@ -760,6 +760,12 @@ Lemma sumEFin I s P (F : I -> R) : \sum_(i <- s | P i) (F i)%:E = (\sum_(i <- s | P i) F i)%:E. Proof. by rewrite (big_morph _ EFinD erefl). Qed. +Lemma EFin_min : {morph (@EFin R) : r s / Num.min r s >-> Order.min r s}. +Proof. by move=> x y; rewrite !minElt lte_fin -fun_if. Qed. + +Lemma EFin_max : {morph (@EFin R) : r s / Num.max r s >-> Order.max r s}. +Proof. by move=> x y; rewrite !maxElt lte_fin -fun_if. Qed. + Definition adde_def x y := ~~ ((x == +oo) && (y == -oo)) && ~~ ((x == -oo) && (y == +oo)). @@ -2433,9 +2439,6 @@ by move=> [x| |] [y| |]//= _ _; apply/esym; have [ab|ba] := leP x y; [apply/max_idPr; rewrite lee_fin|apply/max_idPl; rewrite lee_fin ltW]. Qed. -Lemma EFin_max : {morph (@EFin R) : r s / Num.max r s >-> maxe r s}. -Proof. by move=> a b /=; rewrite -fine_max. Qed. - Lemma fine_min : {in fin_num &, {mono @fine R : x y / mine x y >-> (Num.min x y)%:E}}. Proof. @@ -2443,9 +2446,6 @@ by move=> [x| |] [y| |]//= _ _; apply/esym; have [ab|ba] := leP x y; [apply/min_idPl; rewrite lee_fin|apply/min_idPr; rewrite lee_fin ltW]. Qed. -Lemma EFin_min : {morph (@EFin R) : r s / Num.min r s >-> mine r s}. -Proof. by move=> a b /=; rewrite -fine_min. Qed. - Lemma adde_maxl : left_distributive (@GRing.add (\bar R)) maxe. Proof. move=> x y z; have [xy|yx] := leP x y. From 1fc9fba8797cd2df02a2f10746e6a746f28f4608 Mon Sep 17 00:00:00 2001 From: Pierre Roux Date: Sun, 24 Nov 2024 17:09:29 +0100 Subject: [PATCH 03/19] A few lemmas to backport about min and max --- CHANGELOG_UNRELEASED.md | 5 +++ classical/mathcomp_extra.v | 74 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 79 insertions(+) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index f51f159f2..5f492f08d 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -110,6 +110,11 @@ + lemma `ge0_continuous_FTC2y` + lemma `Rintegral_ge0_continuous_FTC2y` + lemma `le0_continuous_FTC2y` +- in `mathcomp_extra.v` + + lemmas `comparable_BSide_min`, `BSide_min`, `BSide_max`, + `real_BSide_min`, `real_BSide_max`, `natr_min`, `natr_max`, + `comparable_min_le_min`, `comparable_max`, `min_le_min` + and `max_le_max` - new file `measurable_realfun.v` + with as contents the first half of the file `lebesgue_measure.v` diff --git a/classical/mathcomp_extra.v b/classical/mathcomp_extra.v index efb973be7..bddca3d1e 100644 --- a/classical/mathcomp_extra.v +++ b/classical/mathcomp_extra.v @@ -613,3 +613,77 @@ Proof. move=> lt_mn i; rewrite big_nat [ltRHS]big_nat ltr_sum//. by apply/hasP; exists m; rewrite ?mem_index_iota leqnn lt_mn. Qed. + +(* To backport to interval *) +Lemma comparable_BSide_min d (T : porderType d) b (x y : T) : (x >=< y)%O -> + BSide b (Order.min x y) = Order.min (BSide b x) (BSide b y). +Proof. by rewrite !minEle bnd_simp => /comparable_leP[]. Qed. + +(* To backport to interval *) +Lemma comparable_BSide_max d (T : porderType d) b (x y : T) : (x >=< y)%O -> + BSide b (Order.max x y) = Order.max (BSide b x) (BSide b y). +Proof. by rewrite !maxEle bnd_simp => /comparable_leP[]. Qed. + +(* To backport to interval *) +Lemma BSide_min d (T : orderType d) b (x y : T) : (x >=< y)%O -> + BSide b (Order.min x y) = Order.min (BSide b x) (BSide b y). +Proof. exact: comparable_BSide_min. Qed. + +(* To backport to interval *) +Lemma BSide_max d (T : orderType d) b (x y : T) : (x >=< y)%O -> + BSide b (Order.max x y) = Order.max (BSide b x) (BSide b y). +Proof. exact: comparable_BSide_max. Qed. + +Section NumDomainType. + +Variable (R : numDomainType). + +(* To backport to interval *) +Lemma real_BSide_min b (x y : R) : x \in Num.real -> y \in Num.real -> + BSide b (Order.min x y) = Order.min (BSide b x) (BSide b y). +Proof. by move=> xr yr; apply/comparable_BSide_min/real_comparable. Qed. + +(* To backport to interval *) +Lemma real_BSide_max b (x y : R) : x \in Num.real -> y \in Num.real -> + BSide b (Order.max x y) = Order.max (BSide b x) (BSide b y). +Proof. by move=> xr yr; apply/comparable_BSide_max/real_comparable. Qed. + +(* To backport to ssralg.v *) +Lemma natr_min (m n : nat) : (Order.min m n)%:R = Order.min m%:R n%:R :> R. +Proof. by rewrite !minElt ltr_nat /Order.lt/= -fun_if. Qed. + +(* To backport to ssralg.v *) +Lemma natr_max (m n : nat) : (Order.max m n)%:R = Order.max m%:R n%:R :> R. +Proof. by rewrite !maxElt ltr_nat /Order.lt/= -fun_if. Qed. + +End NumDomainType. + +(* To backport to order.v *) +Lemma comparable_min_le_min d (T : porderType d) (x y z t : T) : + (x >=< y)%O -> (z >=< t)%O -> + (x <= z)%O -> (y <= t)%O -> (Order.min x y <= Order.min z t)%O. +Proof. +move=> + + xz yt => /comparable_leP[] xy /comparable_leP[] zt //. +- exact: le_trans xy yt. +- exact: le_trans (ltW xy) xz. +Qed. + +(* To backport to order.v *) +Lemma comparable_max_le_max d (T : porderType d) (x y z t : T) : + (x >=< y)%O -> (z >=< t)%O -> + (x <= z)%O -> (y <= t)%O -> (Order.max x y <= Order.max z t)%O. +Proof. +move=> + + xz yt => /comparable_leP[] xy /comparable_leP[] zt //. +- exact: le_trans yt (ltW zt). +- exact: le_trans xz zt. +Qed. + +(* To backport to order.v *) +Lemma min_le_min d (T : orderType d) (x y z t : T) : + (x <= z)%O -> (y <= t)%O -> (Order.min x y <= Order.min z t)%O. +Proof. exact: comparable_min_le_min. Qed. + +(* To backport to order.v *) +Lemma max_le_max d (T : orderType d) (x y z t : T) : + (x <= z)%O -> (y <= t)%O -> (Order.max x y <= Order.max z t)%O. +Proof. exact: comparable_max_le_max. Qed. From 6805138cf36648872a6ea6e8f2a0ddde274b7f7b Mon Sep 17 00:00:00 2001 From: Pierre Roux Date: Sun, 24 Nov 2024 17:10:05 +0100 Subject: [PATCH 04/19] Lemma real_sqrtC to backport --- CHANGELOG_UNRELEASED.md | 4 ++-- classical/mathcomp_extra.v | 5 +++++ 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index 5f492f08d..40204c0a7 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -113,8 +113,8 @@ - in `mathcomp_extra.v` + lemmas `comparable_BSide_min`, `BSide_min`, `BSide_max`, `real_BSide_min`, `real_BSide_max`, `natr_min`, `natr_max`, - `comparable_min_le_min`, `comparable_max`, `min_le_min` - and `max_le_max` + `comparable_min_le_min`, `comparable_max`, `min_le_min`, + `max_le_max` and `real_sqrtC` - new file `measurable_realfun.v` + with as contents the first half of the file `lebesgue_measure.v` diff --git a/classical/mathcomp_extra.v b/classical/mathcomp_extra.v index bddca3d1e..16c6f86a4 100644 --- a/classical/mathcomp_extra.v +++ b/classical/mathcomp_extra.v @@ -687,3 +687,8 @@ Proof. exact: comparable_min_le_min. Qed. Lemma max_le_max d (T : orderType d) (x y z t : T) : (x <= z)%O -> (y <= t)%O -> (Order.max x y <= Order.max z t)%O. Proof. exact: comparable_max_le_max. Qed. + +(* To backport to ssrnum.v *) +Lemma real_sqrtC {R : numClosedFieldType} (x : R) : 0 <= x -> + sqrtC x \in Num.real. +Proof. by rewrite -sqrtC_ge0; apply: ger0_real. Qed. From a170bf26be18e2568f0c46cf9c2cea83fd887d5a Mon Sep 17 00:00:00 2001 From: Pierre Roux Date: Sun, 24 Nov 2024 17:15:53 +0100 Subject: [PATCH 05/19] Add lemmas about extended reals --- CHANGELOG_UNRELEASED.md | 5 +++ reals/constructive_ereal.v | 92 +++++++++++++++++++++++++++++--------- 2 files changed, 75 insertions(+), 22 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index 40204c0a7..305335b24 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -118,6 +118,10 @@ - new file `measurable_realfun.v` + with as contents the first half of the file `lebesgue_measure.v` +- in `constructive_ereal.v` + + lemmas `cmp0y`, `cmp0Ny`, `real_miney`, `real_minNye`, + `real_maxey`, `real_maxNye`, `oppe_cmp0`, `real_fine`, + `real_muleN`, `real_mulNe`, `real_muleNN` ### Changed @@ -189,6 +193,7 @@ - in `constructive_ereal.v`: + generalized from `realDomainType` to `numDomainType` * lemmas `EFin_min` and `EFin_max` + * lemmas `maxye`, `maxeNy`, `mineNy`, `minye` - in `Rstruct.v`: + lemma `RsqrtE` diff --git a/reals/constructive_ereal.v b/reals/constructive_ereal.v index 13666f615..d081ae752 100644 --- a/reals/constructive_ereal.v +++ b/reals/constructive_ereal.v @@ -396,6 +396,12 @@ Lemma le0y : (0 : \bar R) <= +oo. Proof. exact: real0. Qed. Lemma leNy0 : -oo <= (0 : \bar R). Proof. exact: real0. Qed. +Lemma cmp0y : ((0 : \bar R) >=< +oo%E)%O. +Proof. by rewrite /Order.comparable le0y. Qed. + +Lemma cmp0Ny : ((0 : \bar R) >=< -oo%E)%O. +Proof. by rewrite /Order.comparable leNy0 orbT. Qed. + Lemma lt0e x : (0 < x) = (x != 0) && (0 <= x). Proof. by case: x => [r| |]//; rewrite lte_fin lee_fin lt0r. Qed. @@ -416,6 +422,38 @@ Proof. by case: x => //=; rewrite real0. Qed. Lemma real_leNye x : (-oo <= x) = (fine x \is Num.real). Proof. by case: x => //=; rewrite real0. Qed. +Lemma minye : left_id (+oo : \bar R) Order.min. +Proof. by case. Qed. + +Lemma real_miney (x : \bar R) : (0 >=< x)%O -> Order.min x +oo = x. +Proof. +by case: x => [x |//|//] rx; rewrite minEle real_leey [_ \in Num.real]rx. +Qed. + +Lemma real_minNye (x : \bar R) : (0 >=< x)%O -> Order.min -oo%E x = -oo%E. +Proof. +by case: x => [x |//|//] rx; rewrite minEle real_leNye [_ \in Num.real]rx. +Qed. + +Lemma mineNy : right_zero (-oo : \bar R) Order.min. +Proof. by case=> [x |//|//]; rewrite minElt. Qed. + +Lemma maxye : left_zero (+oo : \bar R) Order.max. +Proof. by case. Qed. + +Lemma real_maxey (x : \bar R) : (0 >=< x)%O -> Order.max x +oo = +oo. +Proof. +by case: x => [x |//|//] rx; rewrite maxEle real_leey [_ \in Num.real]rx. +Qed. + +Lemma real_maxNye (x : \bar R) : (0 >=< x)%O -> Order.max -oo%E x = x. +Proof. +by case: x => [x |//|//] rx; rewrite maxEle real_leNye [_ \in Num.real]rx. +Qed. + +Lemma maxeNy : right_id (-oo : \bar R) Order.max. +Proof. by case=> [x |//|//]; rewrite maxElt. Qed. + Lemma gee0P x : 0 <= x <-> x = +oo \/ exists2 r, (r >= 0)%R & x = r%:E. Proof. split=> [|[->|[r r0 ->//]]]; last by rewrite real_leey/=. @@ -1162,6 +1200,9 @@ Proof. move: x => [x||] //; exact: oppr_ge0. Qed. Lemma oppe_le0 x : (- x <= 0) = (0 <= x). Proof. move: x => [x||] //; exact: oppr_le0. Qed. +Lemma oppe_cmp0 x : (0 >=< - x)%O = (0 >=< x)%O. +Proof. by rewrite /Order.comparable oppe_ge0 oppe_le0 orbC. Qed. + Lemma sume_ge0 T (f : T -> \bar R) (P : pred T) : (forall t, P t -> 0 <= f t) -> forall l, 0 <= \sum_(i <- l | P i) f i. Proof. by move=> f0 l; elim/big_rec : _ => // t x Pt; apply/adde_ge0/f0. Qed. @@ -1291,6 +1332,34 @@ case: x y => [x||] [y||]// rx ry; |by rewrite mulNyNy /Order.comparable le0y]. Qed. +Lemma real_fine (x : \bar R) : (0 >=< x)%O = (fine x \in Num.real). +Proof. by case: x => [x //||//]; rewrite /= real0 /Order.comparable le0y. Qed. + +Lemma real_muleN (x y : \bar R) : (0 >=< x)%O -> (0 >=< y)%O -> + x * - y = - (x * y). +Proof. +rewrite !real_fine; case: x y => [x||] [y||] /= xr yr; rewrite /mule/=. +- by rewrite mulrN. +- by case: ifP; rewrite ?oppe0//; case: ifP. +- by case: ifP; rewrite ?oppe0//; case: ifP. +- rewrite EFinN oppe_eq0; case: ifP; rewrite ?oppe0// oppe_gt0 !lte_fin. + by case: (real_ltgtP xr yr) => // <-; rewrite eqxx. +- by case: ifP. +- by case: ifP. +- rewrite EFinN oppe_eq0; case: ifP; rewrite ?oppe0// oppe_gt0 !lte_fin. + by case: (real_ltgtP xr yr) => // <-; rewrite eqxx. +- by rewrite lt0y. +- by rewrite lt0y. +Qed. + +Lemma real_mulNe (x y : \bar R) : (0 >=< x)%O -> (0 >=< y)%O -> + - x * y = - (x * y). +Proof. by move=> rx ry; rewrite muleC real_muleN 1?muleC. Qed. + +Lemma real_muleNN (x y : \bar R) : (0 >=< x)%O -> (0 >=< y)%O -> + - x * - y = x * y. +Proof. by move=> rx ry; rewrite real_muleN ?real_mulNe ?oppeK ?oppe_cmp0. Qed. + Lemma sqreD x y : x + y \is a fin_num -> (x + y) ^+ 2 = x ^+ 2 + x * y *+ 2 + y ^+ 2. Proof. @@ -1684,16 +1753,7 @@ by move: x y => [r0| |] [r1| |] //=; rewrite ?(leey, leNye)// !lee_fin lerNl. Qed. Lemma muleN x y : x * - y = - (x * y). -Proof. -move: x y => [x| |] [y| |] //=; rewrite /mule/=; try by rewrite ltry. -- by rewrite mulrN. -- by rewrite !eqe !lte_fin; case: ltrgtP => //; rewrite oppe0. -- by rewrite !eqe !lte_fin; case: ltrgtP => //; rewrite oppe0. -- rewrite !eqe oppr_eq0 eq_sym; case: ifP; rewrite ?oppe0// => y0. - by rewrite [RHS]fun_if ltNge if_neg EFinN leeNl oppe0 le_eqVlt eqe y0. -- rewrite !eqe oppr_eq0 eq_sym; case: ifP; rewrite ?oppe0// => y0. - by rewrite [RHS]fun_if ltNge if_neg EFinN leeNl oppe0 le_eqVlt eqe y0. -Qed. +Proof. by rewrite real_muleN ?real_fine ?num_real. Qed. Lemma mulNe x y : - x * y = - (x * y). Proof. by rewrite muleC muleN muleC. Qed. @@ -2460,30 +2520,18 @@ move=> x y z; have [yz|zy] := leP y z. by apply/esym/max_idPl; rewrite leeD2l// ltW. Qed. -Lemma maxye : left_zero (+oo : \bar R) maxe. -Proof. by move=> x; have [|//] := leP +oo x; rewrite leye_eq => /eqP. Qed. - Lemma maxey : right_zero (+oo : \bar R) maxe. Proof. by move=> x; rewrite maxC maxye. Qed. Lemma maxNye : left_id (-oo : \bar R) maxe. Proof. by move=> x; have [//|] := leP -oo x; rewrite ltNge leNye. Qed. -Lemma maxeNy : right_id (-oo : \bar R) maxe. -Proof. by move=> x; rewrite maxC maxNye. Qed. - HB.instance Definition _ := Monoid.isLaw.Build (\bar R) -oo maxe maxA maxNye maxeNy. Lemma minNye : left_zero (-oo : \bar R) mine. Proof. by move=> x; have [|//] := leP x -oo; rewrite leeNy_eq => /eqP. Qed. -Lemma mineNy : right_zero (-oo : \bar R) mine. -Proof. by move=> x; rewrite minC minNye. Qed. - -Lemma minye : left_id (+oo : \bar R) mine. -Proof. by move=> x; have [//|] := leP x +oo; rewrite ltNge leey. Qed. - Lemma miney : right_id (+oo : \bar R) mine. Proof. by move=> x; rewrite minC minye. Qed. From aab7b6590683b56d5fe343788e7542939a0cd9ad Mon Sep 17 00:00:00 2001 From: Pierre Roux Date: Mon, 17 Feb 2025 11:06:09 +0100 Subject: [PATCH 06/19] Rename itv.v -> interval_inference.v --- CHANGELOG_UNRELEASED.md | 2 ++ _CoqProject | 2 +- reals/Make | 2 +- reals/all_reals.v | 2 +- reals/{itv.v => interval_inference.v} | 0 theories/convex.v | 2 +- theories/exp.v | 2 +- theories/hoelder.v | 2 +- 8 files changed, 8 insertions(+), 6 deletions(-) rename reals/{itv.v => interval_inference.v} (100%) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index 305335b24..37edbad27 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -154,6 +154,8 @@ ### Renamed +- file `itv.v` to `interval_inference.v` + - in `measure.v` + `preimage_class` -> `preimage_set_system` + `image_class` -> `image_set_system` diff --git a/_CoqProject b/_CoqProject index 74ddd750a..769dc3a8b 100644 --- a/_CoqProject +++ b/_CoqProject @@ -28,7 +28,7 @@ reals/constructive_ereal.v reals/reals.v reals/real_interval.v reals/signed.v -reals/itv.v +reals/interval_inference.v reals/prodnormedzmodule.v reals/nsatz_realtype.v reals/all_reals.v diff --git a/reals/Make b/reals/Make index 427b997d1..2bb5d1673 100644 --- a/reals/Make +++ b/reals/Make @@ -11,7 +11,7 @@ constructive_ereal.v reals.v real_interval.v signed.v -itv.v +interval_inference.v prodnormedzmodule.v nsatz_realtype.v all_reals.v diff --git a/reals/all_reals.v b/reals/all_reals.v index 1f7707f6c..7a2373141 100644 --- a/reals/all_reals.v +++ b/reals/all_reals.v @@ -1,5 +1,5 @@ From mathcomp Require Export signed. -From mathcomp Require Export itv. +From mathcomp Require Export interval_inference. From mathcomp Require Export constructive_ereal. From mathcomp Require Export reals. From mathcomp Require Export real_interval. diff --git a/reals/itv.v b/reals/interval_inference.v similarity index 100% rename from reals/itv.v rename to reals/interval_inference.v diff --git a/theories/convex.v b/theories/convex.v index 29827d243..67c4ba3ad 100644 --- a/theories/convex.v +++ b/theories/convex.v @@ -4,7 +4,7 @@ From mathcomp Require Import matrix interval zmodp vector fieldext falgebra. From mathcomp Require Import mathcomp_extra boolp classical_sets set_interval. From mathcomp Require Import functions cardinality ereal reals signed. From mathcomp Require Import topology prodnormedzmodule normedtype derive. -From mathcomp Require Import realfun itv. +From mathcomp Require Import realfun interval_inference. From HB Require Import structures. (**md**************************************************************************) diff --git a/theories/exp.v b/theories/exp.v index 3b8e397da..07ef92a28 100644 --- a/theories/exp.v +++ b/theories/exp.v @@ -4,7 +4,7 @@ From mathcomp Require Import interval rat. From mathcomp Require Import boolp classical_sets functions. From mathcomp Require Import mathcomp_extra reals ereal signed. From mathcomp Require Import topology tvs normedtype landau sequences derive. -From mathcomp Require Import realfun itv convex. +From mathcomp Require Import realfun interval_inference convex. (**md**************************************************************************) (* # Theory of exponential/logarithm functions *) diff --git a/theories/hoelder.v b/theories/hoelder.v index 5b5b020f8..79e537f1a 100644 --- a/theories/hoelder.v +++ b/theories/hoelder.v @@ -5,7 +5,7 @@ From mathcomp Require Import mathcomp_extra boolp classical_sets functions. From mathcomp Require Import cardinality fsbigop signed reals ereal. From mathcomp Require Import topology normedtype sequences real_interval. From mathcomp Require Import esum measure lebesgue_measure lebesgue_integral. -From mathcomp Require Import numfun exp convex itv. +From mathcomp Require Import numfun exp convex interval_inference. (**md**************************************************************************) (* # Hoelder's Inequality *) From 987d1837e43223a93e61f7ac8655b26574e97dd5 Mon Sep 17 00:00:00 2001 From: Pierre Roux Date: Fri, 14 Feb 2025 16:05:44 +0100 Subject: [PATCH 07/19] Use module instead of _subdef/_subproof --- CHANGELOG_UNRELEASED.md | 11 ++ reals/interval_inference.v | 243 ++++++++++++++++++------------------- 2 files changed, 131 insertions(+), 123 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index 37edbad27..6e0524fc6 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -156,6 +156,17 @@ - file `itv.v` to `interval_inference.v` +- in `interval_inference.v` + + `itv_top_typ` -> `TypInstances.itv_top_typ` + + `typ_inum` -> `TypInstances.typ_inum` + + `zero_inum` -> `Instances.zero_inum` + + `one_inum` -> `Instances.one_inum` + + `add_inum` -> `Instances.add_inum` + + `interval_sign` -> `Instances.interval_sign` + + `interval_sign_spec` -> `Instances.interval_sign_spec` + + `interval_signP` -> `Instances.interval_signP` + + `mul_inum` -> `Instances.mul_inum` + - in `measure.v` + `preimage_class` -> `preimage_set_system` + `image_class` -> `image_set_system` diff --git a/reals/interval_inference.v b/reals/interval_inference.v index 7ac9e597b..c961a8140 100644 --- a/reals/interval_inference.v +++ b/reals/interval_inference.v @@ -169,13 +169,14 @@ HB.instance Definition _ := [SubChoice_isSubPOrder of nR by <: End POrder. (* TODO: numDomainType on sT ? *) -Lemma itv_top_typ_subproof (R : numDomainType) (x : R) : - Itv.spec `]-oo, +oo[ x. +Module TypInstances. + +Lemma itv_top_typ_spec (R : numDomainType) (x : R) : Itv.spec `]-oo, +oo[ x. Proof. by []. Qed. -Canonical itv_top_typ (R : numDomainType) := Itv.Typ (@itv_top_typ_subproof R). +Canonical itv_top_typ (R : numDomainType) := Itv.Typ (@itv_top_typ_spec R). -Lemma typ_inum_subproof (xt : Itv.typ) (x : Itv.sort xt) : +Lemma typ_inum_spec (xt : Itv.typ) (x : Itv.sort xt) : Itv.spec (Itv.sort_itv xt) x. Proof. by move: xt x => []. Qed. @@ -184,8 +185,10 @@ Proof. by move: xt x => []. Qed. Itv.r) meaning that if no other canonical instance (with a registered head symbol) is found, a canonical instance of Itv.typ, like the ones above, will be looked for. *) -Canonical typ_inum (xt : Itv.typ) (x : Itv.sort xt) := - Itv.mk (typ_inum_subproof x). +Canonical typ_inum (xt : Itv.typ) (x : Itv.sort xt) := Itv.mk (typ_inum_spec x). + +End TypInstances. +Export (canonicals) TypInstances. Notation unify_itv ix iy := (unify wider_itv ix iy). @@ -320,67 +323,63 @@ Notation "x %:i01" := (@widen_itv _ _ Local Open Scope ring_scope. +Module Instances. + Section NumDomainStability. Context {R : numDomainType}. -Lemma zero_inum_subproof : Itv.spec `[0, 0] (0 : R). +Lemma zero_spec : Itv.spec `[0, 0] (0 : R). Proof. by rewrite /Itv.itv_cond/= inE. Qed. -Canonical zero_inum := Itv.mk zero_inum_subproof. +Canonical zero_inum := Itv.mk zero_spec. -Lemma one_inum_subproof : Itv.spec `[1, 1] (1 : R). +Lemma one_spec : Itv.spec `[1, 1] (1 : R). Proof. by rewrite /Itv.itv_cond/= inE. Qed. -Canonical one_inum := Itv.mk one_inum_subproof. +Canonical one_inum := Itv.mk one_spec. -Definition opp_itv_bound_subdef (b : itv_bound int) : itv_bound int := +Definition opp_itv_bound (b : itv_bound int) : itv_bound int := match b with | BSide b x => BSide (~~ b) (intZmod.oppz x) | BInfty b => BInfty _ (~~ b) end. -Arguments opp_itv_bound_subdef /. +Arguments opp_itv_bound /. -Lemma opp_itv_ge0_subproof b : - (BLeft 0%R <= opp_itv_bound_subdef b)%O = (b <= BRight 0%R)%O. +Lemma opp_itv_ge0 b : (BLeft 0%R <= opp_itv_bound b)%O = (b <= BRight 0%R)%O. Proof. by case: b => [[] b | []//]; rewrite /= !bnd_simp oppr_ge0. Qed. -Lemma opp_itv_gt0_subproof b : - (BLeft 0%R < opp_itv_bound_subdef b)%O = (b < BRight 0%R)%O. +Lemma opp_itv_gt0 b : (BLeft 0%R < opp_itv_bound b)%O = (b < BRight 0%R)%O. Proof. by case: b => [[] b | []//]; rewrite /= !bnd_simp ?oppr_ge0 // oppr_gt0. Qed. -Lemma opp_itv_boundr_subproof (x : R) b : - (BRight (- x)%R <= Itv.map_itv_bound intr (opp_itv_bound_subdef b))%O +Lemma opp_itv_boundr (x : R) b : + (BRight (- x)%R <= Itv.map_itv_bound intr (opp_itv_bound b))%O = (Itv.map_itv_bound intr b <= BLeft x)%O. Proof. by case: b => [[] b | []//]; rewrite /= !bnd_simp mulrNz ?lerN2 // ltrN2. Qed. -Lemma opp_itv_le0_subproof b : - (opp_itv_bound_subdef b <= BRight 0%R)%O = (BLeft 0%R <= b)%O. +Lemma opp_itv_le0 b : (opp_itv_bound b <= BRight 0%R)%O = (BLeft 0%R <= b)%O. Proof. by case: b => [[] b | []//]; rewrite /= !bnd_simp oppr_le0. Qed. -Lemma opp_itv_lt0_subproof b : - (opp_itv_bound_subdef b < BRight 0%R)%O = (BLeft 0%R < b)%O. +Lemma opp_itv_lt0 b : (opp_itv_bound b < BRight 0%R)%O = (BLeft 0%R < b)%O. Proof. by case: b => [[] b | []//]; rewrite /= !bnd_simp ?oppr_le0 // oppr_lt0. Qed. -Lemma opp_itv_boundl_subproof (x : R) b : - (Itv.map_itv_bound intr (opp_itv_bound_subdef b) <= BLeft (- x)%R)%O +Lemma opp_itv_boundl (x : R) b : + (Itv.map_itv_bound intr (opp_itv_bound b) <= BLeft (- x)%R)%O = (BRight x <= Itv.map_itv_bound intr b)%O. Proof. by case: b => [[] b | []//]; rewrite /= !bnd_simp mulrNz ?lerN2 // ltrN2. Qed. -Definition opp_itv_subdef (i : interval int) : interval int := - let 'Interval l u := i in - Interval (opp_itv_bound_subdef u) (opp_itv_bound_subdef l). -Arguments opp_itv_subdef /. +Definition opp_itv (i : interval int) : interval int := + let 'Interval l u := i in Interval (opp_itv_bound u) (opp_itv_bound l). +Arguments opp_itv /. -Lemma opp_inum_subproof (i : interval int) - (x : {itv R & i}) (r := opp_itv_subdef i) : +Lemma opp_spec (i : interval int) (x : {itv R & i}) (r := opp_itv i) : Itv.spec r (- x%:inum). Proof. rewrite {}/r; move: i x => [l u] [x /= /andP[xl xu]]; apply/andP; split. @@ -390,32 +389,30 @@ rewrite {}/r; move: i x => [l u] [x /= /andP[xl xu]]; apply/andP; split. do ?[by rewrite ltrNl opprK|by rewrite lerNl opprK]. Qed. -Canonical opp_inum (i : interval int) (x : {itv R & i}) := - Itv.mk (opp_inum_subproof x). +Canonical opp_inum (i : interval int) (x : {itv R & i}) := Itv.mk (opp_spec x). -Definition add_itv_boundl_subdef (b1 b2 : itv_bound int) : itv_bound int := +Definition add_itv_boundl (b1 b2 : itv_bound int) : itv_bound int := match b1, b2 with | BSide b1 x1, BSide b2 x2 => BSide (b1 && b2) (intZmod.addz x1 x2) | _, _ => BInfty _ true end. -Arguments add_itv_boundl_subdef /. +Arguments add_itv_boundl /. -Definition add_itv_boundr_subdef (b1 b2 : itv_bound int) : itv_bound int := +Definition add_itv_boundr (b1 b2 : itv_bound int) : itv_bound int := match b1, b2 with | BSide b1 x1, BSide b2 x2 => BSide (b1 || b2) (intZmod.addz x1 x2) | _, _ => BInfty _ false end. -Arguments add_itv_boundr_subdef /. +Arguments add_itv_boundr /. -Definition add_itv_subdef (i1 i2 : interval int) : interval int := +Definition add_itv (i1 i2 : interval int) : interval int := let 'Interval l1 u1 := i1 in let 'Interval l2 u2 := i2 in - Interval (add_itv_boundl_subdef l1 l2) (add_itv_boundr_subdef u1 u2). -Arguments add_itv_subdef /. + Interval (add_itv_boundl l1 l2) (add_itv_boundr u1 u2). +Arguments add_itv /. -Lemma add_inum_subproof (xi yi : interval int) - (x : {itv R & xi}) (y : {itv R & yi}) - (r := add_itv_subdef xi yi) : +Lemma add_spec (xi yi : interval int) (x : {itv R & xi}) (y : {itv R & yi}) + (r := add_itv xi yi) : Itv.spec r (x%:inum + y%:inum). Proof. rewrite {}/r. @@ -429,9 +426,8 @@ rewrite /Itv.itv_cond in_itv; apply/andP; split. do ?[exact: lerD|exact: ler_ltD|exact: ltr_leD|exact: ltrD]. Qed. -Canonical add_inum (xi yi : interval int) - (x : {itv R & xi}) (y : {itv R & yi}) := - Itv.mk (add_inum_subproof x y). +Canonical add_inum (xi yi : interval int) (x : {itv R & xi}) (y : {itv R & yi}) + := Itv.mk (add_spec x y). End NumDomainStability. @@ -487,7 +483,7 @@ have [lneg|lpos|->] := ltgtP l; have [uneg|upos|->] := ltgtP u. - exact: ISignEqZero. Qed. -Definition mul_itv_boundl_subdef (b1 b2 : itv_bound int) : itv_bound int := +Definition mul_itv_boundl (b1 b2 : itv_bound int) : itv_bound int := match b1, b2 with | BSide true 0%Z, BSide _ _ | BSide _ _, BSide true 0%Z => BSide true 0%Z @@ -495,9 +491,9 @@ Definition mul_itv_boundl_subdef (b1 b2 : itv_bound int) : itv_bound int := | _, BInfty _ | BInfty _, _ => BInfty _ false end. -Arguments mul_itv_boundl_subdef /. +Arguments mul_itv_boundl /. -Definition mul_itv_boundr_subdef (b1 b2 : itv_bound int) : itv_bound int := +Definition mul_itv_boundr (b1 b2 : itv_bound int) : itv_bound int := match b1, b2 with | BSide true 0%Z, _ | _, BSide true 0%Z => BSide true 0%Z @@ -507,13 +503,13 @@ Definition mul_itv_boundr_subdef (b1 b2 : itv_bound int) : itv_bound int := | _, BInfty _ | BInfty _, _ => BInfty _ false end. -Arguments mul_itv_boundr_subdef /. +Arguments mul_itv_boundr /. -Lemma mul_itv_boundl_subproof b1 b2 (x1 x2 : R) : +Lemma mul_itv_boundl_spec b1 b2 (x1 x2 : R) : (BLeft 0%:Z <= b1 -> BLeft 0%:Z <= b2 -> Itv.map_itv_bound intr b1 <= BLeft x1 -> Itv.map_itv_bound intr b2 <= BLeft x2 -> - Itv.map_itv_bound intr (mul_itv_boundl_subdef b1 b2) <= BLeft (x1 * x2))%O. + Itv.map_itv_bound intr (mul_itv_boundl b1 b2) <= BLeft (x1 * x2))%O. Proof. move: b1 b2 => [[] b1 | []//] [[] b2 | []//] /=; rewrite 4!bnd_simp. - set bl := match b1 with 0%Z => _ | _ => _ end. @@ -535,17 +531,17 @@ move: b1 b2 => [[] b1 | []//] [[] b2 | []//] /=; rewrite 4!bnd_simp. - rewrite -2!(ler0z R) bnd_simp intrM; exact: ltr_pM. Qed. -Lemma mul_itv_boundrC_subproof b1 b2 : - mul_itv_boundr_subdef b1 b2 = mul_itv_boundr_subdef b2 b1. +Lemma mul_itv_boundrC b1 b2 : + mul_itv_boundr b1 b2 = mul_itv_boundr b2 b1. Proof. by move: b1 b2 => [[] [[|?]|?] | []] [[] [[|?]|?] | []] //=; rewrite mulnC. Qed. -Lemma mul_itv_boundr_subproof b1 b2 (x1 x2 : R) : +Lemma mul_itv_boundr_spec b1 b2 (x1 x2 : R) : (BLeft 0%R <= BLeft x1 -> BLeft 0%R <= BLeft x2 -> BRight x1 <= Itv.map_itv_bound intr b1 -> BRight x2 <= Itv.map_itv_bound intr b2 -> - BRight (x1 * x2) <= Itv.map_itv_bound intr (mul_itv_boundr_subdef b1 b2))%O. + BRight (x1 * x2) <= Itv.map_itv_bound intr (mul_itv_boundr b1 b2))%O. Proof. move: b1 b2 => [b1b b1 | []] [b2b b2 | []] //=; last first. - move: b2 b2b => [[|p2]|p2] [] // _ + _ +; rewrite !bnd_simp => le1 le2. @@ -585,14 +581,14 @@ case: b1 => [[|p1]|p1]. by move: (le_trans l l'); rewrite ler0z. Qed. -Lemma mul_itv_boundr'_subproof b1 b2 (x1 x2 : R) : +Lemma mul_itv_boundr'_spec b1 b2 (x1 x2 : R) : (BLeft 0%:R <= BLeft x1 -> BRight 0%:Z <= b2 -> BRight x1 <= Itv.map_itv_bound intr b1 -> BRight x2 <= Itv.map_itv_bound intr b2 -> - BRight (x1 * x2) <= Itv.map_itv_bound intr (mul_itv_boundr_subdef b1 b2))%O. + BRight (x1 * x2) <= Itv.map_itv_bound intr (mul_itv_boundr b1 b2))%O. Proof. move=> x1ge0 b2ge0 lex1b1 lex2b2. -have [x2ge0 | x2lt0] := leP 0 x2; first exact: mul_itv_boundr_subproof. +have [x2ge0 | x2lt0] := leP 0 x2; first exact: mul_itv_boundr_spec. have lem0 : (BRight (x1 * x2) <= BRight 0%R)%O. by rewrite bnd_simp mulr_ge0_le0 // ltW. apply: le_trans lem0 _. @@ -610,12 +606,12 @@ case: b1 => [[|p1]|p1]. by case: b1b; rewrite bnd_simp ?ltr0z // ler0z. Qed. -Definition mul_itv_subdef (i1 i2 : interval int) : interval int := +Definition mul_itv (i1 i2 : interval int) : interval int := let 'Interval l1 u1 := i1 in let 'Interval l2 u2 := i2 in - let opp := opp_itv_bound_subdef in - let mull := mul_itv_boundl_subdef in - let mulr := mul_itv_boundr_subdef in + let opp := opp_itv_bound in + let mull := mul_itv_boundl in + let mulr := mul_itv_boundr in match interval_sign i1, interval_sign i2 with | None, _ | _, None => `[1, 0] | some s1, Some s2 => @@ -637,7 +633,7 @@ Definition mul_itv_subdef (i1 i2 : interval int) : interval int := (mulr u1 u2)) end)%snum_sign end. -Arguments mul_itv_subdef /. +Arguments mul_itv /. Lemma map_itv_bound_min (x y : itv_bound int) : Itv.map_itv_bound (fun x => x%:~R : R) (Order.min x y) @@ -655,9 +651,8 @@ have [lexy|ltyx] := leP x y; first by rewrite !maxEle Itv.le_map_itv_bound. by rewrite maxElt -if_neg -leNgt Itv.le_map_itv_bound // ltW. Qed. -Lemma mul_inum_subproof (xi yi : interval int) - (x : {itv R & xi}) (y : {itv R & yi}) - (r := mul_itv_subdef xi yi) : +Lemma mul_spec (xi yi : interval int) (x : {itv R & xi}) (y : {itv R & yi}) + (r := mul_itv xi yi) : Itv.spec r (x%:inum * y%:inum). Proof. rewrite {}/r. @@ -671,9 +666,9 @@ have empty10 (z : R) l u : (u <= l)%O -> rewrite lt_def => /andP[/[swap]] => + /ltac:(apply/negP). rewrite negbK; move: leul => /(Itv.le_map_itv_bound R) le1 le2. by apply/eqP/le_anti; rewrite le1. -pose opp := opp_itv_bound_subdef. -pose mull := mul_itv_boundl_subdef. -pose mulr := mul_itv_boundr_subdef. +pose opp := opp_itv_bound. +pose mull := mul_itv_boundl. +pose mulr := mul_itv_boundr. have [leuxlx|-> ->|lxneg uxneg|lxpos uxpos|lxneg uxpos] := interval_signP. - move=> + + /ltac:(exfalso); exact: empty10. - rewrite 2!bnd_simp => lex1 lex2 ley1 ley2. @@ -697,15 +692,15 @@ have [leuxlx|-> ->|lxneg uxneg|lxpos uxpos|lxneg uxpos] := interval_signP. rewrite -[Interval _ _]/(Interval (mull (opp ux) (opp uy)) (mulr (opp lx) (opp ly))). rewrite -mulrNN /Itv.itv_cond itv_boundlr. - rewrite mul_itv_boundl_subproof ?mul_itv_boundr_subproof //. + rewrite mul_itv_boundl_spec ?mul_itv_boundr_spec //. * by rewrite bnd_simp oppr_ge0. * by rewrite bnd_simp oppr_ge0. - * by rewrite opp_itv_boundr_subproof. - * by rewrite opp_itv_boundr_subproof. - * by rewrite opp_itv_ge0_subproof. - * by rewrite opp_itv_ge0_subproof. - * by rewrite opp_itv_boundl_subproof. - * by rewrite opp_itv_boundl_subproof. + * by rewrite opp_itv_boundr. + * by rewrite opp_itv_boundr. + * by rewrite opp_itv_ge0. + * by rewrite opp_itv_ge0. + * by rewrite opp_itv_boundl. + * by rewrite opp_itv_boundl. + move=> lelyy leyuy. have ypos : 0 <= y. move: (le_trans (Itv.le_map_itv_bound R lypos) lelyy). @@ -713,25 +708,25 @@ have [leuxlx|-> ->|lxneg uxneg|lxpos uxpos|lxneg uxpos] := interval_signP. rewrite -[Interval _ _]/(Interval (opp (mulr (opp lx) uy)) (opp (mull (opp ux) ly))). rewrite -[x * y]opprK -mulNr /Itv.itv_cond itv_boundlr. - rewrite opp_itv_boundl_subproof opp_itv_boundr_subproof. - rewrite mul_itv_boundl_subproof ?mul_itv_boundr_subproof //. + rewrite opp_itv_boundl opp_itv_boundr. + rewrite mul_itv_boundl_spec ?mul_itv_boundr_spec //. * by rewrite bnd_simp oppr_ge0. - * by rewrite opp_itv_boundr_subproof. - * by rewrite opp_itv_ge0_subproof. - * by rewrite opp_itv_boundl_subproof. + * by rewrite opp_itv_boundr. + * by rewrite opp_itv_ge0. + * by rewrite opp_itv_boundl. + move=> lelyy leyuy. rewrite -[Interval _ _]/(Interval (opp (mulr (opp lx) uy)) (mulr (opp lx) (opp ly))). rewrite -[x * y]opprK -mulNr /Itv.itv_cond itv_boundlr. - rewrite opp_itv_boundl_subproof -mulrN. - rewrite 2?mul_itv_boundr'_subproof //. + rewrite opp_itv_boundl -mulrN. + rewrite 2?mul_itv_boundr'_spec //. * by rewrite bnd_simp oppr_ge0. - * by rewrite leBRight_ltBLeft opp_itv_gt0_subproof ltBRight_leBLeft ltW. - * by rewrite opp_itv_boundr_subproof. - * by rewrite opp_itv_boundr_subproof. + * by rewrite leBRight_ltBLeft opp_itv_gt0 ltBRight_leBLeft ltW. + * by rewrite opp_itv_boundr. + * by rewrite opp_itv_boundr. * by rewrite bnd_simp oppr_ge0. * by rewrite ltW. - * by rewrite opp_itv_boundr_subproof. + * by rewrite opp_itv_boundr. - move=> lelxx lexux. have xpos : 0 <= x. move: (le_trans (Itv.le_map_itv_bound R lxpos) lelxx). @@ -748,27 +743,27 @@ have [leuxlx|-> ->|lxneg uxneg|lxpos uxpos|lxneg uxpos] := interval_signP. rewrite -[Interval _ _]/(Interval (opp (mulr ux (opp ly))) (opp (mull lx (opp uy)))). rewrite -[x * y]opprK -mulrN /Itv.itv_cond itv_boundlr. - rewrite opp_itv_boundl_subproof opp_itv_boundr_subproof. - rewrite mul_itv_boundr_subproof ?mul_itv_boundl_subproof //. - * by rewrite opp_itv_ge0_subproof. - * by rewrite opp_itv_boundl_subproof. + rewrite opp_itv_boundl opp_itv_boundr. + rewrite mul_itv_boundr_spec ?mul_itv_boundl_spec //. + * by rewrite opp_itv_ge0. + * by rewrite opp_itv_boundl. * by rewrite bnd_simp oppr_ge0. - * by rewrite opp_itv_boundr_subproof. + * by rewrite opp_itv_boundr. + move=> lelyy leyuy. have ypos : 0 <= y. move: (le_trans (Itv.le_map_itv_bound R lypos) lelyy). by rewrite /= bnd_simp. rewrite -[Interval _ _]/(Interval (mull lx ly) (mulr ux uy)). rewrite /Itv.itv_cond itv_boundlr. - by rewrite mul_itv_boundr_subproof ?mul_itv_boundl_subproof. + by rewrite mul_itv_boundr_spec ?mul_itv_boundl_spec. + move=> lelyy leyuy. rewrite -[Interval _ _]/(Interval (opp (mulr ux (opp ly))) (mulr ux uy)). rewrite -[x * y]opprK -mulrN /Itv.itv_cond itv_boundlr. - rewrite opp_itv_boundl_subproof -mulrN opprK. - rewrite 2?mul_itv_boundr'_subproof //. + rewrite opp_itv_boundl -mulrN opprK. + rewrite 2?mul_itv_boundr'_spec //. * by rewrite ltW. - * by rewrite leBRight_ltBLeft opp_itv_gt0_subproof ltBRight_leBLeft ltW. - * by rewrite opp_itv_boundr_subproof. + * by rewrite leBRight_ltBLeft opp_itv_gt0 ltBRight_leBLeft ltW. + * by rewrite opp_itv_boundr. - move=> lelxx lexux. have [leuyly|-> ->|lyneg uyneg|lypos uypos|lyneg uypos] := interval_signP. + move=> + + /ltac:(exfalso); exact: empty10. @@ -782,28 +777,28 @@ have [leuxlx|-> ->|lxneg uxneg|lxpos uxpos|lxneg uxpos] := interval_signP. rewrite -[Interval _ _]/(Interval (opp (mulr ux (opp ly))) (mulr (opp lx) (opp ly))). rewrite -[x * y]opprK -mulrN /Itv.itv_cond itv_boundlr. - rewrite /mulr mul_itv_boundrC_subproof mulrC opp_itv_boundl_subproof. - rewrite [in X in _ && X]mul_itv_boundrC_subproof -mulrN. - rewrite mul_itv_boundr'_subproof ?mul_itv_boundr'_subproof //. + rewrite /mulr mul_itv_boundrC mulrC opp_itv_boundl. + rewrite [in X in _ && X]mul_itv_boundrC -mulrN. + rewrite mul_itv_boundr'_spec ?mul_itv_boundr'_spec //. * by rewrite bnd_simp oppr_ge0. - * by rewrite leBRight_ltBLeft opp_itv_gt0_subproof ltBRight_leBLeft ltW. - * by rewrite opp_itv_boundr_subproof. - * by rewrite opp_itv_boundr_subproof. + * by rewrite leBRight_ltBLeft opp_itv_gt0 ltBRight_leBLeft ltW. + * by rewrite opp_itv_boundr. + * by rewrite opp_itv_boundr. * by rewrite bnd_simp oppr_ge0. * by rewrite ltW. - * by rewrite opp_itv_boundr_subproof. + * by rewrite opp_itv_boundr. + move=> lelyy leyuy. have ypos : 0 <= y. move: (le_trans (Itv.le_map_itv_bound R lypos) lelyy). by rewrite /= bnd_simp. rewrite -[Interval _ _]/(Interval (opp (mulr (opp lx) uy)) (mulr ux uy)). rewrite -[x * y]opprK -mulNr /Itv.itv_cond itv_boundlr. - rewrite /mulr mul_itv_boundrC_subproof mulrC opp_itv_boundl_subproof. - rewrite [in X in _ && X]mul_itv_boundrC_subproof -mulrN opprK. - rewrite mul_itv_boundr'_subproof ?mul_itv_boundr'_subproof //. + rewrite /mulr mul_itv_boundrC mulrC opp_itv_boundl. + rewrite [in X in _ && X]mul_itv_boundrC -mulrN opprK. + rewrite mul_itv_boundr'_spec ?mul_itv_boundr'_spec //. * by rewrite ltW. - * by rewrite leBRight_ltBLeft opp_itv_gt0_subproof ltBRight_leBLeft ltW. - * by rewrite opp_itv_boundr_subproof. + * by rewrite leBRight_ltBLeft opp_itv_gt0 ltBRight_leBLeft ltW. + * by rewrite opp_itv_boundr. + move=> lelyy leyuy. rewrite -[Interval _ _]/(Interval (Order.min (opp (mulr (opp lx) uy)) @@ -812,32 +807,34 @@ have [leuxlx|-> ->|lxneg uxneg|lxpos uxpos|lxneg uxpos] := interval_signP. (mulr ux uy))). rewrite /Itv.itv_cond itv_boundlr. rewrite map_itv_bound_min map_itv_bound_max ge_min le_max. - rewrite -[x * y]opprK !opp_itv_boundl_subproof. + rewrite -[x * y]opprK !opp_itv_boundl. rewrite -[in X in ((X || _) && _)]mulNr -[in X in ((_ || X) && _)]mulrN. rewrite -[in X in (_ && (X || _))]mulrNN !opprK. have [xpos|xneg] := leP 0 x. - * rewrite [in X in ((_ || X) && _)]mul_itv_boundr'_subproof ?orbT //=; - rewrite ?[in X in (_ || X)]mul_itv_boundr'_subproof ?orbT //. + * rewrite [in X in ((_ || X) && _)]mul_itv_boundr'_spec ?orbT //=; + rewrite ?[in X in (_ || X)]mul_itv_boundr'_spec ?orbT //. - by rewrite ltW. - - by rewrite leBRight_ltBLeft opp_itv_gt0_subproof ltBRight_leBLeft ltW. - - by rewrite opp_itv_boundr_subproof. - * rewrite [in X in ((X || _) && _)]mul_itv_boundr'_subproof //=; - rewrite ?[in X in (X || _)]mul_itv_boundr'_subproof //. + - by rewrite leBRight_ltBLeft opp_itv_gt0 ltBRight_leBLeft ltW. + - by rewrite opp_itv_boundr. + * rewrite [in X in ((X || _) && _)]mul_itv_boundr'_spec //=; + rewrite ?[in X in (X || _)]mul_itv_boundr'_spec //. - by rewrite bnd_simp oppr_ge0 ltW. - - by rewrite leBRight_ltBLeft opp_itv_gt0_subproof ltBRight_leBLeft ltW. - - by rewrite opp_itv_boundr_subproof. - - by rewrite opp_itv_boundr_subproof. + - by rewrite leBRight_ltBLeft opp_itv_gt0 ltBRight_leBLeft ltW. + - by rewrite opp_itv_boundr. + - by rewrite opp_itv_boundr. - by rewrite bnd_simp oppr_ge0 ltW. - by rewrite ltW. - - by rewrite opp_itv_boundr_subproof. + - by rewrite opp_itv_boundr. Qed. -Canonical mul_inum (xi yi : interval int) - (x : {itv R & xi}) (y : {itv R & yi}) := - Itv.mk (mul_inum_subproof x y). +Canonical mul_inum (xi yi : interval int) (x : {itv R & xi}) (y : {itv R & yi}) + := Itv.mk (mul_spec x y). End RealDomainStability. +End Instances. +Export (canonicals) Instances. + Section Morph. Context {R : numDomainType} {i : interval int}. Local Notation nR := {itv R & i}. From dcafc2aac07a9ce14409acc6d36e389100fc3c44 Mon Sep 17 00:00:00 2001 From: Pierre Roux Date: Mon, 11 Nov 2024 15:27:47 +0100 Subject: [PATCH 08/19] Generalize itv.v From intervals on numDomainType to any porderType by making the semantics (from intervals of int to intervals of the considered type) parametric. Currently only instantiated for numDomainType though. Co-authored-by: Reynald Affeldt Co-authored-by: Cyril Cohen --- CHANGELOG_UNRELEASED.md | 76 +- reals/interval_inference.v | 1361 ++++++++++++++++++++---------------- theories/convex.v | 2 +- theories/exp.v | 5 +- theories/hoelder.v | 4 +- 5 files changed, 829 insertions(+), 619 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index 6e0524fc6..3aef24b94 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -118,11 +118,28 @@ - new file `measurable_realfun.v` + with as contents the first half of the file `lebesgue_measure.v` + - in `constructive_ereal.v` + lemmas `cmp0y`, `cmp0Ny`, `real_miney`, `real_minNye`, `real_maxey`, `real_maxNye`, `oppe_cmp0`, `real_fine`, `real_muleN`, `real_mulNe`, `real_muleNN` +- in `interval_inference.v` + + definitions `Itv.t`, `Itv.sub`, `Itv.num_sem`, `Itv.nat_sem`, + `Itv.real1`, `Itv.real2`, `TypInstances.real_domain_typ`, + `TypInstances.real_field_typ`, `TypInstances.nat_typ`, `ItvNum`, + `ItvReal` and `Itv01` + + lemmas `Itv.spec_real1`, `Itv.spec_real2`, + `TypInstances.real_domain_typ_spec`, + `TypInstances.real_field_typ_spec`, `TypInstances.nat_typ_spec`, + `top_wider_anything`, `real_wider_anyreal`, `le_num_itv_bound`, + `num_itv_bound_le_BLeft`, `BRight_le_num_itv_bound`, + `num_spec_sub`, `cmp0`, `neq0`, `eq0F`, `map_itv_bound_comp`, + `map_itv_comp`, `inum_min`, `inum_max`, `num_le_max`, + `num_ge_max`, `num_le_min`, `num_ge_min`, `num_lt_max`, + `num_gt_max`, `num_lt_min`, `num_gt_min`, `itvnum_subdef`, + `itvreal_subdef`, `itv01_subdef` + ### Changed - in `lebesgue_integral.v` @@ -152,19 +169,50 @@ - file `lebesgue_measure.v` + first half moved to a new file `measurable_realfun.v` +- file `interval_inference.v` + + definitions `Itv.def`, `Itv.spec`, `Itv.typ`, `empty_itv` + ### Renamed - file `itv.v` to `interval_inference.v` - in `interval_inference.v` + + `opp_itv_bound_subdef` -> `IntItv.opp_bound` + + `opp_itv_bound_subdef` -> `IntItv.opp_bound` + + `opp_itv_ge0_subproof` -> `IntItv.opp_bound_ge0` + + `opp_itv_gt0_subproof` -> `IntItv.opp_bound_gt0` + + `opp_itv_subdef` -> `IntItv.opp` + + `add_itv_boundl_subdef` -> `IntItv.add_boundl` + + `add_itv_boundr_subdef` -> `IntItv.add_boundr` + + `add_itv_subdef` -> `IntItv.add` + + `itv_bound_signl` -> `IntItv.sign_boundl` + + `itv_bound_signr` -> `IntItv.sign_boundr` + + `interval_sign` -> `IntItv.sign` + + `interval_sign` -> `IntItv.sign` + + `mul_itv_boundl_subdef` -> `IntItv.mul_boundl` + + `mul_itv_boundr_subdef` -> `IntItv.mul_boundr` + + `mul_itv_boundrC_subproof` -> `IntItv.mul_boundrC` + + `mul_itv_subdef` -> `IntItv.mul` + + `Itv.top_typ_subproof` -> `TypInstances.top_typ_spec` + `itv_top_typ` -> `TypInstances.itv_top_typ` + + `typ_inum_subproof` -> `TypInstances.typ_inum_spec` + `typ_inum` -> `TypInstances.typ_inum` + `zero_inum` -> `Instances.zero_inum` + `one_inum` -> `Instances.one_inum` + + `opp_itv_boundl_subproof` -> `Instances.one_boundl` + + `opp_itv_boundr_subproof` -> `Instances.one_boundr` + + `opp_inum_subproof` -> `Instances.num_spec_opp` + + `opp_inum` -> `Instances.opp_inum` + + `add_inum_subproof` -> `Instances.num_spec_add` + `add_inum` -> `Instances.add_inum` - + `interval_sign` -> `Instances.interval_sign` - + `interval_sign_spec` -> `Instances.interval_sign_spec` - + `interval_signP` -> `Instances.interval_signP` + + `interval_sign_spec` -> `Instances.sign_spec` + + `interval_signP` -> `Instances.signP` + + `mul_itv_boundl_subproof` -> `Instances.num_itv_mul_boundl` + + `mul_itv_boundr_subproof` -> `Instances.num_itv_mul_boundr` + + `mul_itv_boundr'_subproof` -> `Instances.BRight_le_mul_boundr` + + `map_itv_bound_min` -> `Instances.num_itv_bound_min` + + `map_itv_bound_max` -> `Instances.num_itv_bound_max` + + `mul_inum_subproof` -> `Instances.num_spec_mul` + `mul_inum` -> `Instances.mul_inum` - in `measure.v` @@ -187,6 +235,20 @@ - in `lebesgue_integral.v`: + `Rintegral_setU_EFin` -> `Rintegral_setU` + +- in `interval_inference.v` + + `itv_bottom` -> `bottom` + + `itv_gt0` -> `gt0` + + `itv_le0F` -> `le0F` + + `itv_lt0` -> `lt0` + + `itv_ge0F` -> `ge0F` + + `itv_ge0` -> `ge0` + + `itv_lt0F` -> `lt0F` + + `itv_le0` -> `le0` + + `itv_gt0F` -> `gt0F` + + `itv_top_typ` -> `top_typ` + + `Itv.map_itv_bound` -> `map_itv_bound` + + `Itv.map_itv` -> `map_itv` ### Generalized @@ -291,6 +353,14 @@ `__deprecated__linear_bounded0 ` (deprecated since 0.6.0) +- in `interval_inference.v` + + reserved notations `[lb of _]`, `[ub of _]`, `[lbe of _]` and `[ube of _]` + (they were unused) + + definitions `wider_itv` + + `Itv.subitv_map_itv` (use `num_spec_sub` instead) + + lemma `le_map_itv_bound` (use `le_num_itv_bound` instead) + + lemmas `opp_itv_le0_subproof`, `opp_itv_lt0_subproof` + ### Infrastructure ### Misc diff --git a/reals/interval_inference.v b/reals/interval_inference.v index c961a8140..6a3139ec9 100644 --- a/reals/interval_inference.v +++ b/reals/interval_inference.v @@ -3,7 +3,7 @@ From HB Require Import structures. From mathcomp Require Import ssreflect ssrfun ssrbool. From mathcomp Require Import ssrnat eqtype choice order ssralg ssrnum ssrint. From mathcomp Require Import interval. -From mathcomp Require Import mathcomp_extra boolp signed. +From mathcomp Require Import mathcomp_extra. (**md**************************************************************************) (* # Numbers within an interval *) @@ -13,53 +13,68 @@ From mathcomp Require Import mathcomp_extra boolp signed. (* like {itv R & `[a, b]}, a notation e%:itv that infers an enclosing *) (* interval for expression e according to existing canonical instances and *) (* %:inum to cast back from type {itv R & i} to R. *) -(* For instance, x : {i01 R}, we have (1 - x%:inum)%:itv : {i01 R} *) +(* For instance, for x : {i01 R}, we have (1 - x%:inum)%:itv : {i01 R} *) (* automatically inferred. *) (* *) (* ## types for values within known interval *) +(* *) (* ``` *) -(* {i01 R} == interface type for elements in R that live in `[0, 1]; *) -(* R must have a numDomainType structure. *) -(* Allows to solve automatically goals of the form x >= 0 *) -(* and x <= 1 if x is canonically a {i01 R}. {i01 R} is *) -(* canonically stable by common operations. *) -(* {itv R & i} == more generic type of values in interval i : interval int *) +(* {itv R & i} == generic type of values in interval i : interval int *) +(* See interval.v for notations that can be used for i. *) (* R must have a numDomainType structure. This type is shown *) (* to be a porderType. *) +(* {i01 R} := {itv R & `[0, 1]} *) +(* Allows to solve automatically goals of the form x >= 0 *) +(* and x <= 1 when x is canonically a {i01 R}. *) +(* {i01 R} is canonically stable by common operations. *) (* ``` *) (* *) (* ## casts from/to values within known interval *) +(* *) +(* Explicit casts of x to some {itv R & i} according to existing canonical *) +(* instances: *) +(* ``` *) +(* x%:itv == cast to the most precisely known {itv R & i} *) +(* x%:i01 == cast to {i01 R}, or fail *) +(* ``` *) +(* *) +(* Explicit casts of x from some {itv R & i} to R: *) (* ``` *) -(* x%:itv == explicitly casts x to the most precise known {itv R & i} *) -(* according to existing canonical instances. *) -(* x%:i01 == explicitly casts x to {i01 R} according to existing *) -(* canonical instances. *) -(* x%:inum == explicit cast from {itv R & i} to R. *) +(* x%:inum == cast from {itv R & i} *) (* ``` *) (* *) (* ## sign proofs *) +(* *) (* ``` *) -(* [itv of x] == proof that x is in interval inferred by x%:itv *) -(* [lb of x] == proof that lb < x or lb <= x with lb the lower bound *) -(* inferred by x%:itv *) -(* [ub of x] == proof that x < ub or x <= ub with ub the upper bound *) -(* inferred by x%:itv *) -(* [lbe of x] == proof that lb <= x *) -(* [ube of x] == proof that x <= ub *) +(* [itv of x] == proof that x is in the interval inferred by x%:itv *) (* ``` *) (* *) (* ## constructors *) +(* *) (* ``` *) -(* ItvNum xin == builds a {itv R & i} from a proof xin : x \in i *) -(* where x : R *) +(* ItvNum xr lx xu == builds a {itv R & i} from proofs xr : x \in Num.real, *) +(* lx : map_itv_bound (Itv.num_sem R) l <= BLeft x *) +(* xu : BRight x <= map_itv_bound (Itv.num_sem R) u *) +(* where x : R with R : numDomainType *) +(* and l u : itv_bound int *) +(* ItvReal lx xu == builds a {itv R & i} from proofs *) +(* lx : map_itv_bound (Itv.num_sem R) l <= BLeft x *) +(* xu : BRight x <= map_itv_bound (Itv.num_sem R) u *) +(* where x : R with R : realDomainType *) +(* and l u : itv_bound int *) +(* Itv01 x0 x1 == builds a {i01 R} from proofs x0 : 0 <= x and x1 : x <= 1*) +(* where x : R with R : numDomainType *) (* ``` *) (* *) (* A number of canonical instances are provided for common operations, if *) (* your favorite operator is missing, look below for examples on how to add *) (* the appropriate Canonical. *) +(* Also note that all provided instances aren't necessarily optimal, *) +(* improvements welcome! *) (* Canonical instances are also provided according to types, as a *) -(* fallback when no known operator appears in the expression. Look to *) -(* itv_top_typ below for an example on how to add your favorite type. *) +(* fallback when no known operator appears in the expression. Look to top_typ *) +(* below for an example on how to add your favorite type. *) +(* *) (******************************************************************************) Reserved Notation "{ 'itv' R & i }" @@ -70,11 +85,8 @@ Reserved Notation "{ 'i01' R }" Reserved Notation "x %:itv" (at level 2, format "x %:itv"). Reserved Notation "x %:i01" (at level 2, format "x %:i01"). Reserved Notation "x %:inum" (at level 2, format "x %:inum"). + Reserved Notation "[ 'itv' 'of' x ]" (format "[ 'itv' 'of' x ]"). -Reserved Notation "[ 'lb' 'of' x ]" (format "[ 'lb' 'of' x ]"). -Reserved Notation "[ 'ub' 'of' x ]" (format "[ 'ub' 'of' x ]"). -Reserved Notation "[ 'lbe' 'of' x ]" (format "[ 'lbe' 'of' x ]"). -Reserved Notation "[ 'ube' 'of' x ]" (format "[ 'ube' 'of' x ]"). Set Implicit Arguments. Unset Strict Implicit. @@ -85,99 +97,291 @@ Import GRing.Theory Num.Theory. Local Open Scope ring_scope. Local Open Scope order_scope. -Definition wider_itv (x y : interval int) := subitv y x. - -Module Itv. -Section Itv. -Context (R : numDomainType). - Definition map_itv_bound S T (f : S -> T) (b : itv_bound S) : itv_bound T := match b with | BSide b x => BSide b (f x) | BInfty b => BInfty _ b end. +Lemma map_itv_bound_comp S T U (f : T -> S) (g : U -> T) (b : itv_bound U) : + map_itv_bound (f \o g) b = map_itv_bound f (map_itv_bound g b). +Proof. by case: b. Qed. + Definition map_itv S T (f : S -> T) (i : interval S) : interval T := let 'Interval l u := i in Interval (map_itv_bound f l) (map_itv_bound f u). -Lemma le_map_itv_bound (x y : itv_bound int) : - x <= y -> - map_itv_bound (fun x => x%:~R : R) x <= map_itv_bound (fun x => x%:~R : R) y. +Lemma map_itv_comp S T U (f : T -> S) (g : U -> T) (i : interval U) : + map_itv (f \o g) i = map_itv f (map_itv g i). +Proof. by case: i => l u /=; rewrite -!map_itv_bound_comp. Qed. + +(* First, the interval arithmetic operations we will later use *) +Module IntItv. +Implicit Types (b : itv_bound int) (i : interval int). + +Definition opp_bound b := + match b with + | BSide b x => BSide (~~ b) (intZmod.oppz x) + | BInfty b => BInfty _ (~~ b) + end. + +Lemma opp_bound_ge0 b : (BLeft 0%R <= opp_bound b)%O = (b <= BRight 0%R)%O. +Proof. by case: b => [[] b | []//]; rewrite /= !bnd_simp oppr_ge0. Qed. + +Lemma opp_bound_gt0 b : (BRight 0%R <= opp_bound b)%O = (b <= BLeft 0%R)%O. Proof. -move: x y => [xb x | []xb //=]; last by case: xb. -case=> [yb y /=|//]. -by rewrite /Order.le/=; case: (_ ==> _) => /=; rewrite ?ler_int// ltr_int. +by case: b => [[] b | []//]; rewrite /= !bnd_simp ?oppr_ge0 ?oppr_gt0. Qed. -Lemma subitv_map_itv (x y : interval int) : - x <= y -> - map_itv (fun x => x%:~R : R) x <= map_itv (fun x => x%:~R : R) y. +Definition opp i := + let: Interval l u := i in Interval (opp_bound u) (opp_bound l). +Arguments opp /. + +Definition add_boundl b1 b2 := + match b1, b2 with + | BSide b1 x1, BSide b2 x2 => BSide (b1 && b2) (intZmod.addz x1 x2) + | _, _ => BInfty _ true + end. + +Definition add_boundr b1 b2 := + match b1, b2 with + | BSide b1 x1, BSide b2 x2 => BSide (b1 || b2) (intZmod.addz x1 x2) + | _, _ => BInfty _ false + end. + +Definition add i1 i2 := + let: Interval l1 u1 := i1 in let: Interval l2 u2 := i2 in + Interval (add_boundl l1 l2) (add_boundr u1 u2). +Arguments add /. + +Variant signb := EqZero | NonNeg | NonPos. + +Definition sign_boundl b := + let: b0 := BLeft 0%Z in + if b == b0 then EqZero else if (b <= b0)%O then NonPos else NonNeg. + +Definition sign_boundr b := + let: b0 := BRight 0%Z in + if b == b0 then EqZero else if (b <= b0)%O then NonPos else NonNeg. + +Variant signi := Known of signb | Unknown | Empty. + +Definition sign i : signi := + let: Interval l u := i in + match sign_boundl l, sign_boundr u with + | EqZero, NonPos + | NonNeg, EqZero + | NonNeg, NonPos => Empty + | EqZero, EqZero => Known EqZero + | NonPos, EqZero + | NonPos, NonPos => Known NonPos + | EqZero, NonNeg + | NonNeg, NonNeg => Known NonNeg + | NonPos, NonNeg => Unknown + end. + +Definition mul_boundl b1 b2 := + match b1, b2 with + | BInfty _, _ + | _, BInfty _ + | BLeft 0%Z, _ + | _, BLeft 0%Z => BLeft 0%Z + | BSide b1 x1, BSide b2 x2 => BSide (b1 && b2) (intRing.mulz x1 x2) + end. + +Definition mul_boundr b1 b2 := + match b1, b2 with + | BLeft 0%Z, _ + | _, BLeft 0%Z => BLeft 0%Z + | BRight 0%Z, _ + | _, BRight 0%Z => BRight 0%Z + | BSide b1 x1, BSide b2 x2 => BSide (b1 || b2) (intRing.mulz x1 x2) + | _, BInfty _ + | BInfty _, _ => +oo%O + end. + +Lemma mul_boundrC b1 b2 : mul_boundr b1 b2 = mul_boundr b2 b1. +Proof. +by move: b1 b2 => [[] [[|?]|?] | []] [[] [[|?]|?] | []] //=; rewrite mulnC. +Qed. + +Lemma mul_boundr_gt0 b1 b2 : + (BRight 0%Z <= b1 -> BRight 0%Z <= b2 -> BRight 0%Z <= mul_boundr b1 b2)%O. Proof. -move: x y => [lx ux] [ly uy] /andP[lel leu]. -apply/andP; split; exact: le_map_itv_bound. +case: b1 b2 => [b1b b1 | []] [b2b b2 | []]//=. +- by case: b1b b2b => -[]; case: b1 b2 => [[|b1] | b1] [[|b2] | b2]. +- by case: b1b b1 => -[[] |]. +- by case: b2b b2 => -[[] |]. Qed. -Definition itv_cond (i : interval int) (x : R) := - x \in map_itv (fun x => x%:~R : R) i. +Definition mul i1 i2 := + let: Interval l1 u1 := i1 in let: Interval l2 u2 := i2 in + let: opp := opp_bound in + let: mull := mul_boundl in let: mulr := mul_boundr in + match sign i1, sign i2 with + | Empty, _ | _, Empty => `[1, 0] + | Known EqZero, _ | _, Known EqZero => `[0, 0] + | Known NonNeg, Known NonNeg => + Interval (mull l1 l2) (mulr u1 u2) + | Known NonPos, Known NonPos => + Interval (mull (opp u1) (opp u2)) (mulr (opp l1) (opp l2)) + | Known NonNeg, Known NonPos => + Interval (opp (mulr u1 (opp l2))) (opp (mull l1 (opp u2))) + | Known NonPos, Known NonNeg => + Interval (opp (mulr (opp l1) u2)) (opp (mull (opp u1) l2)) + | Known NonNeg, Unknown => + Interval (opp (mulr u1 (opp l2))) (mulr u1 u2) + | Known NonPos, Unknown => + Interval (opp (mulr (opp l1) u2)) (mulr (opp l1) (opp l2)) + | Unknown, Known NonNeg => + Interval (opp (mulr (opp l1) u2)) (mulr u1 u2) + | Unknown, Known NonPos => + Interval (opp (mulr u1 (opp l2))) (mulr (opp l1) (opp l2)) + | Unknown, Unknown => + Interval + (Order.min (opp (mulr (opp l1) u2)) (opp (mulr u1 (opp l2)))) + (Order.max (mulr (opp l1) (opp l2)) (mulr u1 u2)) + end. +Arguments mul /. + +End IntItv. + +Module Itv. + +Variant t := Top | Real of interval int. -Record def (i : interval int) := Def { - r :> R; +Definition sub (x y : t) := + match x, y with + | _, Top => true + | Top, Real _ => false + | Real xi, Real yi => subitv xi yi + end. + +Section Itv. +Context T (sem : interval int -> T -> bool). + +Definition spec (i : t) (x : T) := if i is Real i then sem i x else true. + +Record def (i : t) := Def { + r : T; #[canonical=no] - P : itv_cond i r + P : spec i r }. End Itv. -Notation spec i x := (itv_cond i%Z%R x). - -Record typ := Typ { - sort : numDomainType; +Record typ i := Typ { + sort : Type; #[canonical=no] - sort_itv : interval int; + sort_sem : interval int -> sort -> bool; #[canonical=no] - allP : forall x : sort, spec sort_itv x + allP : forall x : sort, spec sort_sem i x }. -Definition mk {R} i r P : @def R i := - @Def R i r P. +Definition mk {T f} i x P : @def T f i := @Def T f i x P. -Definition from {R i} - {x : @def R i} (phx : phantom R x) := x. +Definition from {T f i} {x : @def T f i} (phx : phantom T (r x)) := x. -Definition fromP {R i} - {x : @def R i} (phx : phantom R x) := P x. +Definition fromP {T f i} {x : @def T f i} (phx : phantom T (r x)) := P x. + +Definition num_sem (R : numDomainType) (i : interval int) (x : R) : bool := + (x \in Num.real) && (x \in map_itv intr i). + +Definition nat_sem (i : interval int) (x : nat) : bool := Posz x \in i. + +(* a few lifting helper functions *) +Definition real1 (op1 : interval int -> interval int) (x : Itv.t) : Itv.t := + match x with Itv.Top => Itv.Top | Itv.Real x => Itv.Real (op1 x) end. + +Definition real2 (op2 : interval int -> interval int -> interval int) + (x y : Itv.t) : Itv.t := + match x, y with + | Itv.Top, _ | _, Itv.Top => Itv.Top + | Itv.Real x, Itv.Real y => Itv.Real (op2 x y) + end. + +Lemma spec_real1 T f (op1 : T -> T) (op1i : interval int -> interval int) : + forall (x : T), (forall xi, f xi x = true -> f (op1i xi) (op1 x) = true) -> + forall xi, spec f xi x -> spec f (real1 op1i xi) (op1 x). +Proof. by move=> x + [//| xi]; apply. Qed. + +Lemma spec_real2 T f (op2 : T -> T -> T) + (op2i : interval int -> interval int -> interval int) (x y : T) : + (forall xi yi, f xi x = true -> f yi y = true -> + f (op2i xi yi) (op2 x y) = true) -> + forall xi yi, spec f xi x -> spec f yi y -> + spec f (real2 op2i xi yi) (op2 x y). +Proof. by move=> + [//| xi] [//| yi]; apply. Qed. Module Exports. -Notation "{ 'itv' R & i }" := (def R i%Z) : type_scope. -Notation "{ 'i01' R }" := (def R `[Posz 0, Posz 1]) : type_scope. +Arguments r {T sem i}. +Notation "{ 'itv' R & i }" := (def (@num_sem R) (Itv.Real i%Z)) : type_scope. +Notation "{ 'i01' R }" := {itv R & `[0, 1]} : type_scope. Notation "x %:itv" := (from (Phantom _ x)) : ring_scope. Notation "[ 'itv' 'of' x ]" := (fromP (Phantom _ x)) : ring_scope. Notation inum := r. Notation "x %:inum" := (r x) : ring_scope. -Arguments r {R i}. End Exports. End Itv. Export Itv.Exports. +Local Notation num_spec := (Itv.spec (@Itv.num_sem _)). +Local Notation num_def R := (Itv.def (@Itv.num_sem R)). +Local Notation num_itv_bound R := (@map_itv_bound _ R intr). + +Local Notation nat_spec := (Itv.spec Itv.nat_sem). +Local Notation nat_def := (Itv.def Itv.nat_sem). + Section POrder. -Variables (R : numDomainType) (i : interval int). -Local Notation nR := {itv R & i}. -HB.instance Definition _ := [isSub for @Itv.r R i]. -HB.instance Definition _ := [Choice of nR by <:]. -HB.instance Definition _ := [SubChoice_isSubPOrder of nR by <: - with ring_display]. +Context d (T : porderType d) (f : interval int -> T -> bool) (i : Itv.t). +Local Notation itv := (Itv.def f i). +HB.instance Definition _ := [isSub for @Itv.r T f i]. +HB.instance Definition _ : Order.POrder d itv := [POrder of itv by <:]. End POrder. -(* TODO: numDomainType on sT ? *) + +Section Order. +Variables (R : numDomainType) (i : interval int). +Local Notation nR := (num_def R (Itv.Real i)). + +Lemma itv_le_total_subproof : total (<=%O : rel nR). +Proof. +move=> x y; apply: real_comparable. +- by case: x => [x /=/andP[]]. +- by case: y => [y /=/andP[]]. +Qed. + +HB.instance Definition _ := Order.POrder_isTotal.Build ring_display nR + itv_le_total_subproof. + +End Order. Module TypInstances. -Lemma itv_top_typ_spec (R : numDomainType) (x : R) : Itv.spec `]-oo, +oo[ x. +Lemma top_typ_spec T f (x : T) : Itv.spec f Itv.Top x. Proof. by []. Qed. -Canonical itv_top_typ (R : numDomainType) := Itv.Typ (@itv_top_typ_spec R). +Canonical top_typ T f := Itv.Typ (@top_typ_spec T f). + +Lemma real_domain_typ_spec (R : realDomainType) (x : R) : + num_spec (Itv.Real `]-oo, +oo[) x. +Proof. by rewrite /Itv.num_sem/= num_real. Qed. + +Canonical real_domain_typ (R : realDomainType) := + Itv.Typ (@real_domain_typ_spec R). -Lemma typ_inum_spec (xt : Itv.typ) (x : Itv.sort xt) : - Itv.spec (Itv.sort_itv xt) x. +Lemma real_field_typ_spec (R : realFieldType) (x : R) : + num_spec (Itv.Real `]-oo, +oo[) x. +Proof. exact: real_domain_typ_spec. Qed. + +Canonical real_field_typ (R : realFieldType) := + Itv.Typ (@real_field_typ_spec R). + +Lemma nat_typ_spec (x : nat) : nat_spec (Itv.Real `[0, +oo[) x. +Proof. by []. Qed. + +Canonical nat_typ := Itv.Typ nat_typ_spec. + +Lemma typ_inum_spec (i : Itv.t) (xt : Itv.typ i) (x : Itv.sort xt) : + Itv.spec (@Itv.sort_sem _ xt) i x. Proof. by move: xt x => []. Qed. (* This adds _ <- Itv.r ( typ_inum ) @@ -185,123 +389,179 @@ Proof. by move: xt x => []. Qed. Itv.r) meaning that if no other canonical instance (with a registered head symbol) is found, a canonical instance of Itv.typ, like the ones above, will be looked for. *) -Canonical typ_inum (xt : Itv.typ) (x : Itv.sort xt) := Itv.mk (typ_inum_spec x). +Canonical typ_inum (i : Itv.t) (xt : Itv.typ i) (x : Itv.sort xt) := + Itv.mk (typ_inum_spec x). End TypInstances. Export (canonicals) TypInstances. -Notation unify_itv ix iy := (unify wider_itv ix iy). +Class unify {T} f (x y : T) := Unify : f x y = true. +#[export] Hint Mode unify + + + + : typeclass_instances. +Class unify' {T} f (x y : T) := Unify' : f x y = true. +#[export] Instance unify'P {T} f (x y : T) : unify' f x y -> unify f x y := id. +#[export] +Hint Extern 0 (unify' _ _ _) => vm_compute; reflexivity : typeclass_instances. -Section Theory. -Context {R : numDomainType} {i : interval int}. -Local Notation sT := {itv R & i}. -Implicit Type x : sT. +Notation unify_itv ix iy := (unify Itv.sub ix iy). + +#[export] Instance top_wider_anything i : unify_itv i Itv.Top. +Proof. by case: i. Qed. + +#[export] Instance real_wider_anyreal i : + unify_itv (Itv.Real i) (Itv.Real `]-oo, +oo[). +Proof. by case: i => [l u]; apply/andP; rewrite !bnd_simp. Qed. -Lemma itv_intro {x} : x%:inum = x%:inum :> R. Proof. by []. Qed. +Section NumDomainTheory. +Context {R : numDomainType} {i : Itv.t}. +Implicit Type x : num_def R i. -Definition empty_itv := `[Posz 1, Posz 0]. +Lemma le_num_itv_bound (x y : itv_bound int) : + (num_itv_bound R x <= num_itv_bound R y)%O = (x <= y)%O. +Proof. +by case: x y => [[] x | x] [[] y | y]//=; rewrite !bnd_simp ?ler_int ?ltr_int. +Qed. + +Lemma num_itv_bound_le_BLeft (x : itv_bound int) (y : int) : + (num_itv_bound R x <= BLeft (y%:~R : R))%O = (x <= BLeft y)%O. +Proof. +rewrite -[BLeft y%:~R]/(map_itv_bound intr (BLeft y)). +by rewrite le_num_itv_bound. +Qed. + +Lemma BRight_le_num_itv_bound (x : int) (y : itv_bound int) : + (BRight (x%:~R : R) <= num_itv_bound R y)%O = (BRight x <= y)%O. +Proof. +rewrite -[BRight x%:~R]/(map_itv_bound intr (BRight x)). +by rewrite le_num_itv_bound. +Qed. + +Lemma num_spec_sub (x y : Itv.t) : Itv.sub x y -> + forall z : R, num_spec x z -> num_spec y z. +Proof. +case: x y => [| x] [| y] //= x_sub_y z /andP[rz]; rewrite /Itv.num_sem rz/=. +move: x y x_sub_y => [lx ux] [ly uy] /andP[lel leu] /=. +move=> /andP[lxz zux]; apply/andP; split. +- by apply: le_trans lxz; rewrite le_num_itv_bound. +- by apply: le_trans zux _; rewrite le_num_itv_bound. +Qed. + +Definition empty_itv := Itv.Real `[1, 0]%Z. -Lemma itv_bottom x : unify_itv empty_itv i -> False. +Lemma bottom x : ~ unify_itv i empty_itv. Proof. -move: x => [x /subitvP /(_ x)]; rewrite in_itv/= lexx => /(_ erefl) xi. -move=> /(@Itv.subitv_map_itv R) /subitvP /(_ _ xi). +case: x => x /= /[swap] /num_spec_sub /[apply] /andP[_] /=. by rewrite in_itv/= => /andP[] /le_trans /[apply]; rewrite ler10. Qed. -Lemma itv_gt0 x : unify_itv `]Posz 0, +oo[ i -> 0%R < x%:inum :> R. +Lemma gt0 x : unify_itv i (Itv.Real `]0%Z, +oo[) -> 0 < x%:inum :> R. Proof. -move: x => [x /= xi] /(@Itv.subitv_map_itv R) /subitvP /(_ _ xi). -by rewrite in_itv/= andbT. +case: x => x /= /[swap] /num_spec_sub /[apply] /andP[_]. +by rewrite /= in_itv/= andbT. Qed. -Lemma itv_le0F x : unify_itv `]Posz 0, +oo[ i -> x%:inum <= 0%R :> R = false. +Lemma le0F x : unify_itv i (Itv.Real `]0%Z, +oo[) -> x%:inum <= 0 :> R = false. Proof. -move: x => [x /= xi] /(@Itv.subitv_map_itv R) /subitvP /(_ _ xi). +case: x => x /= /[swap] /num_spec_sub /[apply] /andP[_] /=. by rewrite in_itv/= andbT => /lt_geF. Qed. -Lemma itv_lt0 x : unify_itv `]-oo, Posz 0[ i -> x%:inum < 0%R :> R. +Lemma lt0 x : unify_itv i (Itv.Real `]-oo, 0%Z[) -> x%:inum < 0 :> R. Proof. -move: x => [x /= xi] /(@Itv.subitv_map_itv R) /subitvP /(_ _ xi). -by rewrite in_itv. +by case: x => x /= /[swap] /num_spec_sub /[apply] /andP[_] /=; rewrite in_itv. Qed. -Lemma itv_ge0F x : unify_itv `]-oo, Posz 0[ i -> 0%R <= x%:inum :> R = false. +Lemma ge0F x : unify_itv i (Itv.Real `]-oo, 0%Z[) -> 0 <= x%:inum :> R = false. Proof. -move: x => [x /= xi] /(@Itv.subitv_map_itv R) /subitvP /(_ _ xi). +case: x => x /= /[swap] /num_spec_sub /[apply] /andP[_] /=. by rewrite in_itv/= => /lt_geF. Qed. -Lemma itv_ge0 x : unify_itv `[Posz 0, +oo[ i -> 0%R <= x%:inum :> R. +Lemma ge0 x : unify_itv i (Itv.Real `[0%Z, +oo[) -> 0 <= x%:inum :> R. Proof. -move: x => [x /= xi] /(@Itv.subitv_map_itv R) /subitvP /(_ _ xi). +case: x => x /= /[swap] /num_spec_sub /[apply] /andP[_] /=. by rewrite in_itv/= andbT. Qed. -Lemma itv_lt0F x : unify_itv `[Posz 0, +oo[ i -> x%:inum < 0%R :> R = false. +Lemma lt0F x : unify_itv i (Itv.Real `[0%Z, +oo[) -> x%:inum < 0 :> R = false. Proof. -move: x => [x /= xi] /(@Itv.subitv_map_itv R) /subitvP /(_ _ xi). +case: x => x /= /[swap] /num_spec_sub /[apply] /andP[_] /=. by rewrite in_itv/= andbT => /le_gtF. Qed. -Lemma itv_le0 x : unify_itv `]-oo, Posz 0] i -> x%:inum <= 0%R :> R. +Lemma le0 x : unify_itv i (Itv.Real `]-oo, 0%Z]) -> x%:inum <= 0 :> R. Proof. -move: x => [x /= xi] /(@Itv.subitv_map_itv R) /subitvP /(_ _ xi). -by rewrite in_itv/=. +by case: x => x /= /[swap] /num_spec_sub /[apply] /andP[_] /=; rewrite in_itv. Qed. -Lemma itv_gt0F x : unify_itv `]-oo, Posz 0] i -> 0%R < x%:inum :> R = false. +Lemma gt0F x : unify_itv i (Itv.Real `]-oo, 0%Z]) -> 0 < x%:inum :> R = false. Proof. -move: x => [x /= xi] /(@Itv.subitv_map_itv R) /subitvP /(_ _ xi). +case: x => x /= /[swap] /num_spec_sub /[apply] /andP[_] /=. by rewrite in_itv/= => /le_gtF. Qed. -Lemma lt1 x : unify_itv `]-oo, Posz 1[ i -> x%:inum < 1%R :> R. +Lemma cmp0 x : unify_itv i (Itv.Real `]-oo, +oo[) -> 0 >=< x%:inum. +Proof. by case: i x => [//| i' [x /=/andP[]]]. Qed. + +Lemma neq0 x : + unify (fun ix iy => ~~ Itv.sub ix iy) (Itv.Real `[0%Z, 0%Z]) i -> + x%:inum != 0 :> R. Proof. -move: x => [x /= xi] /(@Itv.subitv_map_itv R) /subitvP /(_ _ xi). -by rewrite in_itv. +case: i x => [//| [l u] [x /= Px]]; apply: contra => /eqP x0 /=. +move: Px; rewrite x0 => /and3P[_ /= l0 u0]; apply/andP; split. +- by case: l l0 => [[] l /= |//]; rewrite !bnd_simp ?lerz0 ?ltrz0. +- by case: u u0 => [[] u /= |//]; rewrite !bnd_simp ?ler0z ?ltr0z. Qed. -Lemma ge1F x : unify_itv `]-oo, Posz 1[ i -> 1%R <= x%:inum :> R = false. +Lemma eq0F x : + unify (fun ix iy => ~~ Itv.sub ix iy) (Itv.Real `[0%Z, 0%Z]) i -> + x%:inum == 0 :> R = false. +Proof. by move=> u; apply/negbTE/neq0. Qed. + +Lemma lt1 x : unify_itv i (Itv.Real `]-oo, 1%Z[) -> x%:inum < 1 :> R. Proof. -move: x => [x /= xi] /(@Itv.subitv_map_itv R) /subitvP /(_ _ xi). -by rewrite in_itv/= => /lt_geF. +by case: x => x /= /[swap] /num_spec_sub /[apply] /andP[_] /=; rewrite in_itv. Qed. -Lemma le1 x : unify_itv `]-oo, Posz 1] i -> x%:inum <= 1%R :> R. +Lemma ge1F x : unify_itv i (Itv.Real `]-oo, 1%Z[) -> 1 <= x%:inum :> R = false. Proof. -move: x => [x /= xi] /(@Itv.subitv_map_itv R) /subitvP /(_ _ xi). -by rewrite in_itv/=. +case: x => x /= /[swap] /num_spec_sub /[apply] /andP[_] /=. +by rewrite in_itv/= => /lt_geF. Qed. -Lemma gt1F x : unify_itv `]-oo, Posz 1] i -> 1%R < x%:inum :> R = false. +Lemma le1 x : unify_itv i (Itv.Real `]-oo, 1%Z]) -> x%:inum <= 1 :> R. Proof. -move: x => [x /= xi] /(@Itv.subitv_map_itv R) /subitvP /(_ _ xi). -by rewrite in_itv/= => /le_gtF. +by case: x => x /= /[swap] /num_spec_sub /[apply] /andP[_] /=; rewrite in_itv. Qed. -Lemma widen_itv_subproof x i' : unify_itv i' i -> Itv.spec i' x%:inum. +Lemma gt1F x : unify_itv i (Itv.Real `]-oo, 1%Z]) -> 1 < x%:inum :> R = false. Proof. -by move: x => [x /= xi] /(@Itv.subitv_map_itv R) /subitvP /(_ _ xi). +case: x => x /= /[swap] /num_spec_sub /[apply] /andP[_] /=. +by rewrite in_itv/= => /le_gtF. Qed. -Definition widen_itv x i' (uni : unify_itv i' i) := +Lemma widen_itv_subproof x i' : Itv.sub i i' -> num_spec i' x%:inum. +Proof. by case: x => x /= /[swap] /num_spec_sub; apply. Qed. + +Definition widen_itv x i' (uni : unify_itv i i') := Itv.mk (widen_itv_subproof x uni). Lemma widen_itvE x (uni : unify_itv i i) : @widen_itv x i uni = x. Proof. exact/val_inj. Qed. -End Theory. - -Arguments itv_bottom {R i} _ {_}. -Arguments itv_gt0 {R i} _ {_}. -Arguments itv_le0F {R i} _ {_}. -Arguments itv_lt0 {R i} _ {_}. -Arguments itv_ge0F {R i} _ {_}. -Arguments itv_ge0 {R i} _ {_}. -Arguments itv_lt0F {R i} _ {_}. -Arguments itv_le0 {R i} _ {_}. -Arguments itv_gt0F {R i} _ {_}. +End NumDomainTheory. + +Arguments bottom {R i} _ {_}. +Arguments gt0 {R i} _ {_}. +Arguments le0F {R i} _ {_}. +Arguments lt0 {R i} _ {_}. +Arguments ge0F {R i} _ {_}. +Arguments ge0 {R i} _ {_}. +Arguments lt0F {R i} _ {_}. +Arguments le0 {R i} _ {_}. +Arguments gt0F {R i} _ {_}. +Arguments cmp0 {R i} _ {_}. +Arguments neq0 {R i} _ {_}. +Arguments eq0F {R i} _ {_}. Arguments lt1 {R i} _ {_}. Arguments ge1F {R i} _ {_}. Arguments le1 {R i} _ {_}. @@ -309,544 +569,425 @@ Arguments gt1F {R i} _ {_}. Arguments widen_itv {R i} _ {_ _}. Arguments widen_itvE {R i} _ {_}. -#[global] Hint Extern 0 (is_true (0%R < _)%O) => solve [apply: itv_gt0] : core. -#[global] Hint Extern 0 (is_true (_ < 0%R)%O) => solve [apply: itv_lt0] : core. -#[global] Hint Extern 0 (is_true (0%R <= _)%O) => solve [apply: itv_ge0] : core. -#[global] Hint Extern 0 (is_true (_ <= 0%R)%O) => solve [apply: itv_le0] : core. -#[global] Hint Extern 0 (is_true (_ < 1%R)%O) => solve [apply: lt1] : core. -#[global] Hint Extern 0 (is_true (_ <= 1%R)%O) => solve [apply: le1] : core. +#[export] Hint Extern 0 (is_true (0%R < _)%R) => solve [apply: gt0] : core. +#[export] Hint Extern 0 (is_true (_ < 0%R)%R) => solve [apply: lt0] : core. +#[export] Hint Extern 0 (is_true (0%R <= _)%R) => solve [apply: ge0] : core. +#[export] Hint Extern 0 (is_true (_ <= 0%R)%R) => solve [apply: le0] : core. +#[export] Hint Extern 0 (is_true (_ \is Num.real)) => solve [apply: cmp0] + : core. +#[export] Hint Extern 0 (is_true (0%R >=< _)%R) => solve [apply: cmp0] : core. +#[export] Hint Extern 0 (is_true (_ != 0%R)) => solve [apply: neq0] : core. +#[export] Hint Extern 0 (is_true (_ < 1%R)%R) => solve [apply: lt1] : core. +#[export] Hint Extern 0 (is_true (_ <= 1%R)%R) => solve [apply: le1] : core. Notation "x %:i01" := (widen_itv x%:itv : {i01 _}) (only parsing) : ring_scope. Notation "x %:i01" := (@widen_itv _ _ - (@Itv.from _ _ _ (Phantom _ x)) `[Posz 0, Posz 1] _) + (@Itv.from _ _ _ (Phantom _ x)) (Itv.Real `[0, 1]%Z) _) (only printing) : ring_scope. Local Open Scope ring_scope. Module Instances. -Section NumDomainStability. -Context {R : numDomainType}. +Import IntItv. -Lemma zero_spec : Itv.spec `[0, 0] (0 : R). -Proof. by rewrite /Itv.itv_cond/= inE. Qed. - -Canonical zero_inum := Itv.mk zero_spec. +Section NumDomainInstances. +Context {R : numDomainType}. -Lemma one_spec : Itv.spec `[1, 1] (1 : R). -Proof. by rewrite /Itv.itv_cond/= inE. Qed. +Lemma num_spec_zero : num_spec (Itv.Real `[0, 0]) (0 : R). +Proof. by apply/andP; split; [exact: real0 | rewrite /= in_itv/= lexx]. Qed. -Canonical one_inum := Itv.mk one_spec. +Canonical zero_inum := Itv.mk num_spec_zero. -Definition opp_itv_bound (b : itv_bound int) : itv_bound int := - match b with - | BSide b x => BSide (~~ b) (intZmod.oppz x) - | BInfty b => BInfty _ (~~ b) - end. -Arguments opp_itv_bound /. +Lemma num_spec_one : num_spec (Itv.Real `[1, 1]) (1 : R). +Proof. by apply/andP; split; [exact: real1 | rewrite /= in_itv/= lexx]. Qed. -Lemma opp_itv_ge0 b : (BLeft 0%R <= opp_itv_bound b)%O = (b <= BRight 0%R)%O. -Proof. by case: b => [[] b | []//]; rewrite /= !bnd_simp oppr_ge0. Qed. +Canonical one_inum := Itv.mk num_spec_one. -Lemma opp_itv_gt0 b : (BLeft 0%R < opp_itv_bound b)%O = (b < BRight 0%R)%O. +Lemma opp_boundr (x : R) b : + (BRight (- x)%R <= num_itv_bound R (opp_bound b))%O + = (num_itv_bound R b <= BLeft x)%O. Proof. -by case: b => [[] b | []//]; rewrite /= !bnd_simp ?oppr_ge0 // oppr_gt0. +by case: b => [[] b | []//]; rewrite /= !bnd_simp mulrNz ?lerN2 // ltrN2. Qed. -Lemma opp_itv_boundr (x : R) b : - (BRight (- x)%R <= Itv.map_itv_bound intr (opp_itv_bound b))%O - = (Itv.map_itv_bound intr b <= BLeft x)%O. +Lemma opp_boundl (x : R) b : + (num_itv_bound R (opp_bound b) <= BLeft (- x)%R)%O + = (BRight x <= num_itv_bound R b)%O. Proof. by case: b => [[] b | []//]; rewrite /= !bnd_simp mulrNz ?lerN2 // ltrN2. Qed. -Lemma opp_itv_le0 b : (opp_itv_bound b <= BRight 0%R)%O = (BLeft 0%R <= b)%O. -Proof. by case: b => [[] b | []//]; rewrite /= !bnd_simp oppr_le0. Qed. - -Lemma opp_itv_lt0 b : (opp_itv_bound b < BRight 0%R)%O = (BLeft 0%R < b)%O. +Lemma num_spec_opp (i : Itv.t) (x : num_def R i) (r := Itv.real1 opp i) : + num_spec r (- x%:inum). Proof. -by case: b => [[] b | []//]; rewrite /= !bnd_simp ?oppr_le0 // oppr_lt0. +apply: Itv.spec_real1 (Itv.P x). +case: x => x /= _ [l u] /and3P[xr lx xu]. +rewrite /Itv.num_sem/= realN xr/=; apply/andP. +by rewrite opp_boundl opp_boundr. Qed. -Lemma opp_itv_boundl (x : R) b : - (Itv.map_itv_bound intr (opp_itv_bound b) <= BLeft (- x)%R)%O - = (BRight x <= Itv.map_itv_bound intr b)%O. +Canonical opp_inum (i : Itv.t) (x : num_def R i) := Itv.mk (num_spec_opp x). + +Lemma num_itv_add_boundl (x1 x2 : R) b1 b2 : + (num_itv_bound R b1 <= BLeft x1)%O -> (num_itv_bound R b2 <= BLeft x2)%O -> + (num_itv_bound R (add_boundl b1 b2) <= BLeft (x1 + x2)%R)%O. Proof. -by case: b => [[] b | []//]; rewrite /= !bnd_simp mulrNz ?lerN2 // ltrN2. +case: b1 b2 => [bb1 b1 |//] [bb2 b2 |//]. +case: bb1; case: bb2; rewrite /= !bnd_simp mulrzDr_tmp. +- exact: lerD. +- exact: ler_ltD. +- exact: ltr_leD. +- exact: ltrD. Qed. -Definition opp_itv (i : interval int) : interval int := - let 'Interval l u := i in Interval (opp_itv_bound u) (opp_itv_bound l). -Arguments opp_itv /. - -Lemma opp_spec (i : interval int) (x : {itv R & i}) (r := opp_itv i) : - Itv.spec r (- x%:inum). +Lemma num_itv_add_boundr (x1 x2 : R) b1 b2 : + (BRight x1 <= num_itv_bound R b1)%O -> (BRight x2 <= num_itv_bound R b2)%O -> + (BRight (x1 + x2)%R <= num_itv_bound R (add_boundr b1 b2))%O. Proof. -rewrite {}/r; move: i x => [l u] [x /= /andP[xl xu]]; apply/andP; split. -- by case: u xu => [[] b i | [] //] /=; rewrite /Order.le/= mulrNz; - do ?[by rewrite lerNl opprK|by rewrite ltrNl opprK]. -- by case: l xl => [[] b i | [] //] /=; rewrite /Order.le/= mulrNz; - do ?[by rewrite ltrNl opprK|by rewrite lerNl opprK]. +case: b1 b2 => [bb1 b1 |//] [bb2 b2 |//]. +case: bb1; case: bb2; rewrite /= !bnd_simp mulrzDr_tmp. +- exact: ltrD. +- exact: ltr_leD. +- exact: ler_ltD. +- exact: lerD. Qed. -Canonical opp_inum (i : interval int) (x : {itv R & i}) := Itv.mk (opp_spec x). - -Definition add_itv_boundl (b1 b2 : itv_bound int) : itv_bound int := - match b1, b2 with - | BSide b1 x1, BSide b2 x2 => BSide (b1 && b2) (intZmod.addz x1 x2) - | _, _ => BInfty _ true - end. -Arguments add_itv_boundl /. +Lemma num_spec_add (xi yi : Itv.t) (x : num_def R xi) (y : num_def R yi) + (r := Itv.real2 add xi yi) : + num_spec r (x%:inum + y%:inum). +Proof. +apply: Itv.spec_real2 (Itv.P x) (Itv.P y). +case: x y => [x /= _] [y /= _] => {xi yi r} -[lx ux] [ly uy]/=. +move=> /andP[xr /=/andP[lxx xux]] /andP[yr /=/andP[lyy yuy]]. +rewrite /Itv.num_sem realD//=; apply/andP. +by rewrite num_itv_add_boundl ?num_itv_add_boundr. +Qed. -Definition add_itv_boundr (b1 b2 : itv_bound int) : itv_bound int := - match b1, b2 with - | BSide b1 x1, BSide b2 x2 => BSide (b1 || b2) (intZmod.addz x1 x2) - | _, _ => BInfty _ false - end. -Arguments add_itv_boundr /. - -Definition add_itv (i1 i2 : interval int) : interval int := - let 'Interval l1 u1 := i1 in - let 'Interval l2 u2 := i2 in - Interval (add_itv_boundl l1 l2) (add_itv_boundr u1 u2). -Arguments add_itv /. - -Lemma add_spec (xi yi : interval int) (x : {itv R & xi}) (y : {itv R & yi}) - (r := add_itv xi yi) : - Itv.spec r (x%:inum + y%:inum). -Proof. -rewrite {}/r. -move: xi x yi y => [lx ux] [x /= /andP[xl xu]] [ly uy] [y /= /andP[yl yu]]. -rewrite /Itv.itv_cond in_itv; apply/andP; split. -- move: lx ly xl yl => [xb lx | //] [yb ly | //]. - by move: xb yb => [] []; rewrite /Order.le/= rmorphD/=; - do ?[exact: lerD|exact: ler_ltD|exact: ltr_leD|exact: ltrD]. -- move: ux uy xu yu => [xb ux | //] [yb uy | //]. - by move: xb yb => [] []; rewrite /Order.le/= rmorphD/=; - do ?[exact: lerD|exact: ler_ltD|exact: ltr_leD|exact: ltrD]. -Qed. - -Canonical add_inum (xi yi : interval int) (x : {itv R & xi}) (y : {itv R & yi}) - := Itv.mk (add_spec x y). - -End NumDomainStability. - -Section RealDomainStability. -Context {R : realDomainType}. - -Definition itv_bound_signl (b : itv_bound int) : KnownSign.sign := - let b0 := BLeft 0%Z in - (if b == b0 then =0 else if (b <= b0)%O then <=0 else >=0)%snum_sign. - -Definition itv_bound_signr (b : itv_bound int) : KnownSign.sign := - let b0 := BRight 0%Z in - (if b == b0 then =0 else if (b <= b0)%O then <=0 else >=0)%snum_sign. - -Definition interval_sign (i : interval int) : option KnownSign.real := - let 'Interval l u := i in - (match itv_bound_signl l, itv_bound_signr u with - | =0, <=0 - | >=0, =0 - | >=0, <=0 => None - | =0, =0 => Some (KnownSign.Sign =0) - | <=0, =0 - | <=0, <=0 => Some (KnownSign.Sign <=0) - | =0, >=0 - | >=0, >=0 => Some (KnownSign.Sign >=0) - | <=0, >=0 => Some >=<0 - end)%snum_sign. - -Variant interval_sign_spec (l u : itv_bound int) : option KnownSign.real -> Set := - | ISignNone : (u <= l)%O -> interval_sign_spec l u None - | ISignEqZero : l = BLeft 0 -> u = BRight 0 -> - interval_sign_spec l u (Some (KnownSign.Sign =0)) - | ISignNeg : (l < BLeft 0%:Z)%O -> (u <= BRight 0%:Z)%O -> - interval_sign_spec l u (Some (KnownSign.Sign <=0)) - | ISignPos : (BLeft 0%:Z <= l)%O -> (BRight 0%:Z < u)%O -> - interval_sign_spec l u (Some (KnownSign.Sign >=0)) - | ISignBoth : (l < BLeft 0%:Z)%O -> (BRight 0%:Z < u)%O -> - interval_sign_spec l u (Some >=<0%snum_sign). - -Lemma interval_signP l u : - interval_sign_spec l u (interval_sign (Interval l u)). -Proof. -rewrite /interval_sign/itv_bound_signl/itv_bound_signr. -have [lneg|lpos|->] := ltgtP l; have [uneg|upos|->] := ltgtP u. -- apply: ISignNeg => //; exact: ltW. +Canonical add_inum (xi yi : Itv.t) (x : num_def R xi) (y : num_def R yi) := + Itv.mk (num_spec_add x y). + +Variant sign_spec (l u : itv_bound int) (x : R) : signi -> Set := + | ISignEqZero : l = BLeft 0 -> u = BRight 0 -> x = 0 -> + sign_spec l u x (Known EqZero) + | ISignNonNeg : (BLeft 0%:Z <= l)%O -> (BRight 0%:Z < u)%O -> 0 <= x -> + sign_spec l u x (Known NonNeg) + | ISignNonPos : (l < BLeft 0%:Z)%O -> (u <= BRight 0%:Z)%O -> x <= 0 -> + sign_spec l u x (Known NonPos) + | ISignBoth : (l < BLeft 0%:Z)%O -> (BRight 0%:Z < u)%O -> x \in Num.real -> + sign_spec l u x Unknown. + +Lemma signP (l u : itv_bound int) (x : R) : + (num_itv_bound R l <= BLeft x)%O -> (BRight x <= num_itv_bound R u)%O -> + x \in Num.real -> + sign_spec l u x (sign (Interval l u)). +Proof. +move=> + + xr; rewrite /sign/sign_boundl/sign_boundr. +have [lneg|lpos|->] := ltgtP l; have [uneg|upos|->] := ltgtP u => lx xu. +- apply: ISignNonPos => //; first exact: ltW. + have:= le_trans xu (eqbRL (le_num_itv_bound _ _) (ltW uneg)). + by rewrite bnd_simp. - exact: ISignBoth. -- exact: ISignNeg. -- by apply/ISignNone/ltW/(lt_le_trans uneg); rewrite leBRight_ltBLeft. -- by apply: ISignPos => //; exact: ltW. -- by apply: ISignNone; rewrite leBRight_ltBLeft. -- by apply: ISignNone; rewrite -ltBRight_leBLeft. -- exact: ISignPos. -- exact: ISignEqZero. +- exact: ISignNonPos. +- have:= @ltxx _ _ (num_itv_bound R l). + rewrite (le_lt_trans lx) -?leBRight_ltBLeft ?(le_trans xu)//. + by rewrite le_num_itv_bound (le_trans (ltW uneg)). +- apply: ISignNonNeg => //; first exact: ltW. + have:= le_trans (eqbRL (le_num_itv_bound _ _) (ltW lpos)) lx. + by rewrite bnd_simp. +- have:= @ltxx _ _ (num_itv_bound R l). + rewrite (le_lt_trans lx) -?leBRight_ltBLeft ?(le_trans xu)//. + by rewrite le_num_itv_bound ?leBRight_ltBLeft. +- have:= @ltxx _ _ (num_itv_bound R (BLeft 0%Z)). + rewrite (le_lt_trans lx) -?leBRight_ltBLeft ?(le_trans xu)//. + by rewrite le_num_itv_bound -?ltBRight_leBLeft. +- exact: ISignNonNeg. +- apply: ISignEqZero => //. + by apply/le_anti/andP; move: lx xu; rewrite !bnd_simp. Qed. -Definition mul_itv_boundl (b1 b2 : itv_bound int) : itv_bound int := - match b1, b2 with - | BSide true 0%Z, BSide _ _ - | BSide _ _, BSide true 0%Z => BSide true 0%Z - | BSide b1 x1, BSide b2 x2 => BSide (b1 && b2) (intRing.mulz x1 x2) - | _, BInfty _ - | BInfty _, _ => BInfty _ false - end. -Arguments mul_itv_boundl /. - -Definition mul_itv_boundr (b1 b2 : itv_bound int) : itv_bound int := - match b1, b2 with - | BSide true 0%Z, _ - | _, BSide true 0%Z => BSide true 0%Z - | BSide false 0%Z, _ - | _, BSide false 0%Z => BSide false 0%Z - | BSide b1 x1, BSide b2 x2 => BSide (b1 || b2) (intRing.mulz x1 x2) - | _, BInfty _ - | BInfty _, _ => BInfty _ false - end. -Arguments mul_itv_boundr /. - -Lemma mul_itv_boundl_spec b1 b2 (x1 x2 : R) : +Lemma num_itv_mul_boundl b1 b2 (x1 x2 : R) : (BLeft 0%:Z <= b1 -> BLeft 0%:Z <= b2 -> - Itv.map_itv_bound intr b1 <= BLeft x1 -> - Itv.map_itv_bound intr b2 <= BLeft x2 -> - Itv.map_itv_bound intr (mul_itv_boundl b1 b2) <= BLeft (x1 * x2))%O. + num_itv_bound R b1 <= BLeft x1 -> + num_itv_bound R b2 <= BLeft x2 -> + num_itv_bound R (mul_boundl b1 b2) <= BLeft (x1 * x2))%O. Proof. move: b1 b2 => [[] b1 | []//] [[] b2 | []//] /=; rewrite 4!bnd_simp. - set bl := match b1 with 0%Z => _ | _ => _ end. have -> : bl = BLeft (b1 * b2). rewrite {}/bl; move: b1 b2 => [[|p1]|p1] [[|p2]|p2]; congr BLeft. by rewrite mulr0. - rewrite -2!(ler0z R) bnd_simp intrM; exact: ler_pM. -- case: b1 => [[|p1]|//]; rewrite -2!(ler0z R) !bnd_simp ?intrM. - by move=> _ geb2 ? ?; apply: mulr_ge0 => //; apply/(le_trans geb2)/ltW. - move=> p1gt0 b2ge0 lep1x1 ltb2x2. - have: (Posz p1.+1)%:~R * x2 <= x1 * x2. - by rewrite ler_pM2r //; apply: le_lt_trans ltb2x2. - by apply: lt_le_trans; rewrite ltr_pM2l // ltr0z. -- case: b2 => [[|p2]|//]; rewrite -2!(ler0z R) !bnd_simp ?intrM. - by move=> geb1 _ ? ?; apply: mulr_ge0 => //; apply/(le_trans geb1)/ltW. - move=> b1ge0 p2gt0 ltb1x1 lep2x2. - have: b1%:~R * x2 < x1 * x2; last exact/le_lt_trans/ler_pM. - by rewrite ltr_pM2r //; apply: lt_le_trans lep2x2; rewrite ltr0z. -- rewrite -2!(ler0z R) bnd_simp intrM; exact: ltr_pM. -Qed. - -Lemma mul_itv_boundrC b1 b2 : - mul_itv_boundr b1 b2 = mul_itv_boundr b2 b1. + by rewrite bnd_simp intrM -2!(ler0z R); apply: ler_pM. +- case: b1 => [[|b1] | b1]; rewrite !bnd_simp// => b1p b2p sx1 sx2. + + by rewrite mulr_ge0 ?(le_trans _ (ltW sx2)) ?ler0z. + + rewrite intrM (@lt_le_trans _ _ (b1.+1%:~R * x2)) ?ltr_pM2l//. + by rewrite ler_pM2r// (le_lt_trans _ sx2) ?ler0z. +- case: b2 => [[|b2] | b2]; rewrite !bnd_simp// => b1p b2p sx1 sx2. + + by rewrite mulr_ge0 ?(le_trans _ (ltW sx1)) ?ler0z. + + rewrite intrM (@le_lt_trans _ _ (b1%:~R * x2)) ?ler_wpM2l ?ler0z//. + by rewrite ltr_pM2r ?(lt_le_trans _ sx2). +- by rewrite -2!(ler0z R) bnd_simp intrM; apply: ltr_pM. +Qed. + +Lemma num_itv_mul_boundr b1 b2 (x1 x2 : R) : + (0 <= x1 -> 0 <= x2 -> + BRight x1 <= num_itv_bound R b1 -> + BRight x2 <= num_itv_bound R b2 -> + BRight (x1 * x2) <= num_itv_bound R (mul_boundr b1 b2))%O. Proof. -by move: b1 b2 => [[] [[|?]|?] | []] [[] [[|?]|?] | []] //=; rewrite mulnC. +case: b1 b2 => [b1b b1 | []] [b2b b2 | []] //= x1p x2p; last first. +- case: b2b b2 => -[[|//] | //] _ x20. + + have:= @ltxx _ (itv_bound R) (BLeft 0%:~R). + by rewrite (lt_le_trans _ x20). + + have -> : x2 = 0 by apply/le_anti/andP. + by rewrite mulr0. +- case: b1b b1 => -[[|//] |//] x10 _. + + have:= @ltxx _ (itv_bound R) (BLeft 0%Z%:~R). + by rewrite (lt_le_trans _ x10). + + by have -> : x1 = 0; [apply/le_anti/andP | rewrite mul0r]. +case: b1b b2b => -[]; rewrite -[intRing.mulz]/GRing.mul. +- case: b1 => [[|b1] | b1]; rewrite !bnd_simp => x1b x2b. + + by have:= @ltxx _ R 0; rewrite (le_lt_trans x1p x1b). + + case: b2 x2b => [[| b2] | b2] => x2b; rewrite bnd_simp. + * by have:= @ltxx _ R 0; rewrite (le_lt_trans x2p x2b). + * by rewrite intrM ltr_pM. + * have:= @ltxx _ R 0; rewrite (le_lt_trans x2p)//. + by rewrite (lt_le_trans x2b) ?lerz0. + + have:= @ltxx _ R 0; rewrite (le_lt_trans x1p)//. + by rewrite (lt_le_trans x1b) ?lerz0. +- case: b1 => [[|b1] | b1]; rewrite !bnd_simp => x1b x2b. + + by have:= @ltxx _ R 0; rewrite (le_lt_trans x1p x1b). + + case: b2 x2b => [[| b2] | b2] x2b; rewrite bnd_simp. + * exact: mulr_ge0_le0. + * by rewrite intrM (le_lt_trans (ler_wpM2l x1p x2b)) ?ltr_pM2r. + * have:= @ltxx _ _ x2. + by rewrite (le_lt_trans x2b) ?(lt_le_trans _ x2p) ?ltrz0. + + have:= @ltxx _ _ x1. + by rewrite (lt_le_trans x1b) ?(le_trans _ x1p) ?lerz0. +- case: b1 => [[|b1] | b1]; rewrite !bnd_simp => x1b x2b. + + case: b2 x2b => [[|b2] | b2] x2b; rewrite bnd_simp. + * by have:= @ltxx _ _ x2; rewrite (lt_le_trans x2b). + * by have -> : x1 = 0; [apply/le_anti/andP | rewrite mul0r]. + * have:= @ltxx _ _ x2. + by rewrite (lt_le_trans x2b) ?(le_trans _ x2p) ?lerz0. + + case: b2 x2b => [[|b2] | b2] x2b; rewrite bnd_simp. + * by have:= @ltxx _ _ x2; rewrite (lt_le_trans x2b). + * by rewrite intrM (le_lt_trans (ler_wpM2r x2p x1b)) ?ltr_pM2l. + * have:= @ltxx _ _ x2. + by rewrite (lt_le_trans x2b) ?(le_trans _ x2p) ?lerz0. + + have:= @ltxx _ _ x1. + by rewrite (le_lt_trans x1b) ?(lt_le_trans _ x1p) ?ltrz0. +- case: b1 => [[|b1] | b1]; rewrite !bnd_simp => x1b x2b. + + by have -> : x1 = 0; [apply/le_anti/andP | rewrite mul0r]. + + case: b2 x2b => [[| b2] | b2] x2b; rewrite bnd_simp. + * by have -> : x2 = 0; [apply/le_anti/andP | rewrite mulr0]. + * by rewrite intrM ler_pM. + * have:= @ltxx _ _ x2. + by rewrite (le_lt_trans x2b) ?(lt_le_trans _ x2p) ?ltrz0. + + have:= @ltxx _ _ x1. + by rewrite (le_lt_trans x1b) ?(lt_le_trans _ x1p) ?ltrz0. Qed. -Lemma mul_itv_boundr_spec b1 b2 (x1 x2 : R) : - (BLeft 0%R <= BLeft x1 -> BLeft 0%R <= BLeft x2 -> - BRight x1 <= Itv.map_itv_bound intr b1 -> - BRight x2 <= Itv.map_itv_bound intr b2 -> - BRight (x1 * x2) <= Itv.map_itv_bound intr (mul_itv_boundr b1 b2))%O. -Proof. -move: b1 b2 => [b1b b1 | []] [b2b b2 | []] //=; last first. -- move: b2 b2b => [[|p2]|p2] [] // _ + _ +; rewrite !bnd_simp => le1 le2. - + by move: (le_lt_trans le1 le2); rewrite ltxx. - + by move: (conj le1 le2) => /andP/le_anti <-; rewrite mulr0. -- move: b1 b1b => [[|p1]|p1] [] // + _ + _; rewrite !bnd_simp => le1 le2. - + by move: (le_lt_trans le1 le2); rewrite ltxx. - + by move: (conj le1 le2) => /andP/le_anti <-; rewrite mul0r. -case: b1 => [[|p1]|p1]. -- case: b1b. - by rewrite !bnd_simp => l _ l' _; move: (le_lt_trans l l'); rewrite ltxx. - by move: b2b b2 => [] [[|p2]|p2]; rewrite !bnd_simp; - first (by move=> _ l _ l'; move: (le_lt_trans l l'); rewrite ltxx); - move=> l _ l' _; move: (conj l l') => /andP/le_anti <-; rewrite mul0r. -- rewrite if_same. - case: b2 => [[|p2]|p2]. - + case: b2b => _ + _ +; rewrite !bnd_simp => l l'. - by move: (le_lt_trans l l'); rewrite ltxx. - by move: (conj l l') => /andP/le_anti <-; rewrite mulr0. - + move: b1b b2b => [] []; rewrite !bnd_simp; - rewrite -[intRing.mulz ?[a] ?[b]]/((Posz ?[a]) * ?[b])%R intrM. - * exact: ltr_pM. - * move=> x1ge0 x2ge0 ltx1p1 lex2p2. - have: x1 * p2.+1%:~R < p1.+1%:~R * p2.+1%:~R. - by rewrite ltr_pM2r // ltr0z. - exact/le_lt_trans/ler_pM. - * move=> x1ge0 x2ge0 lex1p1 ltx2p2. - have: p1.+1%:~R * x2 < p1.+1%:~R * p2.+1%:~R. - by rewrite ltr_pM2l // ltr0z. - exact/le_lt_trans/ler_pM. - * exact: ler_pM. - + case: b2b => _ + _; rewrite 2!bnd_simp => l l'. - by move: (le_lt_trans l l'); rewrite ltr0z. - by move: (le_trans l l'); rewrite ler0z. -- case: b1b => + _ + _; rewrite 2!bnd_simp => l l'. - by move: (le_lt_trans l l'); rewrite ltr0z. - by move: (le_trans l l'); rewrite ler0z. -Qed. - -Lemma mul_itv_boundr'_spec b1 b2 (x1 x2 : R) : - (BLeft 0%:R <= BLeft x1 -> BRight 0%:Z <= b2 -> - BRight x1 <= Itv.map_itv_bound intr b1 -> - BRight x2 <= Itv.map_itv_bound intr b2 -> - BRight (x1 * x2) <= Itv.map_itv_bound intr (mul_itv_boundr b1 b2))%O. -Proof. -move=> x1ge0 b2ge0 lex1b1 lex2b2. -have [x2ge0 | x2lt0] := leP 0 x2; first exact: mul_itv_boundr_spec. +Lemma BRight_le_mul_boundr b1 b2 (x1 x2 : R) : + (0 <= x1 -> x2 \in Num.real -> BRight 0%Z <= b2 -> + BRight x1 <= num_itv_bound R b1 -> + BRight x2 <= num_itv_bound R b2 -> + BRight (x1 * x2) <= num_itv_bound R (mul_boundr b1 b2))%O. +Proof. +move=> x1ge0 x2r b2ge0 lex1b1 lex2b2. +have /orP[x2ge0 | x2le0] := x2r; first exact: num_itv_mul_boundr. have lem0 : (BRight (x1 * x2) <= BRight 0%R)%O. by rewrite bnd_simp mulr_ge0_le0 // ltW. apply: le_trans lem0 _. -move: b1 b2 lex1b1 lex2b2 b2ge0 => [b1b b1 | []] [b2b b2 | []] //=; last first. -- by move: b2 b2b => [[|?]|?] []. -- move: b1 b1b => [[|p1]|p1] [] //. - by rewrite leBRight_ltBLeft => /(le_lt_trans x1ge0); rewrite ltxx. -case: b1 => [[|p1]|p1]. -- case: b1b; last by move: b2b b2 => [] [[|]|]. - by rewrite leBRight_ltBLeft => /(le_lt_trans x1ge0); rewrite ltxx. -- rewrite if_same. - case: b2 => [[|p2]|p2]; first (by case: b2b); last by case: b2b. - by rewrite if_same => _ _ _ /=; rewrite leBSide ltrW_lteif // ltr0z. -- rewrite leBRight_ltBLeft => /(le_lt_trans x1ge0). - by case: b1b; rewrite bnd_simp ?ltr0z // ler0z. -Qed. - -Definition mul_itv (i1 i2 : interval int) : interval int := - let 'Interval l1 u1 := i1 in - let 'Interval l2 u2 := i2 in - let opp := opp_itv_bound in - let mull := mul_itv_boundl in - let mulr := mul_itv_boundr in - match interval_sign i1, interval_sign i2 with - | None, _ | _, None => `[1, 0] - | some s1, Some s2 => - (match s1, s2 with - | =0, _ => `[0, 0] - | _, =0 => `[0, 0] - | >=0, >=0 => Interval (mull l1 l2) (mulr u1 u2) - | <=0, <=0 => Interval (mull (opp u1) (opp u2)) (mulr (opp l1) (opp l2)) - | >=0, <=0 => Interval (opp (mulr u1 (opp l2))) (opp (mull l1 (opp u2))) - | <=0, >=0 => Interval (opp (mulr (opp l1) u2)) (opp (mull (opp u1) l2)) - | >=0, >=<0 => Interval (opp (mulr u1 (opp l2))) (mulr u1 u2) - | <=0, >=<0 => Interval (opp (mulr (opp l1) u2)) (mulr (opp l1) (opp l2)) - | >=<0, >=0 => Interval (opp (mulr (opp l1) u2)) (mulr u1 u2) - | >=<0, <=0 => Interval (opp (mulr u1 (opp l2))) (mulr (opp l1) (opp l2)) - | >=<0, >=<0 => Interval - (Order.min (opp (mulr (opp l1) u2)) - (opp (mulr u1 (opp l2)))) - (Order.max (mulr (opp l1) (opp l2)) - (mulr u1 u2)) - end)%snum_sign - end. -Arguments mul_itv /. - -Lemma map_itv_bound_min (x y : itv_bound int) : - Itv.map_itv_bound (fun x => x%:~R : R) (Order.min x y) - = Order.min (Itv.map_itv_bound intr x) (Itv.map_itv_bound intr y). -Proof. -have [lexy|ltyx] := leP x y; first by rewrite !minEle Itv.le_map_itv_bound. -by rewrite minElt -if_neg -leNgt Itv.le_map_itv_bound // ltW. -Qed. - -Lemma map_itv_bound_max (x y : itv_bound int) : - Itv.map_itv_bound (fun x => x%:~R : R) (Order.max x y) - = Order.max (Itv.map_itv_bound intr x) (Itv.map_itv_bound intr y). -Proof. -have [lexy|ltyx] := leP x y; first by rewrite !maxEle Itv.le_map_itv_bound. -by rewrite maxElt -if_neg -leNgt Itv.le_map_itv_bound // ltW. -Qed. - -Lemma mul_spec (xi yi : interval int) (x : {itv R & xi}) (y : {itv R & yi}) - (r := mul_itv xi yi) : - Itv.spec r (x%:inum * y%:inum). -Proof. -rewrite {}/r. -move: xi x yi y => [lx ux] [x /= /andP[+ +]] [ly uy] [y /= /andP[+ +]]. -rewrite -/(interval_sign (Interval lx ux)). -rewrite -/(interval_sign (Interval ly uy)). -have empty10 (z : R) l u : (u <= l)%O -> - (Itv.map_itv_bound [eta intr] l <= BLeft z)%O -> - (BRight z <= Itv.map_itv_bound [eta intr] u)%O -> False. - move=> leul; rewrite leBRight_ltBLeft => /le_lt_trans /[apply]. - rewrite lt_def => /andP[/[swap]] => + /ltac:(apply/negP). - rewrite negbK; move: leul => /(Itv.le_map_itv_bound R) le1 le2. - by apply/eqP/le_anti; rewrite le1. -pose opp := opp_itv_bound. -pose mull := mul_itv_boundl. -pose mulr := mul_itv_boundr. -have [leuxlx|-> ->|lxneg uxneg|lxpos uxpos|lxneg uxpos] := interval_signP. -- move=> + + /ltac:(exfalso); exact: empty10. -- rewrite 2!bnd_simp => lex1 lex2 ley1 ley2. - have -> : x = 0 by apply: le_anti; rewrite lex1 lex2. - rewrite mul0r. - case: interval_signP; [|by move=> _ _; rewrite /Itv.itv_cond in_itv/= lexx..]. - by move=> leul; exfalso; move: ley1 ley2; apply: empty10. -- move=> lelxx lexux. - have xneg : x <= 0. - move: (le_trans lexux (Itv.le_map_itv_bound R uxneg)). - by rewrite /= bnd_simp. - have [leuyly|-> ->|lyneg uyneg|lypos uypos|lyneg uypos] := interval_signP. - + move=> + + /ltac:(exfalso); exact: empty10. - + rewrite 2!bnd_simp => ley1 ley2. - have -> : y = 0 by apply: le_anti; rewrite ley1 ley2. - by rewrite mulr0 /Itv.itv_cond in_itv/= lexx. - + move=> lelyy leyuy. - have yneg : y <= 0. - move: (le_trans leyuy (Itv.le_map_itv_bound R uyneg)). - by rewrite /= bnd_simp. - rewrite -[Interval _ _]/(Interval (mull (opp ux) (opp uy)) - (mulr (opp lx) (opp ly))). - rewrite -mulrNN /Itv.itv_cond itv_boundlr. - rewrite mul_itv_boundl_spec ?mul_itv_boundr_spec //. - * by rewrite bnd_simp oppr_ge0. - * by rewrite bnd_simp oppr_ge0. - * by rewrite opp_itv_boundr. - * by rewrite opp_itv_boundr. - * by rewrite opp_itv_ge0. - * by rewrite opp_itv_ge0. - * by rewrite opp_itv_boundl. - * by rewrite opp_itv_boundl. - + move=> lelyy leyuy. - have ypos : 0 <= y. - move: (le_trans (Itv.le_map_itv_bound R lypos) lelyy). - by rewrite /= bnd_simp. - rewrite -[Interval _ _]/(Interval (opp (mulr (opp lx) uy)) - (opp (mull (opp ux) ly))). - rewrite -[x * y]opprK -mulNr /Itv.itv_cond itv_boundlr. - rewrite opp_itv_boundl opp_itv_boundr. - rewrite mul_itv_boundl_spec ?mul_itv_boundr_spec //. - * by rewrite bnd_simp oppr_ge0. - * by rewrite opp_itv_boundr. - * by rewrite opp_itv_ge0. - * by rewrite opp_itv_boundl. - + move=> lelyy leyuy. - rewrite -[Interval _ _]/(Interval (opp (mulr (opp lx) uy)) - (mulr (opp lx) (opp ly))). - rewrite -[x * y]opprK -mulNr /Itv.itv_cond itv_boundlr. - rewrite opp_itv_boundl -mulrN. - rewrite 2?mul_itv_boundr'_spec //. - * by rewrite bnd_simp oppr_ge0. - * by rewrite leBRight_ltBLeft opp_itv_gt0 ltBRight_leBLeft ltW. - * by rewrite opp_itv_boundr. - * by rewrite opp_itv_boundr. - * by rewrite bnd_simp oppr_ge0. - * by rewrite ltW. - * by rewrite opp_itv_boundr. -- move=> lelxx lexux. - have xpos : 0 <= x. - move: (le_trans (Itv.le_map_itv_bound R lxpos) lelxx). - by rewrite /= bnd_simp. - have [leuyly|-> ->|lyneg uyneg|lypos uypos|lyneg uypos] := interval_signP. - + move=> + + /ltac:(exfalso); exact: empty10. - + rewrite 2!bnd_simp => ley1 ley2. - have -> : y = 0 by apply: le_anti; rewrite ley1 ley2. - by rewrite mulr0 /Itv.itv_cond in_itv/= lexx. - + move=> lelyy leyuy. - have yneg : y <= 0. - move: (le_trans leyuy (Itv.le_map_itv_bound R uyneg)). - by rewrite /= bnd_simp. - rewrite -[Interval _ _]/(Interval (opp (mulr ux (opp ly))) - (opp (mull lx (opp uy)))). - rewrite -[x * y]opprK -mulrN /Itv.itv_cond itv_boundlr. - rewrite opp_itv_boundl opp_itv_boundr. - rewrite mul_itv_boundr_spec ?mul_itv_boundl_spec //. - * by rewrite opp_itv_ge0. - * by rewrite opp_itv_boundl. - * by rewrite bnd_simp oppr_ge0. - * by rewrite opp_itv_boundr. - + move=> lelyy leyuy. - have ypos : 0 <= y. - move: (le_trans (Itv.le_map_itv_bound R lypos) lelyy). - by rewrite /= bnd_simp. - rewrite -[Interval _ _]/(Interval (mull lx ly) (mulr ux uy)). - rewrite /Itv.itv_cond itv_boundlr. - by rewrite mul_itv_boundr_spec ?mul_itv_boundl_spec. - + move=> lelyy leyuy. - rewrite -[Interval _ _]/(Interval (opp (mulr ux (opp ly))) (mulr ux uy)). - rewrite -[x * y]opprK -mulrN /Itv.itv_cond itv_boundlr. - rewrite opp_itv_boundl -mulrN opprK. - rewrite 2?mul_itv_boundr'_spec //. - * by rewrite ltW. - * by rewrite leBRight_ltBLeft opp_itv_gt0 ltBRight_leBLeft ltW. - * by rewrite opp_itv_boundr. -- move=> lelxx lexux. - have [leuyly|-> ->|lyneg uyneg|lypos uypos|lyneg uypos] := interval_signP. - + move=> + + /ltac:(exfalso); exact: empty10. - + rewrite 2!bnd_simp => ley1 ley2. - have -> : y = 0 by apply: le_anti; rewrite ley1 ley2. - by rewrite mulr0 /Itv.itv_cond in_itv/= lexx. - + move=> lelyy leyuy. - have yneg : y <= 0. - move: (le_trans leyuy (Itv.le_map_itv_bound R uyneg)). - by rewrite /= bnd_simp. - rewrite -[Interval _ _]/(Interval (opp (mulr ux (opp ly))) - (mulr (opp lx) (opp ly))). - rewrite -[x * y]opprK -mulrN /Itv.itv_cond itv_boundlr. - rewrite /mulr mul_itv_boundrC mulrC opp_itv_boundl. - rewrite [in X in _ && X]mul_itv_boundrC -mulrN. - rewrite mul_itv_boundr'_spec ?mul_itv_boundr'_spec //. - * by rewrite bnd_simp oppr_ge0. - * by rewrite leBRight_ltBLeft opp_itv_gt0 ltBRight_leBLeft ltW. - * by rewrite opp_itv_boundr. - * by rewrite opp_itv_boundr. - * by rewrite bnd_simp oppr_ge0. - * by rewrite ltW. - * by rewrite opp_itv_boundr. - + move=> lelyy leyuy. - have ypos : 0 <= y. - move: (le_trans (Itv.le_map_itv_bound R lypos) lelyy). - by rewrite /= bnd_simp. - rewrite -[Interval _ _]/(Interval (opp (mulr (opp lx) uy)) (mulr ux uy)). - rewrite -[x * y]opprK -mulNr /Itv.itv_cond itv_boundlr. - rewrite /mulr mul_itv_boundrC mulrC opp_itv_boundl. - rewrite [in X in _ && X]mul_itv_boundrC -mulrN opprK. - rewrite mul_itv_boundr'_spec ?mul_itv_boundr'_spec //. - * by rewrite ltW. - * by rewrite leBRight_ltBLeft opp_itv_gt0 ltBRight_leBLeft ltW. - * by rewrite opp_itv_boundr. - + move=> lelyy leyuy. - rewrite -[Interval _ _]/(Interval - (Order.min (opp (mulr (opp lx) uy)) - (opp (mulr ux (opp ly)))) - (Order.max (mulr (opp lx) (opp ly)) - (mulr ux uy))). - rewrite /Itv.itv_cond itv_boundlr. - rewrite map_itv_bound_min map_itv_bound_max ge_min le_max. - rewrite -[x * y]opprK !opp_itv_boundl. - rewrite -[in X in ((X || _) && _)]mulNr -[in X in ((_ || X) && _)]mulrN. - rewrite -[in X in (_ && (X || _))]mulrNN !opprK. - have [xpos|xneg] := leP 0 x. - * rewrite [in X in ((_ || X) && _)]mul_itv_boundr'_spec ?orbT //=; - rewrite ?[in X in (_ || X)]mul_itv_boundr'_spec ?orbT //. - - by rewrite ltW. - - by rewrite leBRight_ltBLeft opp_itv_gt0 ltBRight_leBLeft ltW. - - by rewrite opp_itv_boundr. - * rewrite [in X in ((X || _) && _)]mul_itv_boundr'_spec //=; - rewrite ?[in X in (X || _)]mul_itv_boundr'_spec //. - - by rewrite bnd_simp oppr_ge0 ltW. - - by rewrite leBRight_ltBLeft opp_itv_gt0 ltBRight_leBLeft ltW. - - by rewrite opp_itv_boundr. - - by rewrite opp_itv_boundr. - - by rewrite bnd_simp oppr_ge0 ltW. - - by rewrite ltW. - - by rewrite opp_itv_boundr. -Qed. - -Canonical mul_inum (xi yi : interval int) (x : {itv R & xi}) (y : {itv R & yi}) - := Itv.mk (mul_spec x y). - -End RealDomainStability. +rewrite -(mulr0z 1) BRight_le_num_itv_bound. +apply: mul_boundr_gt0 => //. +by rewrite -(@BRight_le_num_itv_bound R) (le_trans _ lex1b1). +Qed. + +Lemma comparable_num_itv_bound (x y : itv_bound int) : + (num_itv_bound R x >=< num_itv_bound R y)%O. +Proof. +by case: x y => [[] x | []] [[] y | []]//; apply/orP; + rewrite !bnd_simp ?ler_int ?ltr_int; + case: leP => xy; apply/orP => //; rewrite ltW ?orbT. +Qed. + +Lemma num_itv_bound_min (x y : itv_bound int) : + num_itv_bound R (Order.min x y) + = Order.min (num_itv_bound R x) (num_itv_bound R y). +Proof. +have [lexy | ltyx] := leP x y; [by rewrite !minEle le_num_itv_bound lexy|]. +rewrite minElt -if_neg -comparable_leNgt ?le_num_itv_bound ?ltW//. +exact: comparable_num_itv_bound. +Qed. + +Lemma num_itv_bound_max (x y : itv_bound int) : + num_itv_bound R (Order.max x y) + = Order.max (num_itv_bound R x) (num_itv_bound R y). +Proof. +have [lexy | ltyx] := leP x y; [by rewrite !maxEle le_num_itv_bound lexy|]. +rewrite maxElt -if_neg -comparable_leNgt ?le_num_itv_bound ?ltW//. +exact: comparable_num_itv_bound. +Qed. + +Lemma num_spec_mul (xi yi : Itv.t) (x : num_def R xi) (y : num_def R yi) + (r := Itv.real2 mul xi yi) : + num_spec r (x%:inum * y%:inum). +Proof. +rewrite {}/r; case: xi yi x y => [//| [xl xu]] [//| [yl yu]]. +case=> [x /=/and3P[xr /= xlx xxu]] [y /=/and3P[yr /= yly yyu]]. +rewrite -/(sign (Interval xl xu)) -/(sign (Interval yl yu)). +have ns000 : @Itv.num_sem R `[0, 0] 0 by apply/and3P. +have xyr : x * y \in Num.real by exact: realM. +case: (signP xlx xxu xr) => xlb xub xs. +- by rewrite xs mul0r; case: (signP yly yyu yr). +- case: (signP yly yyu yr) => ylb yub ys. + + by rewrite ys mulr0. + + apply/and3P; split=> //=. + * exact: num_itv_mul_boundl xlx yly. + * exact: num_itv_mul_boundr xxu yyu. + + apply/and3P; split=> //=; rewrite -[x * y]opprK -mulrN. + * by rewrite opp_boundl num_itv_mul_boundr ?oppr_ge0// opp_boundr. + * by rewrite opp_boundr num_itv_mul_boundl ?opp_boundl// opp_bound_ge0. + + apply/and3P; split=> //=. + * rewrite -[x * y]opprK -mulrN opp_boundl. + by rewrite BRight_le_mul_boundr ?realN ?opp_boundr// opp_bound_gt0 ltW. + * by rewrite BRight_le_mul_boundr// ltW. +- case: (signP yly yyu yr) => ylb yub ys. + + by rewrite ys mulr0. + + apply/and3P; split=> //=; rewrite -[x * y]opprK -mulNr. + * rewrite opp_boundl. + by rewrite num_itv_mul_boundr ?oppr_ge0 ?opp_boundr. + * by rewrite opp_boundr num_itv_mul_boundl ?opp_boundl// opp_bound_ge0. + + apply/and3P; split=> //=; rewrite -mulrNN. + * by rewrite num_itv_mul_boundl ?opp_bound_ge0 ?opp_boundl. + * by rewrite num_itv_mul_boundr ?oppr_ge0 ?opp_boundr. + + apply/and3P; split=> //=; rewrite -[x * y]opprK. + * rewrite -mulNr opp_boundl BRight_le_mul_boundr ?oppr_ge0 ?opp_boundr//. + exact: ltW. + * rewrite opprK -mulrNN. + by rewrite BRight_le_mul_boundr ?opp_boundr + ?oppr_ge0 ?realN ?opp_bound_gt0// ltW. +- case: (signP yly yyu yr) => ylb yub ys. + + by rewrite ys mulr0. + + apply/and3P; split=> //=; rewrite mulrC mul_boundrC. + * rewrite -[y * x]opprK -mulrN opp_boundl. + rewrite BRight_le_mul_boundr ?oppr_ge0 ?realN ?opp_boundr//. + by rewrite opp_bound_gt0 ltW. + * by rewrite BRight_le_mul_boundr// ltW. + + apply/and3P; split=> //=; rewrite mulrC mul_boundrC. + * rewrite -[y * x]opprK -mulNr opp_boundl. + by rewrite BRight_le_mul_boundr ?oppr_ge0 ?opp_boundr// ltW. + * rewrite -mulrNN BRight_le_mul_boundr ?oppr_ge0 ?realN ?opp_boundr//. + by rewrite opp_bound_gt0 ltW. +apply/and3P; rewrite xyr/= num_itv_bound_min num_itv_bound_max. +rewrite (comparable_ge_min _ (comparable_num_itv_bound _ _)). +rewrite (comparable_le_max _ (comparable_num_itv_bound _ _)). +case: (comparable_leP xr) => [x0 | /ltW x0]; split=> //. +- apply/orP; right; rewrite -[x * y]opprK -mulrN opp_boundl. + by rewrite BRight_le_mul_boundr ?realN ?opp_boundr// opp_bound_gt0 ltW. +- by apply/orP; right; rewrite BRight_le_mul_boundr// ltW. +- apply/orP; left; rewrite -[x * y]opprK -mulNr opp_boundl. + by rewrite BRight_le_mul_boundr ?oppr_ge0 ?opp_boundr// ltW. +- apply/orP; left; rewrite -mulrNN. + rewrite BRight_le_mul_boundr ?oppr_ge0 ?realN ?opp_boundr//. + by rewrite opp_bound_gt0 ltW. +Qed. + +Canonical mul_inum (xi yi : Itv.t) (x : num_def R xi) (y : num_def R yi) := + Itv.mk (num_spec_mul x y). + +End NumDomainInstances. End Instances. Export (canonicals) Instances. Section Morph. -Context {R : numDomainType} {i : interval int}. -Local Notation nR := {itv R & i}. +Context {R : numDomainType} {i : Itv.t}. +Local Notation nR := (num_def R i). Implicit Types x y : nR. -Local Notation inum := (@inum R i). +Local Notation inum := (@inum R (@Itv.num_sem R) i). Lemma inum_eq : {mono inum : x y / x == y}. Proof. by []. Qed. Lemma inum_le : {mono inum : x y / (x <= y)%O}. Proof. by []. Qed. Lemma inum_lt : {mono inum : x y / (x < y)%O}. Proof. by []. Qed. +Lemma inum_min : {morph inum : x y / Order.min x y}. +Proof. by move=> x y; rewrite !minEle inum_le -fun_if. Qed. +Lemma inum_max : {morph inum : x y / Order.max x y}. +Proof. by move=> x y; rewrite !maxEle inum_le -fun_if. Qed. End Morph. +Section MorphReal. +Context {R : numDomainType} {i : interval int}. +Local Notation nR := (num_def R (Itv.Real i)). +Implicit Type x y : nR. +Local Notation num := (@inum R (@Itv.num_sem R) i). + +Lemma num_le_max a x y : + a <= Num.max x%:inum y%:inum = (a <= x%:inum) || (a <= y%:inum). +Proof. by rewrite -comparable_le_max// real_comparable. Qed. + +Lemma num_ge_max a x y : + Num.max x%:inum y%:inum <= a = (x%:inum <= a) && (y%:inum <= a). +Proof. by rewrite -comparable_ge_max// real_comparable. Qed. + +Lemma num_le_min a x y : + a <= Num.min x%:inum y%:inum = (a <= x%:inum) && (a <= y%:inum). +Proof. by rewrite -comparable_le_min// real_comparable. Qed. + +Lemma num_ge_min a x y : + Num.min x%:inum y%:inum <= a = (x%:inum <= a) || (y%:inum <= a). +Proof. by rewrite -comparable_ge_min// real_comparable. Qed. + +Lemma num_lt_max a x y : + a < Num.max x%:inum y%:inum = (a < x%:inum) || (a < y%:inum). +Proof. by rewrite -comparable_lt_max// real_comparable. Qed. + +Lemma num_gt_max a x y : + Num.max x%:inum y%:inum < a = (x%:inum < a) && (y%:inum < a). +Proof. by rewrite -comparable_gt_max// real_comparable. Qed. + +Lemma num_lt_min a x y : + a < Num.min x%:inum y%:inum = (a < x%:inum) && (a < y%:inum). +Proof. by rewrite -comparable_lt_min// real_comparable. Qed. + +Lemma num_gt_min a x y : + Num.min x%:inum y%:inum < a = (x%:inum < a) || (y%:inum < a). +Proof. by rewrite -comparable_gt_min// real_comparable. Qed. + +End MorphReal. + +Section ItvNum. +Context (R : numDomainType). +Context (x : R) (l u : itv_bound int). +Context (x_real : x \in Num.real). +Context (l_le_x : (num_itv_bound R l <= BLeft x)%O). +Context (x_le_u : (BRight x <= num_itv_bound R u)%O). +Lemma itvnum_subdef : num_spec (Itv.Real (Interval l u)) x. +Proof. by apply/and3P. Qed. +Definition ItvNum : num_def R (Itv.Real (Interval l u)) := Itv.mk itvnum_subdef. +End ItvNum. + +Section ItvReal. +Context (R : realDomainType). +Context (x : R) (l u : itv_bound int). +Context (l_le_x : (num_itv_bound R l <= BLeft x)%O). +Context (x_le_u : (BRight x <= num_itv_bound R u)%O). +Lemma itvreal_subdef : num_spec (Itv.Real (Interval l u)) x. +Proof. by apply/and3P; split; first exact: num_real. Qed. +Definition ItvReal : num_def R (Itv.Real (Interval l u)) := + Itv.mk itvreal_subdef. +End ItvReal. + +Section Itv01. +Context (R : numDomainType). +Context (x : R) (x_ge0 : 0 <= x) (x_le1 : x <= 1). +Lemma itv01_subdef : num_spec (Itv.Real `[0%Z, 1%Z]) x. +Proof. by apply/and3P; split; rewrite ?bnd_simp// ger0_real. Qed. +Definition Itv01 : num_def R (Itv.Real `[0%Z, 1%Z]) := Itv.mk itv01_subdef. +End Itv01. + Section Test1. Variable R : numDomainType. @@ -888,7 +1029,7 @@ Lemma s_of_p0 (p : {i01 R}) : s_of_pq p 0%:i01 = p. Proof. by apply/val_inj; rewrite /= subr0 mulr1 subKr. Qed. Canonical onem_itv01 (p : {i01 R}) : {i01 R} := - @Itv.mk _ _ (onem p%:inum) [itv of 1 - p%:inum]. + @Itv.mk _ _ _ (onem p%:inum) [itv of 1 - p%:inum]. Definition s_of_pq' (p q : {i01 R}) : {i01 R} := (`1- (`1-(p%:inum) * `1-(q%:inum)))%:i01. diff --git a/theories/convex.v b/theories/convex.v index 67c4ba3ad..698babd56 100644 --- a/theories/convex.v +++ b/theories/convex.v @@ -184,7 +184,7 @@ Let convexf_ptP : a < b -> (forall x, a <= x <= b -> 0 <= L x - f x) -> forall t, f (a <| t |> b) <= f a <| t |> f b. Proof. move=> ab h t; set x := a <| t |> b; have /h : a <= x <= b. - by rewrite -(conv1 a b) -{1}(conv0 a b) /x !le_line_path//= itv_ge0/=. + by rewrite -(conv1 a b) -{1}(conv0 a b) /x !le_line_path//= ge0/=. rewrite subr_ge0 => /le_trans; apply. by rewrite LE// /x line_pathK ?lt_eqF// convC line_pathK ?gt_eqF. Qed. diff --git a/theories/exp.v b/theories/exp.v index 07ef92a28..f53fa3af5 100644 --- a/theories/exp.v +++ b/theories/exp.v @@ -968,11 +968,10 @@ rewrite le_eqVlt => /predU1P[<- b0 p0 q0 _|a0]. by rewrite mul0r powR0 ?gt_eqF// mul0r add0r divr_ge0 ?powR_ge0 ?ltW. rewrite le_eqVlt => /predU1P[<-|b0] p0 q0 pq. by rewrite mulr0 powR0 ?gt_eqF// mul0r addr0 divr_ge0 ?powR_ge0 ?ltW. -have q01 : (q^-1 \in `[0, 1])%R. - by rewrite in_itv/= invr_ge0 (ltW q0)/= -pq ler_wpDl// invr_ge0 ltW. +have iq1 : q^-1 <= 1 by rewrite -pq ler_wpDl// invr_ge0 ltW. have ap0 : (0 < a `^ p)%R by rewrite powR_gt0. have bq0 : (0 < b `^ q)%R by rewrite powR_gt0. -have := @concave_ln _ (@Itv.mk _ `[0, 1] _ q01)%R _ _ ap0 bq0. +have := @concave_ln _ (Itv01 (eqbRL (invr_ge0 _) (ltW q0)) iq1) _ _ ap0 bq0. have pq' : (p^-1 = 1 - q^-1)%R by rewrite -pq addrK. rewrite !convRE/= /onem -pq' -[_ <= ln _]ler_expR expRD (mulrC p^-1). rewrite ln_powR mulrAC divff ?mul1r ?gt_eqF// (mulrC q^-1). diff --git a/theories/hoelder.v b/theories/hoelder.v index 79e537f1a..9e3820b14 100644 --- a/theories/hoelder.v +++ b/theories/hoelder.v @@ -347,8 +347,8 @@ move=> p1; rewrite (@le_trans _ _ ((2^-1 * `| f x | + 2^-1 * `| g x |) `^ p))//. rewrite ge0_ler_powR ?nnegrE ?(le_trans _ p1)//. by rewrite (le_trans (ler_normD _ _))// 2!normrM ger0_norm. rewrite {1 3}(_ : 2^-1 = 1 - 2^-1); last by rewrite {2}(splitr 1) div1r addrK. -rewrite (@convex_powR _ _ p1 (@Itv.mk _ _ _ _)) ?inE/= ?in_itv/= ?normr_ge0//. -by rewrite /Itv.itv_cond/= in_itv/= invr_ge0 ler0n invf_le1 ?ler1n. +rewrite (@convex_powR _ _ p1 (Itv01 _ _))// ?inE/= ?in_itv/= ?normr_ge0 ?invr_ge0//. +by rewrite invf_le1 ?ler1n. Qed. Let measurableT_comp_powR f p : From 6a625417c7f57c360e1083d29062af793819ec74 Mon Sep 17 00:00:00 2001 From: Pierre Roux Date: Sun, 24 Nov 2024 21:19:49 +0100 Subject: [PATCH 09/19] Replace notation %:inum with %:num --- CHANGELOG_UNRELEASED.md | 9 ++++ reals/interval_inference.v | 96 +++++++++++++++++++------------------- 2 files changed, 58 insertions(+), 47 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index 3aef24b94..431693999 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -139,6 +139,7 @@ `num_ge_max`, `num_le_min`, `num_ge_min`, `num_lt_max`, `num_gt_max`, `num_lt_min`, `num_gt_min`, `itvnum_subdef`, `itvreal_subdef`, `itv01_subdef` + + notation `%:num` ### Changed @@ -249,6 +250,11 @@ + `itv_top_typ` -> `top_typ` + `Itv.map_itv_bound` -> `map_itv_bound` + `Itv.map_itv` -> `map_itv` + + `inum_eq` -> `num_eq` + + `inum_le` -> `num_le` + + `inum_lt` -> `num_lt` + + `inum_min` -> `num_min` + + `inum_max` -> `num_max` ### Generalized @@ -287,6 +293,9 @@ ### Deprecated +- in `interval_inference.v`: + + notation `%:inum` (use `%:num` instead) + ### Removed - in `sequences.v`: diff --git a/reals/interval_inference.v b/reals/interval_inference.v index 6a3139ec9..9f3358718 100644 --- a/reals/interval_inference.v +++ b/reals/interval_inference.v @@ -12,8 +12,8 @@ From mathcomp Require Import mathcomp_extra. (* a known interval easier, thanks to canonical structures. This adds types *) (* like {itv R & `[a, b]}, a notation e%:itv that infers an enclosing *) (* interval for expression e according to existing canonical instances and *) -(* %:inum to cast back from type {itv R & i} to R. *) -(* For instance, for x : {i01 R}, we have (1 - x%:inum)%:itv : {i01 R} *) +(* %:num to cast back from type {itv R & i} to R. *) +(* For instance, for x : {i01 R}, we have (1 - x%:num)%:itv : {i01 R} *) (* automatically inferred. *) (* *) (* ## types for values within known interval *) @@ -40,7 +40,7 @@ From mathcomp Require Import mathcomp_extra. (* *) (* Explicit casts of x from some {itv R & i} to R: *) (* ``` *) -(* x%:inum == cast from {itv R & i} *) +(* x%:num == cast from {itv R & i} *) (* ``` *) (* *) (* ## sign proofs *) @@ -85,6 +85,7 @@ Reserved Notation "{ 'i01' R }" Reserved Notation "x %:itv" (at level 2, format "x %:itv"). Reserved Notation "x %:i01" (at level 2, format "x %:i01"). Reserved Notation "x %:inum" (at level 2, format "x %:inum"). +Reserved Notation "x %:num" (at level 2, format "x %:num"). Reserved Notation "[ 'itv' 'of' x ]" (format "[ 'itv' 'of' x ]"). @@ -318,8 +319,9 @@ Notation "{ 'itv' R & i }" := (def (@num_sem R) (Itv.Real i%Z)) : type_scope. Notation "{ 'i01' R }" := {itv R & `[0, 1]} : type_scope. Notation "x %:itv" := (from (Phantom _ x)) : ring_scope. Notation "[ 'itv' 'of' x ]" := (fromP (Phantom _ x)) : ring_scope. -Notation inum := r. -Notation "x %:inum" := (r x) : ring_scope. +Notation num := r. +Notation "x %:inum" := (r x) (only parsing) : ring_scope. +Notation "x %:num" := (r x) : ring_scope. End Exports. End Itv. Export Itv.Exports. @@ -453,58 +455,58 @@ case: x => x /= /[swap] /num_spec_sub /[apply] /andP[_] /=. by rewrite in_itv/= => /andP[] /le_trans /[apply]; rewrite ler10. Qed. -Lemma gt0 x : unify_itv i (Itv.Real `]0%Z, +oo[) -> 0 < x%:inum :> R. +Lemma gt0 x : unify_itv i (Itv.Real `]0%Z, +oo[) -> 0 < x%:num :> R. Proof. case: x => x /= /[swap] /num_spec_sub /[apply] /andP[_]. by rewrite /= in_itv/= andbT. Qed. -Lemma le0F x : unify_itv i (Itv.Real `]0%Z, +oo[) -> x%:inum <= 0 :> R = false. +Lemma le0F x : unify_itv i (Itv.Real `]0%Z, +oo[) -> x%:num <= 0 :> R = false. Proof. case: x => x /= /[swap] /num_spec_sub /[apply] /andP[_] /=. by rewrite in_itv/= andbT => /lt_geF. Qed. -Lemma lt0 x : unify_itv i (Itv.Real `]-oo, 0%Z[) -> x%:inum < 0 :> R. +Lemma lt0 x : unify_itv i (Itv.Real `]-oo, 0%Z[) -> x%:num < 0 :> R. Proof. by case: x => x /= /[swap] /num_spec_sub /[apply] /andP[_] /=; rewrite in_itv. Qed. -Lemma ge0F x : unify_itv i (Itv.Real `]-oo, 0%Z[) -> 0 <= x%:inum :> R = false. +Lemma ge0F x : unify_itv i (Itv.Real `]-oo, 0%Z[) -> 0 <= x%:num :> R = false. Proof. case: x => x /= /[swap] /num_spec_sub /[apply] /andP[_] /=. by rewrite in_itv/= => /lt_geF. Qed. -Lemma ge0 x : unify_itv i (Itv.Real `[0%Z, +oo[) -> 0 <= x%:inum :> R. +Lemma ge0 x : unify_itv i (Itv.Real `[0%Z, +oo[) -> 0 <= x%:num :> R. Proof. case: x => x /= /[swap] /num_spec_sub /[apply] /andP[_] /=. by rewrite in_itv/= andbT. Qed. -Lemma lt0F x : unify_itv i (Itv.Real `[0%Z, +oo[) -> x%:inum < 0 :> R = false. +Lemma lt0F x : unify_itv i (Itv.Real `[0%Z, +oo[) -> x%:num < 0 :> R = false. Proof. case: x => x /= /[swap] /num_spec_sub /[apply] /andP[_] /=. by rewrite in_itv/= andbT => /le_gtF. Qed. -Lemma le0 x : unify_itv i (Itv.Real `]-oo, 0%Z]) -> x%:inum <= 0 :> R. +Lemma le0 x : unify_itv i (Itv.Real `]-oo, 0%Z]) -> x%:num <= 0 :> R. Proof. by case: x => x /= /[swap] /num_spec_sub /[apply] /andP[_] /=; rewrite in_itv. Qed. -Lemma gt0F x : unify_itv i (Itv.Real `]-oo, 0%Z]) -> 0 < x%:inum :> R = false. +Lemma gt0F x : unify_itv i (Itv.Real `]-oo, 0%Z]) -> 0 < x%:num :> R = false. Proof. case: x => x /= /[swap] /num_spec_sub /[apply] /andP[_] /=. by rewrite in_itv/= => /le_gtF. Qed. -Lemma cmp0 x : unify_itv i (Itv.Real `]-oo, +oo[) -> 0 >=< x%:inum. +Lemma cmp0 x : unify_itv i (Itv.Real `]-oo, +oo[) -> 0 >=< x%:num. Proof. by case: i x => [//| i' [x /=/andP[]]]. Qed. Lemma neq0 x : unify (fun ix iy => ~~ Itv.sub ix iy) (Itv.Real `[0%Z, 0%Z]) i -> - x%:inum != 0 :> R. + x%:num != 0 :> R. Proof. case: i x => [//| [l u] [x /= Px]]; apply: contra => /eqP x0 /=. move: Px; rewrite x0 => /and3P[_ /= l0 u0]; apply/andP; split. @@ -514,32 +516,32 @@ Qed. Lemma eq0F x : unify (fun ix iy => ~~ Itv.sub ix iy) (Itv.Real `[0%Z, 0%Z]) i -> - x%:inum == 0 :> R = false. + x%:num == 0 :> R = false. Proof. by move=> u; apply/negbTE/neq0. Qed. -Lemma lt1 x : unify_itv i (Itv.Real `]-oo, 1%Z[) -> x%:inum < 1 :> R. +Lemma lt1 x : unify_itv i (Itv.Real `]-oo, 1%Z[) -> x%:num < 1 :> R. Proof. by case: x => x /= /[swap] /num_spec_sub /[apply] /andP[_] /=; rewrite in_itv. Qed. -Lemma ge1F x : unify_itv i (Itv.Real `]-oo, 1%Z[) -> 1 <= x%:inum :> R = false. +Lemma ge1F x : unify_itv i (Itv.Real `]-oo, 1%Z[) -> 1 <= x%:num :> R = false. Proof. case: x => x /= /[swap] /num_spec_sub /[apply] /andP[_] /=. by rewrite in_itv/= => /lt_geF. Qed. -Lemma le1 x : unify_itv i (Itv.Real `]-oo, 1%Z]) -> x%:inum <= 1 :> R. +Lemma le1 x : unify_itv i (Itv.Real `]-oo, 1%Z]) -> x%:num <= 1 :> R. Proof. by case: x => x /= /[swap] /num_spec_sub /[apply] /andP[_] /=; rewrite in_itv. Qed. -Lemma gt1F x : unify_itv i (Itv.Real `]-oo, 1%Z]) -> 1 < x%:inum :> R = false. +Lemma gt1F x : unify_itv i (Itv.Real `]-oo, 1%Z]) -> 1 < x%:num :> R = false. Proof. case: x => x /= /[swap] /num_spec_sub /[apply] /andP[_] /=. by rewrite in_itv/= => /le_gtF. Qed. -Lemma widen_itv_subproof x i' : Itv.sub i i' -> num_spec i' x%:inum. +Lemma widen_itv_subproof x i' : Itv.sub i i' -> num_spec i' x%:num. Proof. by case: x => x /= /[swap] /num_spec_sub; apply. Qed. Definition widen_itv x i' (uni : unify_itv i i') := @@ -619,7 +621,7 @@ by case: b => [[] b | []//]; rewrite /= !bnd_simp mulrNz ?lerN2 // ltrN2. Qed. Lemma num_spec_opp (i : Itv.t) (x : num_def R i) (r := Itv.real1 opp i) : - num_spec r (- x%:inum). + num_spec r (- x%:num). Proof. apply: Itv.spec_real1 (Itv.P x). case: x => x /= _ [l u] /and3P[xr lx xu]. @@ -655,7 +657,7 @@ Qed. Lemma num_spec_add (xi yi : Itv.t) (x : num_def R xi) (y : num_def R yi) (r := Itv.real2 add xi yi) : - num_spec r (x%:inum + y%:inum). + num_spec r (x%:num + y%:num). Proof. apply: Itv.spec_real2 (Itv.P x) (Itv.P y). case: x y => [x /= _] [y /= _] => {xi yi r} -[lx ux] [ly uy]/=. @@ -832,7 +834,7 @@ Qed. Lemma num_spec_mul (xi yi : Itv.t) (x : num_def R xi) (y : num_def R yi) (r := Itv.real2 mul xi yi) : - num_spec r (x%:inum * y%:inum). + num_spec r (x%:num * y%:num). Proof. rewrite {}/r; case: xi yi x y => [//| [xl xu]] [//| [yl yu]]. case=> [x /=/and3P[xr /= xlx xxu]] [y /=/and3P[yr /= yly yyu]]. @@ -906,15 +908,15 @@ Section Morph. Context {R : numDomainType} {i : Itv.t}. Local Notation nR := (num_def R i). Implicit Types x y : nR. -Local Notation inum := (@inum R (@Itv.num_sem R) i). +Local Notation num := (@num R (@Itv.num_sem R) i). -Lemma inum_eq : {mono inum : x y / x == y}. Proof. by []. Qed. -Lemma inum_le : {mono inum : x y / (x <= y)%O}. Proof. by []. Qed. -Lemma inum_lt : {mono inum : x y / (x < y)%O}. Proof. by []. Qed. -Lemma inum_min : {morph inum : x y / Order.min x y}. -Proof. by move=> x y; rewrite !minEle inum_le -fun_if. Qed. -Lemma inum_max : {morph inum : x y / Order.max x y}. -Proof. by move=> x y; rewrite !maxEle inum_le -fun_if. Qed. +Lemma num_eq : {mono num : x y / x == y}. Proof. by []. Qed. +Lemma num_le : {mono num : x y / (x <= y)%O}. Proof. by []. Qed. +Lemma num_lt : {mono num : x y / (x < y)%O}. Proof. by []. Qed. +Lemma num_min : {morph num : x y / Order.min x y}. +Proof. by move=> x y; rewrite !minEle num_le -fun_if. Qed. +Lemma num_max : {morph num : x y / Order.max x y}. +Proof. by move=> x y; rewrite !maxEle num_le -fun_if. Qed. End Morph. @@ -922,38 +924,38 @@ Section MorphReal. Context {R : numDomainType} {i : interval int}. Local Notation nR := (num_def R (Itv.Real i)). Implicit Type x y : nR. -Local Notation num := (@inum R (@Itv.num_sem R) i). +Local Notation num := (@num R (@Itv.num_sem R) i). Lemma num_le_max a x y : - a <= Num.max x%:inum y%:inum = (a <= x%:inum) || (a <= y%:inum). + a <= Num.max x%:num y%:num = (a <= x%:num) || (a <= y%:num). Proof. by rewrite -comparable_le_max// real_comparable. Qed. Lemma num_ge_max a x y : - Num.max x%:inum y%:inum <= a = (x%:inum <= a) && (y%:inum <= a). + Num.max x%:num y%:num <= a = (x%:num <= a) && (y%:num <= a). Proof. by rewrite -comparable_ge_max// real_comparable. Qed. Lemma num_le_min a x y : - a <= Num.min x%:inum y%:inum = (a <= x%:inum) && (a <= y%:inum). + a <= Num.min x%:num y%:num = (a <= x%:num) && (a <= y%:num). Proof. by rewrite -comparable_le_min// real_comparable. Qed. Lemma num_ge_min a x y : - Num.min x%:inum y%:inum <= a = (x%:inum <= a) || (y%:inum <= a). + Num.min x%:num y%:num <= a = (x%:num <= a) || (y%:num <= a). Proof. by rewrite -comparable_ge_min// real_comparable. Qed. Lemma num_lt_max a x y : - a < Num.max x%:inum y%:inum = (a < x%:inum) || (a < y%:inum). + a < Num.max x%:num y%:num = (a < x%:num) || (a < y%:num). Proof. by rewrite -comparable_lt_max// real_comparable. Qed. Lemma num_gt_max a x y : - Num.max x%:inum y%:inum < a = (x%:inum < a) && (y%:inum < a). + Num.max x%:num y%:num < a = (x%:num < a) && (y%:num < a). Proof. by rewrite -comparable_gt_max// real_comparable. Qed. Lemma num_lt_min a x y : - a < Num.min x%:inum y%:inum = (a < x%:inum) && (a < y%:inum). + a < Num.min x%:num y%:num = (a < x%:num) && (a < y%:num). Proof. by rewrite -comparable_lt_min// real_comparable. Qed. Lemma num_gt_min a x y : - Num.min x%:inum y%:inum < a = (x%:inum < a) || (y%:inum < a). + Num.min x%:num y%:num < a = (x%:num < a) || (y%:num < a). Proof. by rewrite -comparable_gt_min// real_comparable. Qed. End MorphReal. @@ -997,11 +999,11 @@ Goal 0%:i01 = 1%:i01 :> {i01 R}. Proof. Abort. -Goal (- x%:inum)%:itv = (- x%:inum)%:itv :> {itv R & `[-1, 0]}. +Goal (- x%:num)%:itv = (- x%:num)%:itv :> {itv R & `[-1, 0]}. Proof. Abort. -Goal (1 - x%:inum)%:i01 = x. +Goal (1 - x%:num)%:i01 = x. Proof. Abort. @@ -1012,7 +1014,7 @@ Section Test2. Variable R : realDomainType. Variable x y : {i01 R}. -Goal (x%:inum * y%:inum)%:i01 = x%:inum%:i01. +Goal (x%:num * y%:num)%:i01 = x%:num%:i01. Proof. Abort. @@ -1023,16 +1025,16 @@ Section Test3. Variable R : realDomainType. Definition s_of_pq (p q : {i01 R}) : {i01 R} := - (1 - ((1 - p%:inum)%:i01%:inum * (1 - q%:inum)%:i01%:inum))%:i01. + (1 - ((1 - p%:num)%:i01%:num * (1 - q%:num)%:i01%:num))%:i01. Lemma s_of_p0 (p : {i01 R}) : s_of_pq p 0%:i01 = p. Proof. by apply/val_inj; rewrite /= subr0 mulr1 subKr. Qed. Canonical onem_itv01 (p : {i01 R}) : {i01 R} := - @Itv.mk _ _ _ (onem p%:inum) [itv of 1 - p%:inum]. + @Itv.mk _ _ _ (onem p%:num) [itv of 1 - p%:num]. Definition s_of_pq' (p q : {i01 R}) : {i01 R} := - (`1- (`1-(p%:inum) * `1-(q%:inum)))%:i01. + (`1- (`1-(p%:num) * `1-(q%:num)))%:i01. End Test3. End Test3. From 32d602a2f308239431c22756964ecd7c04144301 Mon Sep 17 00:00:00 2001 From: Pierre Roux Date: Sun, 24 Nov 2024 21:11:08 +0100 Subject: [PATCH 10/19] Retrieve posnum and nonneg interfaces from signed into itv --- CHANGELOG_UNRELEASED.md | 5 ++ reals/interval_inference.v | 94 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 99 insertions(+) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index 431693999..a16d9f6c1 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -140,6 +140,11 @@ `num_gt_max`, `num_lt_min`, `num_gt_min`, `itvnum_subdef`, `itvreal_subdef`, `itv01_subdef` + notation `%:num` + + notations `{posnum R}`, `{nonneg R}`, `%:pos`, `%:nng`, + `%:posnum`, `%:nngnum`, `[gt0 of _]`, `[lt0 of _]`, `[ge0 of _]`, + `[le0 of _]`, `[cmp0 of _]`, `[neq0 of _]` + + definitions `PosNum`, `NngNum`, `posnum_spec` and `nonneg_spec` + + lemmas `posnumP` and `nonnegP` ### Changed diff --git a/reals/interval_inference.v b/reals/interval_inference.v index 9f3358718..d34980139 100644 --- a/reals/interval_inference.v +++ b/reals/interval_inference.v @@ -27,6 +27,8 @@ From mathcomp Require Import mathcomp_extra. (* Allows to solve automatically goals of the form x >= 0 *) (* and x <= 1 when x is canonically a {i01 R}. *) (* {i01 R} is canonically stable by common operations. *) +(* {posnum R} := {itv R & `]0, +oo[) *) +(* {nonneg R} := {itv R & `[0, +oo[) *) (* ``` *) (* *) (* ## casts from/to values within known interval *) @@ -36,17 +38,27 @@ From mathcomp Require Import mathcomp_extra. (* ``` *) (* x%:itv == cast to the most precisely known {itv R & i} *) (* x%:i01 == cast to {i01 R}, or fail *) +(* x%:pos == cast to {posnum R}, or fail *) +(* x%:nng == cast to {nonneg R}, or fail *) (* ``` *) (* *) (* Explicit casts of x from some {itv R & i} to R: *) (* ``` *) (* x%:num == cast from {itv R & i} *) +(* x%:posnum == cast from {posnum R} *) +(* x%:nngnum == cast from {nonneg R} *) (* ``` *) (* *) (* ## sign proofs *) (* *) (* ``` *) (* [itv of x] == proof that x is in the interval inferred by x%:itv *) +(* [gt0 of x] == proof that x > 0 *) +(* [lt0 of x] == proof that x < 0 *) +(* [ge0 of x] == proof that x >= 0 *) +(* [le0 of x] == proof that x <= 0 *) +(* [cmp0 of x] == proof that 0 >=< x *) +(* [neq0 of x] == proof that x != 0 *) (* ``` *) (* *) (* ## constructors *) @@ -64,6 +76,8 @@ From mathcomp Require Import mathcomp_extra. (* and l u : itv_bound int *) (* Itv01 x0 x1 == builds a {i01 R} from proofs x0 : 0 <= x and x1 : x <= 1*) (* where x : R with R : numDomainType *) +(* PosNum x0 == builds a {posnum R} from a proof x0 : x > 0 where x : R *) +(* NngNum x0 == builds a {posnum R} from a proof x0 : x >= 0 where x : R*) (* ``` *) (* *) (* A number of canonical instances are provided for common operations, if *) @@ -81,13 +95,25 @@ Reserved Notation "{ 'itv' R & i }" (at level 0, R at level 200, i at level 200, format "{ 'itv' R & i }"). Reserved Notation "{ 'i01' R }" (at level 0, R at level 200, format "{ 'i01' R }"). +Reserved Notation "{ 'posnum' R }" (at level 0, format "{ 'posnum' R }"). +Reserved Notation "{ 'nonneg' R }" (at level 0, format "{ 'nonneg' R }"). Reserved Notation "x %:itv" (at level 2, format "x %:itv"). Reserved Notation "x %:i01" (at level 2, format "x %:i01"). +Reserved Notation "x %:pos" (at level 2, format "x %:pos"). +Reserved Notation "x %:nng" (at level 2, format "x %:nng"). Reserved Notation "x %:inum" (at level 2, format "x %:inum"). Reserved Notation "x %:num" (at level 2, format "x %:num"). +Reserved Notation "x %:posnum" (at level 2, format "x %:posnum"). +Reserved Notation "x %:nngnum" (at level 2, format "x %:nngnum"). Reserved Notation "[ 'itv' 'of' x ]" (format "[ 'itv' 'of' x ]"). +Reserved Notation "[ 'gt0' 'of' x ]" (format "[ 'gt0' 'of' x ]"). +Reserved Notation "[ 'lt0' 'of' x ]" (format "[ 'lt0' 'of' x ]"). +Reserved Notation "[ 'ge0' 'of' x ]" (format "[ 'ge0' 'of' x ]"). +Reserved Notation "[ 'le0' 'of' x ]" (format "[ 'le0' 'of' x ]"). +Reserved Notation "[ 'cmp0' 'of' x ]" (format "[ 'cmp0' 'of' x ]"). +Reserved Notation "[ 'neq0' 'of' x ]" (format "[ 'neq0' 'of' x ]"). Set Implicit Arguments. Unset Strict Implicit. @@ -289,6 +315,12 @@ Definition num_sem (R : numDomainType) (i : interval int) (x : R) : bool := Definition nat_sem (i : interval int) (x : nat) : bool := Posz x \in i. +Definition posnum (R : numDomainType) of phant R := + def (@num_sem R) (Real `]0, +oo[). + +Definition nonneg (R : numDomainType) of phant R := + def (@num_sem R) (Real `[0, +oo[). + (* a few lifting helper functions *) Definition real1 (op1 : interval int -> interval int) (x : Itv.t) : Itv.t := match x with Itv.Top => Itv.Top | Itv.Real x => Itv.Real (op1 x) end. @@ -317,11 +349,15 @@ Module Exports. Arguments r {T sem i}. Notation "{ 'itv' R & i }" := (def (@num_sem R) (Itv.Real i%Z)) : type_scope. Notation "{ 'i01' R }" := {itv R & `[0, 1]} : type_scope. +Notation "{ 'posnum' R }" := (@posnum _ (Phant R)) : ring_scope. +Notation "{ 'nonneg' R }" := (@nonneg _ (Phant R)) : ring_scope. Notation "x %:itv" := (from (Phantom _ x)) : ring_scope. Notation "[ 'itv' 'of' x ]" := (fromP (Phantom _ x)) : ring_scope. Notation num := r. Notation "x %:inum" := (r x) (only parsing) : ring_scope. Notation "x %:num" := (r x) : ring_scope. +Notation "x %:posnum" := (@r _ _ (Real `]0%Z, +oo[) x) : ring_scope. +Notation "x %:nngnum" := (@r _ _ (Real `[0%Z, +oo[) x) : ring_scope. End Exports. End Itv. Export Itv.Exports. @@ -550,6 +586,14 @@ Definition widen_itv x i' (uni : unify_itv i i') := Lemma widen_itvE x (uni : unify_itv i i) : @widen_itv x i uni = x. Proof. exact/val_inj. Qed. +Lemma posE x (uni : unify_itv i (Itv.Real `]0%Z, +oo[)) : + (widen_itv x%:num%:itv uni)%:num = x%:num. +Proof. by []. Qed. + +Lemma nngE x (uni : unify_itv i (Itv.Real `[0%Z, +oo[)) : + (widen_itv x%:num%:itv uni)%:num = x%:num. +Proof. by []. Qed. + End NumDomainTheory. Arguments bottom {R i} _ {_}. @@ -570,6 +614,15 @@ Arguments le1 {R i} _ {_}. Arguments gt1F {R i} _ {_}. Arguments widen_itv {R i} _ {_ _}. Arguments widen_itvE {R i} _ {_}. +Arguments posE {R i} _ {_}. +Arguments nngE {R i} _ {_}. + +Notation "[ 'gt0' 'of' x ]" := (ltac:(refine (gt0 x%:itv))). +Notation "[ 'lt0' 'of' x ]" := (ltac:(refine (lt0 x%:itv))). +Notation "[ 'ge0' 'of' x ]" := (ltac:(refine (ge0 x%:itv))). +Notation "[ 'le0' 'of' x ]" := (ltac:(refine (le0 x%:itv))). +Notation "[ 'cmp0' 'of' x ]" := (ltac:(refine (cmp0 x%:itv))). +Notation "[ 'neq0' 'of' x ]" := (ltac:(refine (neq0 x%:itv))). #[export] Hint Extern 0 (is_true (0%R < _)%R) => solve [apply: gt0] : core. #[export] Hint Extern 0 (is_true (_ < 0%R)%R) => solve [apply: lt0] : core. @@ -586,6 +639,16 @@ Notation "x %:i01" := (widen_itv x%:itv : {i01 _}) (only parsing) : ring_scope. Notation "x %:i01" := (@widen_itv _ _ (@Itv.from _ _ _ (Phantom _ x)) (Itv.Real `[0, 1]%Z) _) (only printing) : ring_scope. +Notation "x %:pos" := (widen_itv x%:itv : {posnum _}) (only parsing) + : ring_scope. +Notation "x %:pos" := (@widen_itv _ _ + (@Itv.from _ _ _ (Phantom _ x)) (Itv.Real `]0%Z, +oo[) _) + (only printing) : ring_scope. +Notation "x %:nng" := (widen_itv x%:itv : {nonneg _}) (only parsing) + : ring_scope. +Notation "x %:nng" := (@widen_itv _ _ + (@Itv.from _ _ _ (Phantom _ x)) (Itv.Real `[0%Z, +oo[) _) + (only printing) : ring_scope. Local Open Scope ring_scope. @@ -990,6 +1053,37 @@ Proof. by apply/and3P; split; rewrite ?bnd_simp// ger0_real. Qed. Definition Itv01 : num_def R (Itv.Real `[0%Z, 1%Z]) := Itv.mk itv01_subdef. End Itv01. +Section Posnum. +Context (R : numDomainType) (x : R) (x_gt0 : 0 < x). +Lemma posnum_subdef : num_spec (Itv.Real `]0, +oo[) x. +Proof. by apply/and3P; rewrite /= gtr0_real. Qed. +Definition PosNum : {posnum R} := Itv.mk posnum_subdef. +End Posnum. + +Section Nngnum. +Context (R : numDomainType) (x : R) (x_ge0 : 0 <= x). +Lemma nngnum_subdef : num_spec (Itv.Real `[0, +oo[) x. +Proof. by apply/and3P; rewrite /= ger0_real. Qed. +Definition NngNum : {nonneg R} := Itv.mk nngnum_subdef. +End Nngnum. + +Variant posnum_spec (R : numDomainType) (x : R) : + R -> bool -> bool -> bool -> Type := +| IsPosnum (p : {posnum R}) : posnum_spec x (p%:num) false true true. + +Lemma posnumP (R : numDomainType) (x : R) : 0 < x -> + posnum_spec x x (x == 0) (0 <= x) (0 < x). +Proof. +move=> x_gt0; case: real_ltgt0P (x_gt0) => []; rewrite ?gtr0_real // => _ _. +by rewrite -[x]/(PosNum x_gt0)%:num; constructor. +Qed. + +Variant nonneg_spec (R : numDomainType) (x : R) : R -> bool -> Type := +| IsNonneg (p : {nonneg R}) : nonneg_spec x (p%:num) true. + +Lemma nonnegP (R : numDomainType) (x : R) : 0 <= x -> nonneg_spec x x (0 <= x). +Proof. by move=> xge0; rewrite xge0 -[x]/(NngNum xge0)%:num; constructor. Qed. + Section Test1. Variable R : numDomainType. From e736e6222ca0354d10d2009561212b576ed7b809 Mon Sep 17 00:00:00 2001 From: Pierre Roux Date: Sun, 24 Nov 2024 17:40:20 +0100 Subject: [PATCH 11/19] Add itv instances for min and max Co-authored-by: Cyril Cohen --- CHANGELOG_UNRELEASED.md | 4 ++ reals/interval_inference.v | 75 +++++++++++++++++++++++++++++++++++++- 2 files changed, 78 insertions(+), 1 deletion(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index a16d9f6c1..1840edfeb 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -129,6 +129,9 @@ `Itv.real1`, `Itv.real2`, `TypInstances.real_domain_typ`, `TypInstances.real_field_typ`, `TypInstances.nat_typ`, `ItvNum`, `ItvReal` and `Itv01` + + definitions `IntItv.min`, `IntItv.max`, `Instances.min_max_typ`, + `Instances.min_typ_inum`, `Instances.max_typ_inum`, + `Instances.num_min_max_typ` + lemmas `Itv.spec_real1`, `Itv.spec_real2`, `TypInstances.real_domain_typ_spec`, `TypInstances.real_field_typ_spec`, `TypInstances.nat_typ_spec`, @@ -139,6 +142,7 @@ `num_ge_max`, `num_le_min`, `num_ge_min`, `num_lt_max`, `num_gt_max`, `num_lt_min`, `num_gt_min`, `itvnum_subdef`, `itvreal_subdef`, `itv01_subdef` + + lemmas `Instances.num_spec_min`, `Instances.num_spec_max` + notation `%:num` + notations `{posnum R}`, `{nonneg R}`, `%:pos`, `%:nng`, `%:posnum`, `%:nngnum`, `[gt0 of _]`, `[lt0 of _]`, `[ge0 of _]`, diff --git a/reals/interval_inference.v b/reals/interval_inference.v index d34980139..47f038e61 100644 --- a/reals/interval_inference.v +++ b/reals/interval_inference.v @@ -143,7 +143,7 @@ Proof. by case: i => l u /=; rewrite -!map_itv_bound_comp. Qed. (* First, the interval arithmetic operations we will later use *) Module IntItv. -Implicit Types (b : itv_bound int) (i : interval int). +Implicit Types (b : itv_bound int) (i j : interval int). Definition opp_bound b := match b with @@ -270,6 +270,16 @@ Definition mul i1 i2 := end. Arguments mul /. +Definition min i j := + let: Interval li ui := i in let: Interval lj uj := j in + Interval (Order.min li lj) (Order.min ui uj). +Arguments min /. + +Definition max i j := + let: Interval li ui := i in let: Interval lj uj := j in + Interval (Order.max li lj) (Order.max ui uj). +Arguments max /. + End IntItv. Module Itv. @@ -962,6 +972,69 @@ Qed. Canonical mul_inum (xi yi : Itv.t) (x : num_def R xi) (y : num_def R yi) := Itv.mk (num_spec_mul x y). +Lemma num_spec_min (xi yi : Itv.t) (x : num_def R xi) (y : num_def R yi) + (r := Itv.real2 min xi yi) : + num_spec r (Order.min x%:num y%:num). +Proof. +apply: Itv.spec_real2 (Itv.P x) (Itv.P y). +case: x y => [x /= _] [y /= _] => {xi yi r} -[lx ux] [ly uy]/=. +move=> /andP[xr /=/andP[lxx xux]] /andP[yr /=/andP[lyy yuy]]. +apply/and3P; split; rewrite ?min_real//= num_itv_bound_min real_BSide_min//. +- apply: (comparable_min_le_min (comparable_num_itv_bound _ _)) => //. + exact: real_comparable. +- apply: (comparable_min_le_min _ (comparable_num_itv_bound _ _)) => //. + exact: real_comparable. +Qed. + +Lemma num_spec_max (xi yi : Itv.t) (x : num_def R xi) (y : num_def R yi) + (r := Itv.real2 max xi yi) : + num_spec r (Order.max x%:num y%:num). +Proof. +apply: Itv.spec_real2 (Itv.P x) (Itv.P y). +case: x y => [x /= _] [y /= _] => {xi yi r} -[lx ux] [ly uy]/=. +move=> /andP[xr /=/andP[lxx xux]] /andP[yr /=/andP[lyy yuy]]. +apply/and3P; split; rewrite ?max_real//= num_itv_bound_max real_BSide_max//. +- apply: (comparable_max_le_max (comparable_num_itv_bound _ _)) => //. + exact: real_comparable. +- apply: (comparable_max_le_max _ (comparable_num_itv_bound _ _)) => //. + exact: real_comparable. +Qed. + +(* We can't directly put an instance on Order.min for R : numDomainType + since we may want instances for other porderType + (typically \bar R or even nat). So we resort on this additional + canonical structure. *) +Record min_max_typ d := MinMaxTyp { + min_max_sort : porderType d; + #[canonical=no] + min_max_sem : interval int -> min_max_sort -> bool; + #[canonical=no] + min_max_minP : forall (xi yi : Itv.t) (x : Itv.def min_max_sem xi) + (y : Itv.def min_max_sem yi), + let: r := Itv.real2 min xi yi in + Itv.spec min_max_sem r (Order.min x%:num y%:num); + #[canonical=no] + min_max_maxP : forall (xi yi : Itv.t) (x : Itv.def min_max_sem xi) + (y : Itv.def min_max_sem yi), + let: r := Itv.real2 max xi yi in + Itv.spec min_max_sem r (Order.max x%:num y%:num); +}. + +(* The default instances on porderType, for min... *) +Canonical min_typ_inum d (t : min_max_typ d) (xi yi : Itv.t) + (x : Itv.def (@min_max_sem d t) xi) (y : Itv.def (@min_max_sem d t) yi) + (r := Itv.real2 min xi yi) := + Itv.mk (min_max_minP x y). + +(* ...and for max *) +Canonical max_typ_inum d (t : min_max_typ d) (xi yi : Itv.t) + (x : Itv.def (@min_max_sem d t) xi) (y : Itv.def (@min_max_sem d t) yi) + (r := Itv.real2 min xi yi) := + Itv.mk (min_max_maxP x y). + +(* Instance of the above structure for numDomainType *) +Canonical num_min_max_typ := MinMaxTyp num_spec_min num_spec_max. + End NumDomainInstances. End Instances. From 56d12efdab28526642ee75d58dae2fd68137ed08 Mon Sep 17 00:00:00 2001 From: Pierre Roux Date: Wed, 13 Nov 2024 13:06:47 +0100 Subject: [PATCH 12/19] Add instances for natmul and intmul --- CHANGELOG_UNRELEASED.md | 7 +++++-- reals/interval_inference.v | 38 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 43 insertions(+), 2 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index 1840edfeb..903d8813e 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -131,7 +131,8 @@ `ItvReal` and `Itv01` + definitions `IntItv.min`, `IntItv.max`, `Instances.min_max_typ`, `Instances.min_typ_inum`, `Instances.max_typ_inum`, - `Instances.num_min_max_typ` + `Instances.num_min_max_typ`, `Instances.natmul_inum`, + `Instances.intmul_inum` + lemmas `Itv.spec_real1`, `Itv.spec_real2`, `TypInstances.real_domain_typ_spec`, `TypInstances.real_field_typ_spec`, `TypInstances.nat_typ_spec`, @@ -142,7 +143,9 @@ `num_ge_max`, `num_le_min`, `num_ge_min`, `num_lt_max`, `num_gt_max`, `num_lt_min`, `num_gt_min`, `itvnum_subdef`, `itvreal_subdef`, `itv01_subdef` - + lemmas `Instances.num_spec_min`, `Instances.num_spec_max` + + lemmas `Instances.num_spec_min`, `Instances.num_spec_max`, + `Instances.nat_num_spec`, `Instances.num_spec_natmul`, + `Instances.num_spec_int`, `Instances.num_spec_intmul` + notation `%:num` + notations `{posnum R}`, `{nonneg R}`, `%:pos`, `%:nng`, `%:posnum`, `%:nngnum`, `[gt0 of _]`, `[lt0 of _]`, `[ge0 of _]`, diff --git a/reals/interval_inference.v b/reals/interval_inference.v index 47f038e61..841c622e3 100644 --- a/reals/interval_inference.v +++ b/reals/interval_inference.v @@ -1035,6 +1035,44 @@ Canonical max_typ_inum d (t : min_max_typ d) (xi yi : Itv.t) (* Instance of the above structure for numDomainType *) Canonical num_min_max_typ := MinMaxTyp num_spec_min num_spec_max. +Lemma nat_num_spec (i : Itv.t) (n : nat) : nat_spec i n = num_spec i (n%:R : R). +Proof. +case: i => [//| [l u]]; rewrite /= /Itv.num_sem realn/=; congr (_ && _). +- by case: l => [[] l |//]; rewrite !bnd_simp ?pmulrn ?ler_int ?ltr_int. +- by case: u => [[] u |//]; rewrite !bnd_simp ?pmulrn ?ler_int ?ltr_int. +Qed. + +Lemma num_spec_natmul (xi ni : Itv.t) (x : num_def R xi) (n : nat_def ni) + (r := Itv.real2 mul xi ni) : + num_spec r (x%:num *+ n%:num). +Proof. +have Pn : num_spec ni (n%:num%:R : R) by case: n => /= n; rewrite nat_num_spec. +by rewrite -mulr_natr -[n%:num%:R]/((Itv.Def Pn)%:num) num_spec_mul. +Qed. + +Canonical natmul_inum (xi ni : Itv.t) (x : num_def R xi) (n : nat_def ni) := + Itv.mk (num_spec_natmul x n). + +Lemma num_spec_int (i : Itv.t) (n : int) : + num_spec i n = num_spec i (n%:~R : R). +Proof. +case: i => [//| [l u]]; rewrite /= /Itv.num_sem num_real realz/=. +congr (andb _ _). +- by case: l => [[] l |//]; rewrite !bnd_simp intz ?ler_int ?ltr_int. +- by case: u => [[] u |//]; rewrite !bnd_simp intz ?ler_int ?ltr_int. +Qed. + +Lemma num_spec_intmul (xi ii : Itv.t) (x : num_def R xi) (i : num_def int ii) + (r := Itv.real2 mul xi ii) : + num_spec r (x%:num *~ i%:num). +Proof. +have Pi : num_spec ii (i%:num%:~R : R) by case: i => /= i; rewrite num_spec_int. +by rewrite -mulrzr -[i%:num%:~R]/((Itv.Def Pi)%:num) num_spec_mul. +Qed. + +Canonical intmul_inum (xi ni : Itv.t) (x : num_def R xi) (n : num_def int ni) := + Itv.mk (num_spec_intmul x n). + End NumDomainInstances. End Instances. From a8e85662da5aded1653cb710b0560f1f46bbd73a Mon Sep 17 00:00:00 2001 From: Pierre Roux Date: Wed, 13 Nov 2024 16:04:52 +0100 Subject: [PATCH 13/19] Add instance for inv --- CHANGELOG_UNRELEASED.md | 7 +++-- reals/interval_inference.v | 63 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 68 insertions(+), 2 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index 903d8813e..f5c93319c 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -132,7 +132,8 @@ + definitions `IntItv.min`, `IntItv.max`, `Instances.min_max_typ`, `Instances.min_typ_inum`, `Instances.max_typ_inum`, `Instances.num_min_max_typ`, `Instances.natmul_inum`, - `Instances.intmul_inum` + `Instances.intmul_inum`, `IntItv.keep_pos_bound`, + `IntItv.keep_neg_bound`, `Instances.inv_inum` + lemmas `Itv.spec_real1`, `Itv.spec_real2`, `TypInstances.real_domain_typ_spec`, `TypInstances.real_field_typ_spec`, `TypInstances.nat_typ_spec`, @@ -145,7 +146,9 @@ `itvreal_subdef`, `itv01_subdef` + lemmas `Instances.num_spec_min`, `Instances.num_spec_max`, `Instances.nat_num_spec`, `Instances.num_spec_natmul`, - `Instances.num_spec_int`, `Instances.num_spec_intmul` + `Instances.num_spec_int`, `Instances.num_spec_intmul`, + `Instances.num_itv_bound_keep_pos`, + `Instances.num_itv_bound_keep_neg`, `Instances.num_spec_inv` + notation `%:num` + notations `{posnum R}`, `{nonneg R}`, `%:pos`, `%:nng`, `%:posnum`, `%:nngnum`, `[gt0 of _]`, `[lt0 of _]`, `[ge0 of _]`, diff --git a/reals/interval_inference.v b/reals/interval_inference.v index 841c622e3..99de26000 100644 --- a/reals/interval_inference.v +++ b/reals/interval_inference.v @@ -280,6 +280,29 @@ Definition max i j := Interval (Order.max li lj) (Order.max ui uj). Arguments max /. +Definition keep_pos_bound b := + match b with + | BSide b 0%Z => BSide b 0%Z + | BSide _ (Posz (S _)) => BRight 0%Z + | BSide _ (Negz _) => -oo + | BInfty _ => -oo + end. +Arguments keep_pos_bound /. + +Definition keep_neg_bound b := + match b with + | BSide b 0%Z => BSide b 0%Z + | BSide _ (Negz _) => BLeft 0%Z + | BSide _ (Posz _) => +oo + | BInfty _ => +oo + end. +Arguments keep_neg_bound /. + +Definition inv i := + let: Interval l u := i in + Interval (keep_pos_bound l) (keep_neg_bound u). +Arguments inv /. + End IntItv. Module Itv. @@ -1073,6 +1096,46 @@ Qed. Canonical intmul_inum (xi ni : Itv.t) (x : num_def R xi) (n : num_def int ni) := Itv.mk (num_spec_intmul x n). +Lemma num_itv_bound_keep_pos (op : R -> R) (x : R) b : + {homo op : x / 0 <= x} -> {homo op : x / 0 < x} -> + (num_itv_bound R b <= BLeft x)%O -> + (num_itv_bound R (keep_pos_bound b) <= BLeft (op x))%O. +Proof. +case: b => [[] [] [| b] // | []//] hle hlt; rewrite !bnd_simp. +- exact: hle. +- by move=> blex; apply: le_lt_trans (hlt _ _) => //; apply: lt_le_trans blex. +- exact: hlt. +- by move=> bltx; apply: le_lt_trans (hlt _ _) => //; apply: le_lt_trans bltx. +Qed. + +Lemma num_itv_bound_keep_neg (op : R -> R) (x : R) b : + {homo op : x / x <= 0} -> {homo op : x / x < 0} -> + (BRight x <= num_itv_bound R b)%O -> + (BRight (op x) <= num_itv_bound R (keep_neg_bound b))%O. +Proof. +case: b => [[] [[|//] | b] | []//] hge hgt; rewrite !bnd_simp. +- exact: hgt. +- by move=> xltb; apply: hgt; apply: lt_le_trans xltb _; rewrite lerz0. +- exact: hge. +- by move=> xleb; apply: hgt; apply: le_lt_trans xleb _; rewrite ltrz0. +Qed. + +Lemma num_spec_inv (i : Itv.t) (x : num_def R i) (r := Itv.real1 inv i) : + num_spec r (x%:num^-1). +Proof. +apply: Itv.spec_real1 (Itv.P x). +case: x => x /= _ [l u] /and3P[xr /= lx xu]. +rewrite /Itv.num_sem/= realV xr/=; apply/andP; split. +- apply: num_itv_bound_keep_pos lx. + + by move=> ?; rewrite invr_ge0. + + by move=> ?; rewrite invr_gt0. +- apply: num_itv_bound_keep_neg xu. + + by move=> ?; rewrite invr_le0. + + by move=> ?; rewrite invr_lt0. +Qed. + +Canonical inv_inum (i : Itv.t) (x : num_def R i) := Itv.mk (num_spec_inv x). + End NumDomainInstances. End Instances. From f3d30edb1cae494f3b43afd676a51e82b0f8aeb5 Mon Sep 17 00:00:00 2001 From: Pierre Roux Date: Wed, 13 Nov 2024 16:35:00 +0100 Subject: [PATCH 14/19] Add instance for exprn --- CHANGELOG_UNRELEASED.md | 6 ++++-- reals/interval_inference.v | 39 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 43 insertions(+), 2 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index f5c93319c..4624b9590 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -133,7 +133,8 @@ `Instances.min_typ_inum`, `Instances.max_typ_inum`, `Instances.num_min_max_typ`, `Instances.natmul_inum`, `Instances.intmul_inum`, `IntItv.keep_pos_bound`, - `IntItv.keep_neg_bound`, `Instances.inv_inum` + `IntItv.keep_neg_bound`, `Instances.inv_inum`, + `IntItv.exprn_le1_bound`, `IntItv.exprn`, `Instances.exprn_inum` + lemmas `Itv.spec_real1`, `Itv.spec_real2`, `TypInstances.real_domain_typ_spec`, `TypInstances.real_field_typ_spec`, `TypInstances.nat_typ_spec`, @@ -148,7 +149,8 @@ `Instances.nat_num_spec`, `Instances.num_spec_natmul`, `Instances.num_spec_int`, `Instances.num_spec_intmul`, `Instances.num_itv_bound_keep_pos`, - `Instances.num_itv_bound_keep_neg`, `Instances.num_spec_inv` + `Instances.num_itv_bound_keep_neg`, `Instances.num_spec_inv`, + `Instances.num_itv_bound_exprn`, `Instances.num_spec_exprn` + notation `%:num` + notations `{posnum R}`, `{nonneg R}`, `%:pos`, `%:nng`, `%:posnum`, `%:nngnum`, `[gt0 of _]`, `[lt0 of _]`, `[ge0 of _]`, diff --git a/reals/interval_inference.v b/reals/interval_inference.v index 99de26000..1dfe3dd25 100644 --- a/reals/interval_inference.v +++ b/reals/interval_inference.v @@ -303,6 +303,16 @@ Definition inv i := Interval (keep_pos_bound l) (keep_neg_bound u). Arguments inv /. +Definition exprn_le1_bound b1 b2 := + if b2 isn't BSide _ 1%Z then +oo + else if (BLeft 0%Z <= b1)%O then BRight 1%Z else +oo. +Arguments exprn_le1_bound /. + +Definition exprn i := + let: Interval l u := i in + Interval (keep_pos_bound l) (exprn_le1_bound l u). +Arguments exprn /. + End IntItv. Module Itv. @@ -1136,6 +1146,35 @@ Qed. Canonical inv_inum (i : Itv.t) (x : num_def R i) := Itv.mk (num_spec_inv x). +Lemma num_itv_bound_exprn_le1 (x : R) n l u : + (num_itv_bound R l <= BLeft x)%O -> + (BRight x <= num_itv_bound R u)%O -> + (BRight (x ^+ n) <= num_itv_bound R (exprn_le1_bound l u))%O. +Proof. +case: u => [bu [[//|[|//]] |//] | []//]. +rewrite /exprn_le1_bound; case: (leP _ l) => [lge1 /= |//] lx xu. +rewrite bnd_simp; case: n => [| n]; rewrite ?expr0// expr_le1//. + by case: bu xu; rewrite bnd_simp//; apply: ltW. +case: l lge1 lx => [[] l | []//]; rewrite !bnd_simp -(@ler_int R). +- exact: le_trans. +- by move=> + /ltW; apply: le_trans. +Qed. + +Lemma num_spec_exprn (i : Itv.t) (x : num_def R i) n (r := Itv.real1 exprn i) : + num_spec r (x%:num ^+ n). +Proof. +apply: (@Itv.spec_real1 _ _ (fun x => x^+n) _ _ _ _ (Itv.P x)). +case: x => x /= _ [l u] /and3P[xr /= lx xu]. +rewrite /Itv.num_sem realX//=; apply/andP; split. +- apply: (@num_itv_bound_keep_pos (fun x => x^+n)) lx. + + exact: exprn_ge0. + + exact: exprn_gt0. +- exact: num_itv_bound_exprn_le1 lx xu. +Qed. + +Canonical exprn_inum (i : Itv.t) (x : num_def R i) n := + Itv.mk (num_spec_exprn x n). + End NumDomainInstances. End Instances. From 880e99729207abb291d3ce50783ff7750af36071 Mon Sep 17 00:00:00 2001 From: Pierre Roux Date: Wed, 13 Nov 2024 16:45:02 +0100 Subject: [PATCH 15/19] Add instance for norm --- CHANGELOG_UNRELEASED.md | 6 ++++-- reals/interval_inference.v | 27 +++++++++++++++++++++++++++ 2 files changed, 31 insertions(+), 2 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index 4624b9590..7ad4f07ab 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -134,7 +134,8 @@ `Instances.num_min_max_typ`, `Instances.natmul_inum`, `Instances.intmul_inum`, `IntItv.keep_pos_bound`, `IntItv.keep_neg_bound`, `Instances.inv_inum`, - `IntItv.exprn_le1_bound`, `IntItv.exprn`, `Instances.exprn_inum` + `IntItv.exprn_le1_bound`, `IntItv.exprn`, `Instances.exprn_inum`, + `Instances.norm_inum` + lemmas `Itv.spec_real1`, `Itv.spec_real2`, `TypInstances.real_domain_typ_spec`, `TypInstances.real_field_typ_spec`, `TypInstances.nat_typ_spec`, @@ -150,7 +151,8 @@ `Instances.num_spec_int`, `Instances.num_spec_intmul`, `Instances.num_itv_bound_keep_pos`, `Instances.num_itv_bound_keep_neg`, `Instances.num_spec_inv`, - `Instances.num_itv_bound_exprn`, `Instances.num_spec_exprn` + `Instances.num_itv_bound_exprn`, `Instances.num_spec_exprn`, + `Instances.num_spec_norm`, `num_abs_le`, `num_abs_lt` + notation `%:num` + notations `{posnum R}`, `{nonneg R}`, `%:pos`, `%:nng`, `%:posnum`, `%:nngnum`, `[gt0 of _]`, `[lt0 of _]`, `[ge0 of _]`, diff --git a/reals/interval_inference.v b/reals/interval_inference.v index 1dfe3dd25..891053343 100644 --- a/reals/interval_inference.v +++ b/reals/interval_inference.v @@ -1175,6 +1175,12 @@ Qed. Canonical exprn_inum (i : Itv.t) (x : num_def R i) n := Itv.mk (num_spec_exprn x n). +Lemma num_spec_norm {V : normedZmodType R} (x : V) : + num_spec (Itv.Real `[0, +oo[) `|x|. +Proof. by apply/and3P; split; rewrite //= ?normr_real ?bnd_simp ?normr_ge0. Qed. + +Canonical norm_inum {V : normedZmodType R} (x : V) := Itv.mk (num_spec_norm x). + End NumDomainInstances. End Instances. @@ -1196,6 +1202,14 @@ Proof. by move=> x y; rewrite !maxEle num_le -fun_if. Qed. End Morph. +Section MorphNum. +Context {R : numDomainType}. + +Lemma num_abs_eq0 (a : R) : (`|a|%:nng == 0%:nng) = (a == 0). +Proof. by rewrite -normr_eq0. Qed. + +End MorphNum. + Section MorphReal. Context {R : numDomainType} {i : interval int}. Local Notation nR := (num_def R (Itv.Real i)). @@ -1236,6 +1250,19 @@ Proof. by rewrite -comparable_gt_min// real_comparable. Qed. End MorphReal. +Section MorphGe0. +Context {R : numDomainType}. +Local Notation nR := (num_def R (Itv.Real `[0%Z, +oo[)). +Implicit Type x y : nR. +Local Notation num := (@num R (@Itv.num_sem R) (Itv.Real `[0%Z, +oo[)). + +Lemma num_abs_le a x : 0 <= a -> (`|a|%:nng <= x) = (a <= x%:num). +Proof. by move=> a0; rewrite -num_le//= ger0_norm. Qed. + +Lemma num_abs_lt a x : 0 <= a -> (`|a|%:nng < x) = (a < x%:num). +Proof. by move=> a0; rewrite -num_lt/= ger0_norm. Qed. +End MorphGe0. + Section ItvNum. Context (R : numDomainType). Context (x : R) (l u : itv_bound int). From d70c164f0af2d1854d95158cfdcdae543c6659a4 Mon Sep 17 00:00:00 2001 From: Pierre Roux Date: Wed, 13 Nov 2024 16:58:34 +0100 Subject: [PATCH 16/19] Add instance for sqrt --- CHANGELOG_UNRELEASED.md | 7 +++-- reals/interval_inference.v | 59 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 64 insertions(+), 2 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index 7ad4f07ab..b158bbbe0 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -135,7 +135,9 @@ `Instances.intmul_inum`, `IntItv.keep_pos_bound`, `IntItv.keep_neg_bound`, `Instances.inv_inum`, `IntItv.exprn_le1_bound`, `IntItv.exprn`, `Instances.exprn_inum`, - `Instances.norm_inum` + `Instances.norm_inum`, `Instances.sqrt_itv`, + `Instances.sqrt_inum`, `Instances.sqrtC_itv`, + `Instances.sqrtC_inum` + lemmas `Itv.spec_real1`, `Itv.spec_real2`, `TypInstances.real_domain_typ_spec`, `TypInstances.real_field_typ_spec`, `TypInstances.nat_typ_spec`, @@ -152,7 +154,8 @@ `Instances.num_itv_bound_keep_pos`, `Instances.num_itv_bound_keep_neg`, `Instances.num_spec_inv`, `Instances.num_itv_bound_exprn`, `Instances.num_spec_exprn`, - `Instances.num_spec_norm`, `num_abs_le`, `num_abs_lt` + `Instances.num_spec_norm`, `num_abs_le`, `num_abs_lt`, + `Instances.num_spec_sqrt`, `Instances.num_spec_sqrtC` + notation `%:num` + notations `{posnum R}`, `{nonneg R}`, `%:pos`, `%:nng`, `%:posnum`, `%:nngnum`, `[gt0 of _]`, `[lt0 of _]`, `[ge0 of _]`, diff --git a/reals/interval_inference.v b/reals/interval_inference.v index 891053343..13295b3f0 100644 --- a/reals/interval_inference.v +++ b/reals/interval_inference.v @@ -1183,6 +1183,65 @@ Canonical norm_inum {V : normedZmodType R} (x : V) := Itv.mk (num_spec_norm x). End NumDomainInstances. +Section RcfInstances. +Context {R : rcfType}. + +Definition sqrt_itv (i : Itv.t) : Itv.t := + match i with + | Itv.Top => Itv.Real `[0%Z, +oo[ + | Itv.Real (Interval l u) => + match l with + | BSide b 0%Z => Itv.Real (Interval (BSide b 0%Z) +oo) + | BSide b (Posz (S _)) => Itv.Real `]0%Z, +oo[ + | _ => Itv.Real `[0, +oo[ + end + end. +Arguments sqrt_itv /. + +Lemma num_spec_sqrt (i : Itv.t) (x : num_def R i) (r := sqrt_itv i) : + num_spec r (Num.sqrt x%:num). +Proof. +have: Itv.num_sem `[0%Z, +oo[ (Num.sqrt x%:num). + by apply/and3P; rewrite /= num_real !bnd_simp sqrtr_ge0. +rewrite {}/r; case: i x => [//| [[bl [l |//] |//] u]] [x /= +] _. +case: bl l => -[| l] /and3P[xr /= bx _]; apply/and3P; split=> //=; + move: bx; rewrite !bnd_simp ?sqrtr_ge0// sqrtr_gt0; + [exact: lt_le_trans | exact: le_lt_trans..]. +Qed. + +Canonical sqrt_inum (i : Itv.t) (x : num_def R i) := Itv.mk (num_spec_sqrt x). + +End RcfInstances. + +Section NumClosedFieldInstances. +Context {R : numClosedFieldType}. + +Definition sqrtC_itv (i : Itv.t) : Itv.t := + match i with + | Itv.Top => Itv.Top + | Itv.Real (Interval l u) => + match l with + | BSide b (Posz _) => Itv.Real (Interval (BSide b 0%Z) +oo) + | _ => Itv.Top + end + end. +Arguments sqrtC_itv /. + +Lemma num_spec_sqrtC (i : Itv.t) (x : num_def R i) (r := sqrtC_itv i) : + num_spec r (sqrtC x%:num). +Proof. +rewrite {}/r; case: i x => [//| [l u] [x /=/and3P[xr /= lx xu]]]. +case: l lx => [bl [l |//] |[]//] lx; apply/and3P; split=> //=. + by apply: real_sqrtC; case: bl lx => /[!bnd_simp] [|/ltW]; apply: le_trans. +case: bl lx => /[!bnd_simp] lx. +- by rewrite sqrtC_ge0; apply: le_trans lx. +- by rewrite sqrtC_gt0; apply: le_lt_trans lx. +Qed. + +Canonical sqrtC_inum (i : Itv.t) (x : num_def R i) := Itv.mk (num_spec_sqrtC x). + +End NumClosedFieldInstances. + End Instances. Export (canonicals) Instances. From 61cde0f8ca01da3fbd6274b2948aa31ddea0a2ef Mon Sep 17 00:00:00 2001 From: Pierre Roux Date: Thu, 14 Nov 2024 23:56:36 +0100 Subject: [PATCH 17/19] Add instances on nat --- CHANGELOG_UNRELEASED.md | 12 ++++- reals/interval_inference.v | 97 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 107 insertions(+), 2 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index b158bbbe0..d665a7c7f 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -137,7 +137,11 @@ `IntItv.exprn_le1_bound`, `IntItv.exprn`, `Instances.exprn_inum`, `Instances.norm_inum`, `Instances.sqrt_itv`, `Instances.sqrt_inum`, `Instances.sqrtC_itv`, - `Instances.sqrtC_inum` + `Instances.sqrtC_inum`, `Instances.zero_inum`, + `Instances.succn_inum`, `Instances.addn_inum`, + `Instances.double_inum`, `Instances.muln_inum`, + `Instances.expn_inum`, `Instances.minn_inum`, + `Instances.maxn_inum`, `Instances.nat_min_max_typ` + lemmas `Itv.spec_real1`, `Itv.spec_real2`, `TypInstances.real_domain_typ_spec`, `TypInstances.real_field_typ_spec`, `TypInstances.nat_typ_spec`, @@ -155,7 +159,11 @@ `Instances.num_itv_bound_keep_neg`, `Instances.num_spec_inv`, `Instances.num_itv_bound_exprn`, `Instances.num_spec_exprn`, `Instances.num_spec_norm`, `num_abs_le`, `num_abs_lt`, - `Instances.num_spec_sqrt`, `Instances.num_spec_sqrtC` + `Instances.num_spec_sqrt`, `Instances.num_spec_sqrtC`, + `Instances.nat_spec_zero`, `Instances.nat_spec_succ`, + `Instances.nat_spec_add`, `Instances.nat_spec_double`, + `Instances.nat_spec_mul`, `Instances.nat_spec_exp`, + `Instances.nat_spec_min`, `Instances.nat_spec_max` + notation `%:num` + notations `{posnum R}`, `{nonneg R}`, `%:pos`, `%:nng`, `%:posnum`, `%:nngnum`, `[gt0 of _]`, `[lt0 of _]`, `[ge0 of _]`, diff --git a/reals/interval_inference.v b/reals/interval_inference.v index 13295b3f0..d9ff693cb 100644 --- a/reals/interval_inference.v +++ b/reals/interval_inference.v @@ -1242,6 +1242,103 @@ Canonical sqrtC_inum (i : Itv.t) (x : num_def R i) := Itv.mk (num_spec_sqrtC x). End NumClosedFieldInstances. +Section NatInstances. +Local Open Scope nat_scope. +Implicit Type (n : nat). + +Lemma nat_spec_zero : nat_spec (Itv.Real `[0, 0]%Z) 0. Proof. by []. Qed. + +Canonical zeron_inum := Itv.mk nat_spec_zero. + +Lemma nat_spec_succ n : nat_spec (Itv.Real `[1, +oo[%Z) n.+1. Proof. by []. Qed. + +Canonical succn_inum n := Itv.mk (nat_spec_succ n). + +Lemma nat_spec_add (xi yi : Itv.t) (x : nat_def xi) (y : nat_def yi) + (r := Itv.real2 add xi yi) : + nat_spec r (x%:num + y%:num). +Proof. +have Px : num_spec xi (x%:num%:R : int). + by case: x => /= x; rewrite (@nat_num_spec int). +have Py : num_spec yi (y%:num%:R : int). + by case: y => /= y; rewrite (@nat_num_spec int). +rewrite (@nat_num_spec int) natrD. +rewrite -[x%:num%:R]/((Itv.Def Px)%:num) -[y%:num%:R]/((Itv.Def Py)%:num). +exact: num_spec_add. +Qed. + +Canonical addn_inum (xi yi : Itv.t) (x : nat_def xi) (y : nat_def yi) := + Itv.mk (nat_spec_add x y). + +Lemma nat_spec_double (i : Itv.t) (n : nat_def i) (r := Itv.real2 add i i) : + nat_spec r (n%:num.*2). +Proof. by rewrite -addnn nat_spec_add. Qed. + +Canonical double_inum (i : Itv.t) (x : nat_def i) := Itv.mk (nat_spec_double x). + +Lemma nat_spec_mul (xi yi : Itv.t) (x : nat_def xi) (y : nat_def yi) + (r := Itv.real2 mul xi yi) : + nat_spec r (x%:num * y%:num). +Proof. +have Px : num_spec xi (x%:num%:R : int). + by case: x => /= x; rewrite (@nat_num_spec int). +have Py : num_spec yi (y%:num%:R : int). + by case: y => /= y; rewrite (@nat_num_spec int). +rewrite (@nat_num_spec int) natrM. +rewrite -[x%:num%:R]/((Itv.Def Px)%:num) -[y%:num%:R]/((Itv.Def Py)%:num). +exact: num_spec_mul. +Qed. + +Canonical muln_inum (xi yi : Itv.t) (x : nat_def xi) (y : nat_def yi) := + Itv.mk (nat_spec_mul x y). + +Lemma nat_spec_exp (i : Itv.t) (x : nat_def i) n (r := Itv.real1 exprn i) : + nat_spec r (x%:num ^ n). +Proof. +have Px : num_spec i (x%:num%:R : int). + by case: x => /= x; rewrite (@nat_num_spec int). +rewrite (@nat_num_spec int) natrX -[x%:num%:R]/((Itv.Def Px)%:num). +exact: num_spec_exprn. +Qed. + +Canonical expn_inum (i : Itv.t) (x : nat_def i) n := Itv.mk (nat_spec_exp x n). + +Lemma nat_spec_min (xi yi : Itv.t) (x : nat_def xi) (y : nat_def yi) + (r := Itv.real2 min xi yi) : + nat_spec r (minn x%:num y%:num). +Proof. +have Px : num_spec xi (x%:num%:R : int). + by case: x => /= x; rewrite (@nat_num_spec int). +have Py : num_spec yi (y%:num%:R : int). + by case: y => /= y; rewrite (@nat_num_spec int). +rewrite (@nat_num_spec int) -minEnat natr_min. +rewrite -[x%:num%:R]/((Itv.Def Px)%:num) -[y%:num%:R]/((Itv.Def Py)%:num). +exact: num_spec_min. +Qed. + +Canonical minn_inum (xi yi : Itv.t) (x : nat_def xi) (y : nat_def yi) := + Itv.mk (nat_spec_min x y). + +Lemma nat_spec_max (xi yi : Itv.t) (x : nat_def xi) (y : nat_def yi) + (r := Itv.real2 max xi yi) : + nat_spec r (maxn x%:num y%:num). +Proof. +have Px : num_spec xi (x%:num%:R : int). + by case: x => /= x; rewrite (@nat_num_spec int). +have Py : num_spec yi (y%:num%:R : int). + by case: y => /= y; rewrite (@nat_num_spec int). +rewrite (@nat_num_spec int) -maxEnat natr_max. +rewrite -[x%:num%:R]/((Itv.Def Px)%:num) -[y%:num%:R]/((Itv.Def Py)%:num). +exact: num_spec_max. +Qed. + +Canonical maxn_inum (xi yi : Itv.t) (x : nat_def xi) (y : nat_def yi) := + Itv.mk (nat_spec_max x y). + +Canonical nat_min_max_typ := MinMaxTyp nat_spec_min nat_spec_max. + +End NatInstances. + End Instances. Export (canonicals) Instances. From 1517dec9493173c277cc489740f3749fbe84dc7a Mon Sep 17 00:00:00 2001 From: Pierre Roux Date: Sat, 16 Nov 2024 17:28:21 +0100 Subject: [PATCH 18/19] Add instances on int --- CHANGELOG_UNRELEASED.md | 6 ++++-- reals/interval_inference.v | 14 ++++++++++++++ 2 files changed, 18 insertions(+), 2 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index d665a7c7f..35f6af9b2 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -141,7 +141,8 @@ `Instances.succn_inum`, `Instances.addn_inum`, `Instances.double_inum`, `Instances.muln_inum`, `Instances.expn_inum`, `Instances.minn_inum`, - `Instances.maxn_inum`, `Instances.nat_min_max_typ` + `Instances.maxn_inum`, `Instances.nat_min_max_typ`, + `Instances.Posz_inum`, `Instances.Negz_inum` + lemmas `Itv.spec_real1`, `Itv.spec_real2`, `TypInstances.real_domain_typ_spec`, `TypInstances.real_field_typ_spec`, `TypInstances.nat_typ_spec`, @@ -163,7 +164,8 @@ `Instances.nat_spec_zero`, `Instances.nat_spec_succ`, `Instances.nat_spec_add`, `Instances.nat_spec_double`, `Instances.nat_spec_mul`, `Instances.nat_spec_exp`, - `Instances.nat_spec_min`, `Instances.nat_spec_max` + `Instances.nat_spec_min`, `Instances.nat_spec_max`, + `Instances.num_spec_Posz`, `Instances.num_spec_Negz` + notation `%:num` + notations `{posnum R}`, `{nonneg R}`, `%:pos`, `%:nng`, `%:posnum`, `%:nngnum`, `[gt0 of _]`, `[lt0 of _]`, `[ge0 of _]`, diff --git a/reals/interval_inference.v b/reals/interval_inference.v index d9ff693cb..2a1ba8d47 100644 --- a/reals/interval_inference.v +++ b/reals/interval_inference.v @@ -1339,6 +1339,20 @@ Canonical nat_min_max_typ := MinMaxTyp nat_spec_min nat_spec_max. End NatInstances. +Section IntInstances. + +Lemma num_spec_Posz n : num_spec (Itv.Real `[0, +oo[) (Posz n). +Proof. by apply/and3P; rewrite /= num_real !bnd_simp. Qed. + +Canonical Posz_inum n := Itv.mk (num_spec_Posz n). + +Lemma num_spec_Negz n : num_spec (Itv.Real `]-oo, -1]) (Negz n). +Proof. by apply/and3P; rewrite /= num_real !bnd_simp. Qed. + +Canonical Negz_inum n := Itv.mk (num_spec_Negz n). + +End IntInstances. + End Instances. Export (canonicals) Instances. From 5d32657d3a9b87be7f5f9c1bb782521974cd01b6 Mon Sep 17 00:00:00 2001 From: Pierre Roux Date: Sun, 24 Nov 2024 17:40:37 +0100 Subject: [PATCH 19/19] Port from signed to itv And deprecate signed. Co-authored-by: Reynald Affeldt Co-authored-by: Cyril Cohen --- CHANGELOG_UNRELEASED.md | 53 +- analysis_stdlib/Rstruct_topology.v | 2 +- analysis_stdlib/showcase/uniform_bigO.v | 4 +- reals/all_reals.v | 1 - reals/constructive_ereal.v | 829 +++++++++++++----- reals/interval_inference.v | 32 + reals/prodnormedzmodule.v | 4 +- reals/real_interval.v | 2 +- reals/signed.v | 3 + theories/charge.v | 28 +- theories/convex.v | 2 +- theories/derive.v | 8 +- theories/ereal.v | 79 +- theories/esum.v | 4 +- theories/exp.v | 2 +- theories/ftc.v | 5 +- theories/function_spaces.v | 6 +- theories/gauss_integral.v | 8 +- theories/hoelder.v | 4 +- theories/kernel.v | 2 +- theories/landau.v | 2 +- theories/lebesgue_integral.v | 28 +- theories/lebesgue_measure.v | 6 +- theories/lebesgue_stieltjes_measure.v | 5 +- theories/measurable_realfun.v | 2 +- theories/measure.v | 28 +- theories/normedtype.v | 13 +- theories/numfun.v | 10 +- theories/pi_irrational.v | 8 +- theories/probability.v | 6 +- theories/realfun.v | 2 +- theories/separation_axioms.v | 8 +- theories/sequences.v | 13 +- theories/topology_theory/compact.v | 10 +- theories/topology_theory/matrix_topology.v | 8 +- theories/topology_theory/num_topology.v | 5 +- theories/topology_theory/product_topology.v | 4 +- .../topology_theory/pseudometric_structure.v | 5 +- theories/topology_theory/weak_topology.v | 5 +- theories/trigo.v | 7 +- theories/tvs.v | 4 +- 41 files changed, 897 insertions(+), 360 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index 35f6af9b2..9186c409f 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -118,11 +118,42 @@ - new file `measurable_realfun.v` + with as contents the first half of the file `lebesgue_measure.v` +- in `interval_inference.v` + + definitions `ItvReal` and `Itv01` + + lemmas `cmp0`, `neq0`, `eq0F`, `num_min`, `num_max` + + notation `%:num` + + notations `{posnum R}`, `{nonneg R}`, `%:pos`, `%:nng`, + `%:posnum`, `%:nngnum`, `[gt0 of _]`, `[lt0 of _]`, `[ge0 of _]`, + `[le0 of _]`, `[cmp0 of _]`, `[neq0 of _]` + + definitions `PosNum` and `NngNum` - in `constructive_ereal.v` - + lemmas `cmp0y`, `cmp0Ny`, `real_miney`, `real_minNye`, - `real_maxey`, `real_maxNye`, `oppe_cmp0`, `real_fine`, - `real_muleN`, `real_mulNe`, `real_muleNN` + + lemmas `cmp0y`, `cmp0Ny`, `real_miney`, `real_minNye`, `real_maxey`, `real_maxNye`, + `oppe_cmp0`, `real_fine`, `real_muleN`, `real_mulNe`, `real_muleNN` + + definition `ext_num_sem` + + lemmas `ext_num_num_sem`, `ext_num_num_spec`, `le_map_itv_bound_EFin`, + `map_itv_bound_EFin_le_BLeft`, `BRight_le_map_itv_bound_EFin`, + `le_ext_num_itv_bound`, `ext_num_spec_sub` + + definition `ext_widen_itv` + + lemmas `gt0e`, `lte0`, `ge0e`, `lee0`, `cmp0e`, `neqe0` + + lemmas `ext_num_spec_pinfty` + + canonicals `pinfty_inum`, `oppe_inum`, `EFin_inum`, `fine_inum`, + `oppe_inum`, `adde_inum`, `dEFin_inum`, `dadde_inum` + + lemmas `ext_num_spec_ninfty`, `ext_num_spec_EFin`, `num_spec_fine`, + `ext_num_sem_y`, `ext_num_sem_Ny`, `oppe_boundr`, `oppe_boundl`, + `ext_num_spec_opp`, `ext_num_spec_add`, `ext_num_spec_dEFin`, + `ext_num_spec_dadd` + + variant `ext_sign_spec` + + lemmas `ext_signP`, `ext_num_itv_mul_boundl`, `ext_num_itv_mul_boundr_pos`, + `ext_num_itv_mul_boundr`, `comparable_ext_num_itv_bound`, + `ext_num_itv_bound_min`, `ext_num_itv_bound_max`, `ext_num_spec_mul` + + canonicals `mule_inum`, `abse_inum`, `ext_min_max_typ` + + definition `abse_itv` + + lemmas `ext_num_spec_abse`, `ext_min_itv_boundr_spec`, `ext_num_spec_min`, + `ext_max_itv_boundl_spec`, `ext_max_itv_boundr_spec`, `ext_num_spec_max` +- in `ereal.v`: + + lemmas `ext_num_spec_ereal_sup`, `ext_num_spec_ereal_inf` + + canonicals `ereal_sup_inum`, `ereal_inf_inum` - in `interval_inference.v` + definitions `Itv.t`, `Itv.sub`, `Itv.num_sem`, `Itv.nat_sem`, @@ -142,7 +173,9 @@ `Instances.double_inum`, `Instances.muln_inum`, `Instances.expn_inum`, `Instances.minn_inum`, `Instances.maxn_inum`, `Instances.nat_min_max_typ`, - `Instances.Posz_inum`, `Instances.Negz_inum` + `Instances.Posz_inum`, `Instances.Negz_inum`, + `IntItv.keep_nonneg_bound`, `IntItv.keep_nonpos_bound`, + `IntItv.keep_sign`, `IntItv.keep_nonpos`, `IntItv.keep_nonneg` + lemmas `Itv.spec_real1`, `Itv.spec_real2`, `TypInstances.real_domain_typ_spec`, `TypInstances.real_field_typ_spec`, `TypInstances.nat_typ_spec`, @@ -204,6 +237,9 @@ - file `interval_inference.v` + definitions `Itv.def`, `Itv.spec`, `Itv.typ`, `empty_itv` +- in `measure.v`: + + `content_snum` -> `content_inum` + + `measure_snum` -> `measure_inum` ### Renamed @@ -326,6 +362,9 @@ ### Deprecated - in `interval_inference.v`: +- file `signed.v` (use `interval_inference.v` instead) + +- in `itv.v`: + notation `%:inum` (use `%:num` instead) ### Removed @@ -402,6 +441,12 @@ + lemma `le_map_itv_bound` (use `le_num_itv_bound` instead) + lemmas `opp_itv_le0_subproof`, `opp_itv_lt0_subproof` +- in `constructive_ereal.v`: + + lemmas `num_abse_le`, `num_abse_lt` + + canonicals `abse_snum`, `mule_snum`, `dadde_snum`, `dEFin_snum`, + `adde_snum`, `oppe_snum`, `fine_snum`, `EFin_snum`, `ninfty_snum`, + `pinfty_snum` + ### Infrastructure ### Misc diff --git a/analysis_stdlib/Rstruct_topology.v b/analysis_stdlib/Rstruct_topology.v index 1d8e3f65a..1a9452c60 100644 --- a/analysis_stdlib/Rstruct_topology.v +++ b/analysis_stdlib/Rstruct_topology.v @@ -12,7 +12,7 @@ From mathcomp Require Import archimedean. From HB Require Import structures. From mathcomp Require Import mathcomp_extra. From mathcomp Require Import boolp classical_sets. -From mathcomp Require Import reals signed. +From mathcomp Require Import reals interval_inference. From mathcomp Require Import topology. From mathcomp Require Export Rstruct. diff --git a/analysis_stdlib/showcase/uniform_bigO.v b/analysis_stdlib/showcase/uniform_bigO.v index 49a724f32..73d1bc772 100644 --- a/analysis_stdlib/showcase/uniform_bigO.v +++ b/analysis_stdlib/showcase/uniform_bigO.v @@ -2,8 +2,8 @@ From Coq Require Import Reals. From Coq Require Import ssreflect ssrfun ssrbool. From mathcomp Require Import ssrnat eqtype choice fintype bigop order ssralg ssrnum. -From mathcomp Require Import boolp reals Rstruct_topology ereal. -From mathcomp Require Import classical_sets signed topology normedtype landau. +From mathcomp Require Import boolp reals Rstruct_topology ereal classical_sets. +From mathcomp Require Import interval_inference topology normedtype landau. Set Implicit Arguments. Unset Strict Implicit. diff --git a/reals/all_reals.v b/reals/all_reals.v index 7a2373141..a1fbb8e92 100644 --- a/reals/all_reals.v +++ b/reals/all_reals.v @@ -1,4 +1,3 @@ -From mathcomp Require Export signed. From mathcomp Require Export interval_inference. From mathcomp Require Export constructive_ereal. From mathcomp Require Export reals. diff --git a/reals/constructive_ereal.v b/reals/constructive_ereal.v index d081ae752..0341f58ba 100644 --- a/reals/constructive_ereal.v +++ b/reals/constructive_ereal.v @@ -11,7 +11,7 @@ bounds of intervals*) From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra finmap. -From mathcomp Require Import mathcomp_extra signed. +From mathcomp Require Import mathcomp_extra interval_inference. (**md**************************************************************************) (* # Extended real numbers $\overline{R}$ *) @@ -83,9 +83,11 @@ From mathcomp Require Import mathcomp_extra signed. (* ## Signed extended real numbers *) (* ``` *) (* {posnum \bar R} == interface type for elements in \bar R that are *) -(* positive, c.f., signed.v, notation in scope %E *) +(* positive, c.f., interval_inference.v, *) +(* notation in scope %E *) (* {nonneg \bar R} == interface types for elements in \bar R that are *) -(* non-negative, c.f. signed.v, notation in scope %E *) +(* non-negative, c.f. interval_inference.v, *) +(* notation in scope %E *) (* x%:pos == explicitly casts x to {posnum \bar R}, in scope %E *) (* x%:nng == explicitly casts x to {nonneg \bar R}, in scope %E *) (* ``` *) @@ -3533,201 +3535,667 @@ Module ConstructiveDualAddTheory. Export DualAddTheory. End ConstructiveDualAddTheory. -Definition posnume (R : numDomainType) of phant R := {> 0 : \bar R}. +Section Itv. +Context {R : numDomainType}. + +Definition ext_num_sem (i : interval int) (x : \bar R) := + (0 >=< x)%O && (x \in map_itv (EFin \o intr) i). + +Local Notation num_spec := (Itv.spec (@Itv.num_sem _)). +Local Notation num_def R := (Itv.def (@Itv.num_sem R)). +Local Notation num_itv_bound R := (@map_itv_bound _ R intr). + +Local Notation ext_num_spec := (Itv.spec ext_num_sem). +Local Notation ext_num_def := (Itv.def ext_num_sem). +Local Notation ext_num_itv_bound := + (@map_itv_bound _ (\bar R) (EFin \o intr)). + +Lemma ext_num_num_sem i (x : R) : Itv.ext_num_sem i x%:E = Itv.num_sem i x. +Proof. by case: i => [l u]; do 2![congr (_ && _)]; [case: l | case: u]. Qed. + +Lemma ext_num_num_spec i (x : R) : ext_num_spec i x%:E = num_spec i x. +Proof. by case: i => [//| i]; apply: ext_num_num_sem. Qed. + +Lemma le_map_itv_bound_EFin (x y : itv_bound R) : + (map_itv_bound EFin x <= map_itv_bound EFin y)%O = (x <= y)%O. +Proof. by case: x y => [xb x | x] [yb y | y]. Qed. + +Lemma map_itv_bound_EFin_le_BLeft (x : itv_bound R) (y : R) : + (map_itv_bound EFin x <= BLeft y%:E)%O = (x <= BLeft y)%O. +Proof. +rewrite -[BLeft y%:E]/(map_itv_bound EFin (BLeft y)). +by rewrite le_map_itv_bound_EFin. +Qed. + +Lemma BRight_le_map_itv_bound_EFin (x : R) (y : itv_bound R) : + (BRight x%:E <= map_itv_bound EFin y)%O = (BRight x <= y)%O. +Proof. +rewrite -[BRight x%:E]/(map_itv_bound EFin (BRight x)). +by rewrite le_map_itv_bound_EFin. +Qed. + +Lemma le_ext_num_itv_bound (x y : itv_bound int) : + (ext_num_itv_bound x <= ext_num_itv_bound y)%O = (x <= y)%O. +Proof. +rewrite !(map_itv_bound_comp EFin intr)/=. +by rewrite le_map_itv_bound_EFin le_num_itv_bound. +Qed. + +Lemma ext_num_spec_sub (x y : Itv.t) : Itv.sub x y -> + forall z : \bar R, ext_num_spec x z -> ext_num_spec y z. +Proof. +case: x y => [| x] [| y] //= x_sub_y z /andP[rz]; rewrite /Itv.ext_num_sem rz/=. +move: x y x_sub_y => [lx ux] [ly uy] /andP[lel leu] /=. +move=> /andP[lxz zux]; apply/andP; split. +- by apply: le_trans lxz; rewrite le_ext_num_itv_bound. +- by apply: le_trans zux _; rewrite le_ext_num_itv_bound. +Qed. + +Section ItvTheory. +Context {i : Itv.t}. +Implicit Type x : ext_num_def i. + +Lemma ext_widen_itv_subproof x i' : Itv.sub i i' -> + ext_num_spec i' x%:inum. +Proof. by case: x => x /= /[swap] /ext_num_spec_sub; apply. Qed. + +Definition ext_widen_itv x i' (uni : unify_itv i i') := + Itv.mk (ext_widen_itv_subproof x uni). + +Lemma gt0e x : unify_itv i (Itv.Real `]0%Z, +oo[) -> 0%E < x%:inum :> \bar R. +Proof. +case: x => x /= /[swap] /ext_num_spec_sub /[apply] /andP[_]. +by rewrite /= in_itv/= andbT. +Qed. + +Lemma lte0 x : unify_itv i (Itv.Real `]-oo, 0%Z[) -> x%:inum < 0%E :> \bar R. +Proof. +by case: x => x /=/[swap] /ext_num_spec_sub /[apply] /andP[_]/=; rewrite in_itv. +Qed. + +Lemma ge0e x : unify_itv i (Itv.Real `[0%Z, +oo[) -> 0%E <= x%:inum :> \bar R. +Proof. +case: x => x /= /[swap] /ext_num_spec_sub /[apply] /andP[_] /=. +by rewrite in_itv/= andbT. +Qed. + +Lemma lee0 x : unify_itv i (Itv.Real `]-oo, 0%Z]) -> x%:inum <= 0%E :> \bar R. +Proof. +by case: x => x /=/[swap] /ext_num_spec_sub /[apply] /andP[_]/=; rewrite in_itv. +Qed. + +Lemma cmp0e x : unify_itv i (Itv.Real `]-oo, +oo[) -> (0%E >=< x%:inum)%O. +Proof. by case: i x => [//| [l u] [[x||//] /=/andP[/= xr _]]]. Qed. + +Lemma neqe0 x : + unify (fun ix iy => ~~ Itv.sub ix iy) (Itv.Real `[0%Z, 0%Z]) i -> + x%:inum != 0 :> \bar R. +Proof. +case: i x => [//| [l u] [x /= Px]]; apply: contra => /eqP x0 /=. +move: Px; rewrite x0 => /and3P[_ /= l0 u0]; apply/andP; split. +- by case: l l0 => [[] l |]; rewrite ?bnd_simp ?lee_fin ?lte_fin ?lerz0 ?ltrz0. +- by case: u u0 => [[] u |]; rewrite ?bnd_simp ?lee_fin ?lte_fin ?ler0z ?ltr0z. +Qed. + +End ItvTheory. + +End Itv. + +Arguments gt0e {R i} _ {_}. +Arguments lte0 {R i} _ {_}. +Arguments ge0e {R i} _ {_}. +Arguments lee0 {R i} _ {_}. +Arguments cmp0e {R i} _ {_}. +Arguments neqe0 {R i} _ {_}. +Arguments ext_widen_itv {R i} _ {_ _}. + +Definition posnume (R : numDomainType) of phant R := + Itv.def (@ext_num_sem R) (Itv.Real `]0%Z, +oo[). Notation "{ 'posnum' '\bar' R }" := (@posnume _ (Phant R)) : type_scope. -Definition nonnege (R : numDomainType) of phant R := {>= 0 : \bar R}. +Definition nonnege (R : numDomainType) of phant R := + Itv.def (@ext_num_sem R) (Itv.Real `[0%Z, +oo[). Notation "{ 'nonneg' '\bar' R }" := (@nonnege _ (Phant R)) : type_scope. - -Notation "x %:pos" := (widen_signed x%:sgn : {posnum \bar _}) (only parsing) - : ereal_dual_scope. -Notation "x %:pos" := (widen_signed x%:sgn : {posnum \bar _}) (only parsing) - : ereal_scope. -Notation "x %:nng" := (widen_signed x%:sgn : {nonneg \bar _}) (only parsing) +Notation "x %:pos" := (ext_widen_itv x%:itv : {posnum \bar _}) (only parsing) : ereal_dual_scope. -Notation "x %:nng" := (widen_signed x%:sgn : {nonneg \bar _}) (only parsing) +Notation "x %:pos" := (ext_widen_itv x%:itv : {posnum \bar _}) (only parsing) : ereal_scope. -Notation "x %:pos" := (@widen_signed ereal_display _ _ _ _ - (@Signed.from _ _ _ _ _ _ (Phantom _ x)) - !=0 (KnownSign.Real (KnownSign.Sign >=0)) _ _) +Notation "x %:pos" := (@ext_widen_itv _ _ + (@Itv.from _ _ _ (Phantom _ x)) (Itv.Real `]Posz 0, +oo[) _) (only printing) : ereal_dual_scope. -Notation "x %:pos" := (@widen_signed ereal_display _ _ _ _ - (@Signed.from _ _ _ _ _ _ (Phantom _ x)) - !=0 (KnownSign.Real (KnownSign.Sign >=0)) _ _) +Notation "x %:pos" := (@ext_widen_itv _ _ + (@Itv.from _ _ _ (Phantom _ x)) (Itv.Real `]Posz 0, +oo[) _) (only printing) : ereal_scope. -Notation "x %:nng" := (@widen_signed ereal_display _ _ _ _ - (@Signed.from _ _ _ _ _ _ (Phantom _ x)) - ?=0 (KnownSign.Real (KnownSign.Sign >=0)) _ _) +Notation "x %:nng" := (ext_widen_itv x%:itv : {nonneg \bar _}) (only parsing) + : ereal_dual_scope. +Notation "x %:nng" := (ext_widen_itv x%:itv : {nonneg \bar _}) (only parsing) + : ereal_scope. +Notation "x %:nng" := (@ext_widen_itv _ _ + (@Itv.from _ _ _ (Phantom _ x)) (Itv.Real `[Posz 0, +oo[) _) (only printing) : ereal_dual_scope. -Notation "x %:nng" := (@widen_signed ereal_display _ _ _ _ - (@Signed.from _ _ _ _ _ _ (Phantom _ x)) - ?=0 (KnownSign.Real (KnownSign.Sign >=0)) _ _) +Notation "x %:nng" := (@ext_widen_itv _ _ + (@Itv.from _ _ _ (Phantom _ x)) (Itv.Real `[Posz 0, +oo[) _) (only printing) : ereal_scope. -#[global] Hint Extern 0 (is_true (0%E < _)%O) => solve [apply: gt0] : core. -#[global] Hint Extern 0 (is_true (_ < 0%E)%O) => solve [apply: lt0] : core. -#[global] Hint Extern 0 (is_true (0%E <= _)%O) => solve [apply: ge0] : core. -#[global] Hint Extern 0 (is_true (_ <= 0%E)%O) => solve [apply: le0] : core. -#[global] Hint Extern 0 (is_true (0%E >=< _)%O) => solve [apply: cmp0] : core. -#[global] Hint Extern 0 (is_true (_ != 0%E)%O) => solve [apply: neq0] : core. +#[export] Hint Extern 0 (is_true (0%R < _)%E) => solve [apply: gt0e] : core. +#[export] Hint Extern 0 (is_true (_ < 0%R)%E) => solve [apply: lte0] : core. +#[export] Hint Extern 0 (is_true (0%R <= _)%E) => solve [apply: ge0e] : core. +#[export] Hint Extern 0 (is_true (_ <= 0%R)%E) => solve [apply: lee0] : core. +#[export] Hint Extern 0 (is_true (0%R >=< _)%O) => solve [apply: cmp0e] : core. +#[export] Hint Extern 0 (is_true (_ != 0%R)%O) => solve [apply: neqe0] : core. + +Module ItvInstances. -Section SignedNumDomainStability. +Import IntItv. +Import Instances. + +Section Itv. Context {R : numDomainType}. -Lemma pinfty_snum_subproof : Signed.spec 0 !=0 >=0 (+oo : \bar R). -Proof. by rewrite /= le0y. Qed. +Local Notation num_spec := (Itv.spec (@Itv.num_sem _)). +Local Notation num_def R := (Itv.def (@Itv.num_sem R)). +Local Notation num_itv_bound R := (@map_itv_bound _ R intr). + +Local Notation ext_num_spec := (Itv.spec ext_num_sem). +Local Notation ext_num_def := (Itv.def ext_num_sem). +Local Notation ext_num_itv_bound := (@map_itv_bound _ (\bar R) (EFin \o intr)). + +Lemma ext_num_spec_pinfty : ext_num_spec (Itv.Real `]1%Z, +oo[) (+oo : \bar R). +Proof. by apply/and3P; rewrite /= cmp0y !bnd_simp real_ltry. Qed. + +Canonical pinfty_inum := Itv.mk (ext_num_spec_pinfty). + +Lemma ext_num_spec_ninfty : + ext_num_spec (Itv.Real `]-oo, (-1)%Z[) (-oo : \bar R). +Proof. by apply/and3P; rewrite /= cmp0Ny !bnd_simp real_ltNyr. Qed. + +Canonical ninfty_snum := Itv.mk (ext_num_spec_ninfty). + +Lemma ext_num_spec_EFin i (x : num_def R i) : ext_num_spec i x%:num%:E. +Proof. +case: i x => [//| [l u] [x /=/and3P[xr /= lx xu]]]. +by apply/and3P; split=> [//||]; [case: l lx | case: u xu]. +Qed. -Canonical pinfty_snum := Signed.mk (pinfty_snum_subproof). +Canonical EFin_inum i (x : num_def R i) := Itv.mk (ext_num_spec_EFin x). -Lemma ninfty_snum_subproof : Signed.spec 0 !=0 <=0 (-oo : \bar R). -Proof. by rewrite /= leNy0. Qed. +Lemma num_spec_fine i (x : ext_num_def i) (r := Itv.real1 keep_sign i) : + num_spec r (fine x%:num : R). +Proof. +rewrite {}/r; case: i x => [//| [l u] [x /=/and3P[xr /= lx xu]]]. +apply/and3P; split; rewrite -?real_fine//. +- case: x lx {xu xr} => [x||]/=; [|by case: l => [? []|]..]. + by case: l => [[] [l |//] |//] /[!bnd_simp] => [|/ltW]/=; rewrite lee_fin; + apply: le_trans. +- case: x xu {lx xr} => [x||]/=; [|by case: u => [? [[]|] |]..]. + by case: u => [bu [[|//] | u] |//]; case: bu => /[!bnd_simp] [/ltW|]/=; + rewrite lee_fin// => /le_trans; apply; rewrite lerz0. +Qed. -Canonical ninfty_snum := Signed.mk (ninfty_snum_subproof). +Canonical fine_inum i (x : ext_num_def i) := Itv.mk (num_spec_fine x). -Lemma EFin_snum_subproof nz cond (x : {num R & nz & cond}) : - Signed.spec 0 nz cond x%:num%:E. +Lemma ext_num_sem_y l u : + ext_num_sem (Interval l u) (+oo : \bar R) = ((l != +oo%O) && (u == +oo%O)). Proof. -apply/andP; split. - case: cond nz x => [[[]|]|] [] x //=; - do ?[by case: (bottom x)|by rewrite eqe eq0F]. -case: cond nz x => [[[]|]|] [] x //=; - do ?[by case: (bottom x)|by rewrite ?lee_fin ?(eq0, ge0, le0) ?[_ || _]cmp0]. +apply/and3P/andP => [[_ ly uy] | [ly uy]]; split. +- by case: l ly => -[]. +- by case: u uy => -[]. +- exact: cmp0y. +- case: l ly => [|[]//]. + by case=> l _ /=; rewrite bnd_simp ?real_leey ?real_ltry /= realz. +- by case: u uy => -[]. Qed. -Canonical EFin_snum nz cond (x : {num R & nz & cond}) := - Signed.mk (EFin_snum_subproof x). +Lemma ext_num_sem_Ny l u : + ext_num_sem (Interval l u) (-oo : \bar R) = ((l == -oo%O) && (u != -oo%O)). +Proof. +apply/and3P/andP => [[_ ly uy] | [ly uy]]; split. +- by case: l ly => -[]. +- by case: u uy => -[]. +- exact: real0. +- by case: l ly => -[]. +- case: u uy => [|[]//]. + by case=> u _ /=; rewrite bnd_simp ?real_leNye ?real_ltNyr /= realz. +Qed. -Lemma fine_snum_subproof (xnz : KnownSign.nullity) (xr : KnownSign.reality) - (x : {compare (0 : \bar R) & xnz & xr}) : - Signed.spec 0%R ?=0 xr (fine x%:num). +Lemma oppe_boundr (x : \bar R) b : + (BRight (- x) <= ext_num_itv_bound (opp_bound b))%O + = (ext_num_itv_bound b <= BLeft x)%O. Proof. -case: xr x => [[[]|]|]//= [x /andP[_]]/=. -- by move=> /eqP ->. -- by case: x. -- by case: x. -- by move=> /orP[]; case: x => [x||]//=; rewrite lee_fin => ->; rewrite ?orbT. +by case: b => [[] b | []//]; rewrite /= !bnd_simp mulrNz EFinN ?leeN2 // lteN2. Qed. -Canonical fine_snum (xnz : KnownSign.nullity) (xr : KnownSign.reality) - (x : {compare (0 : \bar R) & xnz & xr}) := - Signed.mk (fine_snum_subproof x). +Lemma oppe_boundl (x : \bar R) b : + (ext_num_itv_bound (opp_bound b) <= BLeft (- x))%O + = (BRight x <= ext_num_itv_bound b)%O. +Proof. +by case: b => [[] b | []//]; rewrite /= !bnd_simp mulrNz EFinN ?leeN2 // lteN2. +Qed. -Lemma oppe_snum_subproof (xnz : KnownSign.nullity) (xr : KnownSign.reality) - (x : {compare (0 : \bar R) & xnz & xr}) (r := opp_reality_subdef xnz xr) : - Signed.spec 0 xnz r (- x%:num). +Lemma ext_num_spec_opp i (x : ext_num_def i) (r := Itv.real1 opp i) : + ext_num_spec r (- x%:inum : \bar R). Proof. -rewrite {}/r; case: xr xnz x => [[[]|]|] [] x //=; - do ?[by case: (bottom x) - |by rewrite ?eqe_oppLR ?oppe0 1?eq0//; - rewrite ?oppe_le0 ?oppe_ge0 ?(eq0, eq0F, ge0, le0)//; - rewrite orbC [_ || _]cmp0]. +rewrite {}/r; case: x => -[x||]/=; + [|by case: i => [//| [l u]]; rewrite /= ext_num_sem_y ext_num_sem_Ny; + case: l u => [[] ?|[]] [[] ?|[]]..]. +rewrite !ext_num_num_spec => Px. +by rewrite -[x]/(Itv.mk Px)%:inum num_spec_opp. Qed. -Canonical oppe_snum (xnz : KnownSign.nullity) (xr : KnownSign.reality) - (x : {compare (0 : \bar R) & xnz & xr}) := - Signed.mk (oppe_snum_subproof x). +Canonical oppe_inum i (x : ext_num_def i) := Itv.mk (ext_num_spec_opp x). -Lemma adde_snum_subproof (xnz ynz : KnownSign.nullity) - (xr yr : KnownSign.reality) - (x : {compare (0 : \bar R) & xnz & xr}) - (y : {compare (0 : \bar R) & ynz & yr}) - (rnz := add_nonzero_subdef xnz ynz xr yr) - (rrl := add_reality_subdef xnz ynz xr yr) : - Signed.spec 0 rnz rrl (adde x%:num y%:num). +Lemma ext_num_spec_add xi yi (x : ext_num_def xi) (y : ext_num_def yi) + (r := Itv.real2 add xi yi) : + ext_num_spec r (adde x%:inum y%:inum : \bar R). Proof. -rewrite {}/rnz {}/rrl; apply/andP; split. - move: xr yr xnz ynz x y => [[[]|]|] [[[]|]|] [] []//= x y; - by rewrite 1?adde_ss_eq0 ?(eq0F, ge0, le0, andbF, orbT). -move: xr yr xnz ynz x y => [[[]|]|] [[[]|]|] [] []//= x y; - do ?[by case: (bottom x)|by case: (bottom y) - |by rewrite adde_ge0|by rewrite adde_le0 - |exact: realDe|by rewrite 2!eq0 /adde/= addr0]. +rewrite {}/r; case: x y => -[x||] + [[y||]]/=; + [|by case: xi yi => [//| [xl xu]] [//| [yl yu]]; + rewrite /adde/= ?ext_num_sem_y ?ext_num_sem_Ny; + case: xl xu yl yu => [[] ?|[]] [[] ?|[]] [[] ?|[]] [[] ?|[]]..]. +rewrite !ext_num_num_spec => Px Py. +by rewrite -[x]/(Itv.mk Px)%:inum -[y]/(Itv.mk Py)%:inum num_spec_add. Qed. -Canonical adde_snum (xnz ynz : KnownSign.nullity) - (xr yr : KnownSign.reality) - (x : {compare (0 : \bar R) & xnz & xr}) - (y : {compare (0 : \bar R) & ynz & yr}) := - Signed.mk (adde_snum_subproof x y). +Canonical adde_inum xi yi (x : ext_num_def xi) (y : ext_num_def yi) := + Itv.mk (ext_num_spec_add x y). Import DualAddTheory. -Lemma dEFin_snum_subproof nz cond (x : {num R & nz & cond}) : - Signed.spec 0 nz cond (dEFin x%:num). -Proof. exact: EFin_snum_subproof. Qed. - -Canonical dEFin_snum nz cond (x : {num R & nz & cond}) := - Signed.mk (dEFin_snum_subproof x). - -Lemma dadde_snum_subproof (xnz ynz : KnownSign.nullity) - (xr yr : KnownSign.reality) - (x : {compare (0 : \bar R) & xnz & xr}) - (y : {compare (0 : \bar R) & ynz & yr}) - (rnz := add_nonzero_subdef xnz ynz xr yr) - (rrl := add_reality_subdef xnz ynz xr yr) : - Signed.spec 0 rnz rrl (dual_adde x%:num y%:num)%dE. -Proof. -rewrite {}/rnz {}/rrl; apply/andP; split. - move: xr yr xnz ynz x y => [[[]|]|] [[[]|]|] [] []//= x y; - by rewrite 1?dadde_ss_eq0 ?(eq0F, ge0, le0, andbF, orbT). -move: xr yr xnz ynz x y => [[[]|]|] [[[]|]|] [] []//= x y; - do ?[by case: (bottom x)|by case: (bottom y) - |by rewrite dadde_ge0|by rewrite dadde_le0 - |exact: realDed|by rewrite 2!eq0 /dual_adde/= addr0]. -Qed. - -Canonical dadde_snum (xnz ynz : KnownSign.nullity) - (xr yr : KnownSign.reality) - (x : {compare (0 : \bar R) & xnz & xr}) - (y : {compare (0 : \bar R) & ynz & yr}) := - Signed.mk (dadde_snum_subproof x y). - -Lemma mule_snum_subproof (xnz ynz : KnownSign.nullity) - (xr yr : KnownSign.reality) - (x : {compare (0 : \bar R) & xnz & xr}) - (y : {compare (0 : \bar R) & ynz & yr}) - (rnz := mul_nonzero_subdef xnz ynz xr yr) - (rrl := mul_reality_subdef xnz ynz xr yr) : - Signed.spec 0 rnz rrl (x%:num * y%:num). -Proof. -rewrite {}/rnz {}/rrl; apply/andP; split. - by move: xr yr xnz ynz x y => [[[]|]|] [[[]|]|] [] []// x y; - rewrite mule_neq0. -by move: xr yr xnz ynz x y => [[[]|]|] [[[]|]|] [] []/= x y //; - do ?[by case: (bottom x)|by case: (bottom y) - |by rewrite mule_ge0|by rewrite mule_le0_ge0 - |by rewrite mule_ge0_le0|by rewrite mule_le0|exact: realMe - |by rewrite eq0 ?mule0// mul0e]. -Qed. - -Canonical mule_snum (xnz ynz : KnownSign.nullity) (xr yr : KnownSign.reality) - (x : {compare (0 : \bar R) & xnz & xr}) - (y : {compare (0 : \bar R) & ynz & yr}) := - Signed.mk (mule_snum_subproof x y). - -Definition abse_reality_subdef (xnz : KnownSign.nullity) - (xr : KnownSign.reality) := (if xr is =0 then =0 else >=0)%snum_sign. -Arguments abse_reality_subdef /. - -Lemma abse_snum_subproof (xnz : KnownSign.nullity) (xr : KnownSign.reality) - (x : {compare (0 : \bar R) & xnz & xr}) (r := abse_reality_subdef xnz xr) : - Signed.spec 0 xnz r `|x%:num|. -Proof. -rewrite {}/r; case: xr xnz x => [[[]|]|] [] x //=; - do ?[by case: (bottom x)|by rewrite eq0 abse0 - |by rewrite abse_ge0// andbT gee0_abs - |by rewrite abse_ge0// andbT lee0_abs - |by rewrite abse_ge0// andbT abse_eq0]. -Qed. - -Canonical abse_snum (xnz : KnownSign.nullity) (xr : KnownSign.reality) - (x : {compare (0 : \bar R) & xnz & xr}) := - Signed.mk (abse_snum_subproof x). - -End SignedNumDomainStability. +Lemma ext_num_spec_dEFin i (x : num_def R i) : ext_num_spec i (dEFin x%:num). +Proof. +case: i x => [//| [l u] [x /=/and3P[xr /= lx xu]]]. +by apply/and3P; split=> [//||]; [case: l lx | case: u xu]. +Qed. + +Canonical dEFin_inum i (x : num_def R i) := Itv.mk (ext_num_spec_dEFin x). + +Lemma ext_num_spec_dadd xi yi (x : ext_num_def xi) (y : ext_num_def yi) + (r := Itv.real2 add xi yi) : + ext_num_spec r (dual_adde x%:inum y%:inum : \bar^d R). +Proof. +rewrite {}/r; case: x y => -[x||] + [[y||]]/=; + [|by case: xi yi => [//| [xl xu]] [//| [yl yu]]; + rewrite /dual_adde/= ?ext_num_sem_y ?ext_num_sem_Ny; + case: xl xu yl yu => [[] ?|[]] [[] ?|[]] [[] ?|[]] [[] ?|[]]..]. +rewrite !ext_num_num_spec => Px Py. +by rewrite -[x]/(Itv.mk Px)%:inum -[y]/(Itv.mk Py)%:inum num_spec_add. +Qed. + +Canonical dadde_inum xi yi (x : ext_num_def xi) (y : ext_num_def yi) := + Itv.mk (ext_num_spec_dadd x y). + +Variant ext_sign_spec (l u : itv_bound int) (x : \bar R) : signi -> Set := + | ISignEqZero : l = BLeft 0%Z -> u = BRight 0%Z -> x = 0 -> + ext_sign_spec l u x (Known EqZero) + | ISignNonNeg : (BLeft 0%:Z <= l)%O -> (BRight 0%:Z < u)%O -> 0 <= x -> + ext_sign_spec l u x (Known NonNeg) + | ISignNonPos : (l < BLeft 0%:Z)%O -> (u <= BRight 0%:Z)%O -> x <= 0 -> + ext_sign_spec l u x (Known NonPos) + | ISignBoth : (l < BLeft 0%:Z)%O -> (BRight 0%:Z < u)%O -> + (0 >=< x)%O -> ext_sign_spec l u x Unknown. + +Lemma ext_signP (l u : itv_bound int) (x : \bar R) : + (ext_num_itv_bound l <= BLeft x)%O -> (BRight x <= ext_num_itv_bound u)%O -> + (0 >=< x)%O -> + ext_sign_spec l u x (sign (Interval l u)). +Proof. +case: x => [x||] xl xu xs. +- case: (@signP R l u x _ _ xs). + + by case: l xl => -[]. + + by case: u xu => -[]. + + by move=> l0 u0 x0; apply: ISignEqZero => //; rewrite x0. + + by move=> l0 u0 x0; apply: ISignNonNeg. + + by move=> l0 u0 x0; apply: ISignNonPos. + + by move=> l0 u0 x0; apply: ISignBoth. +- have uy : u = +oo%O by case: u xu => -[]. + have u0 : (BRight 0%:Z < u)%O by rewrite uy. + case: (leP (BLeft 0%Z) l) => l0. + + suff -> : sign (Interval l u) = Known NonNeg. + by apply: ISignNonNeg => //; apply: le0y. + rewrite /=/sign_boundl /sign_boundr uy/=. + by case: eqP => [//| /eqP lneq0]; case: ltgtP l0 lneq0. + + suff -> : sign (Interval l u) = Unknown by exact: ISignBoth. + rewrite /=/sign_boundl /sign_boundr uy/=. + by case: eqP l0 => [->//| /eqP leq0] /ltW->. +- have ly : l = -oo%O by case: l xl => -[]. + have l0 : (l < BLeft 0%:Z)%O by rewrite ly. + case: (leP u (BRight 0%Z)) => u0. + + suff -> : sign (Interval l u) = Known NonPos by exact: ISignNonPos. + rewrite /=/sign_boundl /sign_boundr ly/=. + by case: eqP => [//| /eqP uneq0]; case: ltgtP u0 uneq0. + + suff -> : sign (Interval l u) = Unknown by exact: ISignBoth. + rewrite /=/sign_boundl /sign_boundr ly/=. + by case: eqP u0 => [->//| /eqP ueq0]; rewrite ltNge => /negbTE->. +Qed. + +Lemma ext_num_itv_mul_boundl b1 b2 (x1 x2 : \bar R) : + (BLeft 0%:Z <= b1 -> BLeft 0%:Z <= b2 -> + ext_num_itv_bound b1 <= BLeft x1 -> + ext_num_itv_bound b2 <= BLeft x2 -> + ext_num_itv_bound (mul_boundl b1 b2) <= BLeft (x1 * x2))%O. +Proof. +move=> b10 b20 b1x1 b2x2. +have x10 : 0 <= x1. + by case: x1 b1x1 (le_trans (eqbRL (le_ext_num_itv_bound _ _) b10) b1x1). +have x20 : 0 <= x2. + by case: x2 b2x2 (le_trans (eqbRL (le_ext_num_itv_bound _ _) b20) b2x2). +have x1r : (0 >=< x1)%O by rewrite real_fine; exact/ger0_real/fine_ge0. +have x2r : (0 >=< x2)%O by rewrite real_fine; exact/ger0_real/fine_ge0. +have ley b1' b2' : + (map_itv_bound EFin (num_itv_bound R (mul_boundl b1' b2')) + <= BLeft +oo%E)%O. + by case: b1' b2' => [[] [[| ?] | ?] | []] [[] [[| ?] | ?] | []]//=; + rewrite bnd_simp ?real_leey ?real_ltry/= ?realz. +case: x1 x2 x10 x20 x1r x2r b1x1 b2x2 => [x1||] [x2||] //= x10 x20 x1r x2r. +- rewrite !(map_itv_bound_comp, map_itv_bound_EFin_le_BLeft)/=. + exact: num_itv_mul_boundl. +- rewrite !(map_itv_bound_comp EFin intr) real_mulry//= => b1x1 _. + case: (comparable_ltgtP x1r) x10 => [x10 |//| [x10]] _. + by rewrite gtr0_sg ?mul1e ?bnd_simp. + rewrite -x10 sgr0 mul0e/= map_itv_bound_EFin_le_BLeft. + suff -> : b1 = BLeft 0%Z by case: b2 {b20}. + apply/le_anti; rewrite b10 andbT. + move: b1x1; rewrite map_itv_bound_EFin_le_BLeft. + by rewrite -x10 -(mulr0z 1) num_itv_bound_le_BLeft. +- rewrite !(map_itv_bound_comp EFin intr) real_mulyr//= => _ b2x2. + case: (comparable_ltgtP x2r) x20 => [x20 |//| [x20]] _. + by rewrite gtr0_sg ?mul1e ?bnd_simp. + rewrite -x20 sgr0 mul0e/= map_itv_bound_EFin_le_BLeft. + suff -> : b2 = BLeft 0%Z by case: b1 {b10} => [[] [] []|]. + apply/le_anti; rewrite b20 andbT. + move: b2x2; rewrite map_itv_bound_EFin_le_BLeft. + by rewrite -x20 -(mulr0z 1) num_itv_bound_le_BLeft. +- by rewrite mulyy/= 3!map_itv_bound_comp. +Qed. + +Lemma ext_num_itv_mul_boundr_pos b1 b2 (x1 x2 : \bar R) : + (0 <= x1 -> 0 <= x2 -> + BRight x1 <= ext_num_itv_bound b1 -> + BRight x2 <= ext_num_itv_bound b2 -> + BRight (x1 * x2) <= ext_num_itv_bound (mul_boundr b1 b2))%O. +Proof. +move=> x10 x20 b1x1 b2x2. +have x1r : (0 >=< x1)%O by rewrite real_fine; exact/ger0_real/fine_ge0. +have x2r : (0 >=< x2)%O by rewrite real_fine; exact/ger0_real/fine_ge0. +case: x1 x2 x10 x20 x1r x2r b1x1 b2x2 => [x1||] [x2||] //= x10 x20 x1r x2r. +- rewrite !(map_itv_bound_comp, BRight_le_map_itv_bound_EFin)/=. + exact: num_itv_mul_boundr. +- rewrite real_mulry// => b1x1 b2x2. + have -> : b2 = +oo%O by case: b2 b2x2 => -[]. + rewrite mul_boundrC/= map_itv_bound_comp. + case: (comparable_ltgtP x1r) x10 => [x10 |//| [x10]] _. + + rewrite gtr0_sg ?mul1e ?bnd_simp//. + suff: (BRight 0%Z < b1)%O by case: b1 b1x1 => [[] [] [] |]. + move: b1x1; rewrite map_itv_bound_comp BRight_le_map_itv_bound_EFin. + case: b1 => [[] b1 |//]; rewrite !bnd_simp -(@ltr0z R). + * exact/le_lt_trans/ltW. + * exact/lt_le_trans. + + rewrite -x10 sgr0 mul0e/= BRight_le_map_itv_bound_EFin. + suff: (BRight 0%Z <= b1)%O by case: b1 b1x1 => [[] [] [] |]. + move: b1x1; rewrite map_itv_bound_comp BRight_le_map_itv_bound_EFin. + by rewrite -x10 -(@mulr0z R 1) BRight_le_num_itv_bound. +- rewrite real_mulyr// => b1x1 b2x2. + have -> : b1 = +oo%O by case: b1 b1x1 => -[]. + rewrite /= map_itv_bound_comp. + case: (comparable_ltgtP x2r) x20 => [x20 |//| [x20]] _. + + rewrite gtr0_sg ?mul1e ?bnd_simp//. + suff: (BRight 0%Z < b2)%O by case: b2 b2x2 => [[] [] [] |]. + move: b2x2; rewrite map_itv_bound_comp BRight_le_map_itv_bound_EFin. + case: b2 => [[] b2 |//]; rewrite !bnd_simp -(@ltr0z R). + * exact/le_lt_trans/ltW. + * exact/lt_le_trans. + + rewrite -x20 sgr0 mul0e/= BRight_le_map_itv_bound_EFin. + suff: (BRight 0%Z <= b2)%O by case: b2 b2x2 => [[] [] [] |]. + move: b2x2; rewrite map_itv_bound_comp BRight_le_map_itv_bound_EFin. + by rewrite -x20 -(@mulr0z R 1) BRight_le_num_itv_bound. +- rewrite mulyy/= => b1x1 b2x2. + have -> : b1 = +oo%O by case: b1 b1x1 => -[]. + by have -> : b2 = +oo%O by case: b2 b2x2 => -[]. +Qed. + +Lemma ext_num_itv_mul_boundr b1 b2 (x1 x2 : \bar R) : + (0 <= x1 -> (0 >=< x2)%O -> BRight 0%Z <= b2 -> + BRight x1 <= ext_num_itv_bound b1 -> + BRight x2 <= ext_num_itv_bound b2 -> + BRight (x1 * x2) <= ext_num_itv_bound (mul_boundr b1 b2))%O. +Proof. +move=> x1ge0 x2r b2ge0 lex1b1 lex2b2. +have /orP[x2ge0 | x2le0] : (0 <= x2) || (x2 <= 0). +- by case: x2 x2r {lex2b2} => [x2 /=|_|_]; rewrite ?lee_fin ?le0y ?leNy0. +- exact: ext_num_itv_mul_boundr_pos. +have : (BRight (x1 * x2) <= BRight 0%R)%O. + by have:= mule_ge0_le0 x1ge0 x2le0; case: mule. +move/le_trans; apply. +rewrite map_itv_bound_comp BRight_le_map_itv_bound_EFin/=. +rewrite -(@mulr0z R 1) BRight_le_num_itv_bound. +apply: mul_boundr_gt0 => //. +move: x1 x1ge0 lex1b1 => [x1||//]/= x1ge0; last by case: b1 => -[]. +rewrite map_itv_bound_comp BRight_le_map_itv_bound_EFin. +rewrite -(@BRight_le_num_itv_bound R)/=. +by apply: le_trans; rewrite bnd_simp -lee_fin. +Qed. + +Lemma comparable_ext_num_itv_bound (x y : itv_bound int) : + (ext_num_itv_bound x >=< ext_num_itv_bound y)%O. +Proof. +apply/orP; rewrite !(map_itv_bound_comp EFin intr)/= !le_map_itv_bound_EFin. +exact/orP/comparable_num_itv_bound. +Qed. + +Lemma ext_num_itv_bound_min (x y : itv_bound int) : + ext_num_itv_bound (Order.min x y) + = Order.min (ext_num_itv_bound x) (ext_num_itv_bound y). +Proof. +have [lexy | ltyx] := leP x y; [by rewrite !minEle le_ext_num_itv_bound lexy|]. +rewrite minElt -if_neg -comparable_leNgt ?le_ext_num_itv_bound ?ltW//. +exact: comparable_ext_num_itv_bound. +Qed. + +Lemma ext_num_itv_bound_max (x y : itv_bound int) : + ext_num_itv_bound (Order.max x y) + = Order.max (ext_num_itv_bound x) (ext_num_itv_bound y). +Proof. +have [lexy | ltyx] := leP x y; [by rewrite !maxEle le_ext_num_itv_bound lexy|]. +rewrite maxElt -if_neg -comparable_leNgt ?le_ext_num_itv_bound ?ltW//. +exact: comparable_ext_num_itv_bound. +Qed. + +Lemma ext_num_spec_mul xi yi (x : ext_num_def xi) (y : ext_num_def yi) + (r := Itv.real2 mul xi yi) : + ext_num_spec r (x%:inum * y%:inum : \bar R). +Proof. +rewrite {}/r; case: xi yi x y => [//| [xl xu]] [//| [yl yu]]. +case=> [x /=/and3P[xr /= xlx xxu]] [y /=/and3P[yr /= yly yyu]]. +rewrite -/(sign (Interval xl xu)) -/(sign (Interval yl yu)). +have ns000 : ext_num_sem `[0%Z, 0%Z] (0 : \bar R). + by apply/and3P; rewrite ?comparablexx. +have xyr : (0 >=< (x * y)%E)%O by exact: realMe. +case: (ext_signP xlx xxu xr) => xlb xub xs. +- by rewrite xs mul0e; case: (ext_signP yly yyu yr). +- case: (ext_signP yly yyu yr) => ylb yub ys. + + by rewrite ys mule0. + + apply/and3P; split=> //=. + * exact: ext_num_itv_mul_boundl. + * exact: ext_num_itv_mul_boundr_pos. + + apply/and3P; split=> //=; rewrite -[x * y]oppeK -real_muleN//. + * by rewrite oppe_boundl ext_num_itv_mul_boundr_pos ?oppe_ge0 ?oppe_boundr. + * rewrite oppe_boundr ext_num_itv_mul_boundl ?oppe_boundl//. + by rewrite opp_bound_ge0. + + apply/and3P; split=> //=. + * rewrite -[x * y]oppeK -real_muleN// oppe_boundl. + rewrite ext_num_itv_mul_boundr -?real_fine ?oppe_cmp0 ?oppe_boundr//. + by rewrite opp_bound_gt0 ltW. + * by rewrite ext_num_itv_mul_boundr// ltW. +- case: (ext_signP yly yyu yr) => ylb yub ys. + + by rewrite ys mule0. + + apply/and3P; split=> //=; rewrite -[x * y]oppeK -real_mulNe//. + * by rewrite oppe_boundl ext_num_itv_mul_boundr_pos ?oppe_ge0 ?oppe_boundr. + * rewrite oppe_boundr ext_num_itv_mul_boundl ?oppe_boundl//. + by rewrite opp_bound_ge0. + + apply/and3P; split=> //=; rewrite -real_muleNN//. + * by rewrite ext_num_itv_mul_boundl ?opp_bound_ge0 ?oppe_boundl. + * by rewrite ext_num_itv_mul_boundr_pos ?oppe_ge0 ?oppe_boundr. + + apply/and3P; split=> //=; rewrite -[x * y]oppeK. + * rewrite -real_mulNe// oppe_boundl. + by rewrite ext_num_itv_mul_boundr ?oppe_ge0 ?oppe_boundr// ltW. + * rewrite oppeK -real_muleNN//. + by rewrite ext_num_itv_mul_boundr ?oppe_boundr + ?oppe_ge0 ?oppe_cmp0 ?opp_bound_gt0// ltW. +case: (ext_signP yly yyu yr) => ylb yub ys. +- by rewrite ys mule0. +- apply/and3P; split=> //=; rewrite muleC mul_boundrC. + + rewrite -[y * x]oppeK -real_muleN// oppe_boundl. + rewrite ext_num_itv_mul_boundr ?oppe_ge0 ?oppe_cmp0 ?oppe_boundr//. + by rewrite opp_bound_gt0 ltW. + + by rewrite ext_num_itv_mul_boundr// ltW. +- apply/and3P; split=> //=; rewrite muleC mul_boundrC. + + rewrite -[y * x]oppeK -real_mulNe// oppe_boundl. + by rewrite ext_num_itv_mul_boundr ?oppe_ge0 ?oppe_boundr// ltW. + + rewrite -real_muleNN// ext_num_itv_mul_boundr ?oppe_ge0 + ?oppe_cmp0 ?oppe_boundr//. + by rewrite opp_bound_gt0 ltW. +apply/and3P; rewrite xyr/= ext_num_itv_bound_min ext_num_itv_bound_max. +rewrite (comparable_ge_min _ (comparable_ext_num_itv_bound _ _)). +rewrite (comparable_le_max _ (comparable_ext_num_itv_bound _ _)). +have [x0 | /ltW x0] : 0 <= x \/ x < 0; [|split=> //..]. + case: x xr {xlx xxu xyr xs} => [x||] /= xr. + - by case: (comparable_leP xr) => x0; [left | right]. + - by left; rewrite le0y. + - by right; rewrite ltNy0. +- apply/orP; right; rewrite -[x * y]oppeK -real_muleN// oppe_boundl. + by rewrite ext_num_itv_mul_boundr ?oppe_cmp0 ?oppe_boundr// opp_bound_gt0 ltW. +- by apply/orP; right; rewrite ext_num_itv_mul_boundr// ltW. +- apply/orP; left; rewrite -[x * y]oppeK -real_mulNe// oppe_boundl. + by rewrite ext_num_itv_mul_boundr ?oppe_ge0 ?oppe_boundr// ltW. +- apply/orP; left; rewrite -real_muleNN//. + rewrite ext_num_itv_mul_boundr ?oppe_ge0 ?oppe_cmp0 ?oppe_boundr//. + by rewrite opp_bound_gt0 ltW. +Qed. + +Canonical mule_inum xi yi (x : ext_num_def xi) (y : ext_num_def yi) := + Itv.mk (ext_num_spec_mul x y). + +Definition abse_itv (i : Itv.t) : Itv.t := + match i with + | Itv.Top => Itv.Real `[0%Z, +oo[ + | Itv.Real (Interval l u) => + match l with + | BRight (Posz _) | BLeft (Posz (S _)) => Itv.Real `]0%Z, +oo[ + | _ => Itv.Real `[0%Z, +oo[ + end + end. +Arguments abse_itv /. + +Lemma ext_num_spec_abse i (x : ext_num_def i) (r := abse_itv i) : + ext_num_spec r (`|x%:inum| : \bar R). +Proof. +have: ext_num_sem `[0%Z, +oo[ `|x%:inum|. + apply/and3P; split; rewrite ?bnd_simp ?abse_ge0//. + by case: x%:inum => [x'||]; rewrite ?cmp0y// le_comparable ?abse_ge0. +have: 0 < x%:inum -> ext_num_sem `]0%Z, +oo[ `|x%:inum|. + move=> xgt0; apply/and3P; split; rewrite ?bnd_simp//. + - by case: x%:num => [x'||]; rewrite ?cmp0y// le_comparable ?abse_ge0. + - case: x%:inum xgt0 => [x'|//|//]/=. + by rewrite !lte_fin normr_gt0; apply: lt0r_neq0. +rewrite {}/r; case: i x => [//| [[[] [[//| l] | //] | //] u]] [x /=] + + _; + move/and3P => [xr /= /[!bnd_simp]lx _]; apply. +- by apply: lt_le_trans lx; rewrite lte_fin ltr0z. +- by apply: le_lt_trans lx; rewrite lee_fin ler0z. +- by apply: lt_trans lx; rewrite lte_fin ltr0z. +Qed. + +Canonical abse_inum i (x : ext_num_def i) := Itv.mk (ext_num_spec_abse x). + +Lemma ext_min_itv_boundl_spec x1 x2 b1 b2 : + (ext_num_itv_bound b1 <= BLeft x1)%O -> + (ext_num_itv_bound b2 <= BLeft x2)%O -> + (ext_num_itv_bound (Order.min b1 b2) <= BLeft (Order.min x1 x2))%O. +Proof. +case: (leP b1 b2) => [b1_le_b2 | /ltW b2_le_b1]. +- have sb1_le_sb2 := eqbRL (le_ext_num_itv_bound _ _) b1_le_b2. + by rewrite minElt; case: (x1 < x2)%O => [//|_]; apply: le_trans. +- have sb2_le_sb1 := eqbRL (le_ext_num_itv_bound _ _) b2_le_b1. + by rewrite minElt; case: (x1 < x2)%O => [+ _|//]; apply: le_trans. +Qed. + +Lemma ext_min_itv_boundr_spec x1 x2 b1 b2 : (x1 >=< x2)%O -> + (BRight x1 <= ext_num_itv_bound b1)%O -> + (BRight x2 <= ext_num_itv_bound b2)%O -> + (BRight (Order.min x1 x2) <= ext_num_itv_bound (Order.min b1 b2))%O. +Proof. +move=> x1_cmp_x2; case: (leP b1 b2) => [b1_le_b2 | /ltW b2_le_b1]. +- have sb1_le_sb2 := eqbRL (le_ext_num_itv_bound _ _) b1_le_b2. + by case: (comparable_leP x1_cmp_x2) => [//| /ltW ? + _]; apply: le_trans. +- have sb2_le_sb1 := eqbRL (le_ext_num_itv_bound _ _) b2_le_b1. + by case: (comparable_leP x1_cmp_x2) => [? _ |//]; apply: le_trans. +Qed. + +Lemma ext_num_spec_min (xi yi : Itv.t) (x : ext_num_def xi) (y : ext_num_def yi) + (r := Itv.real2 min xi yi) : + ext_num_spec r (Order.min x%:inum y%:inum : \bar R). +Proof. +apply: Itv.spec_real2 (Itv.P x) (Itv.P y). +case: x y => [x /= _] [y /= _] => {xi yi r} -[lx ux] [ly uy]/=. +move=> /andP[xr /=/andP[lxx xux]] /andP[yr /=/andP[lyy yuy]]. +apply/and3P; split. +- case: x y xr yr {lxx xux lyy yuy} => [x||] [y||]//=. + + by move=> ? ?; apply: comparable_minr. + + by move=> ? ?; rewrite real_miney. + + by move=> ? ?; rewrite real_minNye. +- exact: ext_min_itv_boundl_spec. +- by apply: ext_min_itv_boundr_spec => //; apply: ereal_comparable. +Qed. + +Lemma ext_max_itv_boundl_spec x1 x2 b1 b2 : (x1 >=< x2)%O -> + (ext_num_itv_bound b1 <= BLeft x1)%O -> + (ext_num_itv_bound b2 <= BLeft x2)%O -> + (ext_num_itv_bound (Order.max b1 b2) <= BLeft (Order.max x1 x2))%O. +Proof. +move=> x1_cmp_x2. +case: (leP b1 b2) => [b1_le_b2 | /ltW b2_le_b1]. +- case: (comparable_leP x1_cmp_x2) => [//| /ltW ? _ sb2_x2]. + exact: le_trans sb2_x2 _. +- case: (comparable_leP x1_cmp_x2) => [? sb1_x1 _ |//]. + exact: le_trans sb1_x1 _. +Qed. + +Lemma ext_max_itv_boundr_spec x1 x2 b1 b2 : + (BRight x1 <= ext_num_itv_bound b1)%O -> + (BRight x2 <= ext_num_itv_bound b2)%O -> + (BRight (Order.max x1 x2) <= ext_num_itv_bound (Order.max b1 b2))%O. +Proof. +case: (leP b1 b2) => [b1_le_b2 | /ltW b2_le_b1]. +- have sb1_le_sb2 := eqbRL (@le_ext_num_itv_bound R _ _) b1_le_b2. + by rewrite maxElt; case: ifP => [//|_ ? _]; apply: le_trans sb1_le_sb2. +- have sb2_le_sb1 := eqbRL (@le_ext_num_itv_bound R _ _) b2_le_b1. + by rewrite maxElt; case: ifP => [_ _ ?|//]; apply: le_trans sb2_le_sb1. +Qed. + +Lemma ext_num_spec_max (xi yi : Itv.t) (x : ext_num_def xi) (y : ext_num_def yi) + (r := Itv.real2 max xi yi) : + ext_num_spec r (Order.max x%:inum y%:inum : \bar R). +Proof. +apply: Itv.spec_real2 (Itv.P x) (Itv.P y). +case: x y => [x /= _] [y /= _] => {xi yi r} -[lx ux] [ly uy]/=. +move=> /andP[xr /=/andP[lxx xux]] /andP[yr /=/andP[lyy yuy]]. +apply/and3P; split. +- case: x y xr yr {lxx xux lyy yuy} => [x||] [y||]//=. + + by move=> ? ?; apply: comparable_maxr. + + by move=> ? ?; rewrite real_maxey. + + by move=> ? ?; rewrite real_maxNye. +- by apply: ext_max_itv_boundl_spec => //; apply: ereal_comparable. +- exact: ext_max_itv_boundr_spec. +Qed. + +Canonical ext_min_max_typ := MinMaxTyp ext_num_spec_min ext_num_spec_max. + +End Itv. + +End ItvInstances. +Export (canonicals) ItvInstances. Section MorphNum. -Context {R : numDomainType} {nz : KnownSign.nullity} {cond : KnownSign.reality}. -Local Notation nR := {compare (0 : \bar R) & nz & cond}. +Context {R : numDomainType} {i : Itv.t}. +Local Notation nR := (Itv.def (@ext_num_sem R) i). Implicit Types (a : \bar R). Lemma num_abse_eq0 a : (`|a|%:nng == 0%:E%:nng) = (a == 0). @@ -3736,10 +4204,9 @@ Proof. by rewrite -abse_eq0. Qed. End MorphNum. Section MorphReal. -Context {R : numDomainType} {nz : KnownSign.nullity} {r : KnownSign.real}. -Local Notation nR := {compare (0 : \bar R) & nz & r}. -Implicit Type x y : nR. -Local Notation num := (@num _ _ (0 : R) nz r). +Context {R : numDomainType} {xi yi : interval int}. +Implicit Type x : (Itv.def (@ext_num_sem R) (Itv.Real xi)). +Implicit Type y : (Itv.def (@ext_num_sem R) (Itv.Real yi)). Lemma num_lee_max a x y : a <= maxe x%:num y%:num = (a <= x%:num) || (a <= y%:num). @@ -3774,35 +4241,6 @@ Lemma num_gte_min a x y : Proof. by rewrite -comparable_gt_min// ereal_comparable. Qed. End MorphReal. -#[deprecated(since="mathcomp-analysis 1.2.0", note="renamed `num_lee_max`")] -Notation num_lee_maxr := num_lee_max (only parsing). -#[deprecated(since="mathcomp-analysis 1.2.0", note="renamed `num_gee_max`")] -Notation num_lee_maxl := num_gee_max (only parsing). -#[deprecated(since="mathcomp-analysis 1.2.0", note="renamed `num_lee_min`")] -Notation num_lee_minr := num_lee_min (only parsing). -#[deprecated(since="mathcomp-analysis 1.2.0", note="renamed `num_gee_min`")] -Notation num_lee_minl := num_gee_min (only parsing). -#[deprecated(since="mathcomp-analysis 1.2.0", note="renamed `num_lte_max`")] -Notation num_lte_maxr := num_lte_max (only parsing). -#[deprecated(since="mathcomp-analysis 1.2.0", note="renamed `num_gte_max`")] -Notation num_lte_maxl := num_gte_max (only parsing). -#[deprecated(since="mathcomp-analysis 1.2.0", note="renamed `num_lte_min`")] -Notation num_lte_minr := num_lte_min (only parsing). -#[deprecated(since="mathcomp-analysis 1.2.0", note="renamed `num_gte_min`")] -Notation num_lte_minl := num_gte_min (only parsing). - -Section MorphGe0. -Context {R : numDomainType} {nz : KnownSign.nullity}. -Local Notation nR := {compare (0 : \bar R) & ?=0 & >=0}. -Implicit Type x y : nR. -Local Notation num := (@num _ _ (0 : \bar R) ?=0 >=0). - -Lemma num_abse_le a x : 0 <= a -> (`|a|%:nng <= x)%O = (a <= x%:num). -Proof. by move=> a0; rewrite -num_le//= gee0_abs. Qed. - -Lemma num_abse_lt a x : 0 <= a -> (`|a|%:nng < x)%O = (a < x%:num). -Proof. by move=> a0; rewrite -num_lt/= gee0_abs. Qed. -End MorphGe0. Variant posnume_spec (R : numDomainType) (x : \bar R) : \bar R -> bool -> bool -> bool -> Type := @@ -3927,7 +4365,6 @@ apply: le_mono; move=> -[r0 | | ] [r1 | _ | _] //=. - by rewrite ltr_pdivrMr ?ltr_wpDr// mul1r ltr_pwDl // ler_norm. - rewrite ltr_pdivlMr ?mulN1r ?ltr_wpDr// => _. by rewrite ltrNl ltr_pwDl // ler_normr lexx orbT. -- by rewrite -subr_gt0 opprK. Qed. Definition lt_contract := leW_mono le_contract. diff --git a/reals/interval_inference.v b/reals/interval_inference.v index 2a1ba8d47..03ed628d3 100644 --- a/reals/interval_inference.v +++ b/reals/interval_inference.v @@ -280,6 +280,14 @@ Definition max i j := Interval (Order.max li lj) (Order.max ui uj). Arguments max /. +Definition keep_nonneg_bound b := + match b with + | BSide _ (Posz _) => BLeft 0%Z + | BSide _ (Negz _) => -oo%O + | BInfty _ => -oo%O + end. +Arguments keep_nonneg_bound /. + Definition keep_pos_bound b := match b with | BSide b 0%Z => BSide b 0%Z @@ -289,6 +297,14 @@ Definition keep_pos_bound b := end. Arguments keep_pos_bound /. +Definition keep_nonpos_bound b := + match b with + | BSide _ (Negz _) | BSide _ (Posz 0) => BRight 0%Z + | BSide _ (Posz (S _)) => +oo%O + | BInfty _ => +oo%O + end. +Arguments keep_nonpos_bound /. + Definition keep_neg_bound b := match b with | BSide b 0%Z => BSide b 0%Z @@ -313,6 +329,22 @@ Definition exprn i := Interval (keep_pos_bound l) (exprn_le1_bound l u). Arguments exprn /. +Definition keep_sign i := + let: Interval l u := i in + Interval (keep_nonneg_bound l) (keep_nonpos_bound u). + +(* used in ereal.v *) +Definition keep_nonpos i := + let 'Interval l u := i in + Interval -oo%O (keep_nonpos_bound u). +Arguments keep_nonpos /. + +(* used in ereal.v *) +Definition keep_nonneg i := + let 'Interval l u := i in + Interval (keep_nonneg_bound l) +oo%O. +Arguments keep_nonneg /. + End IntItv. Module Itv. diff --git a/reals/prodnormedzmodule.v b/reals/prodnormedzmodule.v index ad613feb7..d4f6cc638 100644 --- a/reals/prodnormedzmodule.v +++ b/reals/prodnormedzmodule.v @@ -1,8 +1,8 @@ (* mathcomp analysis (c) 2020 Inria and AIST. License: CeCILL-C. *) From HB Require Import structures. -From mathcomp Require Import all_ssreflect fingroup ssralg poly ssrnum. +From mathcomp Require Import all_ssreflect fingroup ssralg poly ssrnum. From mathcomp Require Import all_classical. -From mathcomp Require Import signed. +From mathcomp Require Import interval_inference. (**md**************************************************************************) (* This file equips the product of two normedZmodTypes with a canonical *) diff --git a/reals/real_interval.v b/reals/real_interval.v index dfaf36926..2ab7975a7 100644 --- a/reals/real_interval.v +++ b/reals/real_interval.v @@ -4,7 +4,7 @@ From mathcomp Require Import fingroup perm rat archimedean finmap. From mathcomp Require Import boolp classical_sets functions. From mathcomp Require Export set_interval. From HB Require Import structures. -From mathcomp Require Import reals constructive_ereal signed. +From mathcomp Require Import reals interval_inference constructive_ereal. (**md**************************************************************************) (* # Sets and intervals on $\overline{\mathbb{R}}$ *) diff --git a/reals/signed.v b/reals/signed.v index 84fc0d8db..43f17111b 100644 --- a/reals/signed.v +++ b/reals/signed.v @@ -4,6 +4,9 @@ From Coq Require Import ssreflect ssrfun ssrbool. From mathcomp Require Import ssrnat eqtype choice order ssralg ssrnum ssrint. From mathcomp Require Import mathcomp_extra. +Attributes deprecated(since="mathcomp-analysis 1.9.0", + note="Use ""From mathcomp Require Import interval_inference."" instead."). + (**md**************************************************************************) (* # Positive, non-negative numbers, etc. *) (* *) diff --git a/theories/charge.v b/theories/charge.v index 7a028dde7..6ae5e0979 100644 --- a/theories/charge.v +++ b/theories/charge.v @@ -4,9 +4,9 @@ From mathcomp Require Import finmap fingroup perm rat. From mathcomp Require Import mathcomp_extra boolp classical_sets cardinality. From mathcomp Require Import functions fsbigop set_interval. From HB Require Import structures. -From mathcomp Require Import reals ereal signed topology numfun normedtype. -From mathcomp Require Import sequences esum measure realfun lebesgue_measure. -From mathcomp Require Import lebesgue_integral. +From mathcomp Require Import reals interval_inference ereal topology numfun. +From mathcomp Require Import normedtype sequences esum measure realfun. +From mathcomp Require Import lebesgue_measure lebesgue_integral. (**md**************************************************************************) (* # Charges *) @@ -1282,7 +1282,7 @@ Qed. Lemma sup_int_approxRN_fin_num : M \is a fin_num. Proof. -rewrite ge0_fin_numE//; first exact: sup_int_approxRN_lty. +rewrite ge0_fin_numE; first exact: sup_int_approxRN_lty. exact: sup_int_approxRN_ge0. Qed. @@ -1333,7 +1333,7 @@ Qed. Lemma max_approxRN_seq_ge0 n x : 0 <= F_ n x. Proof. -by apply/bigmax_geP; right => /=; exists ord0 => //; exact: approxRN_seq_ge0. +by apply/bigmax_geP; right => /=; exists ord0; [|exact: approxRN_seq_ge0]. Qed. Lemma max_approxRN_seq_ge n x : F_ n x >= g_ n x. @@ -1492,7 +1492,7 @@ Qed. Let F_G m : F m \in G. Proof. -rewrite inE /G/=; split => //. +rewrite inE /G/=; split. - by move=> ?; exact: max_approxRN_seq_ge0. - apply/integrableP; split; first exact: measurable_max_approxRN_seq. under eq_integral. @@ -1565,7 +1565,7 @@ have [muA0|] := eqVneq (mu A) 0. exists (PosNum ltr01). under eq_integral. move=> x _; rewrite -(@gee0_abs _ (_ + _)); last first. - by rewrite adde_ge0// fRN_ge0. + by rewrite adde_ge0 ?fRN_ge0. over. rewrite (@integral_abs_eq0 _ _ _ _ setT)//. by rewrite (le_lt_trans _ h)// integral_ge0// => x Ax; exact: fRN_ge0. @@ -1610,7 +1610,7 @@ move=> mB; rewrite ge0_integralD//; last 2 first. by move=> x Bx; exact: fRN_ge0. exact: measurable_funS measurable_fun_fRN. rewrite fin_numD integral_cst// fin_numM ?fin_num_measure// andbT. -rewrite ge0_fin_numE ?measure_ge0//; last first. +rewrite ge0_fin_numE ?measure_ge0; last first. by apply: integral_ge0 => x Bx; exact: fRN_ge0. rewrite (le_lt_trans _ int_fRN_lty)//. under [in leRHS]eq_integral. @@ -1641,11 +1641,11 @@ apply: cvgeB. + have /cvg_ex[/= l hl] : cvg ((fun n => \sum_(0 <= i < n) \int[mu]_(y in H i) (fRN y + epsRN%:num%:E)) @ \oo). apply: is_cvg_ereal_nneg_natsum => n _. - by apply: integral_ge0 => x _; rewrite adde_ge0//; exact: fRN_ge0. + by apply: integral_ge0 => x _; rewrite adde_ge0 ?fRN_ge0. by rewrite (@cvg_lim _ _ _ _ _ _ l). + apply: emeasurable_funD => //=; apply: measurable_funTS. exact: measurable_fun_fRN. - + by move=> x _; rewrite adde_ge0//; exact: fRN_ge0. + + by move=> x _; rewrite adde_ge0 ?fRN_ge0. Qed. HB.instance Definition _ := @isCharge.Build _ _ _ sigmaRN @@ -1701,7 +1701,7 @@ have mh : measurable_fun setT h. - by apply: measurable_funTS; apply: emeasurable_funD => //; exact: mf. - by apply: measurable_funTS; exact: mf. have hge0 x : 0 <= h x. - by rewrite /h; case: ifPn => [_|?]; [rewrite adde_ge0// f_ge0|exact: f_ge0]. + by rewrite /h; case: ifPn => [_|?]; rewrite ?adde_ge0 ?f_ge0. have hnuP S : measurable S -> S `<=` AP -> \int[mu]_(x in S) h x <= nu S. move=> mS SAP. have : 0 <= sigma S. @@ -1741,7 +1741,7 @@ have int_h_M : \int[mu]_x h x > M. by rewrite setUv//; exact: mf. by move=> x _; exact: f_ge0. rewrite setUv int_fRNE -lte_subel_addl; last first. - rewrite ge0_fin_numE// ?sup_int_approxRN_lty//. + rewrite ge0_fin_numE ?sup_int_approxRN_lty. exact: approxRN_seq.sup_int_approxRN_lty. exact: sup_int_approxRN_ge0. by rewrite /M subee ?mule_gt0// approxRN_seq.sup_int_approxRN_fin_num. @@ -1935,7 +1935,7 @@ have -> : \int[mu]_(x in E) (f \* g) x = - move=> n; apply/emeasurable_funM; apply/measurable_funTS. exact/measurable_EFinP. exact: measurable_int (f_integrable _). - - by move=> n x Ex //=; rewrite mule_ge0 ?lee_fin//=; exact: f_ge0. + - by move=> n x Ex /=; rewrite mule_ge0 ?lee_fin ?f_ge0. - by move=> x Ex a b ab/=; rewrite lee_wpmul2r ?lee_fin ?f_ge0//; exact/lefP/nd_nnsfun_approx. suff suf n : \int[mu]_(x in E) ((EFin \o h n) x * g x) = \int[nu]_(x in E) (EFin \o h n) x. @@ -1967,7 +1967,7 @@ rewrite ge0_integralZl//. by rewrite -integral_mkcondr -f_integral// integral_indic// setIC. - apply: emeasurable_funM; first exact/measurable_EFinP. exact/measurable_funTS/(measurable_int _ (f_integrable _)). -- by move=> t Et; rewrite mule_ge0// ?lee_fin//; exact: f_ge0. +- by move=> t Et; rewrite mule_ge0 ?lee_fin ?f_ge0. - by move: rhn; rewrite inE => -[t _ <-]; rewrite lee_fin. Qed. diff --git a/theories/convex.v b/theories/convex.v index 698babd56..9a4455d2c 100644 --- a/theories/convex.v +++ b/theories/convex.v @@ -2,7 +2,7 @@ From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum finmap. From mathcomp Require Import matrix interval zmodp vector fieldext falgebra. From mathcomp Require Import mathcomp_extra boolp classical_sets set_interval. -From mathcomp Require Import functions cardinality ereal reals signed. +From mathcomp Require Import functions cardinality ereal reals. From mathcomp Require Import topology prodnormedzmodule normedtype derive. From mathcomp Require Import realfun interval_inference. From HB Require Import structures. diff --git a/theories/derive.v b/theories/derive.v index 9bbfe99c2..740d922bc 100644 --- a/theories/derive.v +++ b/theories/derive.v @@ -1,9 +1,9 @@ (* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) From HB Require Import structures. -From mathcomp Require Import all_ssreflect ssralg ssrnum matrix interval. +From mathcomp Require Import all_ssreflect ssralg ssrnum matrix interval poly. From mathcomp Require Import mathcomp_extra boolp classical_sets functions. -From mathcomp Require Import reals signed topology prodnormedzmodule tvs. -From mathcomp Require Import normedtype landau forms poly. +From mathcomp Require Import reals interval_inference topology. +From mathcomp Require Import prodnormedzmodule tvs normedtype landau forms. (**md**************************************************************************) (* # Differentiation *) @@ -505,7 +505,7 @@ rewrite funeqE => x; apply/eqP; have [|xn0] := real_le0P (normr_real x). by rewrite normr_le0 => /eqP ->; rewrite linear0. rewrite -normr_le0 -(mul0r `|x|) -ler_pdivrMr //. apply/ler_gtP => _ /posnumP[e]; rewrite ler_pdivrMr //. -have /oid /nbhs_ballP [_ /posnumP[d] dfe] := !! gt0 e. +have /oid /nbhs_ballP [_ /posnumP[d] dfe] := [elaborate gt0 e]. set k := ((d%:num / 2) / (PosNum xn0)%:num)^-1. rewrite -{1}(@scalerKV _ _ k _ x) /k // linearZZ normrZ. rewrite -ler_pdivlMl; last by rewrite gtr0_norm. diff --git a/theories/ereal.v b/theories/ereal.v index d8125916c..d67395237 100644 --- a/theories/ereal.v +++ b/theories/ereal.v @@ -8,7 +8,7 @@ From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra archimedean finmap. From mathcomp Require Import boolp classical_sets functions. From mathcomp Require Import fsbigop cardinality set_interval. -From mathcomp Require Import reals signed topology. +From mathcomp Require Import reals interval_inference topology. From mathcomp Require Export constructive_ereal. (**md**************************************************************************) @@ -610,47 +610,42 @@ Proof. by apply/funext => x; rewrite /= !patchE; case: ifPn. Qed. Section SignedRealFieldStability. Context {R : realFieldType}. -Definition ereal_sup_reality_subdef (xnz : KnownSign.nullity) - (xr : KnownSign.reality) := - (if KnownSign.wider_reality <=0 xr then KnownSign.Real <=0 - else >=<0)%snum_sign. -Arguments ereal_sup_reality_subdef /. - -Lemma ereal_sup_snum_subproof (xnz : KnownSign.nullity) (xr : KnownSign.reality) - (S : {compare (0 : \bar R) & xnz & xr} -> Prop) - (r := ereal_sup_reality_subdef xnz xr) : - Signed.spec 0 ?=0 r (ereal_sup [set x%:num | x in S]%classic). -Proof. -rewrite {}/r; move: xr S => [[[]|]|] S /=; - do ?[by apply: ub_ereal_sup => _ [? _ <-] - |by case: ereal_sup => [s||]; - rewrite ?leey ?leNye// !lee_fin -realE num_real]. -Qed. - -Canonical ereal_sup_snum (xnz : KnownSign.nullity) (xr : KnownSign.reality) - (S : {compare (0 : \bar R) & xnz & xr} -> Prop) := - Signed.mk (ereal_sup_snum_subproof S). - -Definition ereal_inf_reality_subdef (xnz : KnownSign.nullity) - (xr : KnownSign.reality) := - (if KnownSign.wider_reality >=0 xr then KnownSign.Real >=0 - else >=<0)%snum_sign. -Arguments ereal_inf_reality_subdef /. - -Lemma ereal_inf_snum_subproof (xnz : KnownSign.nullity) (xr : KnownSign.reality) - (S : {compare (0 : \bar R) & xnz & xr} -> Prop) - (r := ereal_inf_reality_subdef xnz xr) : - Signed.spec 0 ?=0 r (ereal_inf [set x%:num | x in S]%classic). -Proof. -rewrite {}/r; move: xr S => [[[]|]|] S /=; - do ?[by apply: lb_ereal_inf => _ [? _ <-] - |by case: ereal_inf => [s||]; - rewrite ?leey ?leNye// !lee_fin -realE num_real]. -Qed. - -Canonical ereal_inf_snum (xnz : KnownSign.nullity) (xr : KnownSign.reality) - (S : {compare (0 : \bar R) & xnz & xr} -> Prop) := - Signed.mk (ereal_inf_snum_subproof S). +Lemma ext_num_spec_ereal_sup i (S : Itv.def (@ext_num_sem R) i -> Prop) + (r := Itv.real1 IntItv.keep_nonpos i) : + Itv.spec (@ext_num_sem R) r (ereal_sup [set x%:num | x in S]). +Proof. +rewrite {}/r; case: i S => [//| [l u]] S /=. +apply/and3P; split. +- rewrite real_fine -real_leey. + by rewrite ub_ereal_sup// => _ [[[x||] /=/and3P[? ? ?]] _ <-]. +- by case: ereal_sup. +- case: u S => [[] [[| u] | u] S |//]; rewrite /= bnd_simp//; + apply: ub_ereal_sup => _ [[x /=/and3P[_ _ /= +]] _ <-]; rewrite bnd_simp//. + + by move/ltW. + + by move=> /ltW /le_trans; apply; rewrite lee_fin lerz0. + + by move=> /le_trans; apply; rewrite lee_fin lerz0. +Qed. + +Canonical ereal_sup_inum i (S : Itv.def (@ext_num_sem R) i -> Prop) := + Itv.mk (ext_num_spec_ereal_sup S). + +Lemma ext_num_spec_ereal_inf i (S : Itv.def (@ext_num_sem R) i -> Prop) + (r := Itv.real1 IntItv.keep_nonneg i) : + Itv.spec (@ext_num_sem R) r (ereal_inf [set x%:num | x in S]). +Proof. +rewrite {}/r; case: i S => [//| [l u]] S /=. +apply/and3P; split. +- rewrite real_fine -real_leNye. + by rewrite lb_ereal_inf// => _ [[[x||] /=/and3P[? ? ?]] _ <-]. +- case: l S => [[] [l | l] S |//]; rewrite /= bnd_simp//; + apply: lb_ereal_inf => _ [[x /=/and3P[_ /= + _]] _ <-]; rewrite bnd_simp. + + by apply: le_trans; rewrite lee_fin ler0z. + + by move=> /ltW; apply: le_trans; rewrite lee_fin ler0z. +- by case: ereal_inf. +Qed. + +Canonical ereal_inf_inum i (S : Itv.def (@ext_num_sem R) i -> Prop) := + Itv.mk (ext_num_spec_ereal_inf S). End SignedRealFieldStability. diff --git a/theories/esum.v b/theories/esum.v index 8696387ac..082c24fb8 100644 --- a/theories/esum.v +++ b/theories/esum.v @@ -1,7 +1,7 @@ (* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) From mathcomp Require Import all_ssreflect ssralg ssrnum finmap. From mathcomp Require Import mathcomp_extra boolp classical_sets functions. -From mathcomp Require Import cardinality fsbigop reals ereal signed. +From mathcomp Require Import cardinality fsbigop reals ereal interval_inference. From mathcomp Require Import topology sequences normedtype numfun. (**md**************************************************************************) @@ -256,7 +256,7 @@ apply: (@le_trans _ _ rewrite (fsetIidPr _). rewrite fsbig_finite// leeDl// big_seq sume_ge0//=. move=> [x y] /imfsetP[[x1 y1]] /[!inE] /andP[] /imfset2P[x2]/= /[!inE]. - rewrite andbT in_fset_set//; last exact: finite_set_fst. + rewrite andbT in_fset_set; last exact: finite_set_fst. move=> /[!inE] x2X [y2] /[!inE] /andP[] /[!in_fset_set]; last first. exact: finite_set_snd. move=> /[!inE] y2X y2J [-> ->] _ [-> ->]; rewrite a_ge0//. diff --git a/theories/exp.v b/theories/exp.v index f53fa3af5..2535deef7 100644 --- a/theories/exp.v +++ b/theories/exp.v @@ -2,7 +2,7 @@ From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum matrix. From mathcomp Require Import interval rat. From mathcomp Require Import boolp classical_sets functions. -From mathcomp Require Import mathcomp_extra reals ereal signed. +From mathcomp Require Import mathcomp_extra reals ereal interval_inference. From mathcomp Require Import topology tvs normedtype landau sequences derive. From mathcomp Require Import realfun interval_inference convex. diff --git a/theories/ftc.v b/theories/ftc.v index 69e0931e3..24ed05fb8 100644 --- a/theories/ftc.v +++ b/theories/ftc.v @@ -2,10 +2,11 @@ From HB Require Import structures. From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint interval finmap. From mathcomp Require Import mathcomp_extra boolp classical_sets functions. -From mathcomp Require Import cardinality fsbigop signed reals ereal. +From mathcomp Require Import cardinality fsbigop reals interval_inference ereal. From mathcomp Require Import topology tvs normedtype sequences real_interval. From mathcomp Require Import esum measure lebesgue_measure numfun realfun. -From mathcomp Require Import itv real_interval lebesgue_integral derive charge. +From mathcomp Require Import interval_inference real_interval lebesgue_integral. +From mathcomp Require Import derive charge. (**md**************************************************************************) (* # Fundamental Theorem of Calculus and Consequences *) diff --git a/theories/function_spaces.v b/theories/function_spaces.v index 0f257a568..7ca765458 100644 --- a/theories/function_spaces.v +++ b/theories/function_spaces.v @@ -2,8 +2,8 @@ From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra finmap generic_quotient. From mathcomp Require Import boolp classical_sets functions. -From mathcomp Require Import cardinality mathcomp_extra fsbigop. -From mathcomp Require Import reals signed topology separation_axioms. +From mathcomp Require Import cardinality mathcomp_extra fsbigop reals. +From mathcomp Require Import interval_inference topology separation_axioms. (**md**************************************************************************) (* # The topology of functions spaces *) @@ -610,7 +610,7 @@ Lemma cvg_switch {U : completeType} f @ F1 --> g -> (forall x1, f x1 @ F2 --> h x1) -> exists l : U, h @ F1 --> l /\ g @ F2 --> l. Proof. -move=> Hfg Hfh; have hcv := !! cvg_switch_2 Hfg Hfh. +move=> Hfg Hfh; have hcv := [elaborate cvg_switch_2 Hfg Hfh]. by exists (lim (h @ F1)); split=> //; apply: cvg_switch_1 Hfg Hfh hcv. Qed. diff --git a/theories/gauss_integral.v b/theories/gauss_integral.v index 1a06d73c6..0abecf461 100644 --- a/theories/gauss_integral.v +++ b/theories/gauss_integral.v @@ -2,7 +2,7 @@ From HB Require Import structures. From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint interval finmap. From mathcomp Require Import mathcomp_extra boolp classical_sets functions. -From mathcomp Require Import cardinality fsbigop signed reals ereal. +From mathcomp Require Import cardinality fsbigop reals interval_inference ereal. From mathcomp Require Import topology tvs normedtype sequences real_interval. From mathcomp Require Import esum measure lebesgue_measure numfun realfun. From mathcomp Require Import exp trigo lebesgue_integral derive charge ftc. @@ -34,10 +34,8 @@ Proof. by rewrite lerDl sqr_ge0. Qed. #[local] Hint Extern 0 (is_true (1 <= oneDsqr _)) => solve[apply: oneDsqr_ge1] : core. -Lemma oneDsqr_gt0_subproof x : Signed.spec 0 !=0 >=0 (oneDsqr x). -Proof. by rewrite /= -lt_def (@lt_le_trans _ _ 1). Qed. - -Canonical oneDsqr_ge0_snum x := Signed.mk (oneDsqr_gt0_subproof x). +Canonical oneDsqr_inum x : {itv R & `[1, +oo[} := @ItvReal R (oneDsqr x) + (BLeft 1%Z) (BInfty _ false) (oneDsqr_ge1 x) erefl. Lemma oneDsqrV_le1 x : oneDsqr\^-1 x <= 1. Proof. by rewrite invf_le1. Qed. diff --git a/theories/hoelder.v b/theories/hoelder.v index 9e3820b14..d420694d2 100644 --- a/theories/hoelder.v +++ b/theories/hoelder.v @@ -2,7 +2,7 @@ From HB Require Import structures. From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint interval finmap. From mathcomp Require Import mathcomp_extra boolp classical_sets functions. -From mathcomp Require Import cardinality fsbigop signed reals ereal. +From mathcomp Require Import cardinality fsbigop reals ereal. From mathcomp Require Import topology normedtype sequences real_interval. From mathcomp Require Import esum measure lebesgue_measure lebesgue_integral. From mathcomp Require Import numfun exp convex interval_inference. @@ -365,7 +365,7 @@ move=> mf mg. rewrite !Lnorm1 -ge0_integralD//; [|by do 2 apply: measurableT_comp..]. rewrite ge0_le_integral//. - by do 2 apply: measurableT_comp => //; exact: measurable_funD. -- by move=> x _; rewrite lee_fin. +- by move=> x _; rewrite adde_ge0. - by apply/measurableT_comp/measurable_funD; exact/measurableT_comp. - by move=> x _; rewrite lee_fin ler_normD. Qed. diff --git a/theories/kernel.v b/theories/kernel.v index 872dab165..3530efb28 100644 --- a/theories/kernel.v +++ b/theories/kernel.v @@ -2,7 +2,7 @@ From HB Require Import structures. From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint interval finmap. From mathcomp Require Import mathcomp_extra boolp classical_sets functions. -From mathcomp Require Import cardinality fsbigop reals ereal signed. +From mathcomp Require Import cardinality fsbigop reals interval_inference ereal. From mathcomp Require Import topology normedtype sequences esum measure. From mathcomp Require Import numfun lebesgue_measure lebesgue_integral. diff --git a/theories/landau.v b/theories/landau.v index bee296e96..2a2bd08aa 100644 --- a/theories/landau.v +++ b/theories/landau.v @@ -2,7 +2,7 @@ From HB Require Import structures. From mathcomp Require Import all_ssreflect ssralg ssrnum. From mathcomp Require Import mathcomp_extra boolp classical_sets functions. -From mathcomp Require Import ereal reals signed topology normedtype. +From mathcomp Require Import ereal reals interval_inference topology normedtype. From mathcomp Require Import prodnormedzmodule. (**md**************************************************************************) diff --git a/theories/lebesgue_integral.v b/theories/lebesgue_integral.v index 71ea321ee..2346a39fc 100644 --- a/theories/lebesgue_integral.v +++ b/theories/lebesgue_integral.v @@ -2,8 +2,8 @@ From HB Require Import structures. From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint interval finmap. From mathcomp Require Import archimedean. -From mathcomp Require Import boolp classical_sets functions cardinality. -From mathcomp Require Import fsbigop signed reals ereal topology tvs. +From mathcomp Require Import boolp classical_sets functions cardinality reals. +From mathcomp Require Import fsbigop interval_inference ereal topology tvs. From mathcomp Require Import normedtype sequences real_interval esum measure. From mathcomp Require Import lebesgue_measure numfun realfun function_spaces. @@ -1677,7 +1677,7 @@ have mh2 : measurable_fun setT h2 by exact/(measurable_restrictT _ _).1. pose g1 := nnsfun_approx measurableT mh1. pose g2 := nnsfun_approx measurableT mh2. pose g12 := fun n => add_nnsfun (g1 n) (g2 n). -rewrite (@nd_ge0_integral_lim _ _ _ mu _ g12) //; last 3 first. +rewrite (@nd_ge0_integral_lim _ _ _ mu _ g12); last 3 first. - by move=> x; rewrite adde_ge0. - by apply: nondecreasing_seqD => // x m n mn; [exact/lefP/nd_nnsfun_approx|exact/lefP/nd_nnsfun_approx]. @@ -1779,7 +1779,7 @@ pose Af x : set R := A `&` f @^-1` [set x]. have mAf x : measurable (Af x) by exact: measurableI. have finAf x : mu (Af x) < +oo. by rewrite (le_lt_trans _ finA)// le_measure// ?inE//; exact: subIsetl. -have eNpos : (0 < eps%:num/N.+1%:R)%R by []. +have eNpos : (0 < eps%:num / N.+1%:R)%R by []. have dK' x := lebesgue_regularity_inner (mAf x) (finAf x) eNpos. pose dK x : set R := projT1 (cid (dK' x)); pose J i : set R := Af i `\` dK i. have dkP x := projT2 (cid (dK' x)). @@ -5335,7 +5335,7 @@ have [] // := @dominated_convergence _ _ _ mu _ mE (fun n => EFin \o g_ n) f f. move=> _ /= fg0 gfcvg; exists g_; split. - move=> n; apply: (le_integrable mE _ _ intf). exact/measurable_EFinP/measurable_funTS. - move=> ? ?; rewrite /g_ !gee0_abs ?lee_fin//; last exact: fpos. + move=> ? ?; rewrite /g_ !gee0_abs ?lee_fin ?fpos//. by rewrite /= nnsfun_approxE le_approx. - exact: cvg_nnsfun_approx. - by apply: cvg_trans fg0; under eq_fun => ? do under eq_fun => t do @@ -5779,7 +5779,7 @@ rewrite [LHS](_ : _ = set r := fun _ => _; set l := fun _ => _; have -> // : l = r. by apply/funext => n; rewrite /l /r sfun_fubini_tonelli1. rewrite [RHS](_ : _ = limn (fun n => \int[m1]_x F_ g n x))//. -rewrite -monotone_convergence //; first exact: eq_integral. +rewrite -monotone_convergence => [|//|||]; first exact: eq_integral. - by move=> n; exact: sfun_measurable_fun_fubini_tonelli_F. - move=> n x _; apply: integral_ge0 => // y _ /=; rewrite lee_fin. exact: fun_ge0. @@ -5813,7 +5813,7 @@ rewrite [LHS](_ : _ = limn set r := fun _ => _; set l := fun _ => _; have -> // : l = r. by apply/funext => n; rewrite /l /r sfun_fubini_tonelli sfun_fubini_tonelli2. rewrite [RHS](_ : _ = limn (fun n => \int[m2]_y G_ g n y))//. -rewrite -monotone_convergence //; first exact: eq_integral. +rewrite -monotone_convergence => [|//|||]; first exact: eq_integral. - by move=> n; exact: sfun_measurable_fun_fubini_tonelli_G. - by move=> n y _; apply: integral_ge0 => // x _ /=; rewrite lee_fin fun_ge0. - move=> y /= _ a b ab; apply: ge0_le_integral => //. @@ -5955,7 +5955,7 @@ Qed. Let integrable_Fminus : m1.-integrable setT Fminus. Proof. apply/integrableP; split=> //. -apply: le_lt_trans (fubini1a.1 imf); apply: ge0_le_integral => //. +apply: le_lt_trans (fubini1a.1 imf); apply: ge0_le_integral => [//|//|||//|]. - exact: measurableT_comp. - by move=> *; exact: integral_ge0. - move=> x _; apply: le_trans. @@ -6084,18 +6084,18 @@ transitivity (\sum_(n n _; apply: eq_integral => x _. by rewrite ge0_integral_measure_series//; exact/measurableT_comp. transitivity (\sum_(n n _; rewrite integral_nneseries//. + apply: eq_eseriesr => n _; rewrite integral_nneseries => [//|//||]. by move=> m; exact: measurable_fun_fubini_tonelli_F. by move=> m x _; exact: integral_ge0. transitivity (\sum_(n n _; apply: eq_eseriesr => m _. by rewrite fubini_tonelli//; exact: finite_measure_sigma_finite. transitivity (\sum_(n n _; rewrite ge0_integral_measure_series//. + apply: eq_eseriesr => n _; rewrite ge0_integral_measure_series => [//|//||]. by move=> y _; exact: integral_ge0. exact: measurable_fun_fubini_tonelli_G. transitivity (\int[mseries s2 0]_y \sum_(n [//|//||]. by move=> n; apply: measurable_fun_fubini_tonelli_G. by move=> n y _; exact: integral_ge0. transitivity (\int[mseries s2 0]_y \int[mseries s1 0]_x f (x, y)). @@ -6361,7 +6361,7 @@ Proof. move=> Df x; apply: ereal_sup_le => //=. pose k := \int[mu]_(x in D `&` ball x 1) `|f x|%:E. exists ((fine (mu (ball x 1)))^-1%:E * k); last first. - rewrite mule_ge0//; last exact: integral_ge0. + rewrite mule_ge0 ?integral_ge0//. by rewrite lee_fin// invr_ge0// fine_ge0. exists 1%R; first by rewrite in_itv/= ltr01. rewrite iavg_restrict//; last exact: measurable_ball. @@ -6426,7 +6426,7 @@ move: a0; rewrite le_eqVlt => /predU1P[a0|a0]. have ka_pos : fine k / a \is Num.pos. by rewrite posrE divr_gt0// fine_gt0 // k_gt0/= locally_integrable_ltbally. have k_fin_num : k \is a fin_num. - by rewrite ge0_fin_numE ?locally_integrable_ltbally// integral_ge0. + by rewrite ge0_fin_numE ?locally_integrable_ltbally ?integral_ge0. have kar : (0 < 2^-1 * (fine k / a) - r)%R. move: afxr; rewrite -{1}(fineK k_fin_num) -lte_pdivrMr; last first. by rewrite fine_gt0// k_gt0/= ltey_eq k_fin_num. @@ -6529,7 +6529,7 @@ apply: (@le_trans _ _ (\sum_(i <- E) c^-1%:E * \int[mu]_(y in B i) `|(f y)|%:E)). rewrite [in leLHS]big_seq [in leRHS]big_seq; apply: lee_sum => r /ED /Dsub /[!inE] rD. by rewrite -lee_pdivrMl ?invr_gt0// invrK /B/=; exact/ltW/cMfx_int. -rewrite -ge0_sume_distrr//; last by move=> x _; rewrite integral_ge0. +rewrite -ge0_sume_distrr; last by move=> x _; rewrite integral_ge0. rewrite lee_wpmul2l//; first by rewrite lee_fin invr_ge0 ltW. rewrite -ge0_integral_bigsetU//=. - apply: ge0_subset_integral => //. diff --git a/theories/lebesgue_measure.v b/theories/lebesgue_measure.v index 7d2a444f6..a22fbb1a6 100644 --- a/theories/lebesgue_measure.v +++ b/theories/lebesgue_measure.v @@ -2,7 +2,7 @@ From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint interval. From mathcomp Require Import finmap fingroup perm rat archimedean. From mathcomp Require Import mathcomp_extra boolp classical_sets functions. -From mathcomp Require Import cardinality fsbigop reals ereal signed. +From mathcomp Require Import cardinality fsbigop reals interval_inference ereal. From mathcomp Require Import topology numfun tvs normedtype function_spaces. From HB Require Import structures. From mathcomp Require Import sequences esum measure real_interval realfun exp. @@ -806,7 +806,7 @@ have [|Aoo e0] := leP +oo (l^* A)%mu. by exists [set: R]; split => //; [exact: openT|rewrite Aoo leey]. have [F AF Fe] : exists2 I_, open_itv_cover A I_ & \sum_(0 <= k /lb_ereal_inf_adherent-/(_ _ e0)[_/= [F]] AF <- Fe. by exists F => //; exact/ltW. @@ -1168,7 +1168,7 @@ have finite_set_F i : finite_set (F i). have {CFi Fir2} := le_trans MC (le_trans CFi Fir2). apply/negP; rewrite -ltNge lebesgue_measure_ball// lte_fin. rewrite -[M%:R]natr1 natr_absz ger0_norm; last first. - by rewrite -(ceil0 R) ceil_le. + by rewrite -[leLHS](ceil0 R) ceil_le. by rewrite -ltr_pdivrMr// intrD1 floor_lt_int ltzD1 ceil_floor// lerDl. have mur2_fin_num_ : mu (ball (0:R) (r%:num + 2))%R < +oo. by rewrite lebesgue_measure_ball// ltry. diff --git a/theories/lebesgue_stieltjes_measure.v b/theories/lebesgue_stieltjes_measure.v index 45312722c..7e1b93fb4 100644 --- a/theories/lebesgue_stieltjes_measure.v +++ b/theories/lebesgue_stieltjes_measure.v @@ -4,8 +4,9 @@ From mathcomp Require Import finmap fingroup perm rat archimedean. From HB Require Import structures. From mathcomp.classical Require Import mathcomp_extra boolp classical_sets. From mathcomp.classical Require Import functions fsbigop cardinality. -From mathcomp Require Import reals ereal signed topology numfun normedtype. -From mathcomp Require Import sequences esum real_interval measure realfun. +From mathcomp Require Import reals ereal interval_inference topology numfun. +From mathcomp Require Import normedtype sequences esum real_interval measure. +From mathcomp Require Import realfun. (**md**************************************************************************) (* # Lebesgue Stieltjes Measure *) diff --git a/theories/measurable_realfun.v b/theories/measurable_realfun.v index 8e9fb289f..cf94f71f6 100644 --- a/theories/measurable_realfun.v +++ b/theories/measurable_realfun.v @@ -2,7 +2,7 @@ From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint interval. From mathcomp Require Import finmap fingroup perm rat archimedean. From mathcomp Require Import mathcomp_extra boolp classical_sets functions. -From mathcomp Require Import cardinality fsbigop reals ereal signed. +From mathcomp Require Import cardinality fsbigop reals ereal interval_inference. From mathcomp Require Import topology numfun tvs normedtype function_spaces. From HB Require Import structures. From mathcomp Require Import sequences esum measure real_interval realfun exp. diff --git a/theories/measure.v b/theories/measure.v index c20af032e..06338ce39 100644 --- a/theories/measure.v +++ b/theories/measure.v @@ -1,7 +1,7 @@ (* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) From mathcomp Require Import all_ssreflect all_algebra archimedean finmap. From mathcomp Require Import mathcomp_extra boolp classical_sets functions. -From mathcomp Require Import cardinality fsbigop reals ereal signed. +From mathcomp Require Import cardinality fsbigop reals interval_inference ereal. From mathcomp Require Import topology normedtype sequences esum numfun. From HB Require Import structures. @@ -1955,10 +1955,16 @@ Context d (T : semiRingOfSetsType d) (R : numFieldType). Variable mu : {content set T -> \bar R}. -Lemma content_snum_subproof S : Signed.spec 0 ?=0 >=0 (mu S). -Proof. exact: measure_ge0. Qed. +Lemma content_inum_subproof S : + Itv.spec (@ext_num_sem R) (Itv.Real `[0%Z, +oo[) (mu S). +Proof. +apply/and3P; split. +- by rewrite real_fine -real_leNye; apply: le_trans (measure_ge0 _ _). +- by rewrite /= bnd_simp measure_ge0. +- by rewrite bnd_simp. +Qed. -Canonical content_snum S := Signed.mk (content_snum_subproof S). +Canonical content_inum S := Itv.mk (content_inum_subproof S). End content_signed. @@ -2109,10 +2115,16 @@ Context d (R : numFieldType) (T : semiRingOfSetsType d). Variable mu : {measure set T -> \bar R}. -Lemma measure_snum_subproof S : Signed.spec 0 ?=0 >=0 (mu S). -Proof. exact: measure_ge0. Qed. +Lemma measure_inum_subproof S : + Itv.spec (@ext_num_sem R) (Itv.Real `[0%Z, +oo[) (mu S). +Proof. +apply/and3P; split. +- by rewrite real_fine -real_leNye; apply: le_trans (measure_ge0 _ _). +- by rewrite /= bnd_simp measure_ge0. +- by rewrite bnd_simp. +Qed. -Canonical measure_snum S := Signed.mk (measure_snum_subproof S). +Canonical measure_inum S := Itv.mk (measure_inum_subproof S). End measure_signed. @@ -3583,7 +3595,7 @@ by rewrite /mnormalize; case: ifPn => // _; rewrite measure0 mul0e. Qed. Let mnormalize_ge0 U : 0 <= mnormalize U. -Proof. by rewrite /mnormalize; case: ifPn => //; case: ifPn. Qed. +Proof. by rewrite /mnormalize; case: ifPn. Qed. Let mnormalize_sigma_additive : semi_sigma_additive mnormalize. Proof. diff --git a/theories/normedtype.v b/theories/normedtype.v index 0900de72a..69e3f53a7 100644 --- a/theories/normedtype.v +++ b/theories/normedtype.v @@ -5,7 +5,8 @@ From mathcomp Require Import rat interval zmodp vector fieldext falgebra. From mathcomp Require Import boolp classical_sets functions. From mathcomp Require Import archimedean. From mathcomp Require Import cardinality set_interval ereal reals. -From mathcomp Require Import signed topology prodnormedzmodule function_spaces. +From mathcomp Require Import interval_inference topology prodnormedzmodule. +From mathcomp Require Import function_spaces. From mathcomp Require Export real_interval separation_axioms tvs. (**md**************************************************************************) @@ -2444,7 +2445,7 @@ rewrite /normr /ball_ predeq3E => x e y /=; rewrite mx_normE; split => xey. by rewrite -num_lt /=; split => // -[? ?] _; rewrite !mxE; exact: xey. - have e_gt0 : 0 < e by rewrite (le_lt_trans _ xey). move: e_gt0 (e_gt0) xey => /ltW/nonnegP[{}e] e_gt0. - move=> /(bigmax_ltP _ _ _ (fun _ => _%:sgn)) /= [e0 xey] i j. + move=> /(bigmax_ltP _ _ _ (fun _ => _%:itv)) /= [e0 xey] i j. by move: (xey (i, j)); rewrite !mxE; exact. Qed. @@ -3138,7 +3139,8 @@ Lemma cvg_abse0P f : abse \o f @ F --> 0 <-> f @ F --> 0. Proof. split; last by move=> /cvg_abse; rewrite abse0. move=> /cvg_ballP f0; apply/cvg_ballP => _/posnumP[e]. -have := !! f0 _ (gt0 e); rewrite !near_simpl => absf0; rewrite near_simpl. +have := [elaborate f0 _ (gt0 e)]. +rewrite !near_simpl => absf0; rewrite near_simpl. apply: filterS absf0 => x /=; rewrite /ball/= /ereal_ball !contract0 !sub0r !normrN. have [fx0|fx0] := leP 0 (f x); first by rewrite gee0_abs. by rewrite (lte0_abs fx0) contractN normrN. @@ -3412,7 +3414,8 @@ rewrite ball_close; split=> [bxy|edist0 eps]; first last. by apply: (@edist_lt_ball _ (x, y)); rewrite edist0. case: ltgtP (edist_ge0 (x, y)) => // dpos _. have xxfin : edist (x, y) \is a fin_num. - by rewrite ge0_fin_numE// (@le_lt_trans _ _ 1%:E) ?ltey// edist_fin. + rewrite ge0_fin_numE// (@le_lt_trans _ _ 1%:E) ?ltey// edist_fin//. + exact: bxy (widen_itv 1%:itv). have dpose : fine (edist (x, y)) > 0 by rewrite -lte_fin fineK. pose eps := PosNum dpose. have : (edist (x, y) <= (eps%:num / 2)%:E)%E. @@ -5480,7 +5483,7 @@ Proof. split=> [/nbhs_ballP[_/posnumP[r] xrB]|[e xeB]]; last first. apply/nbhs_ballP; exists e%:num => //=. exact: (subset_trans (@subset_closure _ _) xeB). -exists (r%:num / 2)%:sgn. +exists (r%:num / 2)%:itv. apply: (subset_trans (closed_ball_subset _ _) xrB) => //=. by rewrite lter_pdivrMr // ltr_pMr // ltr1n. Qed. diff --git a/theories/numfun.v b/theories/numfun.v index acb61398b..2d30d5f39 100644 --- a/theories/numfun.v +++ b/theories/numfun.v @@ -2,9 +2,9 @@ From HB Require Import structures. From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint interval finmap. From mathcomp Require Import mathcomp_extra boolp classical_sets fsbigop. -From mathcomp Require Import functions cardinality set_interval signed reals. -From mathcomp Require Import ereal topology normedtype sequences. -From mathcomp Require Import function_spaces. +From mathcomp Require Import functions cardinality set_interval. +From mathcomp Require Import interval_inference reals ereal topology normedtype. +From mathcomp Require Import sequences function_spaces. (**md**************************************************************************) (* # Numerical functions *) @@ -612,7 +612,7 @@ have cvgh : {uniform, h_ @ \oo --> lim (h_ @ \oo)}. by move=> ?; rewrite /= uniform_nbhsT; exact: cvgh'. exists (lim (h_ @ \oo)); split. - move=> t /set_mem At; have /pointwise_cvgP/(_ t)/(cvg_lim (@Rhausdorff _)) := - !! pointwise_uniform_cvg _ cvgh. + [elaborate pointwise_uniform_cvg _ cvgh]. rewrite -fmap_comp /comp /h_ => <-; apply/esym/(@cvg_lim _ (@Rhausdorff R)). apply: (@cvg_zero R R^o); apply: norm_cvg0; under eq_fun => n. rewrite distrC /series /cst /= -mulN1r fct_sumE mulr_sumr. @@ -631,7 +631,7 @@ exists (lim (h_ @ \oo)); split. by apply: continuousD; [exact: IH|exact: g_cts]. - move=> t. have /pointwise_cvgP/(_ t)/(cvg_lim (@Rhausdorff _)) := - !! pointwise_uniform_cvg _ cvgh. + [elaborate pointwise_uniform_cvg _ cvgh]. rewrite -fmap_comp /comp /h_ => <-. under [fun _ : nat => _]eq_fun => ? do rewrite /series /= fct_sumE. have cvg_gt : cvgn [normed series (g_^~ t)]. diff --git a/theories/pi_irrational.v b/theories/pi_irrational.v index 7f93b4507..0e805f3e1 100644 --- a/theories/pi_irrational.v +++ b/theories/pi_irrational.v @@ -1,9 +1,9 @@ From mathcomp Require Import all_ssreflect all_algebra archimedean finmap. From mathcomp Require Import mathcomp_extra boolp classical_sets functions. -From mathcomp Require Import cardinality fsbigop signed reals ereal topology. -From mathcomp Require Import normedtype sequences real_interval esum measure. -From mathcomp Require Import lebesgue_measure numfun realfun lebesgue_integral. -From mathcomp Require Import derive charge ftc trigo. +From mathcomp Require Import cardinality fsbigop interval_inference reals ereal. +From mathcomp Require Import topology normedtype sequences real_interval esum. +From mathcomp Require Import measure lebesgue_measure numfun realfun. +From mathcomp Require Import lebesgue_integral derive charge ftc trigo. (**md**************************************************************************) (* # Formalisation of A simple proof that pi is irrational by Ivan Niven *) diff --git a/theories/probability.v b/theories/probability.v index 1ff17ee46..b26f34573 100644 --- a/theories/probability.v +++ b/theories/probability.v @@ -5,8 +5,8 @@ From mathcomp Require Import mathcomp_extra boolp classical_sets functions. From mathcomp Require Import cardinality fsbigop. From HB Require Import structures. From mathcomp Require Import exp numfun lebesgue_measure lebesgue_integral. -From mathcomp Require Import reals ereal signed topology normedtype sequences. -From mathcomp Require Import esum measure exp numfun lebesgue_measure. +From mathcomp Require Import reals interval_inference ereal topology normedtype. +From mathcomp Require Import sequences esum measure exp numfun lebesgue_measure. From mathcomp Require Import lebesgue_integral kernel. (**md**************************************************************************) @@ -944,7 +944,7 @@ Context {R : realType}. Variables (p : R) (p0 : (0 <= p)%R) (p1 : ((NngNum p0)%:num <= 1)%R). Lemma bernoulli_dirac : bernoulli p = measure_add - (mscale (NngNum p0) \d_true) (mscale (onem_nonneg p1) \d_false). + (mscale (NngNum p0) \d_true) (mscale (1 - (Itv01 p0 p1)%:num)%:nng \d_false). Proof. apply/funext => U; rewrite /bernoulli; case: ifPn => [p01|]; last first. by rewrite p0/= p1. diff --git a/theories/realfun.v b/theories/realfun.v index 1c38c0f4a..f82995936 100644 --- a/theories/realfun.v +++ b/theories/realfun.v @@ -4,7 +4,7 @@ From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum archimedean. From mathcomp Require Import matrix interval zmodp vector fieldext falgebra. From mathcomp Require Import finmap. From mathcomp Require Import mathcomp_extra boolp classical_sets functions. -From mathcomp Require Import cardinality contra ereal reals signed. +From mathcomp Require Import cardinality contra ereal reals interval_inference. From mathcomp Require Import topology prodnormedzmodule tvs normedtype derive. From mathcomp Require Import sequences real_interval. diff --git a/theories/separation_axioms.v b/theories/separation_axioms.v index ff2dfd228..532c8fa47 100644 --- a/theories/separation_axioms.v +++ b/theories/separation_axioms.v @@ -4,7 +4,7 @@ From mathcomp Require Import all_ssreflect all_algebra finmap generic_quotient. From mathcomp Require Import archimedean. From mathcomp Require Import boolp classical_sets functions wochoice. From mathcomp Require Import cardinality mathcomp_extra fsbigop set_interval. -From mathcomp Require Import filter reals signed topology. +From mathcomp Require Import filter reals interval_inference topology. (**md**************************************************************************) (* # Separation Axioms *) @@ -106,8 +106,8 @@ Definition hausdorff_space := forall p q : T, cluster (nbhs p) q -> p = q. Lemma compact_closed (A : set T) : hausdorff_space -> compact A -> closed A. Proof. -move=> hT Aco p clAp; have pA := !! @withinT _ (nbhs p) A _. -have [q [Aq clsAp_q]] := !! Aco _ _ pA; rewrite (hT p q) //. +move=> hT Aco p clAp; have pA := [elaborate @withinT _ (nbhs p) A _]. +have [q [Aq clsAp_q]] := [elaborate Aco _ _ pA]; rewrite (hT p q) //. by apply: cvg_cluster clsAp_q; apply: cvg_within. Qed. @@ -446,7 +446,7 @@ Lemma ball_close {R : numFieldType} {M : pseudoMetricType R} (x y : M) : close x y = forall eps : {posnum R}, ball x eps%:num y. Proof. rewrite propeqE; split => [cxy eps|cxy]. - have := !! cxy _ (open_nbhs_ball _ (eps%:num/2)%:pos). + have := [elaborate cxy _ (open_nbhs_ball _ (eps%:num/2)%:pos)]. rewrite closureEonbhs/= meetsC meets_globallyr. move/(_ _ (open_nbhs_ball _ (eps%:num/2)%:pos)) => [z [zx zy]]. by apply: (@ball_splitl _ _ z); apply: interior_subset. diff --git a/theories/sequences.v b/theories/sequences.v index 7c31e06f0..a94ac54f8 100644 --- a/theories/sequences.v +++ b/theories/sequences.v @@ -3,8 +3,8 @@ From HB Require Import structures. From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum matrix. From mathcomp Require Import interval rat archimedean. From mathcomp Require Import mathcomp_extra boolp classical_sets functions. -From mathcomp Require Import set_interval reals ereal signed topology. -From mathcomp Require Import tvs normedtype landau. +From mathcomp Require Import set_interval reals interval_inference ereal. +From mathcomp Require Import topology tvs normedtype landau. (**md**************************************************************************) (* # Definitions and lemmas about sequences *) @@ -850,7 +850,7 @@ suff abel : forall n, rewrite a_o. set h := 'o_\oo (@harmonic R). apply/eqoP => _/posnumP[e] /=. - near=> n; rewrite normr1 mulr1 normrM -ler_pdivlMl// ?normr_gt0//. + near=> n; rewrite normr1 mulr1 normrM -ler_pdivlMl ?normr_gt0//. rewrite mulrC -normrV ?unitfE //. near: n. by case: (eqoP eventually_filterType (@harmonic R) h) => Hh _; apply Hh. @@ -1027,7 +1027,7 @@ Lemma cauchy_seriesP {R : numFieldType} (V : normedModType R) (u_ : V ^nat) : \forall n \near (\oo, \oo), `|\sum_(n.1 <= k < n.2) u_ k| < e. Proof. rewrite -cauchy_ballP; split=> su_cv _/posnumP[e]; -have {}su_cv := !! su_cv _ (gt0 e); +have {}su_cv := [elaborate su_cv _ (gt0 e)]; rewrite -near2_pair -ball_normE !near_simpl/= in su_cv *. apply: filterS su_cv => -[/= m n]; rewrite distrC sub_series. by have [|/ltnW]:= leqP m n => mn//; rewrite (big_geq mn) ?normr0. @@ -2646,8 +2646,9 @@ have /le_trans -> // : `| y n - y (n + m)| <= rewrite (le_trans (ler_distD (y (n + m)%N) _ _))//. apply: (le_trans (lerD ih _)); first by rewrite distrC addnS; exact: f1. rewrite [_ * `|_|]mulrC exprD mulrA geometric_seriesE ?lt_eqF//=. - rewrite -!/(`1-_) (onem_PosNum ctrf.1) (onemX_NngNum (ltW ctrf.1)). - rewrite -!mulrA -mulrDr ler_pM// -mulrDr exprSr onemM -addrA. + pose q' := Itv01 [elaborate ge0 q] (ltW q1). + rewrite -[q%:num]/(q'%:num) -!mulrA -mulrDr ler_pM// {}/q'/=. + rewrite -!/(`1-_) -mulrDr exprSr onemM -addrA. rewrite -[in leRHS](mulrC _ `1-(_ ^+ m)) -onemMr onemK. by rewrite [in leRHS]mulrDl mulrAC mulrV ?mul1r// unitf_gt0// onem_gt0. rewrite geometric_seriesE ?lt_eqF//= -[leRHS]mulr1 (ACl (1*4*2*3))/= -/C. diff --git a/theories/topology_theory/compact.v b/theories/topology_theory/compact.v index f0187e8a1..9afc4dd82 100644 --- a/theories/topology_theory/compact.v +++ b/theories/topology_theory/compact.v @@ -1,8 +1,8 @@ (* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra finmap all_classical. -From mathcomp Require Import signed reals topology_structure uniform_structure. -From mathcomp Require Import pseudometric_structure. +From mathcomp Require Import interval_inference reals topology_structure. +From mathcomp Require Import uniform_structure pseudometric_structure. (**md**************************************************************************) (* # Compactness *) @@ -40,6 +40,12 @@ Unset Printing Implicit Defensive. Local Open Scope classical_set_scope. Local Open Scope ring_scope. +(* infer class to help typeclass inference on the fly *) +Class infer (P : Prop) := Infer : P. +#[export] Hint Mode infer ! : typeclass_instances. +#[export] Hint Extern 0 (infer _) => (exact) : typeclass_instances. +Lemma inferP (P : Prop) : P -> infer P. Proof. by []. Qed. + Section Compact. Context {T : topologicalType}. diff --git a/theories/topology_theory/matrix_topology.v b/theories/topology_theory/matrix_topology.v index c02628f4d..2919a5717 100644 --- a/theories/topology_theory/matrix_topology.v +++ b/theories/topology_theory/matrix_topology.v @@ -1,13 +1,13 @@ (* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra finmap all_classical. -From mathcomp Require Import signed topology_structure uniform_structure. -From mathcomp Require Import pseudometric_structure. +From mathcomp Require Import interval_inference topology_structure. +From mathcomp Require Import uniform_structure pseudometric_structure. (**md**************************************************************************) (* # Matrix topology *) (* ``` *) -(* mx_ent m n A == entourages for the m x n matrices *) -(* mx_ball m n A == balls for the m x n matrices *) +(* mx_ent m n A == entourages for the m x n matrices *) +(* mx_ball m n A == balls for the m x n matrices *) (* ``` *) (* Matrices `'M[T]_(m, n)` are endowed with the structures of: *) (* - topology *) diff --git a/theories/topology_theory/num_topology.v b/theories/topology_theory/num_topology.v index a1bd6eb84..56e85fa81 100644 --- a/theories/topology_theory/num_topology.v +++ b/theories/topology_theory/num_topology.v @@ -2,8 +2,9 @@ From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra archimedean. From mathcomp Require Import all_classical. -From mathcomp Require Import signed reals topology_structure uniform_structure. -From mathcomp Require Import pseudometric_structure order_topology. +From mathcomp Require Import interval_inference reals topology_structure. +From mathcomp Require Import uniform_structure pseudometric_structure. +From mathcomp Require Import order_topology. (**md**************************************************************************) (* # Topological notions for numerical types *) diff --git a/theories/topology_theory/product_topology.v b/theories/topology_theory/product_topology.v index 8a4cf8dc1..83b9e2322 100644 --- a/theories/topology_theory/product_topology.v +++ b/theories/topology_theory/product_topology.v @@ -1,8 +1,8 @@ (* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra all_classical. -From mathcomp Require Import signed topology_structure uniform_structure. -From mathcomp Require Import pseudometric_structure compact. +From mathcomp Require Import interval_inference topology_structure. +From mathcomp Require Import uniform_structure pseudometric_structure compact. (**md**************************************************************************) (* # Product topology *) diff --git a/theories/topology_theory/pseudometric_structure.v b/theories/topology_theory/pseudometric_structure.v index a88c1d2bd..9f3a2dc1e 100644 --- a/theories/topology_theory/pseudometric_structure.v +++ b/theories/topology_theory/pseudometric_structure.v @@ -2,7 +2,8 @@ From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra archimedean. From mathcomp Require Import all_classical. -From mathcomp Require Import signed reals topology_structure uniform_structure. +From mathcomp Require Import interval_inference reals topology_structure. +From mathcomp Require Import uniform_structure. (**md**************************************************************************) (* # PseudoMetric Spaces *) @@ -189,7 +190,7 @@ Proof. by rewrite nbhs_simpl. Qed. Lemma ball_center {R : numDomainType} (M : pseudoMetricType R) (x : M) (e : {posnum R}) : ball x e%:num x. Proof. exact: ball_center_subproof. Qed. -#[global] Hint Resolve ball_center : core. +#[global] Hint Extern 0 (ball _ _ _) => solve[apply: ball_center] : core. Section pseudoMetricType_numDomainType. Context {R : numDomainType} {M : pseudoMetricType R}. diff --git a/theories/topology_theory/weak_topology.v b/theories/topology_theory/weak_topology.v index 0b13ca98d..68c10e31b 100644 --- a/theories/topology_theory/weak_topology.v +++ b/theories/topology_theory/weak_topology.v @@ -1,8 +1,9 @@ (* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra all_classical. -From mathcomp Require Import signed reals topology_structure uniform_structure. -From mathcomp Require Import order_topology pseudometric_structure. +From mathcomp Require Import interval_inference reals topology_structure. +From mathcomp Require Import uniform_structure order_topology. +From mathcomp Require Import pseudometric_structure. (**md**************************************************************************) (* # Weak topology *) diff --git a/theories/trigo.v b/theories/trigo.v index 3d240c85f..02f881089 100644 --- a/theories/trigo.v +++ b/theories/trigo.v @@ -3,8 +3,9 @@ From HB Require Import structures. From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum matrix. From mathcomp Require Import interval rat. From mathcomp Require Import mathcomp_extra boolp classical_sets functions. -From mathcomp Require Import reals ereal nsatz_realtype signed topology. -From mathcomp Require Import normedtype landau sequences derive realfun exp. +From mathcomp Require Import reals ereal nsatz_realtype interval_inference. +From mathcomp Require Import topology normedtype landau sequences derive. +From mathcomp Require Import realfun exp. (**md**************************************************************************) (* # Theory of trigonometric functions *) @@ -48,7 +49,7 @@ Lemma cvg_series_cvg_series_group (R : realFieldType) (f : R ^nat) k : [series \sum_(n * k <= i < n.+1 * k) f i]_n @ \oo --> lim (series f @ \oo). Proof. move=> /cvg_ballP cf k0; apply/cvg_ballP => _/posnumP[e]. -have := !! cf _ (gt0 e) => -[n _ nl]; near=> m. +have := [elaborate cf _ (gt0 e)] => -[n _ nl]; near=> m. rewrite /ball /= [in X in `|_ - X|]/series [in X in `|_ - X|]/= -big_nat_mul. have /nl : (n <= m * k)%N. by near: m; exists n.+1 => //= p /ltnW /leq_trans /(_ (leq_pmulr _ k0)). diff --git a/theories/tvs.v b/theories/tvs.v index cb5c93eaf..21e8659f6 100644 --- a/theories/tvs.v +++ b/theories/tvs.v @@ -4,8 +4,8 @@ From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum finmap matrix. From mathcomp Require Import rat interval zmodp vector fieldext falgebra. From mathcomp Require Import archimedean. From mathcomp Require Import boolp classical_sets functions cardinality. -From mathcomp Require Import set_interval ereal reals signed topology. -From mathcomp Require Import prodnormedzmodule function_spaces. +From mathcomp Require Import set_interval ereal reals interval_inference. +From mathcomp Require Import topology prodnormedzmodule function_spaces. From mathcomp Require Import separation_axioms. (**md**************************************************************************)