From fbf0b7568b8d6231671954cba8bcae4120e591cc Mon Sep 17 00:00:00 2001 From: Kazuhiko Sakaguchi Date: Tue, 5 Feb 2019 15:38:39 +0100 Subject: Make an appropriate use of the order library everywhere (#278, #280, #282, #283, #285, #286, #288, #296, #330, #334, and #341) ssrnum related changes: - Redefine the intermediate structure between `idomainType` and `numDomainType`, which is `normedDomainType` (normed integral domain without an order). - Generalize (by using `normedDomainType` or the order structures), relocate (to order.v), and rename ssrnum related definitions and lemmas. - Add a compatibility module `Num.mc_1_9` and export it to check compilation. - Remove the use of the deprecated definitions and lemmas from entire theories. - Implement factories mechanism to construct several ordered and num structures from fewer axioms. order related changes: - Reorganize the hierarchy of finite lattice structures. Finite lattices have top and bottom elements except for empty set. Therefore we removed finite lattice structures without top and bottom. - Reorganize the theory modules in order.v: + `LTheory` (lattice and partial order, without complement and totality) + `CTheory` (`LTheory` + complement) + `Theory` (all) - Give a unique head symbol for `Total.mixin_of`. - Replace reverse and `^r` with converse and `^c` respectively. - Fix packing and cloning functions and notations. - Provide more ordered type instances: Products and lists can be ordered in two different ways: the lexicographical ordering and the pointwise ordering. Now their canonical instances are not exported to make the users choose them. - Export `Order.*.Exports` modules by default. - Specify the core hint database explicitly in order.v. (see #252) - Apply 80 chars per line restriction. General changes: - Give consistency to shape of formulae and namings of `lt_def` and `lt_neqAle` like lemmas: lt_def x y : (x < y) = (y != x) && (x <= y), lt_neqAle x y : (x < y) = (x != y) && (x <= y). - Enable notation overloading by using scopes and displays: + Define `min` and `max` notations (`minr` and `maxr` for `ring_display`) as aliases of `meet` and `join` specialized for `total_display`. + Provide the `ring_display` version of `le`, `lt`, `ge`, `gt`, `leif`, and `comparable` notations and their explicit variants in `Num.Def`. + Define 3 variants of `[arg min_(i < n | P) F]` and `[arg max_(i < n | P) F]` notations in `nat_scope` (specialized for nat), `order_scope` (general version), and `ring_scope` (specialized for `ring_display`). - Update documents and put CHANGELOG entries. --- mathcomp/algebra/intdiv.v | 28 +- mathcomp/algebra/interval.v | 60 +- mathcomp/algebra/rat.v | 56 +- mathcomp/algebra/ssralg.v | 2 +- mathcomp/algebra/ssrint.v | 165 +- mathcomp/algebra/ssrnum.v | 3398 +++++++++++++++++------------- mathcomp/character/character.v | 33 +- mathcomp/character/classfun.v | 23 +- mathcomp/character/inertia.v | 24 +- mathcomp/character/integral_char.v | 28 +- mathcomp/character/vcharacter.v | 31 +- mathcomp/field/algC.v | 64 +- mathcomp/field/algebraics_fundamentals.v | 141 +- mathcomp/field/algnum.v | 3 +- mathcomp/field/finfield.v | 12 +- mathcomp/ssreflect/all_ssreflect.v | 1 + mathcomp/ssreflect/fintype.v | 18 +- mathcomp/ssreflect/order.v | 3105 +++++++++++++++++---------- 18 files changed, 4270 insertions(+), 2922 deletions(-) (limited to 'mathcomp') diff --git a/mathcomp/algebra/intdiv.v b/mathcomp/algebra/intdiv.v index 7663e63..eaa256c 100644 --- a/mathcomp/algebra/intdiv.v +++ b/mathcomp/algebra/intdiv.v @@ -1,7 +1,7 @@ (* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import ssreflect ssrbool ssrfun eqtype ssrnat seq path. -From mathcomp Require Import div choice fintype tuple finfun bigop prime. +From mathcomp Require Import div choice fintype tuple finfun bigop prime order. From mathcomp Require Import ssralg poly ssrnum ssrint rat matrix. From mathcomp Require Import polydiv finalg perm zmodp mxalgebra vector. @@ -46,7 +46,7 @@ Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. -Import GRing.Theory Num.Theory. +Import Order.Theory GRing.Theory Num.Theory. Local Open Scope ring_scope. Definition divz (m d : int) := @@ -79,7 +79,7 @@ Proof. by case: d => // d; rewrite /divz /= mul1r. Qed. Lemma divzN m d : (m %/ - d)%Z = - (m %/ d)%Z. Proof. by case: m => n; rewrite /divz /= sgzN abszN mulNr. Qed. -Lemma divz_abs m d : (m %/ `|d|)%Z = (-1) ^+ (d < 0)%R * (m %/ d)%Z. +Lemma divz_abs (m d : int) : (m %/ `|d|)%Z = (-1) ^+ (d < 0)%R * (m %/ d)%Z. Proof. by rewrite {3}[d]intEsign !mulr_sign; case: ifP => -> //; rewrite divzN opprK. Qed. @@ -132,7 +132,7 @@ Qed. Lemma divzMDl q m d : d != 0 -> ((q * d + m) %/ d)%Z = q + (m %/ d)%Z. Proof. -rewrite neqr_lt -oppr_gt0 => nz_d. +rewrite neq_lt -oppr_gt0 => nz_d. wlog{nz_d} d_gt0: q d / d > 0; last case: d => // d in d_gt0 *. move=> IH; case/orP: nz_d => /IH// /(_ (- q)). by rewrite mulrNN !divzN -opprD => /oppr_inj. @@ -179,8 +179,8 @@ Lemma divzMpl p m d : p > 0 -> (p * m %/ (p * d) = m %/ d)%Z. Proof. case: p => // p p_gt0; wlog d_gt0: d / d > 0; last case: d => // d in d_gt0 *. by move=> IH; case/intP: d => [|d|d]; rewrite ?mulr0 ?divz0 ?mulrN ?divzN ?IH. -rewrite {1}(divz_eq m d) mulrDr mulrCA divzMDl ?mulf_neq0 ?gtr_eqF // addrC. -rewrite divz_small ?add0r // PoszM pmulr_rge0 ?modz_ge0 ?gtr_eqF //=. +rewrite {1}(divz_eq m d) mulrDr mulrCA divzMDl ?mulf_neq0 ?gt_eqF // addrC. +rewrite divz_small ?add0r // PoszM pmulr_rge0 ?modz_ge0 ?gt_eqF //=. by rewrite ltr_pmul2l ?ltz_pmod. Qed. Arguments divzMpl [p m d]. @@ -203,19 +203,20 @@ Qed. Lemma ltz_ceil m d : d > 0 -> m < ((m %/ d)%Z + 1) * d. Proof. -by case: d => // d d_gt0; rewrite mulrDl mul1r -ltr_subl_addl ltz_mod ?gtr_eqF. +by case: d => // d d_gt0; rewrite mulrDl mul1r -ltr_subl_addl ltz_mod ?gt_eqF. Qed. Lemma ltz_divLR m n d : d > 0 -> ((m %/ d)%Z < n) = (m < n * d). Proof. move=> d_gt0; apply/idP/idP. - by rewrite -lez_addr1 -(ler_pmul2r d_gt0); apply: ltr_le_trans (ltz_ceil _ _). -rewrite -(ltr_pmul2r d_gt0 _ n) //; apply: ler_lt_trans (lez_floor _ _). -by rewrite gtr_eqF. + by rewrite -[_ < n]lez_addr1 -(ler_pmul2r d_gt0); + apply: lt_le_trans (ltz_ceil _ _). +rewrite -(ltr_pmul2r d_gt0 _ n) //; apply: le_lt_trans (lez_floor _ _). +by rewrite gt_eqF. Qed. Lemma lez_divRL m n d : d > 0 -> (m <= (n %/ d)%Z) = (m * d <= n). -Proof. by move=> d_gt0; rewrite !lerNgt ltz_divLR. Qed. +Proof. by move=> d_gt0; rewrite !leNgt ltz_divLR. Qed. Lemma divz_ge0 m d : d > 0 -> ((m %/ d)%Z >= 0) = (m >= 0). Proof. by case: d m => // d [] n d_gt0; rewrite (divz_nat, divNz_nat). Qed. @@ -225,9 +226,9 @@ Proof. case: n => // [[|n]] _; first by rewrite mul0r !divz0 div0z. wlog p_gt0: p / p > 0; last case: p => // p in p_gt0 *. by case/intP: p => [|p|p] IH; rewrite ?mulr0 ?divz0 ?mulrN ?divzN // IH. -rewrite {2}(divz_eq m (n.+1%:Z * p)) mulrA mulrAC !divzMDl // ?gtr_eqF //. +rewrite {2}(divz_eq m (n.+1%:Z * p)) mulrA mulrAC !divzMDl // ?gt_eqF //. rewrite [rhs in _ + rhs]divz_small ?addr0 // ltz_divLR // divz_ge0 //. -by rewrite mulrC ltz_pmod ?modz_ge0 ?gtr_eqF ?pmulr_lgt0. +by rewrite mulrC ltz_pmod ?modz_ge0 ?gt_eqF ?pmulr_lgt0. Qed. Lemma modz_small m d : 0 <= m < d -> (m %% d)%Z = m. @@ -1073,4 +1074,3 @@ rewrite -defS -2!mulmxA; have ->: T *m pinvmx T = 1%:M. by apply: (row_free_inj uT); rewrite mul1mx mulmxKpV. by move=> i; rewrite mulmx1 -map_mxM 2!mxE denq_int mxE. Qed. - diff --git a/mathcomp/algebra/interval.v b/mathcomp/algebra/interval.v index eb0785f..48d5254 100644 --- a/mathcomp/algebra/interval.v +++ b/mathcomp/algebra/interval.v @@ -1,7 +1,8 @@ (* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq choice. -From mathcomp Require Import div fintype bigop ssralg finset fingroup ssrnum. +From mathcomp Require Import div fintype bigop order ssralg finset fingroup. +From mathcomp Require Import ssrnum. (*****************************************************************************) (* This file provide support for intervals in numerical and real domains. *) @@ -39,13 +40,14 @@ Unset Strict Implicit. Unset Printing Implicit Defensive. Local Open Scope ring_scope. -Import GRing.Theory Num.Theory. +Import Order.Theory Order.Syntax GRing.Theory Num.Theory. Local Notation mid x y := ((x + y) / 2%:R). Section LersifPo. Variable R : numDomainType. +Implicit Types (b : bool) (x y z : R). Definition lersif (x y : R) b := if b then x < y else x <= y. @@ -65,7 +67,7 @@ Lemma lersif_trans x y z b1 b2 : x <= y ?< if b1 -> y <= z ?< if b2 -> x <= z ?< if b1 || b2. Proof. by case: b1 b2 => [] []; - apply (ltr_trans, ltr_le_trans, ler_lt_trans, ler_trans). + [apply: lt_trans | apply: lt_le_trans | apply: le_lt_trans | apply: le_trans]. Qed. Lemma lersif01 b : 0 <= 1 ?< if b. @@ -74,16 +76,16 @@ Proof. by case: b; apply lter01. Qed. Lemma lersif_anti b1 b2 x y : (x <= y ?< if b1) && (y <= x ?< if b2) = if b1 || b2 then false else x == y. -Proof. by case: b1 b2 => [] []; rewrite lter_anti. Qed. +Proof. by case: b1 b2 => [] []; rewrite lte_anti. Qed. Lemma lersifxx x b : (x <= x ?< if b) = ~~ b. -Proof. by case: b; rewrite /= lterr. Qed. +Proof. by case: b; rewrite /= ltexx. Qed. Lemma lersifNF x y b : y <= x ?< if ~~ b -> x <= y ?< if b = false. -Proof. by case: b => /= [/ler_gtF|/ltr_geF]. Qed. +Proof. by case: b => /= [/le_gtF|/lt_geF]. Qed. Lemma lersifS x y b : x < y -> x <= y ?< if b. -Proof. by case: b => //= /ltrW. Qed. +Proof. by case: b => //= /ltW. Qed. Lemma lersifT x y : x <= y ?< if true = (x < y). Proof. by []. Qed. @@ -132,25 +134,25 @@ Definition lersif_sub_addl := (lersif_subl_addl, lersif_subr_addl). Lemma lersif_andb x y : {morph lersif x y : p q / p || q >-> p && q}. Proof. -by case=> [] [] /=; rewrite ?ler_eqVlt; +by case=> [] [] /=; rewrite ?le_eqVlt; case: (_ < _)%R; rewrite ?(orbT, orbF, andbF, andbb). Qed. Lemma lersif_orb x y : {morph lersif x y : p q / p && q >-> p || q}. Proof. -by case=> [] [] /=; rewrite ?ler_eqVlt; +by case=> [] [] /=; rewrite ?le_eqVlt; case: (_ < _)%R; rewrite ?(orbT, orbF, orbb). Qed. Lemma lersif_imply b1 b2 r1 r2 : b2 ==> b1 -> r1 <= r2 ?< if b1 -> r1 <= r2 ?< if b2. -Proof. by case: b1 b2 => [] [] //= _ /ltrW. Qed. +Proof. by case: b1 b2 => [] [] //= _ /ltW. Qed. Lemma lersifW b x y : x <= y ?< if b -> x <= y. -Proof. by case: b => // /ltrW. Qed. +Proof. by case: b => // /ltW. Qed. Lemma ltrW_lersif b x y : x < y -> x <= y ?< if b. -Proof. by case: b => // /ltrW. Qed. +Proof. by case: b => // /ltW. Qed. Lemma lersif_pmul2l b x : 0 < x -> {mono *%R x : y z / y <= z ?< if b}. Proof. by case: b; apply lter_pmul2l. Qed. @@ -166,7 +168,7 @@ Proof. by case: b; apply lter_nmul2r. Qed. Lemma real_lersifN x y b : x \is Num.real -> y \is Num.real -> x <= y ?< if ~~b = ~~ (y <= x ?< if b). -Proof. by case: b => [] xR yR /=; case: real_ltrgtP. Qed. +Proof. by case: b => [] xR yR /=; case: real_ltgtP. Qed. Lemma real_lersif_norml b x y : x \is Num.real -> @@ -207,20 +209,20 @@ Lemma lersif_distl : Proof. by case: b; apply lter_distl. Qed. Lemma lersif_minr : - (x <= Num.min y z ?< if b) = (x <= y ?< if b) && (x <= z ?< if b). -Proof. by case: b; apply lter_minr. Qed. + (x <= y `&` z ?< if b) = (x <= y ?< if b) && (x <= z ?< if b). +Proof. by case: b; rewrite /= ltexI. Qed. Lemma lersif_minl : - (Num.min y z <= x ?< if b) = (y <= x ?< if b) || (z <= x ?< if b). -Proof. by case: b; apply lter_minl. Qed. + (y `&` z <= x ?< if b) = (y <= x ?< if b) || (z <= x ?< if b). +Proof. by case: b; rewrite /= lteIx. Qed. Lemma lersif_maxr : - (x <= Num.max y z ?< if b) = (x <= y ?< if b) || (x <= z ?< if b). -Proof. by case: b; apply lter_maxr. Qed. + (x <= y `|` z ?< if b) = (x <= y ?< if b) || (x <= z ?< if b). +Proof. by case: b; rewrite /= ltexU. Qed. Lemma lersif_maxl : - (Num.max y z <= x ?< if b) = (y <= x ?< if b) && (z <= x ?< if b). -Proof. by case: b; apply lter_maxl. Qed. + (y `|` z <= x ?< if b) = (y <= x ?< if b) && (z <= x ?< if b). +Proof. by case: b; rewrite /= lteUx. Qed. End LersifOrdered. @@ -459,13 +461,9 @@ Definition bound_in_itv := (boundl_in_itv, boundr_in_itv). Lemma itvP : forall (x : R) (i : interval R), x \in i -> itv_rewrite i x. Proof. -move=> x [[[] a|] [[] b|]] /itv_dec // [? ?]; - do ?split => //; rewrite ?bound_in_itv /le_boundl /le_boundr //=; - do 1?[apply/negbTE; rewrite (ler_gtF, ltr_geF) //]; - by [ rewrite ltrW - | rewrite (@ler_trans _ x) // 1?ltrW - | rewrite (@ltr_le_trans _ x) - | rewrite (@ler_lt_trans _ x) // 1?ltrW ]. +move=> x [[[] a|] [[] b|]] /itv_dec [ha hb]; do !split; + rewrite ?bound_in_itv //=; do 1?[apply/negbTE; rewrite (le_gtF, lt_geF)]; + by [ | apply: ltW | move: (lersif_trans ha hb) => //=; exact: ltW ]. Qed. Arguments itvP [x i]. @@ -484,7 +482,7 @@ Definition itv_intersectioni1 : right_id `]-oo, +oo[ itv_intersection. Proof. by case=> [[lb lr |] [ub ur |]]. Qed. Lemma itv_intersectionii : idempotent itv_intersection. -Proof. by case=> [[[] lr |] [[] ur |]] //=; rewrite !lerr. Qed. +Proof. by case=> [[[] lr |] [[] ur |]] //=; rewrite !lexx. Qed. Definition subitv (i1 i2 : interval R) := match i1, i2 with @@ -558,7 +556,7 @@ Lemma le_boundl_total : total (@le_boundl R). Proof. by move=> [[] l |] [[] r |] //=; case: (ltrgtP l r). Qed. Lemma le_boundr_total : total (@le_boundr R). -Proof. by move=> [[] l |] [[] r |] //=; case (ltrgtP l r). Qed. +Proof. by move=> [[] l |] [[] r |] //=; case: (ltrgtP l r). Qed. Lemma itv_splitU (xc : R) bc a b : xc \in Interval a b -> forall y, y \in Interval a b = @@ -626,7 +624,7 @@ Variable R : realFieldType. Lemma mid_in_itv : forall ba bb (xa xb : R), xa <= xb ?< if ba || bb -> mid xa xb \in Interval (BOpen_if ba xa) (BOpen_if bb xb). Proof. -by move=> [] [] xa xb /= ?; apply/itv_dec=> /=; rewrite ?midf_lte // ?ltrW. +by move=> [] [] xa xb /= ?; apply/itv_dec=> /=; rewrite ?midf_lte // ?ltW. Qed. Lemma mid_in_itvoo : forall (xa xb : R), xa < xb -> mid xa xb \in `]xa, xb[. diff --git a/mathcomp/algebra/rat.v b/mathcomp/algebra/rat.v index 228a824..4ef050f 100644 --- a/mathcomp/algebra/rat.v +++ b/mathcomp/algebra/rat.v @@ -1,7 +1,8 @@ (* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq choice. -From mathcomp Require Import fintype bigop ssralg countalg div ssrnum ssrint. +From mathcomp Require Import fintype bigop order ssralg countalg div ssrnum. +From mathcomp Require Import ssrint. (******************************************************************************) (* This file defines a datatype for rational numbers and equips it with a *) @@ -18,8 +19,7 @@ From mathcomp Require Import fintype bigop ssralg countalg div ssrnum ssrint. (* ratr x == generic embedding of (r : R) into an arbitrary unitring. *) (******************************************************************************) -Import GRing.Theory. -Import Num.Theory. +Import Order.Theory GRing.Theory Num.Theory. Set Implicit Arguments. Unset Strict Implicit. @@ -51,16 +51,16 @@ Canonical rat_subCountType := [subCountType of rat]. Definition numq x := nosimpl ((valq x).1). Definition denq x := nosimpl ((valq x).2). -Lemma denq_gt0 x : 0 < denq x. +Lemma denq_gt0 x : 0 < denq x. Proof. by rewrite /denq; case: x=> [[a b] /= /andP []]. Qed. Hint Resolve denq_gt0 : core. -Definition denq_ge0 x := ltrW (denq_gt0 x). +Definition denq_ge0 x := ltW (denq_gt0 x). -Lemma denq_lt0 x : (denq x < 0) = false. Proof. by rewrite ltr_gtF. Qed. +Lemma denq_lt0 x : (denq x < 0) = false. Proof. by rewrite lt_gtF. Qed. Lemma denq_neq0 x : denq x != 0. -Proof. by rewrite /denq gtr_eqF ?denq_gt0. Qed. +Proof. by rewrite /denq gt_eqF ?denq_gt0. Qed. Hint Resolve denq_neq0 : core. Lemma denq_eq0 x : (denq x == 0) = false. @@ -99,7 +99,7 @@ Fact valqK x : fracq (valq x) = x. Proof. move: x => [[n d] /= Pnd]; apply: val_inj=> /=. move: Pnd; rewrite /coprime /fracq /= => /andP[] hd -/eqP hnd. -by rewrite ltr_gtF ?gtr_eqF //= hnd !divn1 mulz_sign_abs abszE gtr0_norm. +by rewrite lt_gtF ?gt_eqF //= hnd !divn1 mulz_sign_abs abszE gtr0_norm. Qed. Fact scalq_key : unit. Proof. by []. Qed. @@ -343,7 +343,7 @@ Canonical rat_comUnitRing := Eval hnf in [comUnitRingType of rat]. Fact rat_field_axiom : GRing.Field.mixin_of rat_unitRing. Proof. exact. Qed. Definition RatFieldIdomainMixin := (FieldIdomainMixin rat_field_axiom). -Canonical rat_iDomain := +Canonical rat_idomainType := Eval hnf in IdomainType rat (FieldIdomainMixin rat_field_axiom). Canonical rat_fieldType := FieldType rat rat_field_axiom. @@ -396,13 +396,13 @@ Lemma rat1 : 1%:Q = 1. Proof. by []. Qed. Lemma numqN x : numq (- x) = - numq x. Proof. rewrite /numq; case: x=> [[a b] /= /andP [hb]]; rewrite /coprime=> /eqP hab. -by rewrite ltr_gtF ?gtr_eqF // {2}abszN hab divn1 mulz_sign_abs. +by rewrite lt_gtF ?gt_eqF // {2}abszN hab divn1 mulz_sign_abs. Qed. Lemma denqN x : denq (- x) = denq x. Proof. rewrite /denq; case: x=> [[a b] /= /andP [hb]]; rewrite /coprime=> /eqP hab. -by rewrite gtr_eqF // abszN hab divn1 gtz0_abs. +by rewrite gt_eqF // abszN hab divn1 gtz0_abs. Qed. (* Will be subsumed by pnatr_eq0 *) @@ -502,7 +502,7 @@ Proof. rewrite !ge_rat0 => hnx hny. have hxy: (0 <= numq x * denq y + numq y * denq x). by rewrite addr_ge0 ?mulr_ge0. -by rewrite /numq /= -!/(denq _) ?mulf_eq0 ?denq_eq0 !ler_gtF ?mulr_ge0. +by rewrite /numq /= -!/(denq _) ?mulf_eq0 ?denq_eq0 !le_gtF ?mulr_ge0. Qed. Fact le_rat0M x y : le_rat 0 x -> le_rat 0 y -> le_rat 0 (x * y). @@ -510,12 +510,12 @@ Proof. rewrite !ge_rat0 => hnx hny. have hxy: (0 <= numq x * denq y + numq y * denq x). by rewrite addr_ge0 ?mulr_ge0. -by rewrite /numq /= -!/(denq _) ?mulf_eq0 ?denq_eq0 !ler_gtF ?mulr_ge0. +by rewrite /numq /= -!/(denq _) ?mulf_eq0 ?denq_eq0 !le_gtF ?mulr_ge0. Qed. Fact le_rat0_anti x : le_rat 0 x -> le_rat x 0 -> x = 0. Proof. -by move=> hx hy; apply/eqP; rewrite -numq_eq0 eqr_le -ge_rat0 -le_rat0 hx hy. +by move=> hx hy; apply/eqP; rewrite -numq_eq0 eq_le -ge_rat0 -le_rat0 hx hy. Qed. Lemma sgr_numq_div (n d : int) : sgr (numq (n%:Q / d%:Q)) = sgr n * sgr d. @@ -530,12 +530,12 @@ Proof. symmetry; rewrite ge_rat0 /le_rat -subr_ge0. case: ratP => nx dx cndx; case: ratP => ny dy cndy. rewrite -!mulNr addf_div ?intq_eq0 // !mulNr -!rmorphM -rmorphB /=. -symmetry; rewrite !lerNgt -sgr_cp0 sgr_numq_div mulrC gtr0_sg //. +symmetry; rewrite !leNgt -sgr_cp0 sgr_numq_div mulrC gtr0_sg //. by rewrite mul1r sgr_cp0. Qed. Fact le_rat_total : total le_rat. -Proof. by move=> x y; apply: ler_total. Qed. +Proof. by move=> x y; apply: le_total. Qed. Fact numq_sign_mul (b : bool) x : numq ((-1) ^+ b * x) = (-1) ^+ b * numq x. Proof. by case: b; rewrite ?(mul1r, mulN1r) // numqN. Qed. @@ -566,14 +566,19 @@ by rewrite /normq /= normr_num_div ?ger0_norm // divq_num_den. Qed. Fact lt_rat_def x y : (lt_rat x y) = (y != x) && (le_rat x y). -Proof. by rewrite /lt_rat ltr_def rat_eq. Qed. +Proof. by rewrite /lt_rat lt_def rat_eq. Qed. -Definition ratLeMixin := RealLeMixin le_rat0D le_rat0M le_rat0_anti - subq_ge0 (@le_rat_total 0) norm_ratN ge_rat0_norm lt_rat_def. +Definition ratLeMixin : realLeMixin rat_idomainType := + RealLeMixin le_rat0D le_rat0M le_rat0_anti subq_ge0 + (@le_rat_total 0) norm_ratN ge_rat0_norm lt_rat_def. +Canonical rat_porderType := POrderType ring_display rat ratLeMixin. +Canonical rat_latticeType := LatticeType rat ratLeMixin. +Canonical rat_orderType := OrderType rat le_rat_total. Canonical rat_numDomainType := NumDomainType rat ratLeMixin. +Canonical rat_normedDomainType := NormedDomainType rat rat ratLeMixin. Canonical rat_numFieldType := [numFieldType of rat]. -Canonical rat_realDomainType := RealDomainType rat (@le_rat_total 0). +Canonical rat_realDomainType := [realDomainType of rat]. Canonical rat_realFieldType := [realFieldType of rat]. Lemma numq_ge0 x : (0 <= numq x) = (0 <= x). @@ -585,10 +590,10 @@ Lemma numq_le0 x : (numq x <= 0) = (x <= 0). Proof. by rewrite -oppr_ge0 -numqN numq_ge0 oppr_ge0. Qed. Lemma numq_gt0 x : (0 < numq x) = (0 < x). -Proof. by rewrite !ltrNge numq_le0. Qed. +Proof. by rewrite !ltNge numq_le0. Qed. Lemma numq_lt0 x : (numq x < 0) = (x < 0). -Proof. by rewrite !ltrNge numq_ge0. Qed. +Proof. by rewrite !ltNge numq_ge0. Qed. Lemma sgr_numq x : sgz (numq x) = sgz x. Proof. @@ -605,7 +610,7 @@ Proof. by rewrite normrEsign denq_mulr_sign. Qed. Fact rat_archimedean : Num.archimedean_axiom [numDomainType of rat]. Proof. move=> x; exists `|numq x|.+1; rewrite mulrS ltr_spaddl //. -rewrite pmulrn abszE intr_norm numqE normrM ler_pemulr ?norm_ge0 //. +rewrite pmulrn abszE intr_norm numqE normrM ler_pemulr //. by rewrite -intr_norm ler1n absz_gt0 denq_eq0. Qed. @@ -758,7 +763,7 @@ by rewrite ![_ / _ * _]mulrAC !ler_pdivr_mulr ?ltr0z // -!rmorphM /= !ler_int. Qed. Lemma ltr_rat : {mono (@ratr F) : x y / x < y}. -Proof. exact: lerW_mono ler_rat. Qed. +Proof. exact: leW_mono ler_rat. Qed. Lemma ler0q x : (0 <= ratr F x) = (0 <= x). Proof. by rewrite (_ : 0 = ratr F 0) ?ler_rat ?rmorph0. Qed. @@ -777,8 +782,7 @@ Proof. by rewrite !sgr_def fmorph_eq0 ltrq0 rmorphMn rmorph_sign. Qed. Lemma ratr_norm x : ratr F `|x| = `|ratr F x|. Proof. -rewrite {2}[x]numEsign rmorphMsign normrMsign [`|ratr F _|]ger0_norm //. -by rewrite ler0q ?normr_ge0. +by rewrite {2}[x]numEsign rmorphMsign normrMsign [`|ratr F _|]ger0_norm ?ler0q. Qed. End InPrealField. diff --git a/mathcomp/algebra/ssralg.v b/mathcomp/algebra/ssralg.v index 4b1d85c..83cc853 100644 --- a/mathcomp/algebra/ssralg.v +++ b/mathcomp/algebra/ssralg.v @@ -1700,7 +1700,7 @@ Definition clone c of phant_id class c := @Pack phR T c. Let xT := let: Pack T _ := cT in T. Notation xclass := (class : class_of xT). -Definition pack T b0 mul0 (axT : @axiom R (@Lmodule.Pack R _ T b0) mul0) := +Definition pack b0 mul0 (axT : @axiom R (@Lmodule.Pack R _ T b0) mul0) := fun bT b & phant_id (Ring.class bT) (b : Ring.class_of T) => fun mT m & phant_id (@Lmodule.class R phR mT) (@Lmodule.Class R T b m) => fun ax & phant_id axT ax => diff --git a/mathcomp/algebra/ssrint.v b/mathcomp/algebra/ssrint.v index 2a17a4a..cbd6fa1 100644 --- a/mathcomp/algebra/ssrint.v +++ b/mathcomp/algebra/ssrint.v @@ -1,7 +1,8 @@ (* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat choice seq. -From mathcomp Require Import fintype finfun bigop ssralg countalg ssrnum poly. +From mathcomp Require Import fintype finfun bigop order ssralg countalg ssrnum. +From mathcomp Require Import poly. (******************************************************************************) (* This file develops a basic theory of signed integers, defining: *) @@ -39,7 +40,7 @@ Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. -Import GRing.Theory Num.Theory. +Import Order.Theory GRing.Theory Num.Theory. Delimit Scope int_scope with Z. Local Open Scope int_scope. @@ -351,7 +352,7 @@ End intUnitRing. Canonical int_unitRingType := Eval hnf in UnitRingType int intUnitRing.comMixin. Canonical int_comUnitRing := Eval hnf in [comUnitRingType of int]. -Canonical int_iDomain := +Canonical int_idomainType := Eval hnf in IdomainType int intUnitRing.idomain_axiomz. Canonical int_countZmodType := [countZmodType of int]. @@ -390,26 +391,14 @@ Definition ltz m n := | Negz m', Negz n' => (n' < m')%N end. -Fact lez_norm_add x y : lez (normz (x + y)) (normz x + normz y). -Proof. -move: x y=> [] m [] n; rewrite /= ?addnS //=; -rewrite /GRing.add /GRing.Zmodule.add /=; case: ltnP=> //=; -rewrite ?addSn ?ltnS ?leq_subLR ?(addnS, addSn) ?(leq_trans _ (leqnSn _)) //; -by rewrite 1?addnCA ?leq_addr ?addnA ?leq_addl. -Qed. - -Fact ltz_add x y : ltz 0 x -> ltz 0 y -> ltz 0 (x + y). -Proof. by move: x y => [] x [] y //= hx hy; rewrite ltn_addr. Qed. - -Fact eq0_normz x : normz x = 0 -> x = 0. Proof. by case: x. Qed. +Fact lez_add m n : lez 0 m -> lez 0 n -> lez 0 (m + n). +Proof. by case: m n => [] m [] n. Qed. -Fact lez_total x y : lez x y || lez y x. -Proof. by move: x y => [] x [] y //=; apply: leq_total. Qed. +Fact lez_mul m n : lez 0 m -> lez 0 n -> lez 0 (m * n). +Proof. by case: m n => [] m [] n. Qed. -Lemma abszN (n : nat) : absz (- n%:Z) = n. Proof. by case: n. Qed. - -Fact normzM : {morph (fun n => normz n) : x y / x * y}. -Proof. by move=> [] x [] y; rewrite // abszN // mulnC. Qed. +Fact lez_anti m : lez 0 m -> lez m 0 -> m = 0. +Proof. by case: m; first case. Qed. Lemma subz_ge0 m n : lez 0 (n - m) = lez m n. Proof. @@ -420,23 +409,33 @@ by [ rewrite subzn // move: hmn; rewrite -subn_gt0; case: (_ - _)%N]. Qed. -Fact lez_def x y : (lez x y) = (normz (y - x) == y - x). -Proof. by rewrite -subz_ge0; move: (_ - _) => [] n //=; rewrite eqxx. Qed. +Fact lez_total m n : lez m n || lez n m. +Proof. by move: m n => [] m [] n //=; apply: leq_total. Qed. + +Fact normzN m : normz (- m) = normz m. +Proof. by case: m => // -[]. Qed. + +Fact gez0_norm m : lez 0 m -> normz m = m. +Proof. by case: m. Qed. -Fact ltz_def x y : (ltz x y) = (y != x) && (lez x y). +Fact ltz_def m n : (ltz m n) = (n != m) && (lez m n). Proof. -by move: x y=> [] x [] y //=; rewrite (ltn_neqAle, leq_eqVlt) // eq_sym. +by move: m n => [] m [] n //=; rewrite (ltn_neqAle, leq_eqVlt) // eq_sym. Qed. -Definition Mixin := - NumMixin lez_norm_add ltz_add eq0_normz (in2W lez_total) normzM - lez_def ltz_def. +Definition Mixin : realLeMixin int_idomainType := + RealLeMixin + lez_add lez_mul lez_anti subz_ge0 (lez_total 0) normzN gez0_norm ltz_def. End intOrdered. End intOrdered. +Canonical int_porderType := POrderType ring_display int intOrdered.Mixin. +Canonical int_latticeType := LatticeType int intOrdered.Mixin. +Canonical int_orderType := OrderType int intOrdered.lez_total. Canonical int_numDomainType := NumDomainType int intOrdered.Mixin. -Canonical int_realDomainType := RealDomainType int (intOrdered.lez_total 0). +Canonical int_normedDomainType := NormedDomainType int int intOrdered.Mixin. +Canonical int_realDomainType := [realDomainType of int]. Section intOrderedTheory. @@ -448,7 +447,7 @@ Lemma lez_nat m n : (m <= n :> int) = (m <= n)%N. Proof. by []. Qed. Lemma ltz_nat m n : (m < n :> int) = (m < n)%N. -Proof. by rewrite ltnNge ltrNge lez_nat. Qed. +Proof. by rewrite ltnNge ltNge lez_nat. Qed. Definition ltez_nat := (lez_nat, ltz_nat). @@ -805,7 +804,7 @@ Lemma ler_pmulz2r n (hn : 0 < n) : {mono *~%R^~ n :x y / x <= y :> R}. Proof. by move=> x y; case: n hn=> [[]|] // n _; rewrite ler_pmuln2r. Qed. Lemma ltr_pmulz2r n (hn : 0 < n) : {mono *~%R^~ n : x y / x < y :> R}. -Proof. exact: lerW_mono (ler_pmulz2r _). Qed. +Proof. exact: leW_mono (ler_pmulz2r _). Qed. Lemma ler_nmulz2r n (hn : n < 0) : {mono *~%R^~ n : x y /~ x <= y :> R}. Proof. @@ -814,7 +813,7 @@ by rewrite ler_pmulz2r (oppr_cp0, ler_opp2). Qed. Lemma ltr_nmulz2r n (hn : n < 0) : {mono *~%R^~ n : x y /~ x < y :> R}. -Proof. exact: lerW_nmono (ler_nmulz2r _). Qed. +Proof. exact: leW_nmono (ler_nmulz2r _). Qed. Lemma ler_wpmulz2r n (hn : 0 <= n) : {homo *~%R^~ n : x y / x <= y :> R}. Proof. by move=> x y xy; case: n hn=> [] // n _; rewrite ler_wmuln2r. Qed. @@ -883,10 +882,10 @@ by move=> m n /= hmn; rewrite -subr_gt0 -mulrzBr nmulrz_lgt0 // subr_lt0. Qed. Lemma ltr_pmulz2l x (hx : 0 < x) : {mono *~%R x : x y / x < y}. -Proof. exact: lerW_mono (ler_pmulz2l _). Qed. +Proof. exact: leW_mono (ler_pmulz2l _). Qed. Lemma ltr_nmulz2l x (hx : x < 0) : {mono *~%R x : x y /~ x < y}. -Proof. exact: lerW_nmono (ler_nmulz2l _). Qed. +Proof. exact: leW_nmono (ler_nmulz2l _). Qed. Lemma pmulrz_rgt0 x n (x0 : 0 < x) : 0 < x *~ n = (0 < n). Proof. by rewrite -(mulr0z x) ltr_pmulz2l. Qed. @@ -915,7 +914,7 @@ Proof. by rewrite -(mulr0z x) ler_nmulz2l. Qed. Lemma mulrIz x (hx : x != 0) : injective ( *~%R x). Proof. move=> y z; rewrite -![x *~ _]mulrzr => /(mulfI hx). -by apply: incr_inj y z; apply: ler_pmulz2l. +by apply: inc_inj y z; apply: ler_pmulz2l. Qed. Lemma ler_int m n : (m%:~R <= n%:~R :> R) = (m <= n). @@ -961,7 +960,7 @@ Lemma mulrz_neq0 x n : x *~ n != 0 = ((n != 0) && (x != 0)). Proof. by rewrite mulrz_eq0 negb_or. Qed. Lemma realz n : (n%:~R : R) \in Num.real. -Proof. by rewrite -topredE /Num.real /= ler0z lerz0 ler_total. Qed. +Proof. by rewrite -topredE /Num.real /= ler0z lerz0 le_total. Qed. Hint Resolve realz : core. Definition intr_inj := @mulrIz 1 (oner_neq0 R). @@ -1070,7 +1069,7 @@ Qed. Lemma exprzDr x (ux : x \is a GRing.unit) m n : x ^ (m + n) = x ^ m * x ^ n. Proof. -move: n m; apply: wlog_ler=> n m hnm. +move: n m; apply: wlog_le=> n m hnm. by rewrite addrC hnm commrXz //; apply: commr_sym; apply: commrXz. case: (intP m) hnm=> {m} [|m|m]; rewrite ?mul1r ?add0r //; case: (intP n)=> {n} [|n|n _]; rewrite ?mulr1 ?addr0 //; @@ -1244,17 +1243,17 @@ Fact ler_wneexpz2l x (x1 : 1 <= x) : {in <= 0 &, {homo (exprz x) : x y / x <= y}}. Proof. move=> m n hm hn /= hmn. -rewrite -lef_pinv -?topredE /= ?exprz_gt0 ?(ltr_le_trans ltr01) //. +rewrite -lef_pinv -?topredE /= ?exprz_gt0 ?(lt_le_trans ltr01) //. by rewrite !invr_expz ler_wpeexpz2l ?ler_opp2 -?topredE //= oppr_cp0. Qed. Lemma ler_weexpz2l x (x1 : 1 <= x) : {homo (exprz x) : x y / x <= y}. Proof. -move=> m n /= hmn; case: (lerP 0 m)=> [|/ltrW] hm. - by rewrite ler_wpeexpz2l // [_ \in _](ler_trans hm). -case: (lerP n 0)=> [|/ltrW] hn. - by rewrite ler_wneexpz2l // [_ \in _](ler_trans hmn). -apply: (@ler_trans _ (x ^ 0)); first by rewrite ler_wneexpz2l. +move=> m n /= hmn; case: (lerP 0 m)=> [|/ltW] hm. + by rewrite ler_wpeexpz2l // [_ \in _](le_trans hm). +case: (lerP n 0)=> [|/ltW] hn. + by rewrite ler_wneexpz2l // [_ \in _](le_trans hmn). +apply: (@le_trans _ _ (x ^ 0)); first by rewrite ler_wneexpz2l. by rewrite ler_wpeexpz2l. Qed. @@ -1266,45 +1265,45 @@ Qed. Lemma ieexprIz x (x0 : 0 < x) (nx1 : x != 1) : injective (exprz x). Proof. -apply: wlog_ltr=> // m n hmn; first by move=> hmn'; rewrite hmn. +apply: wlog_lt=> // m n hmn; first by move=> hmn'; rewrite hmn. move=> /(f_equal ( *%R^~ (x ^ (- n)))). -rewrite -!expfzDr ?gtr_eqF // subrr expr0z=> /eqP. -by rewrite pexprz_eq1 ?(ltrW x0) // (negPf nx1) subr_eq0 orbF=> /eqP. +rewrite -!expfzDr ?gt_eqF // subrr expr0z=> /eqP. +by rewrite pexprz_eq1 ?(ltW x0) // (negPf nx1) subr_eq0 orbF=> /eqP. Qed. Lemma ler_piexpz2l x (x0 : 0 < x) (x1 : x < 1) : {in >= 0 &, {mono (exprz x) : x y /~ x <= y}}. Proof. -apply: (ler_nmono_in (inj_nhomo_ltr_in _ _)). - by move=> n m hn hm /=; apply: ieexprIz; rewrite // ltr_eqF. -by apply: ler_wpiexpz2l; rewrite ?ltrW. +apply: (le_nmono_in (inj_nhomo_lt_in _ _)). + by move=> n m hn hm /=; apply: ieexprIz; rewrite // lt_eqF. +by apply: ler_wpiexpz2l; rewrite ?ltW. Qed. Lemma ltr_piexpz2l x (x0 : 0 < x) (x1 : x < 1) : {in >= 0 &, {mono (exprz x) : x y /~ x < y}}. -Proof. exact: (lerW_nmono_in (ler_piexpz2l _ _)). Qed. +Proof. exact: (leW_nmono_in (ler_piexpz2l _ _)). Qed. Lemma ler_niexpz2l x (x0 : 0 < x) (x1 : x < 1) : {in < 0 &, {mono (exprz x) : x y /~ x <= y}}. Proof. -apply: (ler_nmono_in (inj_nhomo_ltr_in _ _)). - by move=> n m hn hm /=; apply: ieexprIz; rewrite // ltr_eqF. -by apply: ler_wniexpz2l; rewrite ?ltrW. +apply: (le_nmono_in (inj_nhomo_lt_in _ _)). + by move=> n m hn hm /=; apply: ieexprIz; rewrite // lt_eqF. +by apply: ler_wniexpz2l; rewrite ?ltW. Qed. Lemma ltr_niexpz2l x (x0 : 0 < x) (x1 : x < 1) : {in < 0 &, {mono (exprz x) : x y /~ x < y}}. -Proof. exact: (lerW_nmono_in (ler_niexpz2l _ _)). Qed. +Proof. exact: (leW_nmono_in (ler_niexpz2l _ _)). Qed. Lemma ler_eexpz2l x (x1 : 1 < x) : {mono (exprz x) : x y / x <= y}. Proof. -apply: (ler_mono (inj_homo_ltr _ _)). - by apply: ieexprIz; rewrite ?(ltr_trans ltr01) // gtr_eqF. -by apply: ler_weexpz2l; rewrite ?ltrW. +apply: (le_mono (inj_homo_lt _ _)). + by apply: ieexprIz; rewrite ?(lt_trans ltr01) // gt_eqF. +by apply: ler_weexpz2l; rewrite ?ltW. Qed. Lemma ltr_eexpz2l x (x1 : 1 < x) : {mono (exprz x) : x y / x < y}. -Proof. exact: (lerW_mono (ler_eexpz2l _)). Qed. +Proof. exact: (leW_mono (ler_eexpz2l _)). Qed. Lemma ler_wpexpz2r n (hn : 0 <= n) : {in >= 0 & , {homo ((@exprz R)^~ n) : x y / x <= y}}. @@ -1314,7 +1313,7 @@ Lemma ler_wnexpz2r n (hn : n <= 0) : {in > 0 & , {homo ((@exprz R)^~ n) : x y /~ x <= y}}. Proof. move=> x y /= hx hy hxy; rewrite -lef_pinv ?[_ \in _]exprz_gt0 //. -by rewrite !invr_expz ler_wpexpz2r ?[_ \in _]ltrW // oppr_cp0. +by rewrite !invr_expz ler_wpexpz2r ?[_ \in _]ltW // oppr_cp0. Qed. Lemma pexpIrz n (n0 : n != 0) : {in >= 0 &, injective ((@exprz R)^~ n)}. @@ -1324,46 +1323,46 @@ move=> x y; rewrite ![_ \in _]le0r=> /orP [/eqP-> _ /eqP|hx]. case/orP=> [/eqP-> /eqP|hy]. by rewrite exp0rz ?(negPf n0) expfz_eq0=> /andP [_ /eqP]. move=> /(f_equal ( *%R^~ (y ^ (- n)))) /eqP. -rewrite -expfzDr ?(gtr_eqF hy) // subrr expr0z -exprz_inv -expfzMl. -rewrite pexprz_eq1 ?(negPf n0) /= ?mulr_ge0 ?invr_ge0 ?ltrW //. -by rewrite (can2_eq (mulrVK _) (mulrK _)) ?unitfE ?(gtr_eqF hy) // mul1r=> /eqP. +rewrite -expfzDr ?(gt_eqF hy) // subrr expr0z -exprz_inv -expfzMl. +rewrite pexprz_eq1 ?(negPf n0) /= ?mulr_ge0 ?invr_ge0 ?ltW //. +by rewrite (can2_eq (mulrVK _) (mulrK _)) ?unitfE ?(gt_eqF hy) // mul1r=> /eqP. Qed. Lemma nexpIrz n (n0 : n != 0) : {in <= 0 &, injective ((@exprz R)^~ n)}. Proof. -move=> x y; rewrite ![_ \in _]ler_eqVlt => /orP [/eqP -> _ /eqP|hx]. +move=> x y; rewrite ![_ \in _]le_eqVlt => /orP [/eqP -> _ /eqP|hx]. by rewrite exp0rz ?(negPf n0) eq_sym expfz_eq0=> /andP [_ /eqP->]. case/orP=> [/eqP -> /eqP|hy]. by rewrite exp0rz ?(negPf n0) expfz_eq0=> /andP [_ /eqP]. move=> /(f_equal ( *%R^~ (y ^ (- n)))) /eqP. -rewrite -expfzDr ?(ltr_eqF hy) // subrr expr0z -exprz_inv -expfzMl. -rewrite pexprz_eq1 ?(negPf n0) /= ?mulr_le0 ?invr_le0 ?ltrW //. -by rewrite (can2_eq (mulrVK _) (mulrK _)) ?unitfE ?(ltr_eqF hy) // mul1r=> /eqP. +rewrite -expfzDr ?(lt_eqF hy) // subrr expr0z -exprz_inv -expfzMl. +rewrite pexprz_eq1 ?(negPf n0) /= ?mulr_le0 ?invr_le0 ?ltW //. +by rewrite (can2_eq (mulrVK _) (mulrK _)) ?unitfE ?(lt_eqF hy) // mul1r=> /eqP. Qed. Lemma ler_pexpz2r n (hn : 0 < n) : {in >= 0 & , {mono ((@exprz R)^~ n) : x y / x <= y}}. Proof. -apply: ler_mono_in (inj_homo_ltr_in _ _). - by move=> x y hx hy /=; apply: pexpIrz; rewrite // gtr_eqF. -by apply: ler_wpexpz2r; rewrite ltrW. +apply: le_mono_in (inj_homo_lt_in _ _). + by move=> x y hx hy /=; apply: pexpIrz; rewrite // gt_eqF. +by apply: ler_wpexpz2r; rewrite ltW. Qed. Lemma ltr_pexpz2r n (hn : 0 < n) : {in >= 0 & , {mono ((@exprz R)^~ n) : x y / x < y}}. -Proof. exact: lerW_mono_in (ler_pexpz2r _). Qed. +Proof. exact: leW_mono_in (ler_pexpz2r _). Qed. Lemma ler_nexpz2r n (hn : n < 0) : {in > 0 & , {mono ((@exprz R)^~ n) : x y /~ x <= y}}. Proof. -apply: ler_nmono_in (inj_nhomo_ltr_in _ _); last first. - by apply: ler_wnexpz2r; rewrite ltrW. -by move=> x y hx hy /=; apply: pexpIrz; rewrite ?[_ \in _]ltrW ?ltr_eqF. +apply: le_nmono_in (inj_nhomo_lt_in _ _); last first. + by apply: ler_wnexpz2r; rewrite ltW. +by move=> x y hx hy /=; apply: pexpIrz; rewrite ?[_ \in _]ltW ?lt_eqF. Qed. Lemma ltr_nexpz2r n (hn : n < 0) : {in > 0 & , {mono ((@exprz R)^~ n) : x y /~ x < y}}. -Proof. exact: lerW_nmono_in (ler_nexpz2r _). Qed. +Proof. exact: leW_nmono_in (ler_nexpz2r _). Qed. Lemma eqr_expz2 n x y : n != 0 -> 0 <= x -> 0 <= y -> (x ^ n == y ^ n) = (x == y). @@ -1388,10 +1387,10 @@ Proof. by rewrite /sgz; case: (_ == _); case: (_ < _). Qed. Lemma sgrEz x : sgr x = (sgz x)%:~R. Proof. by rewrite !(fun_if intr). Qed. Lemma gtr0_sgz x : 0 < x -> sgz x = 1. -Proof. by move=> x_gt0; rewrite /sgz ltr_neqAle andbC eqr_le ltr_geF //. Qed. +Proof. by move=> x_gt0; rewrite /sgz lt_neqAle andbC eq_le lt_geF. Qed. Lemma ltr0_sgz x : x < 0 -> sgz x = -1. -Proof. by move=> x_lt0; rewrite /sgz eq_sym eqr_le x_lt0 ltr_geF. Qed. +Proof. by move=> x_lt0; rewrite /sgz eq_sym eq_le x_lt0 lt_geF. Qed. Lemma sgz0 : sgz (0 : R) = 0. Proof. by rewrite /sgz eqxx. Qed. Lemma sgz1 : sgz (1 : R) = 1. Proof. by rewrite gtr0_sgz // ltr01. Qed. @@ -1459,7 +1458,7 @@ Lemma sgzP x : (sgz x == 0) (sgz x == -1) (sgz x == 1) `|x| (sgr x) (sgz x). Proof. rewrite ![_ == sgz _]eq_sym ![_ == sgr _]eq_sym !sgr_cp0 !sgz_cp0. -by rewrite /sgr /sgz !lerNgt; case: ltrgt0P; constructor. +by rewrite /sgr /sgz !leNgt; case: ltrgt0P; constructor. Qed. Lemma sgzN x : sgz (- x) = - sgz x. @@ -1661,14 +1660,14 @@ Lemma leqif_add_distz m1 m2 m3 : `|m1 - m3| <= `|m1 - m2| + `|m2 - m3| ?= iff (m1 <= m2 <= m3)%R || (m3 <= m2 <= m1)%R. Proof. -apply/leqifP; rewrite -ltz_nat -eqz_nat PoszD !abszE; apply/lerifP. +apply/leqifP; rewrite -ltz_nat -eqz_nat PoszD !abszE; apply/leifP. wlog le_m31 : m1 m3 / (m3 <= m1)%R. - move=> IH; case/orP: (ler_total m1 m3) => /IH //. + move=> IH; case/orP: (le_total m1 m3) => /IH //. by rewrite (addrC `|_|)%R orbC !(distrC m1) !(distrC m3). rewrite ger0_norm ?subr_ge0 // orb_idl => [|/andP[le_m12 le_m23]]; last first. - by have /eqP->: m2 == m3; rewrite ?lerr // eqr_le le_m23 (ler_trans le_m31). -rewrite -{1}(subrK m2 m1) -addrA -subr_ge0 andbC -subr_ge0. -by apply: lerif_add; apply/real_lerif_norm/num_real. + by have /eqP->: m2 == m3; rewrite ?lexx // eq_le le_m23 (le_trans le_m31). +rewrite -{1}(subrK m2 m1) -addrA -subr_ge0 andbC -[X in X && _]subr_ge0. +by apply: leif_add; apply/real_leif_norm/num_real. Qed. Lemma leqif_add_dist n1 n2 n3 : @@ -1692,7 +1691,7 @@ Section NormInt. Variable R : numDomainType. -Lemma intr_norm m : `|m|%:~R = `|m%:~R| :> R. +Lemma intr_norm m : `|m|%:~R = `|m%:~R : R|. Proof. by rewrite {2}[m]intEsign rmorphMsign normrMsign abszE normr_nat. Qed. Lemma normrMz m (x : R) : `|x *~ m| = `|x| *~ `|m|. diff --git a/mathcomp/algebra/ssrnum.v b/mathcomp/algebra/ssrnum.v index 7244b13..5f47084 100644 --- a/mathcomp/algebra/ssrnum.v +++ b/mathcomp/algebra/ssrnum.v @@ -5,91 +5,93 @@ From mathcomp Require Import div fintype path bigop order finset fingroup. From mathcomp Require Import ssralg poly. (******************************************************************************) -(* *) (* This file defines some classes to manipulate number structures, i.e *) -(* structures with an order and a norm *) +(* structures with an order and a norm. *) (* *) -(* * NumDomain (Integral domain with an order and a norm) *) -(* NumMixin == the mixin that provides an order and a norm over *) -(* a ring and their characteristic properties. *) +(* * NumDomain (Integral domain with an order and a norm) *) (* numDomainType == interface for a num integral domain. *) -(* NumDomainType T m *) -(* == packs the num mixin into a numberDomainType. The *) -(* carrier T must have a integral domain structure. *) -(* [numDomainType of T for S ] *) -(* == T-clone of the numDomainType structure S. *) -(* [numDomainType of T] *) -(* == clone of a canonical numDomainType structure on T. *) +(* NumDomainType T m *) +(* == packs the num mixin into a numDomainType. The carrier *) +(* T must have an integral domain and a partial order *) +(* structures. *) +(* [numDomainType of T for S] *) +(* == T-clone of the numDomainType structure S. *) +(* [numDomainType of T] *) +(* == clone of a canonical numDomainType structure on T. *) +(* *) +(* * NormedDomain (Integral domain with a norm) *) +(* normedDomainType R *) +(* == interface for a normed domain structure indexed by *) +(* numDomainType R. *) +(* NormedDomainType R T m *) +(* == pack the normed domain mixin into a normedDomainType. *) +(* The carrier T must have an integral domain structure. *) +(* [normedDomainType R of T for S] *) +(* == T-clone of the normedDomainType R structure S. *) +(* [normedDomainType R of T] *) +(* == clone of a canonical normedDomainType R structure on T.*) (* *) (* * NumField (Field with an order and a norm) *) -(* numFieldType == interface for a num field. *) -(* [numFieldType of T] *) -(* == clone of a canonical numFieldType structure on T *) +(* numFieldType == interface for a num field. *) +(* [numFieldType of T] *) +(* == clone of a canonical numFieldType structure on T. *) (* *) -(* * NumClosedField (Closed Field with an order and a norm) *) -(* numClosedFieldType *) -(* == interface for a num closed field. *) -(* [numClosedFieldType of T] *) -(* == clone of a canonical numClosedFieldType structure on T *) +(* * NumClosedField (Partially ordered Closed Field with conjugation) *) +(* numClosedFieldType *) +(* == interface for a closed field with conj. *) +(* NumClosedFieldType T r *) +(* == packs the real closed axiom r into a *) +(* numClosedFieldType. The carrier T must have a closed *) +(* field type structure. *) +(* [numClosedFieldType of T] *) +(* == clone of a canonical numClosedFieldType structure on T.*) +(* [numClosedFieldType of T for S] *) +(* == T-clone of the numClosedFieldType structure S. *) (* *) -(* * RealDomain (Num domain where all elements are positive or negative) *) +(* * RealDomain (Num domain where all elements are positive or negative) *) (* realDomainType == interface for a real integral domain. *) -(* RealDomainType T r *) -(* == packs the real axiom r into a realDomainType. The *) -(* carrier T must have a num domain structure. *) -(* [realDomainType of T for S ] *) -(* == T-clone of the realDomainType structure S. *) -(* [realDomainType of T] *) +(* [realDomainType of T] *) (* == clone of a canonical realDomainType structure on T. *) (* *) (* * RealField (Num Field where all elements are positive or negative) *) (* realFieldType == interface for a real field. *) -(* [realFieldType of T] *) -(* == clone of a canonical realFieldType structure on T *) +(* [realFieldType of T] *) +(* == clone of a canonical realFieldType structure on T. *) (* *) (* * ArchiField (A Real Field with the archimedean axiom) *) -(* archiFieldType == interface for an archimedean field. *) +(* archiFieldType == interface for an archimedean field. *) (* ArchiFieldType T r *) (* == packs the archimeadean axiom r into an archiFieldType. *) -(* The carrier T must have a real field type structure. *) -(* [archiFieldType of T for S ] *) -(* == T-clone of the archiFieldType structure S. *) -(* [archiFieldType of T] *) -(* == clone of a canonical archiFieldType structure on T *) +(* The carrier T must have a real field type structure. *) +(* [archiFieldType of T for S] *) +(* == T-clone of the archiFieldType structure S. *) +(* [archiFieldType of T] *) +(* == clone of a canonical archiFieldType structure on T. *) (* *) (* * RealClosedField (Real Field with the real closed axiom) *) -(* rcfType == interface for a real closed field. *) -(* RcfType T r == packs the real closed axiom r into a *) -(* rcfType. The carrier T must have a real *) -(* field type structure. *) -(* [rcfType of T] == clone of a canonical realClosedFieldType structure on *) +(* rcfType == interface for a real closed field. *) +(* RcfType T r == packs the real closed axiom r into a rcfType. *) +(* The carrier T must have a real field type structure. *) +(* [rcfType of T] == clone of a canonical realClosedFieldType structure on *) (* T. *) -(* [rcfType of T for S ] *) -(* == T-clone of the realClosedFieldType structure S. *) +(* [rcfType of T for S] *) +(* == T-clone of the realClosedFieldType structure S. *) (* *) -(* * NumClosedField (Partially ordered Closed Field with conjugation) *) -(* numClosedFieldType == interface for a closed field with conj. *) -(* NumClosedFieldType T r == packs the real closed axiom r into a *) -(* numClosedFieldType. The carrier T must have a closed *) -(* field type structure. *) -(* [numClosedFieldType of T] == clone of a canonical numClosedFieldType *) -(* structure on T *) -(* [numClosedFieldType of T for S ] *) -(* == T-clone of the realClosedFieldType structure S. *) +(* The ordering symbols and notations (<, <=, >, >=, _ <= _ ?= iff _, >=<, *) +(* and ><) and lattice operations (meet and join) defined in order.v are *) +(* redefined for the ring_display in the ring_scope (%R). 0-ary ordering *) +(* symbols for the ring_display have the suffix "%R", e.g., <%R. All the *) +(* other ordering notations are the same as order.v. The meet and join *) +(* operators for the ring_display are Num.min and Num.max. *) (* *) (* Over these structures, we have the following operations *) -(* `|x| == norm of x. *) -(* x <= y <=> x is less than or equal to y (:= '|y - x| == y - x). *) -(* x < y <=> x is less than y (:= (x <= y) && (x != y)). *) -(* x <= y ?= iff C <-> x is less than y, or equal iff C is true. *) -(* Num.sg x == sign of x: equal to 0 iff x = 0, to 1 iff x > 0, and *) -(* to -1 in all other cases (including x < 0). *) +(* `|x| == norm of x. *) +(* Num.sg x == sign of x: equal to 0 iff x = 0, to 1 iff x > 0, and *) +(* to -1 in all other cases (including x < 0). *) (* x \is a Num.pos <=> x is positive (:= x > 0). *) (* x \is a Num.neg <=> x is negative (:= x < 0). *) (* x \is a Num.nneg <=> x is positive or 0 (:= x >= 0). *) (* x \is a Num.real <=> x is real (:= x >= 0 or x < 0). *) -(* Num.min x y == minimum of x y *) -(* Num.max x y == maximum of x y *) (* Num.bound x == in archimedean fields, and upper bound for x, i.e., *) (* and n such that `|x| < n%:R. *) (* Num.sqrt x == in a real-closed field, a positive square root of x if *) @@ -107,17 +109,6 @@ From mathcomp Require Import ssralg poly. (* an thus not equal to -1 for n odd > 1 (this will be shown in *) (* file cyclotomic.v). *) (* *) -(* There are now three distinct uses of the symbols <, <=, > and >=: *) -(* 0-ary, unary (prefix) and binary (infix). *) -(* 0. <%R, <=%R, >%R, >=%R stand respectively for lt, le, gt and ge. *) -(* 1. (< x), (<= x), (> x), (>= x) stand respectively for *) -(* (gt x), (ge x), (lt x), (le x). *) -(* So (< x) is a predicate characterizing elements smaller than x. *) -(* 2. (x < y), (x <= y), ... mean what they are expected to. *) -(* These convention are compatible with haskell's, *) -(* where ((< y) x) = (x < y) = ((<) x y), *) -(* except that we write <%R instead of (<). *) -(* *) (* - list of prefixes : *) (* p : positive *) (* n : negative *) @@ -126,24 +117,15 @@ From mathcomp Require Import ssralg poly. (* i : interior = in [0, 1] or ]0, 1[ *) (* e : exterior = in [1, +oo[ or ]1; +oo[ *) (* w : non strict (weak) monotony *) -(* *) -(* [arg minr_(i < i0 | P) M] == a value i : T minimizing M : R, subject *) -(* to the condition P (i may appear in P and M), and *) -(* provided P holds for i0. *) -(* [arg maxr_(i > i0 | P) M] == a value i maximizing M subject to P and *) -(* provided P holds for i0. *) -(* [arg minr_(i < i0 in A) M] == an i \in A minimizing M if i0 \in A. *) -(* [arg maxr_(i > i0 in A) M] == an i \in A maximizing M if i0 \in A. *) -(* [arg minr_(i < i0) M] == an i : T minimizing M, given i0 : T. *) -(* [arg maxr_(i > i0) M] == an i : T maximizing M, given i0 : T. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. +Local Open Scope order_scope. Local Open Scope ring_scope. -Import GRing.Theory. +Import Order.Theory Order.Def Order.Syntax GRing.Theory. Reserved Notation "<= y" (at level 35). Reserved Notation ">= y" (at level 35). @@ -154,61 +136,29 @@ Reserved Notation ">= y :> T" (at level 35, y at next level). Reserved Notation "< y :> T" (at level 35, y at next level). Reserved Notation "> y :> T" (at level 35, y at next level). -(* this structures should be shared and overloaded *) -(* by every notion of norm or abslute value *) -Module Norm. - -Section ClassDef. -Variable (R : Type). - -Definition class_of T := T -> R. -Structure type := Pack {sort; _ : class_of sort}. -Local Coercion sort : type >-> Sortclass. -Variables (T : Type) (cT : type). -Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. -Let xT := let: Pack T _ := cT in T. -Notation xclass := (class : class_of xT). -Definition clone c of phant_id class c := @Pack T c. -Definition pack m := @Pack T m. - -End ClassDef. - -Module Exports. -Coercion sort : type >-> Sortclass. -Bind Scope ring_scope with sort. -Notation normedType := type. -Notation NormedType R T m := (@pack R T m). -Notation "[ 'normedType' R 'of' T 'for' cT ]" := (@clone R T cT _ idfun) - (at level 0, format "[ 'normedType' R 'of' T 'for' cT ]") : form_scope. -Notation "[ 'normedType' R 'of' T ]" := (@clone R T _ _ id) - (at level 0, format "[ 'normedType' R 'of' T ]") : form_scope. -End Exports. - -End Norm. -Import Norm.Exports. - -Definition norm (R : Type) (T : normedType R) : T -> R := @Norm.class R T. -Notation "`| x |" := (norm x) : ring_scope. - -Import Order.Theory Order.Def Order.Syntax. -Local Open Scope order_scope. -Local Open Scope ring_scope. - Fact ring_display : unit. Proof. exact: tt. Qed. Module Num. -Record mixin_of (R : ringType) (Rorder : Order.POrder.mixin_of R) - (le_op := Order.POrder.le Rorder) - (lt_op := Order.POrder.lt Rorder) (norm_op : R -> R) - := Mixin { +Record normed_mixin_of (R T : ringType) (Rorder : porderMixin R) + (le_op := Order.POrder.le Rorder) (lt_op := Order.POrder.lt Rorder) + := NormedMixin { + norm_op : T -> R; _ : forall x y, le_op (norm_op (x + y)) (norm_op x + norm_op y); - _ : forall x y, lt_op 0 x -> lt_op 0 y -> lt_op 0 (x + y); _ : forall x, norm_op x = 0 -> x = 0; + _ : forall x n, norm_op (x *+ n) = norm_op x *+ n; + _ : forall x, norm_op (- x) = norm_op x; +}. + +Record mixin_of (R : ringType) (Rorder : porderMixin R) + (le_op := Order.POrder.le Rorder) (lt_op := Order.POrder.lt Rorder) + (normed : @normed_mixin_of R R Rorder) (norm_op := norm_op normed) + := Mixin { + _ : forall x y, lt_op 0 x -> lt_op 0 y -> lt_op 0 (x + y); _ : forall x y, le_op 0 x -> le_op 0 y -> le_op x y || le_op y x; _ : {morph norm_op : x y / x * y}; _ : forall x y, (le_op x y) = (norm_op (y - x) == y - x); - _ : forall x y, (lt_op x y) = (y != x) && (le_op x y)}. +}. Local Notation ring_for T b := (@GRing.Ring.Pack T b). @@ -217,15 +167,14 @@ Module NumDomain. Section ClassDef. Record class_of T := Class { base : GRing.IntegralDomain.class_of T; - order_mixin : Order.POrder.mixin_of (ring_for T base); - norm_base : Norm.class_of T T; - mixin : mixin_of order_mixin norm_base + order_mixin : porderMixin (ring_for T base); + normed_mixin : normed_mixin_of (ring_for T base) order_mixin; + mixin : mixin_of normed_mixin; }. Local Coercion base : class_of >-> GRing.IntegralDomain.class_of. Local Coercion order_base T (class_of_T : class_of T) := @Order.POrder.Class _ class_of_T (order_mixin class_of_T). -Local Coercion norm_base : class_of >-> Norm.class_of. Structure type := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. @@ -234,8 +183,15 @@ Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Let xT := let: Pack T _ := cT in T. Notation xclass := (class : class_of xT). Definition clone c of phant_id class c := @Pack T c. -(* TODO Kazuhiko: this is broken, rewrite the pack please *) -Definition pack c := @Pack T c. +Definition pack (b0 : GRing.IntegralDomain.class_of _) om0 + (nm0 : @normed_mixin_of (ring_for T b0) (ring_for T b0) om0) + (m0 : @mixin_of (ring_for T b0) om0 nm0) := + fun bT (b : GRing.IntegralDomain.class_of T) + & phant_id (@GRing.IntegralDomain.class bT) b => + fun om & phant_id om0 om => + fun nm & phant_id nm0 nm => + fun m & phant_id m0 m => + @Pack T (@Class T b om nm m). Definition eqType := @Equality.Pack cT xclass. Definition choiceType := @Choice.Pack cT xclass. @@ -246,21 +202,21 @@ Definition unitRingType := @GRing.UnitRing.Pack cT xclass. Definition comUnitRingType := @GRing.ComUnitRing.Pack cT xclass. Definition idomainType := @GRing.IntegralDomain.Pack cT xclass. Definition porderType := @Order.POrder.Pack ring_display cT xclass. -Definition normedType := @Norm.Pack cT cT xclass. - -Definition order_zmodType := - @GRing.Zmodule.Pack (Order.POrder.sort porderType) xclass. -Definition order_ringType := - @GRing.Ring.Pack (Order.POrder.sort porderType) xclass. -(* 9 more missing *) +Definition porder_zmodType := @GRing.Zmodule.Pack porderType xclass. +Definition porder_ringType := @GRing.Ring.Pack porderType xclass. +Definition porder_comRingType := @GRing.ComRing.Pack porderType xclass. +Definition porder_unitRingType := @GRing.UnitRing.Pack porderType xclass. +Definition porder_comUnitRingType := @GRing.ComUnitRing.Pack porderType xclass. +Definition porder_idomainType := @GRing.IntegralDomain.Pack porderType xclass. End ClassDef. + Module Exports. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. -Coercion order_base : class_of >-> Order.POrder.class_of. Coercion base : class_of >-> GRing.IntegralDomain.class_of. -Coercion norm_base : class_of >-> Norm.class_of. +Coercion order_base : class_of >-> Order.POrder.class_of. +Coercion normed_mixin : class_of >-> normed_mixin_of. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. @@ -279,31 +235,162 @@ Coercion idomainType : type >-> GRing.IntegralDomain.type. Canonical idomainType. Coercion porderType : type >-> Order.POrder.type. Canonical porderType. -Coercion normedType : type >-> Norm.type. -Canonical normedType. -Canonical order_zmodType. -Canonical order_ringType. -(* 9 more missing *) +Canonical porder_zmodType. +Canonical porder_ringType. +Canonical porder_comRingType. +Canonical porder_unitRingType. +Canonical porder_comUnitRingType. +Canonical porder_idomainType. Notation numDomainType := type. -Notation NumDomainType T m := (@pack T m). +Notation NumDomainType T m := (@pack T _ _ _ m _ _ id _ id _ id _ id). Notation "[ 'numDomainType' 'of' T 'for' cT ]" := (@clone T cT _ idfun) (at level 0, format "[ 'numDomainType' 'of' T 'for' cT ]") : form_scope. Notation "[ 'numDomainType' 'of' T ]" := (@clone T _ _ id) (at level 0, format "[ 'numDomainType' 'of' T ]") : form_scope. End Exports. + End NumDomain. Import NumDomain.Exports. -About NumDomain.order_zmodType. -Print Canonical Projections. +Local Notation num_for T b := (@NumDomain.Pack T b). + +Module NormedDomain. + +Section ClassDef. + +Variable R : numDomainType. + +Record class_of (T : Type) := Class { + base : GRing.IntegralDomain.class_of T; + mixin : @normed_mixin_of R (ring_for T base) (NumDomain.class R); +}. + +Local Coercion base : class_of >-> GRing.IntegralDomain.class_of. +Local Coercion mixin : class_of >-> normed_mixin_of. + +Structure type (phR : phant R) := + Pack { sort; _ : class_of sort }. +Local Coercion sort : type >-> Sortclass. + +Variables (phR : phant R) (T : Type) (cT : type phR). + +Definition class := let: Pack _ c := cT return class_of cT in c. +Definition clone c of phant_id class c := @Pack phR T c. +Let xT := let: Pack T _ := cT in T. +Notation xclass := (class : class_of xT). +Definition pack b0 (m0 : @normed_mixin_of R (@GRing.IntegralDomain.Pack T b0) + (NumDomain.class R)) := + Pack phR (@Class T b0 m0). + +Definition eqType := @Equality.Pack cT xclass. +Definition choiceType := @Choice.Pack cT xclass. +Definition zmodType := @GRing.Zmodule.Pack cT xclass. +Definition ringType := @GRing.Ring.Pack cT xclass. +Definition comRingType := @GRing.ComRing.Pack cT xclass. +Definition unitRingType := @GRing.UnitRing.Pack cT xclass. +Definition comUnitRingType := @GRing.ComUnitRing.Pack cT xclass. +Definition idomainType := @GRing.IntegralDomain.Pack cT xclass. + +End ClassDef. + +Definition numDomain_normedDomainType (R : numDomainType) : type (Phant R) := + Pack (Phant R) (@Class R _ _ (NumDomain.normed_mixin (NumDomain.class R))). + +Module Exports. +Coercion base : class_of >-> GRing.IntegralDomain.class_of. +Coercion mixin : class_of >-> normed_mixin_of. +Coercion sort : type >-> Sortclass. +Coercion eqType : type >-> Equality.type. +Canonical eqType. +Coercion choiceType : type >-> Choice.type. +Canonical choiceType. +Coercion zmodType : type >-> GRing.Zmodule.type. +Canonical zmodType. +Coercion ringType : type >-> GRing.Ring.type. +Canonical ringType. +Coercion comRingType : type >-> GRing.ComRing.type. +Canonical comRingType. +Coercion unitRingType : type >-> GRing.UnitRing.type. +Canonical unitRingType. +Coercion comUnitRingType : type >-> GRing.ComUnitRing.type. +Canonical comUnitRingType. +Coercion idomainType : type >-> GRing.IntegralDomain.type. +Canonical idomainType. +Coercion numDomain_normedDomainType : numDomainType >-> type. +Canonical numDomain_normedDomainType. +Notation normedDomainType R := (type (Phant R)). +Notation NormedDomainType R T m := (@pack _ (Phant R) T _ m). +Notation NormedDomainMixin := Mixin. +Notation "[ 'normedDomainType' R 'of' T 'for' cT ]" := + (@clone _ (Phant R) T cT _ idfun) + (at level 0, format "[ 'normedDomainType' R 'of' T 'for' cT ]") : + form_scope. +Notation "[ 'normedDomainType' R 'of' T ]" := (@clone _ (Phant R) T _ _ id) + (at level 0, format "[ 'normedDomainType' R 'of' T ]") : form_scope. +End Exports. + +End NormedDomain. +Import NormedDomain.Exports. -Module Import Def. Section Def. +Module NumDomain_joins. Import NumDomain. +Section NumDomain_joins. + +Variables (T : Type) (cT : type). + +Let xT := let: Pack T _ := cT in T. +Notation xclass := (class cT : class_of xT). + +Notation ringType := (ringType cT). +Notation normedDomainType := (NormedDomain.numDomain_normedDomainType cT). + +Definition normedDomain_porderType := + @Order.POrder.Pack ring_display normedDomainType xclass. + +End NumDomain_joins. + +Module Exports. +Canonical normedDomain_porderType. +End Exports. +End NumDomain_joins. +Export NumDomain_joins.Exports. + +Module Import Def. + +Definition normr (R : numDomainType) (T : normedDomainType R) : T -> R := + nosimpl (norm_op (NormedDomain.class T)). +Arguments normr {R T} x. + +Notation ler := (@le ring_display _) (only parsing). +Notation "@ 'ler' R" := + (@le ring_display R) (at level 10, R at level 8, only parsing). +Notation ltr := (@lt ring_display _) (only parsing). +Notation "@ 'ltr' R" := + (@lt ring_display R) (at level 10, R at level 8, only parsing). +Notation ger := (@ge ring_display _) (only parsing). +Notation "@ 'ger' R" := + (@ge ring_display R) (at level 10, R at level 8, only parsing). +Notation gtr := (@gt ring_display _) (only parsing). +Notation "@ 'gtr' R" := + (@gt ring_display R) (at level 10, R at level 8, only parsing). +Notation lerif := (@leif ring_display _) (only parsing). +Notation "@ 'lerif' R" := + (@lerif ring_display R) (at level 10, R at level 8, only parsing). +Notation comparabler := (@comparable ring_display _) (only parsing). +Notation "@ 'comparabler' R" := + (@comparable ring_display R) (at level 10, R at level 8, only parsing). +Notation maxr := (@join ring_display _). +Notation "@ 'maxr' R" := + (@join ring_display R) (at level 10, R at level 8, only parsing). +Notation minr := (@meet ring_display _). +Notation "@ 'minr' R" := + (@meet ring_display R) (at level 10, R at level 8, only parsing). + +Section Def. Context {R : numDomainType}. -Implicit Types (x y : R) (C : bool). +Implicit Types (x : R). Definition sgr x : R := if x == 0 then 0 else if x < 0 then -1 else 1. - Definition Rpos : qualifier 0 R := [qualify x : R | 0 < x]. Definition Rneg : qualifier 0 R := [qualify x : R | x < 0]. Definition Rnneg : qualifier 0 R := [qualify x : R | 0 <= x]. @@ -312,7 +399,16 @@ Definition Rreal : qualifier 0 R := [qualify x : R | (0 <= x) || (x <= 0)]. End Def. End Def. (* Shorter qualified names, when Num.Def is not imported. *) +Notation norm := normr (only parsing). +Notation le := ler (only parsing). +Notation lt := ltr (only parsing). +Notation ge := ger (only parsing). +Notation gt := gtr (only parsing). +Notation leif := lerif (only parsing). +Notation comparable := comparabler (only parsing). Notation sg := sgr. +Notation max := maxr. +Notation min := minr. Notation pos := Rpos. Notation neg := Rneg. Notation nneg := Rnneg. @@ -328,19 +424,69 @@ Fact Rnneg_key : pred_key (@nneg R). Proof. by []. Qed. Definition Rnneg_keyed := KeyedQualifier Rnneg_key. Fact Rreal_key : pred_key (@real R). Proof. by []. Qed. Definition Rreal_keyed := KeyedQualifier Rreal_key. -(* Decide whether this should stay: *) -(* Definition ler_of_leif x y C (le_xy : @lerif R x y C) := le_xy.1 : le x y. *) End Keys. End Keys. (* (Exported) symbolic syntax. *) Module Import Syntax. Import Def Keys. +Notation "`| x |" := (norm x) : ring_scope. + +Notation "<=%R" := le : ring_scope. +Notation ">=%R" := ge : ring_scope. +Notation "<%R" := lt : ring_scope. +Notation ">%R" := gt : ring_scope. +Notation "=<%R" := comparable : ring_scope. +Notation "><%R" := (fun x y => ~~ (comparable x y)) : ring_scope. + +Notation "<= y" := (ge y) : ring_scope. +Notation "<= y :> T" := (<= (y : T)) : ring_scope. +Notation ">= y" := (le y) : ring_scope. +Notation ">= y :> T" := (>= (y : T)) : ring_scope. + +Notation "< y" := (gt y) : ring_scope. +Notation "< y :> T" := (< (y : T)) : ring_scope. +Notation "> y" := (lt y) : ring_scope. +Notation "> y :> T" := (> (y : T)) : ring_scope. + +Notation ">=< y" := (comparable y) : ring_scope. +Notation ">=< y :> T" := (>=< (y : T)) : ring_scope. + +Notation "x <= y" := (le x y) : ring_scope. +Notation "x <= y :> T" := ((x : T) <= (y : T)) : ring_scope. +Notation "x >= y" := (y <= x) (only parsing) : ring_scope. +Notation "x >= y :> T" := ((x : T) >= (y : T)) (only parsing) : ring_scope. + +Notation "x < y" := (lt x y) : ring_scope. +Notation "x < y :> T" := ((x : T) < (y : T)) : ring_scope. +Notation "x > y" := (y < x) (only parsing) : ring_scope. +Notation "x > y :> T" := ((x : T) > (y : T)) (only parsing) : ring_scope. + +Notation "x <= y <= z" := ((x <= y) && (y <= z)) : ring_scope. +Notation "x < y <= z" := ((x < y) && (y <= z)) : ring_scope. +Notation "x <= y < z" := ((x <= y) && (y < z)) : ring_scope. +Notation "x < y < z" := ((x < y) && (y < z)) : ring_scope. + +Notation "x <= y ?= 'iff' C" := (lerif x y C) : ring_scope. +Notation "x <= y ?= 'iff' C :> R" := ((x : R) <= (y : R) ?= iff C) + (only parsing) : ring_scope. + +Notation ">=< x" := (comparable x) : ring_scope. +Notation ">=< x :> T" := (>=< (x : T)) (only parsing) : ring_scope. +Notation "x >=< y" := (comparable x y) : ring_scope. + +Notation ">< x" := (fun y => ~~ (comparable x y)) : ring_scope. +Notation ">< x :> T" := (>< (x : T)) (only parsing) : ring_scope. +Notation "x >< y" := (~~ (comparable x y)) : ring_scope. + Canonical Rpos_keyed. Canonical Rneg_keyed. Canonical Rnneg_keyed. Canonical Rreal_keyed. +Export Order.POCoercions. + End Syntax. Section ExtensionAxioms. @@ -357,18 +503,18 @@ Definition real_closed_axiom : Prop := End ExtensionAxioms. -Local Notation num_for T b := (@NumDomain.Pack T b). - (* The rest of the numbers interface hierarchy. *) Module NumField. Section ClassDef. -Record class_of R := - Class { base : GRing.Field.class_of R; mixin : mixin_of (ring_for R base) }. -Definition base2 R (c : class_of R) := NumDomain.Class (mixin c). -Local Coercion base : class_of >-> GRing.Field.class_of. -Local Coercion base2 : class_of >-> NumDomain.class_of. +Record class_of R := Class { + base : NumDomain.class_of R; + mixin : GRing.Field.mixin_of (num_for R base); +}. +Local Coercion base : class_of >-> NumDomain.class_of. +Local Coercion base2 R (c : class_of R) : GRing.Field.class_of _ := + GRing.Field.Class (@mixin _ c). Structure type := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. @@ -376,10 +522,9 @@ Variables (T : Type) (cT : type). Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Let xT := let: Pack T _ := cT in T. Notation xclass := (class : class_of xT). - Definition pack := - fun bT b & phant_id (GRing.Field.class bT) (b : GRing.Field.class_of T) => - fun mT m & phant_id (NumDomain.class mT) (@NumDomain.Class T b m) => + fun bT b & phant_id (NumDomain.class bT) (b : NumDomain.class_of T) => + fun mT m & phant_id (GRing.Field.mixin (GRing.Field.class mT)) m => Pack (@Class T b m). Definition eqType := @Equality.Pack cT xclass. @@ -390,15 +535,19 @@ Definition comRingType := @GRing.ComRing.Pack cT xclass. Definition unitRingType := @GRing.UnitRing.Pack cT xclass. Definition comUnitRingType := @GRing.ComUnitRing.Pack cT xclass. Definition idomainType := @GRing.IntegralDomain.Pack cT xclass. +Definition porderType := @Order.POrder.Pack ring_display cT xclass. Definition numDomainType := @NumDomain.Pack cT xclass. Definition fieldType := @GRing.Field.Pack cT xclass. -Definition join_numDomainType := @NumDomain.Pack fieldType xclass. +Definition normedDomainType := NormedDomainType numDomainType cT xclass. +Definition porder_fieldType := @GRing.Field.Pack porderType xclass. +Definition normedDomain_fieldType := @GRing.Field.Pack normedDomainType xclass. +Definition numDomain_fieldType := @GRing.Field.Pack numDomainType xclass. End ClassDef. Module Exports. -Coercion base : class_of >-> GRing.Field.class_of. -Coercion base2 : class_of >-> NumDomain.class_of. +Coercion base : class_of >-> NumDomain.class_of. +Coercion base2 : class_of >-> GRing.Field.class_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. @@ -417,10 +566,17 @@ Coercion comUnitRingType : type >-> GRing.ComUnitRing.type. Canonical comUnitRingType. Coercion idomainType : type >-> GRing.IntegralDomain.type. Canonical idomainType. +Coercion porderType : type >-> Order.POrder.type. +Canonical porderType. Coercion numDomainType : type >-> NumDomain.type. Canonical numDomainType. Coercion fieldType : type >-> GRing.Field.type. Canonical fieldType. +Coercion normedDomainType : type >-> NormedDomain.type. +Canonical normedDomainType. +Canonical porder_fieldType. +Canonical normedDomain_fieldType. +Canonical numDomain_fieldType. Notation numFieldType := type. Notation "[ 'numFieldType' 'of' T ]" := (@pack T _ _ id _ _ id) (at level 0, format "[ 'numFieldType' 'of' T ]") : form_scope. @@ -441,13 +597,16 @@ Record imaginary_mixin_of (R : numDomainType) := ImaginaryMixin { }. Record class_of R := Class { - base : GRing.ClosedField.class_of R; - mixin : mixin_of (ring_for R base); - conj_mixin : imaginary_mixin_of (num_for R (NumDomain.Class mixin)) + base : NumField.class_of R; + decField_mixin : GRing.DecidableField.mixin_of (num_for R base); + closedField_axiom : GRing.ClosedField.axiom (num_for R base); + conj_mixin : imaginary_mixin_of (num_for R base); }. -Definition base2 R (c : class_of R) := NumField.Class (mixin c). -Local Coercion base : class_of >-> GRing.ClosedField.class_of. -Local Coercion base2 : class_of >-> NumField.class_of. +Local Coercion base : class_of >-> NumField.class_of. +Local Coercion base2 R (c : class_of R) : GRing.ClosedField.class_of R := + @GRing.ClosedField.Class + R (@GRing.DecidableField.Class R (base c) (@decField_mixin _ c)) + (@closedField_axiom _ c). Structure type := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. @@ -455,13 +614,14 @@ Variables (T : Type) (cT : type). Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Let xT := let: Pack T _ := cT in T. Notation xclass := (class : class_of xT). - -Definition pack := - fun bT b & phant_id (GRing.ClosedField.class bT) - (b : GRing.ClosedField.class_of T) => - fun mT m & phant_id (NumField.class mT) (@NumField.Class T b m) => - fun mc => Pack (@Class T b m mc). Definition clone := fun b & phant_id class (b : class_of T) => Pack b. +Definition pack := + fun bT b & phant_id (NumField.class bT) (b : NumField.class_of T) => + fun mT dec closed + & phant_id (GRing.ClosedField.class mT) + (@GRing.ClosedField.Class + _ (@GRing.DecidableField.Class _ b dec) closed) => + fun mc => Pack (@Class T b dec closed mc). Definition eqType := @Equality.Pack cT xclass. Definition choiceType := @Choice.Pack cT xclass. @@ -471,21 +631,33 @@ Definition comRingType := @GRing.ComRing.Pack cT xclass. Definition unitRingType := @GRing.UnitRing.Pack cT xclass. Definition comUnitRingType := @GRing.ComUnitRing.Pack cT xclass. Definition idomainType := @GRing.IntegralDomain.Pack cT xclass. +Definition porderType := @Order.POrder.Pack ring_display cT xclass. Definition numDomainType := @NumDomain.Pack cT xclass. Definition fieldType := @GRing.Field.Pack cT xclass. Definition numFieldType := @NumField.Pack cT xclass. Definition decFieldType := @GRing.DecidableField.Pack cT xclass. Definition closedFieldType := @GRing.ClosedField.Pack cT xclass. -Definition join_dec_numDomainType := @NumDomain.Pack decFieldType xclass. -Definition join_dec_numFieldType := @NumField.Pack decFieldType xclass. -Definition join_numDomainType := @NumDomain.Pack closedFieldType xclass. -Definition join_numFieldType := @NumField.Pack closedFieldType xclass. +Definition normedDomainType := NormedDomainType numDomainType cT xclass. +Definition porder_decFieldType := @GRing.DecidableField.Pack porderType xclass. +Definition normedDomain_decFieldType := + @GRing.DecidableField.Pack normedDomainType xclass. +Definition numDomain_decFieldType := + @GRing.DecidableField.Pack numDomainType xclass. +Definition numField_decFieldType := + @GRing.DecidableField.Pack numFieldType xclass. +Definition porder_closedFieldType := @GRing.ClosedField.Pack porderType xclass. +Definition normedDomain_closedFieldType := + @GRing.ClosedField.Pack normedDomainType xclass. +Definition numDomain_closedFieldType := + @GRing.ClosedField.Pack numDomainType xclass. +Definition numField_closedFieldType := + @GRing.ClosedField.Pack numFieldType xclass. End ClassDef. Module Exports. -Coercion base : class_of >-> GRing.ClosedField.class_of. -Coercion base2 : class_of >-> NumField.class_of. +Coercion base : class_of >-> NumField.class_of. +Coercion base2 : class_of >-> GRing.ClosedField.class_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. @@ -504,6 +676,8 @@ Coercion comUnitRingType : type >-> GRing.ComUnitRing.type. Canonical comUnitRingType. Coercion idomainType : type >-> GRing.IntegralDomain.type. Canonical idomainType. +Coercion porderType : type >-> Order.POrder.type. +Canonical porderType. Coercion numDomainType : type >-> NumDomain.type. Canonical numDomainType. Coercion fieldType : type >-> GRing.Field.type. @@ -514,12 +688,18 @@ Coercion numFieldType : type >-> NumField.type. Canonical numFieldType. Coercion closedFieldType : type >-> GRing.ClosedField.type. Canonical closedFieldType. -Canonical join_dec_numDomainType. -Canonical join_dec_numFieldType. -Canonical join_numDomainType. -Canonical join_numFieldType. +Coercion normedDomainType : type >-> NormedDomain.type. +Canonical normedDomainType. +Canonical porder_decFieldType. +Canonical normedDomain_decFieldType. +Canonical numDomain_decFieldType. +Canonical numField_decFieldType. +Canonical porder_closedFieldType. +Canonical normedDomain_closedFieldType. +Canonical numDomain_closedFieldType. +Canonical numField_closedFieldType. Notation numClosedFieldType := type. -Notation NumClosedFieldType T m := (@pack T _ _ id _ _ id m). +Notation NumClosedFieldType T m := (@pack T _ _ id _ _ _ id m). Notation "[ 'numClosedFieldType' 'of' T 'for' cT ]" := (@clone T cT _ id) (at level 0, format "[ 'numClosedFieldType' 'of' T 'for' cT ]") : form_scope. @@ -534,9 +714,17 @@ Module RealDomain. Section ClassDef. -Record class_of R := - Class {base : NumDomain.class_of R; _ : @real_axiom (num_for R base)}. +Record class_of R := Class { + base : NumDomain.class_of R; + lmixin_disp : unit; + lmixin : Order.Lattice.mixin_of (Order.POrder.Pack lmixin_disp base); + tmixin_disp : unit; + tmixin : Order.Total.mixin_of + (Order.Lattice.Pack tmixin_disp (Order.Lattice.Class lmixin)); +}. Local Coercion base : class_of >-> NumDomain.class_of. +Local Coercion base2 T (c : class_of T) : Order.Total.class_of T := + @Order.Total.Class _ (Order.Lattice.Class (@lmixin _ c)) _ (@tmixin _ c). Structure type := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. @@ -544,11 +732,13 @@ Variables (T : Type) (cT : type). Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Let xT := let: Pack T _ := cT in T. Notation xclass := (class : class_of xT). - -Definition clone c of phant_id class c := @Pack T c. -Definition pack b0 (m0 : real_axiom (num_for T b0)) := - fun bT b & phant_id (NumDomain.class bT) b => - fun m & phant_id m0 m => Pack (@Class T b m). +Definition pack := + fun bT b & phant_id (NumDomain.class bT) (b : NumDomain.class_of T) => + fun mT ldisp l mdisp m & + phant_id (@Order.Total.class ring_display mT) + (@Order.Total.Class + T (@Order.Lattice.Class T b ldisp l) mdisp m) => + Pack (@Class T b ldisp l mdisp m). Definition eqType := @Equality.Pack cT xclass. Definition choiceType := @Choice.Pack cT xclass. @@ -558,12 +748,45 @@ Definition comRingType := @GRing.ComRing.Pack cT xclass. Definition unitRingType := @GRing.UnitRing.Pack cT xclass. Definition comUnitRingType := @GRing.ComUnitRing.Pack cT xclass. Definition idomainType := @GRing.IntegralDomain.Pack cT xclass. +Definition porderType := @Order.POrder.Pack ring_display cT xclass. +Definition latticeType := @Order.Lattice.Pack ring_display cT xclass. +Definition orderType := @Order.Total.Pack ring_display cT xclass. Definition numDomainType := @NumDomain.Pack cT xclass. +Definition normedDomainType := NormedDomainType numDomainType cT xclass. +Definition zmod_latticeType := @Order.Lattice.Pack ring_display zmodType xclass. +Definition ring_latticeType := @Order.Lattice.Pack ring_display ringType xclass. +Definition comRing_latticeType := + @Order.Lattice.Pack ring_display comRingType xclass. +Definition unitRing_latticeType := + @Order.Lattice.Pack ring_display unitRingType xclass. +Definition comUnitRing_latticeType := + @Order.Lattice.Pack ring_display comUnitRingType xclass. +Definition idomain_latticeType := + @Order.Lattice.Pack ring_display idomainType xclass. +Definition normedDomain_latticeType := + @Order.Lattice.Pack ring_display normedDomainType xclass. +Definition numDomain_latticeType := + @Order.Lattice.Pack ring_display numDomainType xclass. +Definition zmod_orderType := @Order.Total.Pack ring_display zmodType xclass. +Definition ring_orderType := @Order.Total.Pack ring_display ringType xclass. +Definition comRing_orderType := + @Order.Total.Pack ring_display comRingType xclass. +Definition unitRing_orderType := + @Order.Total.Pack ring_display unitRingType xclass. +Definition comUnitRing_orderType := + @Order.Total.Pack ring_display comUnitRingType xclass. +Definition idomain_orderType := + @Order.Total.Pack ring_display idomainType xclass. +Definition normedDomain_orderType := + @Order.Total.Pack ring_display normedDomainType xclass. +Definition numDomain_orderType := + @Order.Total.Pack ring_display numDomainType xclass. End ClassDef. Module Exports. Coercion base : class_of >-> NumDomain.class_of. +Coercion base2 : class_of >-> Order.Total.class_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. @@ -582,13 +805,34 @@ Coercion comUnitRingType : type >-> GRing.ComUnitRing.type. Canonical comUnitRingType. Coercion idomainType : type >-> GRing.IntegralDomain.type. Canonical idomainType. +Coercion porderType : type >-> Order.POrder.type. +Canonical porderType. Coercion numDomainType : type >-> NumDomain.type. Canonical numDomainType. +Coercion latticeType : type >-> Order.Lattice.type. +Canonical latticeType. +Coercion orderType : type >-> Order.Total.type. +Canonical orderType. +Coercion normedDomainType : type >-> NormedDomain.type. +Canonical normedDomainType. +Canonical zmod_latticeType. +Canonical ring_latticeType. +Canonical comRing_latticeType. +Canonical unitRing_latticeType. +Canonical comUnitRing_latticeType. +Canonical idomain_latticeType. +Canonical normedDomain_latticeType. +Canonical numDomain_latticeType. +Canonical zmod_orderType. +Canonical ring_orderType. +Canonical comRing_orderType. +Canonical unitRing_orderType. +Canonical comUnitRing_orderType. +Canonical idomain_orderType. +Canonical normedDomain_orderType. +Canonical numDomain_orderType. Notation realDomainType := type. -Notation RealDomainType T m := (@pack T _ m _ _ id _ id). -Notation "[ 'realDomainType' 'of' T 'for' cT ]" := (@clone T cT _ idfun) - (at level 0, format "[ 'realDomainType' 'of' T 'for' cT ]") : form_scope. -Notation "[ 'realDomainType' 'of' T ]" := (@clone T _ _ id) +Notation "[ 'realDomainType' 'of' T ]" := (@pack T _ _ id _ _ _ _ _ id) (at level 0, format "[ 'realDomainType' 'of' T ]") : form_scope. End Exports. @@ -599,11 +843,17 @@ Module RealField. Section ClassDef. -Record class_of R := - Class { base : NumField.class_of R; mixin : real_axiom (num_for R base) }. -Definition base2 R (c : class_of R) := RealDomain.Class (@mixin R c). +Record class_of R := Class { + base : NumField.class_of R; + lmixin_disp : unit; + lmixin : Order.Lattice.mixin_of (@Order.POrder.Pack lmixin_disp R base); + tmixin_disp : unit; + tmixin : Order.Total.mixin_of + (Order.Lattice.Pack tmixin_disp (Order.Lattice.Class lmixin)); +}. Local Coercion base : class_of >-> NumField.class_of. -Local Coercion base2 : class_of >-> RealDomain.class_of. +Local Coercion base2 R (c : class_of R) : RealDomain.class_of R := + RealDomain.Class (@tmixin R c). Structure type := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. @@ -611,11 +861,11 @@ Variables (T : Type) (cT : type). Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Let xT := let: Pack T _ := cT in T. Notation xclass := (class : class_of xT). - Definition pack := - fun bT b & phant_id (NumField.class bT) (b : NumField.class_of T) => - fun mT m & phant_id (RealDomain.class mT) (@RealDomain.Class T b m) => - Pack (@Class T b m). + fun bT (b : NumField.class_of T) & phant_id (NumField.class bT) b => + fun mT ldisp l tdisp t & phant_id (RealDomain.class mT) + (@RealDomain.Class T b ldisp l tdisp t) => + Pack (@Class T b ldisp l tdisp t). Definition eqType := @Equality.Pack cT xclass. Definition choiceType := @Choice.Pack cT xclass. @@ -625,11 +875,23 @@ Definition comRingType := @GRing.ComRing.Pack cT xclass. Definition unitRingType := @GRing.UnitRing.Pack cT xclass. Definition comUnitRingType := @GRing.ComUnitRing.Pack cT xclass. Definition idomainType := @GRing.IntegralDomain.Pack cT xclass. +Definition porderType := @Order.POrder.Pack ring_display cT xclass. Definition numDomainType := @NumDomain.Pack cT xclass. +Definition latticeType := @Order.Lattice.Pack ring_display cT xclass. +Definition orderType := @Order.Total.Pack ring_display cT xclass. Definition realDomainType := @RealDomain.Pack cT xclass. Definition fieldType := @GRing.Field.Pack cT xclass. Definition numFieldType := @NumField.Pack cT xclass. -Definition join_realDomainType := @RealDomain.Pack numFieldType xclass. +Definition normedDomainType := NormedDomainType numDomainType cT xclass. +Definition field_latticeType := + @Order.Lattice.Pack ring_display fieldType xclass. +Definition field_orderType := @Order.Total.Pack ring_display fieldType xclass. +Definition field_realDomainType := @RealDomain.Pack fieldType xclass. +Definition numField_latticeType := + @Order.Lattice.Pack ring_display numFieldType xclass. +Definition numField_orderType := + @Order.Total.Pack ring_display numFieldType xclass. +Definition numField_realDomainType := @RealDomain.Pack numFieldType xclass. End ClassDef. @@ -654,17 +916,30 @@ Coercion comUnitRingType : type >-> GRing.ComUnitRing.type. Canonical comUnitRingType. Coercion idomainType : type >-> GRing.IntegralDomain.type. Canonical idomainType. +Coercion porderType : type >-> Order.POrder.type. +Canonical porderType. Coercion numDomainType : type >-> NumDomain.type. Canonical numDomainType. +Coercion latticeType : type >-> Order.Lattice.type. +Canonical latticeType. +Coercion orderType : type >-> Order.Total.type. +Canonical orderType. Coercion realDomainType : type >-> RealDomain.type. Canonical realDomainType. Coercion fieldType : type >-> GRing.Field.type. Canonical fieldType. Coercion numFieldType : type >-> NumField.type. Canonical numFieldType. -Canonical join_realDomainType. +Coercion normedDomainType : type >-> NormedDomain.type. +Canonical normedDomainType. +Canonical field_latticeType. +Canonical field_orderType. +Canonical field_realDomainType. +Canonical numField_latticeType. +Canonical numField_orderType. +Canonical numField_realDomainType. Notation realFieldType := type. -Notation "[ 'realFieldType' 'of' T ]" := (@pack T _ _ id _ _ id) +Notation "[ 'realFieldType' 'of' T ]" := (@pack T _ _ id _ _ _ _ _ id) (at level 0, format "[ 'realFieldType' 'of' T ]") : form_scope. End Exports. @@ -685,7 +960,6 @@ Variables (T : Type) (cT : type). Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Let xT := let: Pack T _ := cT in T. Notation xclass := (class : class_of xT). - Definition clone c of phant_id class c := @Pack T c. Definition pack b0 (m0 : archimedean_axiom (num_for T b0)) := fun bT b & phant_id (RealField.class bT) b => @@ -699,11 +973,15 @@ Definition comRingType := @GRing.ComRing.Pack cT xclass. Definition unitRingType := @GRing.UnitRing.Pack cT xclass. Definition comUnitRingType := @GRing.ComUnitRing.Pack cT xclass. Definition idomainType := @GRing.IntegralDomain.Pack cT xclass. +Definition porderType := @Order.POrder.Pack ring_display cT xclass. Definition numDomainType := @NumDomain.Pack cT xclass. +Definition latticeType := @Order.Lattice.Pack ring_display cT xclass. +Definition orderType := @Order.Total.Pack ring_display cT xclass. Definition realDomainType := @RealDomain.Pack cT xclass. Definition fieldType := @GRing.Field.Pack cT xclass. Definition numFieldType := @NumField.Pack cT xclass. Definition realFieldType := @RealField.Pack cT xclass. +Definition normedDomainType := NormedDomainType numDomainType cT xclass. End ClassDef. @@ -727,8 +1005,14 @@ Coercion comUnitRingType : type >-> GRing.ComUnitRing.type. Canonical comUnitRingType. Coercion idomainType : type >-> GRing.IntegralDomain.type. Canonical idomainType. +Coercion porderType : type >-> Order.POrder.type. +Canonical porderType. Coercion numDomainType : type >-> NumDomain.type. Canonical numDomainType. +Coercion latticeType : type >-> Order.Lattice.type. +Canonical latticeType. +Coercion orderType : type >-> Order.Total.type. +Canonical orderType. Coercion realDomainType : type >-> RealDomain.type. Canonical realDomainType. Coercion fieldType : type >-> GRing.Field.type. @@ -737,6 +1021,8 @@ Coercion numFieldType : type >-> NumField.type. Canonical numFieldType. Coercion realFieldType : type >-> RealField.type. Canonical realFieldType. +Coercion normedDomainType : type >-> NormedDomain.type. +Canonical normedDomainType. Notation archiFieldType := type. Notation ArchiFieldType T m := (@pack T _ m _ _ id _ id). Notation "[ 'archiFieldType' 'of' T 'for' cT ]" := (@clone T cT _ idfun) @@ -762,7 +1048,6 @@ Variables (T : Type) (cT : type). Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Let xT := let: Pack T _ := cT in T. Notation xclass := (class : class_of xT). - Definition clone c of phant_id class c := @Pack T c. Definition pack b0 (m0 : real_closed_axiom (num_for T b0)) := fun bT b & phant_id (RealField.class bT) b => @@ -776,11 +1061,15 @@ Definition comRingType := @GRing.ComRing.Pack cT xclass. Definition unitRingType := @GRing.UnitRing.Pack cT xclass. Definition comUnitRingType := @GRing.ComUnitRing.Pack cT xclass. Definition idomainType := @GRing.IntegralDomain.Pack cT xclass. +Definition porderType := @Order.POrder.Pack ring_display cT xclass. Definition numDomainType := @NumDomain.Pack cT xclass. +Definition latticeType := @Order.Lattice.Pack ring_display cT xclass. +Definition orderType := @Order.Total.Pack ring_display cT xclass. Definition realDomainType := @RealDomain.Pack cT xclass. Definition fieldType := @GRing.Field.Pack cT xclass. Definition numFieldType := @NumField.Pack cT xclass. Definition realFieldType := @RealField.Pack cT xclass. +Definition normedDomainType := NormedDomainType numDomainType cT xclass. End ClassDef. @@ -804,16 +1093,24 @@ Coercion comUnitRingType : type >-> GRing.ComUnitRing.type. Canonical comUnitRingType. Coercion idomainType : type >-> GRing.IntegralDomain.type. Canonical idomainType. +Coercion porderType : type >-> Order.POrder.type. +Canonical porderType. Coercion numDomainType : type >-> NumDomain.type. Canonical numDomainType. Coercion realDomainType : type >-> RealDomain.type. Canonical realDomainType. +Coercion latticeType : type >-> Order.Lattice.type. +Canonical latticeType. +Coercion orderType : type >-> Order.Total.type. +Canonical orderType. Coercion fieldType : type >-> GRing.Field.type. Canonical fieldType. Coercion numFieldType : type >-> NumField.type. Canonical numFieldType. Coercion realFieldType : type >-> RealField.type. Canonical realFieldType. +Coercion normedDomainType : type >-> NormedDomain.type. +Canonical normedDomainType. Notation rcfType := Num.RealClosedField.type. Notation RcfType T m := (@pack T _ m _ _ id _ id). Notation "[ 'rcfType' 'of' T 'for' cT ]" := (@clone T cT _ idfun) @@ -829,32 +1126,41 @@ Import RealClosedField.Exports. (* operations for the extensions described above. *) Module Import Internals. -Section Domain. -Variable R : numDomainType. -Implicit Types x y : R. +Section NormedDomain. +Variables (R : numDomainType) (V : normedDomainType R). +Implicit Types (l : R) (x y : V). -(* Lemmas from the signature *) +Lemma ler_norm_add x y : `|x + y| <= `|x| + `|y|. +Proof. by case: V x y => ? [? []]. Qed. Lemma normr0_eq0 x : `|x| = 0 -> x = 0. -Proof. by case: R x => ? [? []]. Qed. +Proof. by case: V x => ? [? []]. Qed. -Lemma ler_norm_add x y : `|x + y| <= `|x| + `|y|. -Proof. by case: R x y => ? [? []]. Qed. +Lemma normrMn x n : `|x *+ n| = `|x| *+ n. +Proof. by case: V x => ? [? []]. Qed. + +Lemma normrN x : `|- x| = `|x|. +Proof. by case: V x => ? [? []]. Qed. + +End NormedDomain. + +Section NumDomain. +Variable R : numDomainType. +Implicit Types x y : R. + +(* Lemmas from the signature *) Lemma addr_gt0 x y : 0 < x -> 0 < y -> 0 < x + y. -Proof. by case: R x y => ? [? []]. Qed. +Proof. by case: R x y => ? [? ? ? []]. Qed. Lemma ger_leVge x y : 0 <= x -> 0 <= y -> (x <= y) || (y <= x). -Proof. by case: R x y => ? [? []]. Qed. +Proof. by case: R x y => ? [? ? ? []]. Qed. -Lemma normrM : {morph norm : x y / x * y : R}. -Proof. by case: R => ? [? []]. Qed. +Lemma normrM : {morph norm : x y / (x : R) * y}. +Proof. by case: R => ? [? ? ? []]. Qed. Lemma ler_def x y : (x <= y) = (`|y - x| == y - x). -Proof. by case: R x y => ? [? []]. Qed. - -Lemma ltr_def x y : (x < y) = (y != x) && (x <= y). -Proof. by case: R x y => ? [? []]. Qed. +Proof. by case: R x y => ? [? ? ? []]. Qed. (* Basic consequences (just enough to get predicate closure properties). *) @@ -869,33 +1175,24 @@ Proof. by rewrite -sub0r subr_ge0. Qed. Lemma ler01 : 0 <= 1 :> R. Proof. -have n1_nz: `|1| != 0 :> R by apply: contraNneq (@oner_neq0 R) => /normr0_eq0->. +have n1_nz: `|1 : R| != 0 by apply: contraNneq (@oner_neq0 R) => /normr0_eq0->. by rewrite ger0_def -(inj_eq (mulfI n1_nz)) -normrM !mulr1. Qed. -Lemma ltr01 : 0 < 1 :> R. Proof. by rewrite ltr_def oner_neq0 ler01. Qed. - -Lemma ltrW x y : x < y -> x <= y. Proof. by rewrite ltr_def => /andP[]. Qed. - -Lemma lerr x : x <= x. -Proof. -have n2: `|2%:R| == 2%:R :> R by rewrite -ger0_def ltrW ?addr_gt0 ?ltr01. -rewrite ler_def subrr -(inj_eq (addrI `|0|)) addr0 -mulr2n -mulr_natr. -by rewrite -(eqP n2) -normrM mul0r. -Qed. +Lemma ltr01 : 0 < 1 :> R. Proof. by rewrite lt_def oner_neq0 ler01. Qed. Lemma le0r x : (0 <= x) = (x == 0) || (0 < x). -Proof. by rewrite ltr_def; case: eqP => // ->; rewrite lerr. Qed. +Proof. by rewrite lt_def; case: eqP => // ->; rewrite lexx. Qed. Lemma addr_ge0 x y : 0 <= x -> 0 <= y -> 0 <= x + y. Proof. rewrite le0r; case/predU1P=> [-> | x_pos]; rewrite ?add0r // le0r. -by case/predU1P=> [-> | y_pos]; rewrite ltrW ?addr0 ?addr_gt0. +by case/predU1P=> [-> | y_pos]; rewrite ltW ?addr0 ?addr_gt0. Qed. Lemma pmulr_rgt0 x y : 0 < x -> (0 < x * y) = (0 < y). Proof. -rewrite !ltr_def !ger0_def normrM mulf_eq0 negb_or => /andP[x_neq0 /eqP->]. +rewrite !lt_def !ger0_def normrM mulf_eq0 negb_or => /andP[x_neq0 /eqP->]. by rewrite x_neq0 (inj_eq (mulfI x_neq0)). Qed. @@ -924,7 +1221,7 @@ Canonical nneg_mulrPred := MulrPred nneg_divr_closed. Canonical nneg_divrPred := DivrPred nneg_divr_closed. Fact nneg_addr_closed : addr_closed (@nneg R). -Proof. by split; [apply: lerr | apply: addr_ge0]. Qed. +Proof. by split; [apply: lexx | apply: addr_ge0]. Qed. Canonical nneg_addrPred := AddrPred nneg_addr_closed. Canonical nneg_semiringPred := SemiringPred nneg_divr_closed. @@ -934,7 +1231,7 @@ Canonical real_opprPred := OpprPred real_oppr_closed. Fact real_addr_closed : addr_closed (@real R). Proof. -split=> [|x y Rx Ry]; first by rewrite realE lerr. +split=> [|x y Rx Ry]; first by rewrite realE lexx. without loss{Rx} x_ge0: x y Ry / 0 <= x. case/orP: Rx => [? | x_le0]; first exact. by rewrite -rpredN opprD; apply; rewrite ?rpredN ?oppr_ge0. @@ -962,10 +1259,10 @@ Canonical real_semiringPred := SemiringPred real_divr_closed. Canonical real_subringPred := SubringPred real_divr_closed. Canonical real_divringPred := DivringPred real_divr_closed. -End Domain. +End NumDomain. Lemma num_real (R : realDomainType) (x : R) : x \is real. -Proof. by case: R x => T []. Qed. +Proof. by rewrite unfold_in; apply: le_total. Qed. Fact archi_bound_subproof (R : archiFieldType) : archimedean_axiom R. Proof. by case: R => ? []. Qed. @@ -988,12 +1285,6 @@ Qed. End RealClosed. -(* TODO Kazuhiko: Add a normedModType R, with R : numDomainType *) -(* follow https://github.com/math-comp/analysis/blob/3f8dfbe0e8a963d32003ef7fdcef71823c8484c3/hierarchy.v#L1273-L1279 replacing absRingType by numDomainType, -parametrize by Norm.class, and remove ax3 *) - -(* TODO Kazuhiko: Add that any R : numDomainType is canonically a normedModType R *) - End Internals. Module PredInstances. @@ -1030,36 +1321,28 @@ End ExtraDef. Notation bound := archi_bound. Notation sqrt := sqrtr. - -(* /!\ TODO Kazuhiko: REWRITE DIFFERENTLY *) -(* - Everything only about 0, + and norm and order on R - should be for a normedModType R *) -(* - Everything about only < and <= and meet and join should be - removed or ported to order *) -(* - Everything else should be for a numDomainType or substructure *) - Module Theory. Section NumIntegralDomainTheory. Variable R : numDomainType. -Implicit Types x y z t : R. +Implicit Types (V : normedDomainType R) (x y z t : R). (* Lemmas from the signature (reexported from internals). *) -Definition ler_norm_add x y : `|x + y| <= `|x| + `|y| := ler_norm_add x y. +Definition ler_norm_add V (x y : V) : `|x + y| <= `|x| + `|y| := + ler_norm_add x y. Definition addr_gt0 x y : 0 < x -> 0 < y -> 0 < x + y := @addr_gt0 R x y. -Definition normr0_eq0 x : `|x| = 0 -> x = 0 := @normr0_eq0 R x. +Definition normr0_eq0 V (x : V) : `|x| = 0 -> x = 0 := @normr0_eq0 R V x. Definition ger_leVge x y : 0 <= x -> 0 <= y -> (x <= y) || (y <= x) := @ger_leVge R x y. -Definition normrM : {morph normr : x y / x * y : R} := @normrM R. -Definition ler_def x y : (x <= y) = (`|y - x| == y - x) := @ler_def R x y. -Definition ltr_def x y : (x < y) = (y != x) && (x <= y) := @ltr_def R x y. +Definition normrM : {morph norm : x y / (x : R) * y} := @normrM R. +Definition ler_def x y : (x <= y) = (`|y - x| == y - x) := ler_def x y. +Definition normrMn V (x : V) n : `|x *+ n| = `|x| *+ n := normrMn x n. +Definition normrN V (x : V) : `|- x| = `|x| := normrN x. -(* Predicate and relation definitions. *) +(* Predicate definitions. *) -Lemma gerE x y : ge x y = (y <= x). Proof. by []. Qed. -Lemma gtrE x y : gt x y = (y < x). Proof. by []. Qed. Lemma posrE x : (x \is pos) = (0 < x). Proof. by []. Qed. Lemma negrE x : (x \is neg) = (x < 0). Proof. by []. Qed. Lemma nnegrE x : (x \is nneg) = (0 <= x). Proof. by []. Qed. @@ -1067,31 +1350,14 @@ Lemma realE x : (x \is real) = (0 <= x) || (x <= 0). Proof. by []. Qed. (* General properties of <= and < *) -Lemma lerr x : x <= x. Proof. exact: lerr. Qed. -Lemma ltrr x : x < x = false. Proof. by rewrite ltr_def eqxx. Qed. -Lemma ltrW x y : x < y -> x <= y. Proof. exact: ltrW. Qed. -Hint Resolve lerr ltrr ltrW : core. - -Lemma ltr_neqAle x y : (x < y) = (x != y) && (x <= y). -Proof. by rewrite ltr_def eq_sym. Qed. - -Lemma ler_eqVlt x y : (x <= y) = (x == y) || (x < y). -Proof. by rewrite ltr_neqAle; case: eqP => // ->; rewrite lerr. Qed. - -Lemma lt0r x : (0 < x) = (x != 0) && (0 <= x). Proof. by rewrite ltr_def. Qed. +Lemma lt0r x : (0 < x) = (x != 0) && (0 <= x). Proof. by rewrite lt_def. Qed. Lemma le0r x : (0 <= x) = (x == 0) || (0 < x). Proof. exact: le0r. Qed. -Lemma lt0r_neq0 (x : R) : 0 < x -> x != 0. +Lemma lt0r_neq0 (x : R) : 0 < x -> x != 0. Proof. by rewrite lt0r; case/andP. Qed. -Lemma ltr0_neq0 (x : R) : x < 0 -> x != 0. -Proof. by rewrite ltr_neqAle; case/andP. Qed. - -Lemma gtr_eqF x y : y < x -> x == y = false. -Proof. by rewrite ltr_def; case/andP; move/negPf=> ->. Qed. - -Lemma ltr_eqF x y : x < y -> x == y = false. -Proof. by move=> hyx; rewrite eq_sym gtr_eqF. Qed. +Lemma ltr0_neq0 (x : R) : x < 0 -> x != 0. +Proof. by rewrite lt_neqAle; case/andP. Qed. Lemma pmulr_rgt0 x y : 0 < x -> (0 < x * y) = (0 < y). Proof. exact: pmulr_rgt0. Qed. @@ -1113,7 +1379,7 @@ Proof. by case: n => //= n; apply: ltr0Sn. Qed. Hint Resolve ltr0Sn : core. Lemma pnatr_eq0 n : (n%:R == 0 :> R) = (n == 0)%N. -Proof. by case: n => [|n]; rewrite ?mulr0n ?eqxx // gtr_eqF. Qed. +Proof. by case: n => [|n]; rewrite ?mulr0n ?eqxx // gt_eqF. Qed. Lemma char_num : [char R] =i pred0. Proof. by case=> // p /=; rewrite !inE pnatr_eq0 andbF. Qed. @@ -1124,12 +1390,8 @@ Lemma ger0_def x : (0 <= x) = (`|x| == x). Proof. exact: ger0_def. Qed. Lemma normr_idP {x} : reflect (`|x| = x) (0 <= x). Proof. by rewrite ger0_def; apply: eqP. Qed. Lemma ger0_norm x : 0 <= x -> `|x| = x. Proof. exact: normr_idP. Qed. - -Lemma normr0 : `|0| = 0 :> R. Proof. exact: ger0_norm. Qed. -Lemma normr1 : `|1| = 1 :> R. Proof. exact: ger0_norm. Qed. -Lemma normr_nat n : `|n%:R| = n%:R :> R. Proof. exact: ger0_norm. Qed. -Lemma normrMn x n : `|x *+ n| = `|x| *+ n. -Proof. by rewrite -mulr_natl normrM normr_nat mulr_natl. Qed. +Lemma normr1 : `|1 : R| = 1. Proof. exact: ger0_norm. Qed. +Lemma normr_nat n : `|n%:R : R| = n%:R. Proof. exact: ger0_norm. Qed. Lemma normr_prod I r (P : pred I) (F : I -> R) : `|\prod_(i <- r | P i) F i| = \prod_(i <- r | P i) `|F i|. @@ -1138,60 +1400,78 @@ Proof. exact: (big_morph norm normrM normr1). Qed. Lemma normrX n x : `|x ^+ n| = `|x| ^+ n. Proof. by rewrite -(card_ord n) -!prodr_const normr_prod. Qed. -Lemma normr_unit : {homo (@norm R) : x / x \is a GRing.unit}. +Lemma normr_unit : {homo (@norm R R) : x / x \is a GRing.unit}. Proof. move=> x /= /unitrP [y [yx xy]]; apply/unitrP; exists `|y|. by rewrite -!normrM xy yx normr1. Qed. -Lemma normrV : {in GRing.unit, {morph (@normr R) : x / x ^-1}}. +Lemma normrV : {in GRing.unit, {morph (@norm R R) : x / x ^-1}}. Proof. move=> x ux; apply: (mulrI (normr_unit ux)). by rewrite -normrM !divrr ?normr1 ?normr_unit. Qed. -Lemma normr0P {x} : reflect (`|x| = 0) (x == 0). -Proof. by apply: (iffP eqP)=> [->|/normr0_eq0 //]; apply: normr0. Qed. - -Definition normr_eq0 x := sameP (`|x| =P 0) normr0P. - -Lemma normrN1 : `|-1| = 1 :> R. +Lemma normrN1 : `|-1 : R| = 1. Proof. -have: `|-1| ^+ 2 == 1 :> R by rewrite -normrX -signr_odd normr1. +have: `|-1 : R| ^+ 2 == 1 by rewrite -normrX -signr_odd normr1. rewrite sqrf_eq1 => /orP[/eqP //|]; rewrite -ger0_def le0r oppr_eq0 oner_eq0. -by move/(addr_gt0 ltr01); rewrite subrr ltrr. +by move/(addr_gt0 ltr01); rewrite subrr ltxx. Qed. -Lemma normrN x : `|- x| = `|x|. -Proof. by rewrite -mulN1r normrM normrN1 mul1r. Qed. +Section NormedDomainTheory. -Lemma distrC x y : `|x - y| = `|y - x|. -Proof. by rewrite -opprB normrN. Qed. +Variable V : normedDomainType R. +Implicit Types (v w : V). -Lemma ler0_def x : (x <= 0) = (`|x| == - x). -Proof. by rewrite ler_def sub0r normrN. Qed. +Lemma normr0 : `|0 : V| = 0. +Proof. by rewrite -(mulr0n 0) normrMn mulr0n. Qed. + +Lemma normr0P v : reflect (`|v| = 0) (v == 0). +Proof. by apply: (iffP eqP)=> [->|/normr0_eq0 //]; apply: normr0. Qed. + +Definition normr_eq0 v := sameP (`|v| =P 0) (normr0P v). + +Lemma distrC v w : `|v - w| = `|w - v|. +Proof. by rewrite -opprB normrN. Qed. -Lemma normr_id x : `|`|x| | = `|x|. +Lemma normr_id v : `| `|v| | = `|v|. Proof. have nz2: 2%:R != 0 :> R by rewrite pnatr_eq0. apply: (mulfI nz2); rewrite -{1}normr_nat -normrM mulr_natl mulr2n ger0_norm //. -by rewrite -{2}normrN -normr0 -(subrr x) ler_norm_add. +by rewrite -{2}normrN -normr0 -(subrr v) ler_norm_add. Qed. -Lemma normr_ge0 x : 0 <= `|x|. Proof. by rewrite ger0_def normr_id. Qed. -Hint Resolve normr_ge0 : core. +Lemma normr_ge0 v : 0 <= `|v|. Proof. by rewrite ger0_def normr_id. Qed. + +Lemma normr_le0 v : `|v| <= 0 = (v == 0). +Proof. by rewrite -normr_eq0 eq_le normr_ge0 andbT. Qed. + +Lemma normr_lt0 v : `|v| < 0 = false. +Proof. by rewrite lt_neqAle normr_le0 normr_eq0 andNb. Qed. + +Lemma normr_gt0 v : `|v| > 0 = (v != 0). +Proof. by rewrite lt_def normr_eq0 normr_ge0 andbT. Qed. + +Definition normrE := (normr_id, normr0, normr1, normrN1, normr_ge0, normr_eq0, + normr_lt0, normr_le0, normr_gt0, normrN). + +End NormedDomainTheory. + +Lemma ler0_def x : (x <= 0) = (`|x| == - x). +Proof. by rewrite ler_def sub0r normrN. Qed. Lemma ler0_norm x : x <= 0 -> `|x| = - x. Proof. by move=> x_le0; rewrite -[r in _ = r]ger0_norm ?normrN ?oppr_ge0. Qed. -Definition gtr0_norm x (hx : 0 < x) := ger0_norm (ltrW hx). -Definition ltr0_norm x (hx : x < 0) := ler0_norm (ltrW hx). +Definition gtr0_norm x (hx : 0 < x) := ger0_norm (ltW hx). +Definition ltr0_norm x (hx : x < 0) := ler0_norm (ltW hx). (* Comparision to 0 of a difference *) Lemma subr_ge0 x y : (0 <= y - x) = (x <= y). Proof. exact: subr_ge0. Qed. Lemma subr_gt0 x y : (0 < y - x) = (x < y). -Proof. by rewrite !ltr_def subr_eq0 subr_ge0. Qed. +Proof. by rewrite !lt_def subr_eq0 subr_ge0. Qed. Lemma subr_le0 x y : (y - x <= 0) = (y <= x). Proof. by rewrite -subr_ge0 opprB add0r subr_ge0. Qed. Lemma subr_lt0 x y : (y - x < 0) = (y < x). @@ -1203,392 +1483,53 @@ Definition subr_cp0 := (subr_lte0, subr_gte0). (* Ordered ring properties. *) -Lemma ler_asym : antisymmetric (<=%R : rel R). -Proof. -move=> x y; rewrite !ler_def distrC -opprB -addr_eq0 => /andP[/eqP->]. -by rewrite -mulr2n -mulr_natl mulf_eq0 subr_eq0 pnatr_eq0 => /eqP. -Qed. - -Lemma eqr_le x y : (x == y) = (x <= y <= x). -Proof. by apply/eqP/idP=> [->|/ler_asym]; rewrite ?lerr. Qed. - -Lemma ltr_trans : transitive (@ltr R). -Proof. -move=> y x z le_xy le_yz. -by rewrite -subr_gt0 -(subrK y z) -addrA addr_gt0 ?subr_gt0. -Qed. - -Lemma ler_lt_trans y x z : x <= y -> y < z -> x < z. -Proof. by rewrite !ler_eqVlt => /orP[/eqP -> //|/ltr_trans]; apply. Qed. - -Lemma ltr_le_trans y x z : x < y -> y <= z -> x < z. -Proof. by rewrite !ler_eqVlt => lxy /orP[/eqP <- //|/(ltr_trans lxy)]. Qed. - -Lemma ler_trans : transitive (@ler R). -Proof. -move=> y x z; rewrite !ler_eqVlt => /orP [/eqP -> //|lxy]. -by move=> /orP [/eqP <-|/(ltr_trans lxy) ->]; rewrite ?lxy orbT. -Qed. - Definition lter01 := (ler01, ltr01). -Definition lterr := (lerr, ltrr). Lemma addr_ge0 x y : 0 <= x -> 0 <= y -> 0 <= x + y. Proof. exact: addr_ge0. Qed. -Lemma lerifP x y C : reflect (x <= y ?= iff C) (if C then x == y else x < y). -Proof. -rewrite /lerif ler_eqVlt; apply: (iffP idP)=> [|[]]. - by case: C => [/eqP->|lxy]; rewrite ?eqxx // lxy ltr_eqF. -by move=> /orP[/eqP->|lxy] <-; rewrite ?eqxx // ltr_eqF. -Qed. +End NumIntegralDomainTheory. -Lemma ltr_asym x y : x < y < x = false. -Proof. by apply/negP=> /andP [/ltr_trans hyx /hyx]; rewrite ltrr. Qed. +Arguments ler01 {R}. +Arguments ltr01 {R}. +Arguments normr_idP {R x}. +Arguments normr0P {R V v}. +Hint Resolve @ler01 @ltr01 ltr0Sn ler0n : core. +Hint Extern 0 (is_true (0 <= norm _)) => exact: normr_ge0 : core. -Lemma ler_anti : antisymmetric (@ler R). -Proof. by move=> x y; rewrite -eqr_le=> /eqP. Qed. +Section NumDomainOperationTheory. -Lemma ltr_le_asym x y : x < y <= x = false. -Proof. by rewrite ltr_neqAle -andbA -eqr_le eq_sym; case: (_ == _). Qed. +Variable R : numDomainType. +Implicit Types x y z t : R. -Lemma ler_lt_asym x y : x <= y < x = false. -Proof. by rewrite andbC ltr_le_asym. Qed. +(* Comparision and opposite. *) -Definition lter_anti := (=^~ eqr_le, ltr_asym, ltr_le_asym, ler_lt_asym). +Lemma ler_opp2 : {mono -%R : x y /~ x <= y :> R}. +Proof. by move=> x y /=; rewrite -subr_ge0 opprK addrC subr_ge0. Qed. +Hint Resolve ler_opp2 : core. +Lemma ltr_opp2 : {mono -%R : x y /~ x < y :> R}. +Proof. by move=> x y /=; rewrite leW_nmono. Qed. +Hint Resolve ltr_opp2 : core. +Definition lter_opp2 := (ler_opp2, ltr_opp2). -Lemma ltr_geF x y : x < y -> (y <= x = false). -Proof. -by move=> xy; apply: contraTF isT=> /(ltr_le_trans xy); rewrite ltrr. -Qed. +Lemma ler_oppr x y : (x <= - y) = (y <= - x). +Proof. by rewrite (monoRL opprK ler_opp2). Qed. -Lemma ler_gtF x y : x <= y -> (y < x = false). -Proof. by apply: contraTF=> /ltr_geF->. Qed. +Lemma ltr_oppr x y : (x < - y) = (y < - x). +Proof. by rewrite (monoRL opprK (leW_nmono _)). Qed. -Definition ltr_gtF x y hxy := ler_gtF (@ltrW x y hxy). +Definition lter_oppr := (ler_oppr, ltr_oppr). -(* Norm and order properties. *) +Lemma ler_oppl x y : (- x <= y) = (- y <= x). +Proof. by rewrite (monoLR opprK ler_opp2). Qed. -Lemma normr_le0 x : (`|x| <= 0) = (x == 0). -Proof. by rewrite -normr_eq0 eqr_le normr_ge0 andbT. Qed. +Lemma ltr_oppl x y : (- x < y) = (- y < x). +Proof. by rewrite (monoLR opprK (leW_nmono _)). Qed. -Lemma normr_lt0 x : `|x| < 0 = false. -Proof. by rewrite ltr_neqAle normr_le0 normr_eq0 andNb. Qed. +Definition lter_oppl := (ler_oppl, ltr_oppl). -Lemma normr_gt0 x : (`|x| > 0) = (x != 0). -Proof. by rewrite ltr_def normr_eq0 normr_ge0 andbT. Qed. - -Definition normrE x := (normr_id, normr0, normr1, normrN1, normr_ge0, normr_eq0, - normr_lt0, normr_le0, normr_gt0, normrN). - -End NumIntegralDomainTheory. - -Arguments ler01 {R}. -Arguments ltr01 {R}. -Arguments normr_idP {R x}. -Arguments normr0P {R x}. -Arguments lerifP {R x y C}. -Hint Resolve @ler01 @ltr01 lerr ltrr ltrW ltr_eqF ltr0Sn ler0n normr_ge0 : core. - -Section NumIntegralDomainMonotonyTheory. - -Variables R R' : numDomainType. -Implicit Types m n p : nat. -Implicit Types x y z : R. -Implicit Types u v w : R'. - -(****************************************************************************) -(* This listing of "Let"s factor out the required premices for the *) -(* subsequent lemmas, putting them in the context so that "done" solves the *) -(* goals quickly *) -(****************************************************************************) - -Let leqnn := leqnn. -Let ltnE := ltn_neqAle. -Let ltrE := @ltr_neqAle R. -Let ltr'E := @ltr_neqAle R'. -Let gtnE (m n : nat) : (m > n)%N = (m != n) && (m >= n)%N. -Proof. by rewrite ltn_neqAle eq_sym. Qed. -Let gtrE (x y : R) : (x > y) = (x != y) && (x >= y). -Proof. by rewrite ltr_neqAle eq_sym. Qed. -Let gtr'E (x y : R') : (x > y) = (x != y) && (x >= y). -Proof. by rewrite ltr_neqAle eq_sym. Qed. -Let leq_anti : antisymmetric leq. -Proof. by move=> m n; rewrite -eqn_leq => /eqP. Qed. -Let geq_anti : antisymmetric geq. -Proof. by move=> m n; rewrite -eqn_leq => /eqP. Qed. -Let ler_antiR := @ler_anti R. -Let ler_antiR' := @ler_anti R'. -Let ger_antiR : antisymmetric (>=%R : rel R). -Proof. by move=> ??; rewrite andbC; apply: ler_anti. Qed. -Let ger_antiR' : antisymmetric (>=%R : rel R'). -Proof. by move=> ??; rewrite andbC; apply: ler_anti. Qed. -Let leq_total := leq_total. -Let geq_total : total geq. -Proof. by move=> m n; apply: leq_total. Qed. - -Section AcrossTypes. - -Variables (D D' : {pred R}) (f : R -> R'). - -Lemma ltrW_homo : {homo f : x y / x < y} -> {homo f : x y / x <= y}. -Proof. exact: homoW. Qed. - -Lemma ltrW_nhomo : {homo f : x y /~ x < y} -> {homo f : x y /~ x <= y}. -Proof. exact: homoW. Qed. - -Lemma inj_homo_ltr : - injective f -> {homo f : x y / x <= y} -> {homo f : x y / x < y}. -Proof. exact: inj_homo. Qed. - -Lemma inj_nhomo_ltr : - injective f -> {homo f : x y /~ x <= y} -> {homo f : x y /~ x < y}. -Proof. exact: inj_homo. Qed. - -Lemma incr_inj : {mono f : x y / x <= y} -> injective f. -Proof. exact: mono_inj. Qed. - -Lemma decr_inj : {mono f : x y /~ x <= y} -> injective f. -Proof. exact: mono_inj. Qed. - -Lemma lerW_mono : {mono f : x y / x <= y} -> {mono f : x y / x < y}. -Proof. exact: anti_mono. Qed. - -Lemma lerW_nmono : {mono f : x y /~ x <= y} -> {mono f : x y /~ x < y}. -Proof. exact: anti_mono. Qed. - -(* Monotony in D D' *) -Lemma ltrW_homo_in : - {in D & D', {homo f : x y / x < y}} -> {in D & D', {homo f : x y / x <= y}}. -Proof. exact: homoW_in. Qed. - -Lemma ltrW_nhomo_in : - {in D & D', {homo f : x y /~ x < y}} -> {in D & D', {homo f : x y /~ x <= y}}. -Proof. exact: homoW_in. Qed. - -Lemma inj_homo_ltr_in : - {in D & D', injective f} -> {in D & D', {homo f : x y / x <= y}} -> - {in D & D', {homo f : x y / x < y}}. -Proof. exact: inj_homo_in. Qed. - -Lemma inj_nhomo_ltr_in : - {in D & D', injective f} -> {in D & D', {homo f : x y /~ x <= y}} -> - {in D & D', {homo f : x y /~ x < y}}. -Proof. exact: inj_homo_in. Qed. - -Lemma incr_inj_in : {in D &, {mono f : x y / x <= y}} -> - {in D &, injective f}. -Proof. exact: mono_inj_in. Qed. - -Lemma decr_inj_in : - {in D &, {mono f : x y /~ x <= y}} -> {in D &, injective f}. -Proof. exact: mono_inj_in. Qed. - -Lemma lerW_mono_in : - {in D &, {mono f : x y / x <= y}} -> {in D &, {mono f : x y / x < y}}. -Proof. exact: anti_mono_in. Qed. - -Lemma lerW_nmono_in : - {in D &, {mono f : x y /~ x <= y}} -> {in D &, {mono f : x y /~ x < y}}. -Proof. exact: anti_mono_in. Qed. - -End AcrossTypes. - -Section NatToR. - -Variables (D D' : {pred nat}) (f : nat -> R). - -Lemma ltnrW_homo : {homo f : m n / (m < n)%N >-> m < n} -> - {homo f : m n / (m <= n)%N >-> m <= n}. -Proof. exact: homoW. Qed. - -Lemma ltnrW_nhomo : {homo f : m n / (n < m)%N >-> m < n} -> - {homo f : m n / (n <= m)%N >-> m <= n}. -Proof. exact: homoW. Qed. - -Lemma inj_homo_ltnr : injective f -> - {homo f : m n / (m <= n)%N >-> m <= n} -> - {homo f : m n / (m < n)%N >-> m < n}. -Proof. exact: inj_homo. Qed. - -Lemma inj_nhomo_ltnr : injective f -> - {homo f : m n / (n <= m)%N >-> m <= n} -> - {homo f : m n / (n < m)%N >-> m < n}. -Proof. exact: inj_homo. Qed. - -Lemma incnr_inj : {mono f : m n / (m <= n)%N >-> m <= n} -> injective f. -Proof. exact: mono_inj. Qed. - -Lemma decnr_inj_inj : {mono f : m n / (n <= m)%N >-> m <= n} -> injective f. -Proof. exact: mono_inj. Qed. - -Lemma lenrW_mono : {mono f : m n / (m <= n)%N >-> m <= n} -> - {mono f : m n / (m < n)%N >-> m < n}. -Proof. exact: anti_mono. Qed. - -Lemma lenrW_nmono : {mono f : m n / (n <= m)%N >-> m <= n} -> - {mono f : m n / (n < m)%N >-> m < n}. -Proof. exact: anti_mono. Qed. - -Lemma lenr_mono : {homo f : m n / (m < n)%N >-> m < n} -> - {mono f : m n / (m <= n)%N >-> m <= n}. -Proof. exact: total_homo_mono. Qed. - -Lemma lenr_nmono : {homo f : m n / (n < m)%N >-> m < n} -> - {mono f : m n / (n <= m)%N >-> m <= n}. -Proof. exact: total_homo_mono. Qed. - -Lemma ltnrW_homo_in : {in D & D', {homo f : m n / (m < n)%N >-> m < n}} -> - {in D & D', {homo f : m n / (m <= n)%N >-> m <= n}}. -Proof. exact: homoW_in. Qed. - -Lemma ltnrW_nhomo_in : {in D & D', {homo f : m n / (n < m)%N >-> m < n}} -> - {in D & D', {homo f : m n / (n <= m)%N >-> m <= n}}. -Proof. exact: homoW_in. Qed. - -Lemma inj_homo_ltnr_in : {in D & D', injective f} -> - {in D & D', {homo f : m n / (m <= n)%N >-> m <= n}} -> - {in D & D', {homo f : m n / (m < n)%N >-> m < n}}. -Proof. exact: inj_homo_in. Qed. - -Lemma inj_nhomo_ltnr_in : {in D & D', injective f} -> - {in D & D', {homo f : m n / (n <= m)%N >-> m <= n}} -> - {in D & D', {homo f : m n / (n < m)%N >-> m < n}}. -Proof. exact: inj_homo_in. Qed. - -Lemma incnr_inj_in : {in D &, {mono f : m n / (m <= n)%N >-> m <= n}} -> - {in D &, injective f}. -Proof. exact: mono_inj_in. Qed. - -Lemma decnr_inj_inj_in : {in D &, {mono f : m n / (n <= m)%N >-> m <= n}} -> - {in D &, injective f}. -Proof. exact: mono_inj_in. Qed. - -Lemma lenrW_mono_in : {in D &, {mono f : m n / (m <= n)%N >-> m <= n}} -> - {in D &, {mono f : m n / (m < n)%N >-> m < n}}. -Proof. exact: anti_mono_in. Qed. - -Lemma lenrW_nmono_in : {in D &, {mono f : m n / (n <= m)%N >-> m <= n}} -> - {in D &, {mono f : m n / (n < m)%N >-> m < n}}. -Proof. exact: anti_mono_in. Qed. - -Lemma lenr_mono_in : {in D &, {homo f : m n / (m < n)%N >-> m < n}} -> - {in D &, {mono f : m n / (m <= n)%N >-> m <= n}}. -Proof. exact: total_homo_mono_in. Qed. - -Lemma lenr_nmono_in : {in D &, {homo f : m n / (n < m)%N >-> m < n}} -> - {in D &, {mono f : m n / (n <= m)%N >-> m <= n}}. -Proof. exact: total_homo_mono_in. Qed. - -End NatToR. - -Section RToNat. - -Variables (D D' : {pred R}) (f : R -> nat). - -Lemma ltrnW_homo : {homo f : m n / m < n >-> (m < n)%N} -> - {homo f : m n / m <= n >-> (m <= n)%N}. -Proof. exact: homoW. Qed. - -Lemma ltrnW_nhomo : {homo f : m n / n < m >-> (m < n)%N} -> - {homo f : m n / n <= m >-> (m <= n)%N}. -Proof. exact: homoW. Qed. - -Lemma inj_homo_ltrn : injective f -> - {homo f : m n / m <= n >-> (m <= n)%N} -> - {homo f : m n / m < n >-> (m < n)%N}. -Proof. exact: inj_homo. Qed. - -Lemma inj_nhomo_ltrn : injective f -> - {homo f : m n / n <= m >-> (m <= n)%N} -> - {homo f : m n / n < m >-> (m < n)%N}. -Proof. exact: inj_homo. Qed. - -Lemma incrn_inj : {mono f : m n / m <= n >-> (m <= n)%N} -> injective f. -Proof. exact: mono_inj. Qed. - -Lemma decrn_inj : {mono f : m n / n <= m >-> (m <= n)%N} -> injective f. -Proof. exact: mono_inj. Qed. - -Lemma lernW_mono : {mono f : m n / m <= n >-> (m <= n)%N} -> - {mono f : m n / m < n >-> (m < n)%N}. -Proof. exact: anti_mono. Qed. - -Lemma lernW_nmono : {mono f : m n / n <= m >-> (m <= n)%N} -> - {mono f : m n / n < m >-> (m < n)%N}. -Proof. exact: anti_mono. Qed. - -Lemma ltrnW_homo_in : {in D & D', {homo f : m n / m < n >-> (m < n)%N}} -> - {in D & D', {homo f : m n / m <= n >-> (m <= n)%N}}. -Proof. exact: homoW_in. Qed. - -Lemma ltrnW_nhomo_in : {in D & D', {homo f : m n / n < m >-> (m < n)%N}} -> - {in D & D', {homo f : m n / n <= m >-> (m <= n)%N}}. -Proof. exact: homoW_in. Qed. - -Lemma inj_homo_ltrn_in : {in D & D', injective f} -> - {in D & D', {homo f : m n / m <= n >-> (m <= n)%N}} -> - {in D & D', {homo f : m n / m < n >-> (m < n)%N}}. -Proof. exact: inj_homo_in. Qed. - -Lemma inj_nhomo_ltrn_in : {in D & D', injective f} -> - {in D & D', {homo f : m n / n <= m >-> (m <= n)%N}} -> - {in D & D', {homo f : m n / n < m >-> (m < n)%N}}. -Proof. exact: inj_homo_in. Qed. - -Lemma incrn_inj_in : {in D &, {mono f : m n / m <= n >-> (m <= n)%N}} -> - {in D &, injective f}. -Proof. exact: mono_inj_in. Qed. - -Lemma decrn_inj_in : {in D &, {mono f : m n / n <= m >-> (m <= n)%N}} -> - {in D &, injective f}. -Proof. exact: mono_inj_in. Qed. - -Lemma lernW_mono_in : {in D &, {mono f : m n / m <= n >-> (m <= n)%N}} -> - {in D &, {mono f : m n / m < n >-> (m < n)%N}}. -Proof. exact: anti_mono_in. Qed. - -Lemma lernW_nmono_in : {in D &, {mono f : m n / n <= m >-> (m <= n)%N}} -> - {in D &, {mono f : m n / n < m >-> (m < n)%N}}. -Proof. exact: anti_mono_in. Qed. - -End RToNat. - -End NumIntegralDomainMonotonyTheory. - -Section NumDomainOperationTheory. - -Variable R : numDomainType. -Implicit Types x y z t : R. - -(* Comparision and opposite. *) - -Lemma ler_opp2 : {mono -%R : x y /~ x <= y :> R}. -Proof. by move=> x y /=; rewrite -subr_ge0 opprK addrC subr_ge0. Qed. -Hint Resolve ler_opp2 : core. -Lemma ltr_opp2 : {mono -%R : x y /~ x < y :> R}. -Proof. by move=> x y /=; rewrite lerW_nmono. Qed. -Hint Resolve ltr_opp2 : core. -Definition lter_opp2 := (ler_opp2, ltr_opp2). - -Lemma ler_oppr x y : (x <= - y) = (y <= - x). -Proof. by rewrite (monoRL opprK ler_opp2). Qed. - -Lemma ltr_oppr x y : (x < - y) = (y < - x). -Proof. by rewrite (monoRL opprK (lerW_nmono _)). Qed. - -Definition lter_oppr := (ler_oppr, ltr_oppr). - -Lemma ler_oppl x y : (- x <= y) = (- y <= x). -Proof. by rewrite (monoLR opprK ler_opp2). Qed. - -Lemma ltr_oppl x y : (- x < y) = (- y < x). -Proof. by rewrite (monoLR opprK (lerW_nmono _)). Qed. - -Definition lter_oppl := (ler_oppl, ltr_oppl). - -Lemma oppr_ge0 x : (0 <= - x) = (x <= 0). -Proof. by rewrite lter_oppr oppr0. Qed. +Lemma oppr_ge0 x : (0 <= - x) = (x <= 0). +Proof. by rewrite lter_oppr oppr0. Qed. Lemma oppr_gt0 x : (0 < - x) = (x < 0). Proof. by rewrite lter_oppr oppr0. Qed. @@ -1606,23 +1547,23 @@ Definition oppr_cp0 := (oppr_gte0, oppr_lte0). Definition lter_oppE := (oppr_cp0, lter_opp2). Lemma ge0_cp x : 0 <= x -> (- x <= 0) * (- x <= x). -Proof. by move=> hx; rewrite oppr_cp0 hx (@ler_trans _ 0) ?oppr_cp0. Qed. +Proof. by move=> hx; rewrite oppr_cp0 hx (@le_trans _ _ 0) ?oppr_cp0. Qed. Lemma gt0_cp x : 0 < x -> (0 <= x) * (- x <= 0) * (- x <= x) * (- x < 0) * (- x < x). Proof. -move=> hx; move: (ltrW hx) => hx'; rewrite !ge0_cp hx' //. -by rewrite oppr_cp0 hx // (@ltr_trans _ 0) ?oppr_cp0. +move=> hx; move: (ltW hx) => hx'; rewrite !ge0_cp hx' //. +by rewrite oppr_cp0 hx // (@lt_trans _ _ 0) ?oppr_cp0. Qed. Lemma le0_cp x : x <= 0 -> (0 <= - x) * (x <= - x). -Proof. by move=> hx; rewrite oppr_cp0 hx (@ler_trans _ 0) ?oppr_cp0. Qed. +Proof. by move=> hx; rewrite oppr_cp0 hx (@le_trans _ _ 0) ?oppr_cp0. Qed. Lemma lt0_cp x : x < 0 -> (x <= 0) * (0 <= - x) * (x <= - x) * (0 < - x) * (x < - x). Proof. -move=> hx; move: (ltrW hx) => hx'; rewrite !le0_cp // hx'. -by rewrite oppr_cp0 hx // (@ltr_trans _ 0) ?oppr_cp0. +move=> hx; move: (ltW hx) => hx'; rewrite !le0_cp // hx'. +by rewrite oppr_cp0 hx // (@lt_trans _ _ 0) ?oppr_cp0. Qed. (* Properties of the real subset. *) @@ -1634,10 +1575,10 @@ Lemma ler0_real x : x <= 0 -> x \is real. Proof. by rewrite realE orbC => ->. Qed. Lemma gtr0_real x : 0 < x -> x \is real. -Proof. by move=> /ltrW/ger0_real. Qed. +Proof. by move=> /ltW/ger0_real. Qed. Lemma ltr0_real x : x < 0 -> x \is real. -Proof. by move=> /ltrW/ler0_real. Qed. +Proof. by move=> /ltW/ler0_real. Qed. Lemma real0 : 0 \is @real R. Proof. by rewrite ger0_real. Qed. Hint Resolve real0 : core. @@ -1653,8 +1594,8 @@ Proof. by rewrite -!oppr_ge0 => /(ger_leVge _) h /h; rewrite !ler_opp2. Qed. Lemma real_leVge x y : x \is real -> y \is real -> (x <= y) || (y <= x). Proof. rewrite !realE; have [x_ge0 _|x_nge0 /= x_le0] := boolP (_ <= _); last first. - by have [/(ler_trans x_le0)->|_ /(ler_leVge x_le0) //] := boolP (0 <= _). -by have [/(ger_leVge x_ge0)|_ /ler_trans->] := boolP (0 <= _); rewrite ?orbT. + by have [/(le_trans x_le0)->|_ /(ler_leVge x_le0) //] := boolP (0 <= _). +by have [/(ger_leVge x_ge0)|_ /le_trans->] := boolP (0 <= _); rewrite ?orbT. Qed. Lemma realB : {in real &, forall x y, x - y \is real}. @@ -1689,39 +1630,39 @@ Variant comparer x y : R -> R -> | ComparerEq of x = y : comparer x y 0 0 true true true true false false. -Lemma real_lerP x y : +Lemma real_leP x y : x \is real -> y \is real -> ler_xor_gt x y `|x - y| `|y - x| (x <= y) (y < x). Proof. move=> xR /(real_leVge xR); have [le_xy _|Nle_xy /= le_yx] := boolP (_ <= _). - have [/(ler_lt_trans le_xy)|] := boolP (_ < _); first by rewrite ltrr. + have [/(le_lt_trans le_xy)|] := boolP (_ < _); first by rewrite ltxx. by rewrite ler0_norm ?ger0_norm ?subr_cp0 ?opprB //; constructor. have [lt_yx|] := boolP (_ < _). by rewrite ger0_norm ?ler0_norm ?subr_cp0 ?opprB //; constructor. -by rewrite ltr_def le_yx andbT negbK=> /eqP exy; rewrite exy lerr in Nle_xy. +by rewrite lt_def le_yx andbT negbK=> /eqP exy; rewrite exy lexx in Nle_xy. Qed. -Lemma real_ltrP x y : +Lemma real_ltP x y : x \is real -> y \is real -> ltr_xor_ge x y `|x - y| `|y - x| (y <= x) (x < y). -Proof. by move=> xR yR; case: real_lerP=> //; constructor. Qed. +Proof. by move=> xR yR; case: real_leP=> //; constructor. Qed. -Lemma real_ltrNge : {in real &, forall x y, (x < y) = ~~ (y <= x)}. -Proof. by move=> x y xR yR /=; case: real_lerP. Qed. +Lemma real_ltNge : {in real &, forall x y, (x < y) = ~~ (y <= x)}. +Proof. by move=> x y xR yR /=; case: real_leP. Qed. -Lemma real_lerNgt : {in real &, forall x y, (x <= y) = ~~ (y < x)}. -Proof. by move=> x y xR yR /=; case: real_lerP. Qed. +Lemma real_leNgt : {in real &, forall x y, (x <= y) = ~~ (y < x)}. +Proof. by move=> x y xR yR /=; case: real_leP. Qed. -Lemma real_ltrgtP x y : +Lemma real_ltgtP x y : x \is real -> y \is real -> comparer x y `|x - y| `|y - x| (y == x) (x == y) (x <= y) (y <= x) (x < y) (x > y). Proof. -move=> xR yR; case: real_lerP => // [le_yx|lt_xy]; last first. - by rewrite gtr_eqF // ltr_eqF // ler_gtF ?ltrW //; constructor. -case: real_lerP => // [le_xy|lt_yx]; last first. - by rewrite ltr_eqF // gtr_eqF //; constructor. -have /eqP ->: x == y by rewrite eqr_le le_yx le_xy. +move=> xR yR; case: real_leP => // [le_yx|lt_xy]; last first. + by rewrite gt_eqF // lt_eqF // le_gtF ?ltW //; constructor. +case: real_leP => // [le_xy|lt_yx]; last first. + by rewrite lt_eqF // gt_eqF //; constructor. +have /eqP ->: x == y by rewrite eq_le le_yx le_xy. by rewrite subrr eqxx; constructor. Qed. @@ -1739,28 +1680,28 @@ Variant comparer0 x : | ComparerLt0 of x < 0 : comparer0 x (- x) false false true false true false | ComparerEq0 of x = 0 : comparer0 x 0 true true true true false false. -Lemma real_ger0P x : x \is real -> ger0_xor_lt0 x `|x| (x < 0) (0 <= x). +Lemma real_ge0P x : x \is real -> ger0_xor_lt0 x `|x| (x < 0) (0 <= x). Proof. -move=> hx; rewrite -{2}[x]subr0; case: real_ltrP; +move=> hx; rewrite -{2}[x]subr0; case: real_ltP; by rewrite ?subr0 ?sub0r //; constructor. Qed. -Lemma real_ler0P x : x \is real -> ler0_xor_gt0 x `|x| (0 < x) (x <= 0). +Lemma real_le0P x : x \is real -> ler0_xor_gt0 x `|x| (0 < x) (x <= 0). Proof. -move=> hx; rewrite -{2}[x]subr0; case: real_ltrP; +move=> hx; rewrite -{2}[x]subr0; case: real_ltP; by rewrite ?subr0 ?sub0r //; constructor. Qed. -Lemma real_ltrgt0P x : +Lemma real_ltgt0P x : x \is real -> comparer0 x `|x| (0 == x) (x == 0) (x <= 0) (0 <= x) (x < 0) (x > 0). Proof. -move=> hx; rewrite -{2}[x]subr0; case: real_ltrgtP; +move=> hx; rewrite -{2}[x]subr0; case: real_ltgtP; by rewrite ?subr0 ?sub0r //; constructor. Qed. Lemma real_neqr_lt : {in real &, forall x y, (x != y) = (x < y) || (y < x)}. -Proof. by move=> * /=; case: real_ltrgtP. Qed. +Proof. by move=> * /=; case: real_ltgtP. Qed. Lemma ler_sub_real x y : x <= y -> y - x \is real. Proof. by move=> le_xy; rewrite ger0_real // subr_ge0. Qed. @@ -1784,10 +1725,10 @@ Lemma Nreal_geF x y : y \is real -> x \notin real -> (y <= x) = false. Proof. by move=> yR; apply: contraNF=> /ger_real->. Qed. Lemma Nreal_ltF x y : y \is real -> x \notin real -> (x < y) = false. -Proof. by move=> yR xNR; rewrite ltr_def Nreal_leF ?andbF. Qed. +Proof. by move=> yR xNR; rewrite lt_def Nreal_leF ?andbF. Qed. Lemma Nreal_gtF x y : y \is real -> x \notin real -> (y < x) = false. -Proof. by move=> yR xNR; rewrite ltr_def Nreal_geF ?andbF. Qed. +Proof. by move=> yR xNR; rewrite lt_def Nreal_geF ?andbF. Qed. (* real wlog *) @@ -1796,7 +1737,7 @@ Lemma real_wlog_ler P : forall a b : R, a \is real -> b \is real -> P a b. Proof. move=> sP hP a b ha hb; wlog: a b ha hb / a <= b => [hwlog|]; last exact: hP. -by case: (real_lerP ha hb)=> [/hP //|/ltrW hba]; apply: sP; apply: hP. +by case: (real_leP ha hb)=> [/hP //|/ltW hba]; apply: sP; apply: hP. Qed. Lemma real_wlog_ltr P : @@ -1805,7 +1746,7 @@ Lemma real_wlog_ltr P : forall a b : R, a \is real -> b \is real -> P a b. Proof. move=> rP sP hP; apply: real_wlog_ler=> // a b. -by rewrite ler_eqVlt; case: (altP (_ =P _))=> [->|] //= _ lab; apply: hP. +by rewrite le_eqVlt; case: (altP (_ =P _))=> [->|] //= _ lab; apply: hP. Qed. (* Monotony of addition *) @@ -1818,10 +1759,10 @@ Lemma ler_add2r x : {mono +%R^~ x : y z / y <= z}. Proof. by move=> y z /=; rewrite ![_ + x]addrC ler_add2l. Qed. Lemma ltr_add2l x : {mono +%R x : y z / y < z}. -Proof. by move=> y z /=; rewrite (lerW_mono (ler_add2l _)). Qed. +Proof. by move=> y z /=; rewrite (leW_mono (ler_add2l _)). Qed. Lemma ltr_add2r x : {mono +%R^~ x : y z / y < z}. -Proof. by move=> y z /=; rewrite (lerW_mono (ler_add2r _)). Qed. +Proof. by move=> y z /=; rewrite (leW_mono (ler_add2r _)). Qed. Definition ler_add2 := (ler_add2l, ler_add2r). Definition ltr_add2 := (ltr_add2l, ltr_add2r). @@ -1829,16 +1770,16 @@ Definition lter_add2 := (ler_add2, ltr_add2). (* Addition, subtraction and transitivity *) Lemma ler_add x y z t : x <= y -> z <= t -> x + z <= y + t. -Proof. by move=> lxy lzt; rewrite (@ler_trans _ (y + z)) ?lter_add2. Qed. +Proof. by move=> lxy lzt; rewrite (@le_trans _ _ (y + z)) ?lter_add2. Qed. Lemma ler_lt_add x y z t : x <= y -> z < t -> x + z < y + t. -Proof. by move=> lxy lzt; rewrite (@ler_lt_trans _ (y + z)) ?lter_add2. Qed. +Proof. by move=> lxy lzt; rewrite (@le_lt_trans _ _ (y + z)) ?lter_add2. Qed. Lemma ltr_le_add x y z t : x < y -> z <= t -> x + z < y + t. -Proof. by move=> lxy lzt; rewrite (@ltr_le_trans _ (y + z)) ?lter_add2. Qed. +Proof. by move=> lxy lzt; rewrite (@lt_le_trans _ _ (y + z)) ?lter_add2. Qed. Lemma ltr_add x y z t : x < y -> z < t -> x + z < y + t. -Proof. by move=> lxy lzt; rewrite ltr_le_add // ltrW. Qed. +Proof. by move=> lxy lzt; rewrite ltr_le_add // ltW. Qed. Lemma ler_sub x y z t : x <= y -> t <= z -> x - z <= y - t. Proof. by move=> lxy ltz; rewrite ler_add // lter_opp2. Qed. @@ -1966,7 +1907,7 @@ Lemma paddr_eq0 (x y : R) : 0 <= x -> 0 <= y -> (x + y == 0) = (x == 0) && (y == 0). Proof. rewrite le0r; case/orP=> [/eqP->|hx]; first by rewrite add0r eqxx. -by rewrite (gtr_eqF hx) /= => hy; rewrite gtr_eqF // ltr_spaddl. +by rewrite (gt_eqF hx) /= => hy; rewrite gt_eqF // ltr_spaddl. Qed. Lemma naddr_eq0 (x y : R) : @@ -1988,7 +1929,7 @@ Proof. exact: (big_ind _ _ (@ler_paddl 0)). Qed. Lemma ler_sum I (r : seq I) (P : pred I) (F G : I -> R) : (forall i, P i -> F i <= G i) -> \sum_(i <- r | P i) F i <= \sum_(i <- r | P i) G i. -Proof. exact: (big_ind2 _ (lerr _) ler_add). Qed. +Proof. exact: (big_ind2 _ (lexx _) ler_add). Qed. Lemma psumr_eq0 (I : eqType) (r : seq I) (P : pred I) (F : I -> R) : (forall i, P i -> 0 <= F i) -> @@ -2015,7 +1956,7 @@ by move=> x_gt0 y z /=; rewrite -subr_ge0 -mulrBr pmulr_rge0 // subr_ge0. Qed. Lemma ltr_pmul2l x : 0 < x -> {mono *%R x : x y / x < y}. -Proof. by move=> x_gt0; apply: lerW_mono (ler_pmul2l _). Qed. +Proof. by move=> x_gt0; apply: leW_mono (ler_pmul2l _). Qed. Definition lter_pmul2l := (ler_pmul2l, ltr_pmul2l). @@ -2023,7 +1964,7 @@ Lemma ler_pmul2r x : 0 < x -> {mono *%R^~ x : x y / x <= y}. Proof. by move=> x_gt0 y z /=; rewrite ![_ * x]mulrC ler_pmul2l. Qed. Lemma ltr_pmul2r x : 0 < x -> {mono *%R^~ x : x y / x < y}. -Proof. by move=> x_gt0; apply: lerW_mono (ler_pmul2r _). Qed. +Proof. by move=> x_gt0; apply: leW_mono (ler_pmul2r _). Qed. Definition lter_pmul2r := (ler_pmul2r, ltr_pmul2r). @@ -2033,7 +1974,7 @@ by move=> x_lt0 y z /=; rewrite -ler_opp2 -!mulNr ler_pmul2l ?oppr_gt0. Qed. Lemma ltr_nmul2l x : x < 0 -> {mono *%R x : x y /~ x < y}. -Proof. by move=> x_lt0; apply: lerW_nmono (ler_nmul2l _). Qed. +Proof. by move=> x_lt0; apply: leW_nmono (ler_nmul2l _). Qed. Definition lter_nmul2l := (ler_nmul2l, ltr_nmul2l). @@ -2041,7 +1982,7 @@ Lemma ler_nmul2r x : x < 0 -> {mono *%R^~ x : x y /~ x <= y}. Proof. by move=> x_lt0 y z /=; rewrite ![_ * x]mulrC ler_nmul2l. Qed. Lemma ltr_nmul2r x : x < 0 -> {mono *%R^~ x : x y /~ x < y}. -Proof. by move=> x_lt0; apply: lerW_nmono (ler_nmul2r _). Qed. +Proof. by move=> x_lt0; apply: leW_nmono (ler_nmul2r _). Qed. Definition lter_nmul2r := (ler_nmul2r, ltr_nmul2r). @@ -2068,15 +2009,15 @@ Qed. Lemma ler_pmul x1 y1 x2 y2 : 0 <= x1 -> 0 <= x2 -> x1 <= y1 -> x2 <= y2 -> x1 * x2 <= y1 * y2. Proof. -move=> x1ge0 x2ge0 le_xy1 le_xy2; have y1ge0 := ler_trans x1ge0 le_xy1. -exact: ler_trans (ler_wpmul2r x2ge0 le_xy1) (ler_wpmul2l y1ge0 le_xy2). +move=> x1ge0 x2ge0 le_xy1 le_xy2; have y1ge0 := le_trans x1ge0 le_xy1. +exact: le_trans (ler_wpmul2r x2ge0 le_xy1) (ler_wpmul2l y1ge0 le_xy2). Qed. Lemma ltr_pmul x1 y1 x2 y2 : 0 <= x1 -> 0 <= x2 -> x1 < y1 -> x2 < y2 -> x1 * x2 < y1 * y2. Proof. -move=> x1ge0 x2ge0 lt_xy1 lt_xy2; have y1gt0 := ler_lt_trans x1ge0 lt_xy1. -by rewrite (ler_lt_trans (ler_wpmul2r x2ge0 (ltrW lt_xy1))) ?ltr_pmul2l. +move=> x1ge0 x2ge0 lt_xy1 lt_xy2; have y1gt0 := le_lt_trans x1ge0 lt_xy1. +by rewrite (le_lt_trans (ler_wpmul2r x2ge0 (ltW lt_xy1))) ?ltr_pmul2l. Qed. (* complement for x *+ n and <= or < *) @@ -2087,10 +2028,10 @@ by case: n => // n _ x y /=; rewrite -mulr_natl -[y *+ _]mulr_natl ler_pmul2l. Qed. Lemma ltr_pmuln2r n : (0 < n)%N -> {mono (@GRing.natmul R)^~ n : x y / x < y}. -Proof. by move/ler_pmuln2r/lerW_mono. Qed. +Proof. by move/ler_pmuln2r/leW_mono. Qed. Lemma pmulrnI n : (0 < n)%N -> injective ((@GRing.natmul R)^~ n). -Proof. by move/ler_pmuln2r/incr_inj. Qed. +Proof. by move/ler_pmuln2r/inc_inj. Qed. Lemma eqr_pmuln2r n : (0 < n)%N -> {mono (@GRing.natmul R)^~ n : x y / x == y}. Proof. by move/pmulrnI/inj_eq. Qed. @@ -2123,13 +2064,13 @@ Lemma mulrn_wle0 x n : x <= 0 -> x *+ n <= 0. Proof. by move=> /(ler_wmuln2r n); rewrite mul0rn. Qed. Lemma ler_muln2r n x y : (x *+ n <= y *+ n) = ((n == 0%N) || (x <= y)). -Proof. by case: n => [|n]; rewrite ?lerr ?eqxx // ler_pmuln2r. Qed. +Proof. by case: n => [|n]; rewrite ?lexx ?eqxx // ler_pmuln2r. Qed. Lemma ltr_muln2r n x y : (x *+ n < y *+ n) = ((0 < n)%N && (x < y)). -Proof. by case: n => [|n]; rewrite ?lerr ?eqxx // ltr_pmuln2r. Qed. +Proof. by case: n => [|n]; rewrite ?lexx ?eqxx // ltr_pmuln2r. Qed. Lemma eqr_muln2r n x y : (x *+ n == y *+ n) = (n == 0)%N || (x == y). -Proof. by rewrite !eqr_le !ler_muln2r -orb_andr. Qed. +Proof. by rewrite !(@eq_le _ R) !ler_muln2r -orb_andr. Qed. (* More characteristic zero properties. *) @@ -2162,14 +2103,14 @@ Proof. by case: n => // n hx; rewrite pmulrn_llt0. Qed. Lemma ler_pmuln2l x : 0 < x -> {mono (@GRing.natmul R x) : m n / (m <= n)%N >-> m <= n}. Proof. -move=> x_gt0 m n /=; case: leqP => hmn; first by rewrite ler_wpmuln2l // ltrW. -rewrite -(subnK (ltnW hmn)) mulrnDr ger_addr ltr_geF //. +move=> x_gt0 m n /=; case: leqP => hmn; first by rewrite ler_wpmuln2l // ltW. +rewrite -(subnK (ltnW hmn)) mulrnDr ger_addr lt_geF //. by rewrite mulrn_wgt0 // subn_gt0. Qed. Lemma ltr_pmuln2l x : 0 < x -> {mono (@GRing.natmul R x) : m n / (m < n)%N >-> m < n}. -Proof. by move=> x_gt0; apply: lenrW_mono (ler_pmuln2l _). Qed. +Proof. by move=> x_gt0; apply: leW_mono (ler_pmuln2l _). Qed. Lemma ler_nmuln2l x : x < 0 -> {mono (@GRing.natmul R x) : m n / (n <= m)%N >-> m <= n}. @@ -2179,7 +2120,7 @@ Qed. Lemma ltr_nmuln2l x : x < 0 -> {mono (@GRing.natmul R x) : m n / (n < m)%N >-> m < n}. -Proof. by move=> x_lt0; apply: lenrW_nmono (ler_nmuln2l _). Qed. +Proof. by move=> x_lt0; apply: leW_nmono (ler_nmuln2l _). Qed. Lemma ler_nat m n : (m%:R <= n%:R :> R) = (m <= n)%N. Proof. by rewrite ler_pmuln2l. Qed. @@ -2206,10 +2147,10 @@ Lemma ltrn1 n : n%:R < 1 :> R = (n < 1)%N. Proof. by rewrite -ltr_nat. Qed. Lemma ltrN10 : -1 < 0 :> R. Proof. by rewrite oppr_lt0. Qed. Lemma lerN10 : -1 <= 0 :> R. Proof. by rewrite oppr_le0. Qed. -Lemma ltr10 : 1 < 0 :> R = false. Proof. by rewrite ler_gtF. Qed. -Lemma ler10 : 1 <= 0 :> R = false. Proof. by rewrite ltr_geF. Qed. -Lemma ltr0N1 : 0 < -1 :> R = false. Proof. by rewrite ler_gtF // lerN10. Qed. -Lemma ler0N1 : 0 <= -1 :> R = false. Proof. by rewrite ltr_geF // ltrN10. Qed. +Lemma ltr10 : 1 < 0 :> R = false. Proof. by rewrite le_gtF. Qed. +Lemma ler10 : 1 <= 0 :> R = false. Proof. by rewrite lt_geF. Qed. +Lemma ltr0N1 : 0 < -1 :> R = false. Proof. by rewrite le_gtF // lerN10. Qed. +Lemma ler0N1 : 0 <= -1 :> R = false. Proof. by rewrite lt_geF // ltrN10. Qed. Lemma pmulrn_rgt0 x n : 0 < x -> 0 < x *+ n = (0 < n)%N. Proof. by move=> x_gt0; rewrite -(mulr0n x) ltr_pmuln2l. Qed. @@ -2324,9 +2265,9 @@ Lemma ltr_prod I r (P : pred I) (E1 E2 : I -> R) : Proof. elim: r => //= i r IHr; rewrite !big_cons; case: ifP => {IHr}// Pi _ ltE12. have /andP[le0E1i ltE12i] := ltE12 i Pi; set E2r := \prod_(j <- r | P j) E2 j. -apply: ler_lt_trans (_ : E1 i * E2r < E2 i * E2r). - by rewrite ler_wpmul2l ?ler_prod // => j /ltE12/andP[-> /ltrW]. -by rewrite ltr_pmul2r ?prodr_gt0 // => j /ltE12/andP[le0E1j /ler_lt_trans->]. +apply: le_lt_trans (_ : E1 i * E2r < E2 i * E2r). + by rewrite ler_wpmul2l ?ler_prod // => j /ltE12/andP[-> /ltW]. +by rewrite ltr_pmul2r ?prodr_gt0 // => j /ltE12/andP[le0E1j /le_lt_trans->]. Qed. Lemma ltr_prod_nat (E1 E2 : nat -> R) (n m : nat) : @@ -2341,7 +2282,7 @@ Qed. Lemma realMr x y : x != 0 -> x \is real -> (x * y \is real) = (y \is real). Proof. -move=> x_neq0 xR; case: real_ltrgtP x_neq0 => // hx _; rewrite !realE. +move=> x_neq0 xR; case: real_ltgtP x_neq0 => // hx _; rewrite !realE. by rewrite nmulr_rge0 // nmulr_rle0 // orbC. by rewrite pmulr_rge0 // pmulr_rle0 // orbC. Qed. @@ -2433,21 +2374,21 @@ Lemma ler_nimulr x y : y <= 0 -> x <= 1 -> y <= y * x. Proof. by move=> hx hy; rewrite -{1}[y]mulr1 ler_wnmul2l. Qed. Lemma mulr_ile1 x y : 0 <= x -> 0 <= y -> x <= 1 -> y <= 1 -> x * y <= 1. -Proof. by move=> *; rewrite (@ler_trans _ y) ?ler_pimull. Qed. +Proof. by move=> *; rewrite (@le_trans _ _ y) ?ler_pimull. Qed. Lemma mulr_ilt1 x y : 0 <= x -> 0 <= y -> x < 1 -> y < 1 -> x * y < 1. -Proof. by move=> *; rewrite (@ler_lt_trans _ y) ?ler_pimull // ltrW. Qed. +Proof. by move=> *; rewrite (@le_lt_trans _ _ y) ?ler_pimull // ltW. Qed. Definition mulr_ilte1 := (mulr_ile1, mulr_ilt1). Lemma mulr_ege1 x y : 1 <= x -> 1 <= y -> 1 <= x * y. Proof. -by move=> le1x le1y; rewrite (@ler_trans _ y) ?ler_pemull // (ler_trans ler01). +by move=> le1x le1y; rewrite (@le_trans _ _ y) ?ler_pemull // (le_trans ler01). Qed. Lemma mulr_egt1 x y : 1 < x -> 1 < y -> 1 < x * y. Proof. -by move=> le1x lt1y; rewrite (@ltr_trans _ y) // ltr_pmull // (ltr_trans ltr01). +by move=> le1x lt1y; rewrite (@lt_trans _ _ y) // ltr_pmull // (lt_trans ltr01). Qed. Definition mulr_egte1 := (mulr_ege1, mulr_egt1). Definition mulr_cp1 := (mulr_ilte1, mulr_egte1). @@ -2504,7 +2445,7 @@ Qed. Lemma exprn_ilt1 n x : 0 <= x -> x < 1 -> x ^+ n < 1 = (n != 0%N). Proof. move=> xge0 xlt1. -case: n; [by rewrite eqxx ltrr | elim=> [|n ihn]; first by rewrite expr1]. +case: n; [by rewrite eqxx ltxx | elim=> [|n ihn]; first by rewrite expr1]. by rewrite exprS mulr_ilt1 // exprn_ge0. Qed. @@ -2517,7 +2458,7 @@ Qed. Lemma exprn_egt1 n x : 1 < x -> 1 < x ^+ n = (n != 0%N). Proof. -move=> xgt1; case: n; first by rewrite eqxx ltrr. +move=> xgt1; case: n; first by rewrite eqxx ltxx. elim=> [|n ihn]; first by rewrite expr1. by rewrite exprS mulr_egt1 // exprn_ge0. Qed. @@ -2530,8 +2471,8 @@ Proof. by case: n => n // *; rewrite exprS ler_pimulr // exprn_ile1. Qed. Lemma ltr_iexpr x n : 0 < x -> x < 1 -> (x ^+ n < x) = (1 < n)%N. Proof. -case: n=> [|[|n]] //; first by rewrite expr0 => _ /ltr_gtF ->. -by move=> x0 x1; rewrite exprS gtr_pmulr // ?exprn_ilt1 // ltrW. +case: n=> [|[|n]] //; first by rewrite expr0 => _ /lt_gtF ->. +by move=> x0 x1; rewrite exprS gtr_pmulr // ?exprn_ilt1 // ltW. Qed. Definition lter_iexpr := (ler_iexpr, ltr_iexpr). @@ -2539,13 +2480,13 @@ Definition lter_iexpr := (ler_iexpr, ltr_iexpr). Lemma ler_eexpr x n : (0 < n)%N -> 1 <= x -> x <= x ^+ n. Proof. case: n => // n _ x_ge1. -by rewrite exprS ler_pemulr ?(ler_trans _ x_ge1) // exprn_ege1. +by rewrite exprS ler_pemulr ?(le_trans _ x_ge1) // exprn_ege1. Qed. Lemma ltr_eexpr x n : 1 < x -> (x < x ^+ n) = (1 < n)%N. Proof. -move=> x_ge1; case: n=> [|[|n]] //; first by rewrite expr0 ltr_gtF. -by rewrite exprS ltr_pmulr ?(ltr_trans _ x_ge1) ?exprn_egt1. +move=> x_ge1; case: n=> [|[|n]] //; first by rewrite expr0 lt_gtF. +by rewrite exprS ltr_pmulr ?(lt_trans _ x_ge1) ?exprn_egt1. Qed. Definition lter_eexpr := (ler_eexpr, ltr_eexpr). @@ -2562,15 +2503,15 @@ Lemma ler_weexpn2l x : 1 <= x -> {homo (GRing.exp x) : m n / (m <= n)%N >-> m <= n}. Proof. move=> xge1 m n /= hmn; rewrite -(subnK hmn) exprD. -by rewrite ler_pemull ?(exprn_ge0, exprn_ege1) // (ler_trans _ xge1) ?ler01. +by rewrite ler_pemull ?(exprn_ge0, exprn_ege1) // (le_trans _ xge1) ?ler01. Qed. Lemma ieexprn_weq1 x n : 0 <= x -> (x ^+ n == 1) = ((n == 0%N) || (x == 1)). Proof. move=> xle0; case: n => [|n]; first by rewrite expr0 eqxx. -case: (@real_ltrgtP x 1); do ?by rewrite ?ger0_real. -+ by move=> x_lt1; rewrite ?ltr_eqF // exprn_ilt1. -+ by move=> x_lt1; rewrite ?gtr_eqF // exprn_egt1. +case: (@real_ltgtP x 1); do ?by rewrite ?ger0_real. ++ by move=> x_lt1; rewrite 1?lt_eqF // exprn_ilt1. ++ by move=> x_lt1; rewrite 1?gt_eqF // exprn_egt1. by move->; rewrite expr1n eqxx. Qed. @@ -2579,50 +2520,50 @@ Proof. move=> x_gt0 x_neq1 m n; without loss /subnK <-: m n / (n <= m)%N. by move=> IH eq_xmn; case/orP: (leq_total m n) => /IH->. case: {m}(m - n)%N => // m /eqP/idPn[]; rewrite -[x ^+ n]mul1r exprD. -by rewrite (inj_eq (mulIf _)) ?ieexprn_weq1 ?ltrW // expf_neq0 ?gtr_eqF. +by rewrite (inj_eq (mulIf _)) ?ieexprn_weq1 ?ltW // expf_neq0 ?gt_eqF. Qed. Lemma ler_iexpn2l x : 0 < x -> x < 1 -> {mono (GRing.exp x) : m n / (n <= m)%N >-> m <= n}. Proof. -move=> xgt0 xlt1; apply: (lenr_nmono (inj_nhomo_ltnr _ _)); last first. - by apply: ler_wiexpn2l; rewrite ltrW. -by apply: ieexprIn; rewrite ?ltr_eqF ?ltr_cpable. +move=> xgt0 xlt1; apply: (le_nmono (inj_nhomo_lt _ _)); last first. + by apply: ler_wiexpn2l; rewrite ltW. +by apply: ieexprIn; rewrite ?lt_eqF ?ltr_cpable. Qed. Lemma ltr_iexpn2l x : 0 < x -> x < 1 -> {mono (GRing.exp x) : m n / (n < m)%N >-> m < n}. -Proof. by move=> xgt0 xlt1; apply: (lenrW_nmono (ler_iexpn2l _ _)). Qed. +Proof. by move=> xgt0 xlt1; apply: (leW_nmono (ler_iexpn2l _ _)). Qed. Definition lter_iexpn2l := (ler_iexpn2l, ltr_iexpn2l). Lemma ler_eexpn2l x : 1 < x -> {mono (GRing.exp x) : m n / (m <= n)%N >-> m <= n}. Proof. -move=> xgt1; apply: (lenr_mono (inj_homo_ltnr _ _)); last first. - by apply: ler_weexpn2l; rewrite ltrW. -by apply: ieexprIn; rewrite ?gtr_eqF ?gtr_cpable //; apply: ltr_trans xgt1. +move=> xgt1; apply: (le_mono (inj_homo_lt _ _)); last first. + by apply: ler_weexpn2l; rewrite ltW. +by apply: ieexprIn; rewrite ?gt_eqF ?gtr_cpable //; apply: lt_trans xgt1. Qed. Lemma ltr_eexpn2l x : 1 < x -> {mono (GRing.exp x) : m n / (m < n)%N >-> m < n}. -Proof. by move=> xgt1; apply: (lenrW_mono (ler_eexpn2l _)). Qed. +Proof. by move=> xgt1; apply: (leW_mono (ler_eexpn2l _)). Qed. Definition lter_eexpn2l := (ler_eexpn2l, ltr_eexpn2l). Lemma ltr_expn2r n x y : 0 <= x -> x < y -> x ^+ n < y ^+ n = (n != 0%N). Proof. -move=> xge0 xlty; case: n; first by rewrite ltrr. +move=> xge0 xlty; case: n; first by rewrite ltxx. elim=> [|n IHn]; rewrite ?[_ ^+ _.+2]exprS //. -rewrite (@ler_lt_trans _ (x * y ^+ n.+1)) ?ler_wpmul2l ?ltr_pmul2r ?IHn //. - by rewrite ltrW // ihn. -by rewrite exprn_gt0 // (ler_lt_trans xge0). +rewrite (@le_lt_trans _ _ (x * y ^+ n.+1)) ?ler_wpmul2l ?ltr_pmul2r ?IHn //. + by rewrite ltW // ihn. +by rewrite exprn_gt0 // (le_lt_trans xge0). Qed. Lemma ler_expn2r n : {in nneg & , {homo ((@GRing.exp R)^~ n) : x y / x <= y}}. Proof. move=> x y /= x0 y0 xy; elim: n => [|n IHn]; rewrite !(expr0, exprS) //. -by rewrite (@ler_trans _ (x * y ^+ n)) ?ler_wpmul2l ?ler_wpmul2r ?exprn_ge0. +by rewrite (@le_trans _ _ (x * y ^+ n)) ?ler_wpmul2l ?ler_wpmul2r ?exprn_ge0. Qed. Definition lter_expn2r := (ler_expn2r, ltr_expn2r). @@ -2644,13 +2585,13 @@ Qed. Lemma ltr_pexpn2r n : (0 < n)%N -> {in nneg & , {mono ((@GRing.exp R)^~ n) : x y / x < y}}. Proof. -by move=> n_gt0 x y x_ge0 y_ge0; rewrite !ltr_neqAle !eqr_le !ler_pexpn2r. +by move=> n_gt0 x y x_ge0 y_ge0; rewrite !lt_neqAle !eq_le !ler_pexpn2r. Qed. Definition lter_pexpn2r := (ler_pexpn2r, ltr_pexpn2r). Lemma pexpIrn n : (0 < n)%N -> {in nneg &, injective ((@GRing.exp R)^~ n)}. -Proof. by move=> n_gt0; apply: incr_inj_in (ler_pexpn2r _). Qed. +Proof. by move=> n_gt0; apply: inc_inj_in (ler_pexpn2r _). Qed. (* expr and ler/ltr *) Lemma expr_le1 n x : (0 < n)%N -> 0 <= x -> (x ^+ n <= 1) = (x <= 1). @@ -2678,7 +2619,7 @@ Qed. Definition expr_gte1 := (expr_ge1, expr_gt1). Lemma pexpr_eq1 x n : (0 < n)%N -> 0 <= x -> (x ^+ n == 1) = (x == 1). -Proof. by move=> ngt0 xge0; rewrite !eqr_le expr_le1 // expr_ge1. Qed. +Proof. by move=> ngt0 xge0; rewrite !eq_le expr_le1 // expr_ge1. Qed. Lemma pexprn_eq1 x n : 0 <= x -> (x ^+ n == 1) = (n == 0%N) || (x == 1). Proof. by case: n => [|n] xge0; rewrite ?eqxx // pexpr_eq1 ?gtn_eqF. Qed. @@ -2717,11 +2658,11 @@ Qed. Lemma ltr_pinv : {in [pred x in GRing.unit | 0 < x] &, {mono (@GRing.inv R) : x y /~ x < y}}. -Proof. exact: lerW_nmono_in ler_pinv. Qed. +Proof. exact: leW_nmono_in ler_pinv. Qed. Lemma ltr_ninv : {in [pred x in GRing.unit | x < 0] &, {mono (@GRing.inv R) : x y /~ x < y}}. -Proof. exact: lerW_nmono_in ler_ninv. Qed. +Proof. exact: leW_nmono_in ler_ninv. Qed. Lemma invr_gt1 x : x \is a GRing.unit -> 0 < x -> (1 < x^-1) = (x < 1). Proof. @@ -2749,44 +2690,61 @@ Definition invr_cp1 := (invr_gte1, invr_lte1). Lemma real_ler_norm x : x \is real -> x <= `|x|. Proof. -by case/real_ger0P=> hx //; rewrite (ler_trans (ltrW hx)) // oppr_ge0 ltrW. +by case/real_ge0P=> hx //; rewrite (le_trans (ltW hx)) // oppr_ge0 ltW. Qed. (* norm + add *) -Lemma normr_real x : `|x| \is real. Proof. by rewrite ger0_real. Qed. +Section NormedDomainTheory. + +Variable V : normedDomainType R. +Implicit Types (u v w : V). + +Lemma normr_real v : `|v| \is real. Proof. by apply/ger0_real. Qed. Hint Resolve normr_real : core. -Lemma ler_norm_sum I r (G : I -> R) (P : pred I): +Lemma ler_norm_sum I r (G : I -> V) (P : pred I): `|\sum_(i <- r | P i) G i| <= \sum_(i <- r | P i) `|G i|. Proof. elim/big_rec2: _ => [|i y x _]; first by rewrite normr0. -by rewrite -(ler_add2l `|G i|); apply: ler_trans; apply: ler_norm_add. +by rewrite -(ler_add2l `|G i|); apply: le_trans; apply: ler_norm_add. Qed. -Lemma ler_norm_sub x y : `|x - y| <= `|x| + `|y|. -Proof. by rewrite (ler_trans (ler_norm_add _ _)) ?normrN. Qed. +Lemma ler_norm_sub v w : `|v - w| <= `|v| + `|w|. +Proof. by rewrite (le_trans (ler_norm_add _ _)) ?normrN. Qed. -Lemma ler_dist_add z x y : `|x - y| <= `|x - z| + `|z - y|. -Proof. by rewrite (ler_trans _ (ler_norm_add _ _)) // addrA addrNK. Qed. +Lemma ler_dist_add u v w : `|v - w| <= `|v - u| + `|u - w|. +Proof. by rewrite (le_trans _ (ler_norm_add _ _)) // addrA addrNK. Qed. -Lemma ler_sub_norm_add x y : `|x| - `|y| <= `|x + y|. +Lemma ler_sub_norm_add v w : `|v| - `|w| <= `|v + w|. Proof. -rewrite -{1}[x](addrK y) lter_sub_addl. -by rewrite (ler_trans (ler_norm_add _ _)) // addrC normrN. +rewrite -{1}[v](addrK w) lter_sub_addl. +by rewrite (le_trans (ler_norm_add _ _)) // addrC normrN. Qed. -Lemma ler_sub_dist x y : `|x| - `|y| <= `|x - y|. -Proof. by rewrite -[`|y|]normrN ler_sub_norm_add. Qed. +Lemma ler_sub_dist v w : `|v| - `|w| <= `|v - w|. +Proof. by rewrite -[`|w|]normrN ler_sub_norm_add. Qed. -Lemma ler_dist_dist x y : `|`|x| - `|y| | <= `|x - y|. +Lemma ler_dist_dist v w : `| `|v| - `|w| | <= `|v - w|. Proof. -have [||_|_] // := @real_lerP `|x| `|y|; last by rewrite ler_sub_dist. +have [||_|_] // := @real_leP `|v| `|w|; last by rewrite ler_sub_dist. by rewrite distrC ler_sub_dist. Qed. -Lemma ler_dist_norm_add x y : `| `|x| - `|y| | <= `| x + y |. -Proof. by rewrite -[y]opprK normrN ler_dist_dist. Qed. +Lemma ler_dist_norm_add v w : `| `|v| - `|w| | <= `|v + w|. +Proof. by rewrite -[w]opprK normrN ler_dist_dist. Qed. + +Lemma ler_nnorml v x : x < 0 -> `|v| <= x = false. +Proof. by move=> h; rewrite lt_geF //; apply/(lt_le_trans h). Qed. + +Lemma ltr_nnorml v x : x <= 0 -> `|v| < x = false. +Proof. by move=> h; rewrite le_gtF //; apply/(le_trans h). Qed. + +Definition lter_nnormr := (ler_nnorml, ltr_nnorml). + +End NormedDomainTheory. + +Hint Extern 0 (is_true (norm _ \is real)) => exact: normr_real : core. Lemma real_ler_norml x y : x \is real -> (`|x| <= y) = (- y <= x <= y). Proof. @@ -2794,7 +2752,7 @@ move=> xR; wlog x_ge0 : x xR / 0 <= x => [hwlog|]. move: (xR) => /(@real_leVge 0) /orP [|/hwlog->|hx] //. by rewrite -[x]opprK normrN ler_opp2 andbC ler_oppl hwlog ?realN ?oppr_ge0. rewrite ger0_norm //; have [le_xy|] := boolP (x <= y); last by rewrite andbF. -by rewrite (ler_trans _ x_ge0) // oppr_le0 (ler_trans x_ge0). +by rewrite (le_trans _ x_ge0) // oppr_le0 (le_trans x_ge0). Qed. Lemma real_ler_normlP x y : @@ -2809,16 +2767,16 @@ Lemma real_eqr_norml x y : Proof. move=> Rx. apply/idP/idP=> [|/andP[/pred2P[]-> /ger0_norm/eqP]]; rewrite ?normrE //. -case: real_ler0P => // hx; rewrite 1?eqr_oppLR => /eqP exy. +case: real_le0P => // hx; rewrite 1?eqr_oppLR => /eqP exy. by move: hx; rewrite exy ?oppr_le0 eqxx orbT //. -by move: hx=> /ltrW; rewrite exy eqxx. +by move: hx=> /ltW; rewrite exy eqxx. Qed. Lemma real_eqr_norm2 x y : x \is real -> y \is real -> (`|x| == `|y|) = (x == y) || (x == -y). Proof. move=> Rx Ry; rewrite real_eqr_norml // normrE andbT. -by case: real_ler0P; rewrite // opprK orbC. +by case: real_le0P; rewrite // opprK orbC. Qed. Lemma real_ltr_norml x y : x \is real -> (`|x| < y) = (- y < x < y). @@ -2827,7 +2785,7 @@ move=> Rx; wlog x_ge0 : x Rx / 0 <= x => [hwlog|]. move: (Rx) => /(@real_leVge 0) /orP [|/hwlog->|hx] //. by rewrite -[x]opprK normrN ltr_opp2 andbC ltr_oppl hwlog ?realN ?oppr_ge0. rewrite ger0_norm //; have [le_xy|] := boolP (x < y); last by rewrite andbF. -by rewrite (ltr_le_trans _ x_ge0) // oppr_lt0 (ler_lt_trans x_ge0). +by rewrite (lt_le_trans _ x_ge0) // oppr_lt0 (le_lt_trans x_ge0). Qed. Definition real_lter_norml := (real_ler_norml, real_ltr_norml). @@ -2844,7 +2802,7 @@ Lemma real_ler_normr x y : y \is real -> (x <= `|y|) = (x <= y) || (x <= - y). Proof. move=> Ry. have [xR|xNR] := boolP (x \is real); last by rewrite ?Nreal_leF ?realN. -rewrite real_lerNgt ?real_ltr_norml // negb_and -?real_lerNgt ?realN //. +rewrite real_leNgt ?real_ltr_norml // negb_and -?real_leNgt ?realN //. by rewrite orbC ler_oppr. Qed. @@ -2852,20 +2810,12 @@ Lemma real_ltr_normr x y : y \is real -> (x < `|y|) = (x < y) || (x < - y). Proof. move=> Ry. have [xR|xNR] := boolP (x \is real); last by rewrite ?Nreal_ltF ?realN. -rewrite real_ltrNge ?real_ler_norml // negb_and -?real_ltrNge ?realN //. +rewrite real_ltNge ?real_ler_norml // negb_and -?real_ltNge ?realN //. by rewrite orbC ltr_oppr. Qed. Definition real_lter_normr := (real_ler_normr, real_ltr_normr). -Lemma ler_nnorml x y : y < 0 -> `|x| <= y = false. -Proof. by move=> y_lt0; rewrite ltr_geF // (ltr_le_trans y_lt0). Qed. - -Lemma ltr_nnorml x y : y <= 0 -> `|x| < y = false. -Proof. by move=> y_le0; rewrite ler_gtF // (ler_trans y_le0). Qed. - -Definition lter_nnormr := (ler_nnorml, ltr_nnorml). - Lemma real_ler_distl x y e : x - y \is real -> (`|x - y| <= e) = (y - e <= x <= y + e). Proof. by move=> Rxy; rewrite real_lter_norml // !lter_sub_addl. Qed. @@ -2883,9 +2833,9 @@ Definition eqr_norm_idVN := =^~ (ger0_def, ler0_def). Lemma real_exprn_even_ge0 n x : x \is real -> ~~ odd n -> 0 <= x ^+ n. Proof. -move=> xR even_n; have [/exprn_ge0 -> //|x_lt0] := real_ger0P xR. +move=> xR even_n; have [/exprn_ge0 -> //|x_lt0] := real_ge0P xR. rewrite -[x]opprK -mulN1r exprMn -signr_odd (negPf even_n) expr0 mul1r. -by rewrite exprn_ge0 ?oppr_ge0 ?ltrW. +by rewrite exprn_ge0 ?oppr_ge0 ?ltW. Qed. Lemma real_exprn_even_gt0 n x : @@ -2898,21 +2848,21 @@ Qed. Lemma real_exprn_even_le0 n x : x \is real -> ~~ odd n -> (x ^+ n <= 0) = (n != 0%N) && (x == 0). Proof. -move=> xR n_even; rewrite !real_lerNgt ?rpred0 ?rpredX //. +move=> xR n_even; rewrite !real_leNgt ?rpred0 ?rpredX //. by rewrite real_exprn_even_gt0 // negb_or negbK. Qed. Lemma real_exprn_even_lt0 n x : x \is real -> ~~ odd n -> (x ^+ n < 0) = false. -Proof. by move=> xR n_even; rewrite ler_gtF // real_exprn_even_ge0. Qed. +Proof. by move=> xR n_even; rewrite le_gtF // real_exprn_even_ge0. Qed. Lemma real_exprn_odd_ge0 n x : x \is real -> odd n -> (0 <= x ^+ n) = (0 <= x). Proof. -case/real_ger0P => [x_ge0|x_lt0] n_odd; first by rewrite exprn_ge0. -apply: negbTE; rewrite ltr_geF //. +case/real_ge0P => [x_ge0|x_lt0] n_odd; first by rewrite exprn_ge0. +apply: negbTE; rewrite lt_geF //. case: n n_odd => // n /= n_even; rewrite exprS pmulr_llt0 //. -by rewrite real_exprn_even_gt0 ?ler0_real ?ltrW // ltr_eqF ?orbT. +by rewrite real_exprn_even_gt0 ?ler0_real ?ltW // (lt_eqF x_lt0) ?orbT. Qed. Lemma real_exprn_odd_gt0 n x : x \is real -> odd n -> (0 < x ^+ n) = (0 < x). @@ -2922,12 +2872,12 @@ Qed. Lemma real_exprn_odd_le0 n x : x \is real -> odd n -> (x ^+ n <= 0) = (x <= 0). Proof. -by move=> xR n_odd; rewrite !real_lerNgt ?rpred0 ?rpredX // real_exprn_odd_gt0. +by move=> xR n_odd; rewrite !real_leNgt ?rpred0 ?rpredX // real_exprn_odd_gt0. Qed. Lemma real_exprn_odd_lt0 n x : x \is real -> odd n -> (x ^+ n < 0) = (x < 0). Proof. -by move=> xR n_odd; rewrite !real_ltrNge ?rpred0 ?rpredX // real_exprn_odd_ge0. +by move=> xR n_odd; rewrite !real_ltNge ?rpred0 ?rpredX // real_exprn_odd_ge0. Qed. (* GG: Could this be a better definition of "real" ? *) @@ -2939,7 +2889,7 @@ Proof. by move=> Rx; rewrite -normrX ger0_norm -?realEsqr. Qed. (* Binary sign ((-1) ^+ s). *) -Lemma normr_sign s : `|(-1) ^+ s| = 1 :> R. +Lemma normr_sign s : `|(-1) ^+ s : R| = 1. Proof. by rewrite normrX normrN1 expr1n. Qed. Lemma normrMsign s x : `|(-1) ^+ s * x| = `|x|. @@ -2955,7 +2905,7 @@ Lemma signr_ge0 (b : bool) : (0 <= (-1) ^+ b :> R) = ~~ b. Proof. by rewrite le0r signr_eq0 signr_gt0. Qed. Lemma signr_le0 (b : bool) : ((-1) ^+ b <= 0 :> R) = b. -Proof. by rewrite ler_eqVlt signr_eq0 signr_lt0. Qed. +Proof. by rewrite le_eqVlt signr_eq0 signr_lt0. Qed. (* This actually holds for char R != 2. *) Lemma signr_inj : injective (fun b : bool => (-1) ^+ b : R). @@ -2970,10 +2920,10 @@ Lemma neqr0_sign x : x != 0 -> (-1) ^+ (x < 0)%R = sgr x. Proof. by rewrite sgr_def => ->. Qed. Lemma gtr0_sg x : 0 < x -> sg x = 1. -Proof. by move=> x_gt0; rewrite /sg gtr_eqF // ltr_gtF. Qed. +Proof. by move=> x_gt0; rewrite /sg gt_eqF // lt_gtF. Qed. Lemma ltr0_sg x : x < 0 -> sg x = -1. -Proof. by move=> x_lt0; rewrite /sg x_lt0 ltr_eqF. Qed. +Proof. by move=> x_lt0; rewrite /sg x_lt0 lt_eqF. Qed. Lemma sgr0 : sg 0 = 0 :> R. Proof. by rewrite /sgr eqxx. Qed. Lemma sgr1 : sg 1 = 1 :> R. Proof. by rewrite gtr0_sg // ltr01. Qed. @@ -3017,16 +2967,16 @@ Proof. by rewrite !(fun_if sg) !sgrE. Qed. Lemma sgr_lt0 x : (sg x < 0) = (x < 0). Proof. rewrite /sg; case: eqP => [-> // | _]. -by case: ifP => _; rewrite ?ltrN10 // ltr_gtF. +by case: ifP => _; rewrite ?ltrN10 // lt_gtF. Qed. Lemma sgr_le0 x : (sgr x <= 0) = (x <= 0). -Proof. by rewrite !ler_eqVlt sgr_eq0 sgr_lt0. Qed. +Proof. by rewrite !le_eqVlt sgr_eq0 sgr_lt0. Qed. (* sign and norm *) Lemma realEsign x : x \is real -> x = (-1) ^+ (x < 0)%R * `|x|. -Proof. by case/real_ger0P; rewrite (mul1r, mulN1r) ?opprK. Qed. +Proof. by case/real_ge0P; rewrite (mul1r, mulN1r) ?opprK. Qed. Lemma realNEsign x : x \is real -> - x = (-1) ^+ (0 < x)%R * `|x|. Proof. by move=> Rx; rewrite -normrN -oppr_lt0 -realEsign ?rpredN. Qed. @@ -3051,121 +3001,72 @@ Lemma normr_sg x : `|sg x| = (x != 0)%:R. Proof. by rewrite sgr_def -mulr_natr normrMsign normr_nat. Qed. Lemma sgr_norm x : sg `|x| = (x != 0)%:R. -Proof. by rewrite /sg ler_gtF ?normr_ge0 // normr_eq0 mulrb if_neg. Qed. - -(* lerif *) - -Lemma lerif_refl x C : reflect (x <= x ?= iff C) C. -Proof. by apply: (iffP idP) => [-> | <-] //; split; rewrite ?eqxx. Qed. - -Lemma lerif_trans x1 x2 x3 C12 C23 : - x1 <= x2 ?= iff C12 -> x2 <= x3 ?= iff C23 -> x1 <= x3 ?= iff C12 && C23. -Proof. -move=> ltx12 ltx23; apply/lerifP; rewrite -ltx12. -case eqx12: (x1 == x2). - by rewrite (eqP eqx12) ltr_neqAle !ltx23 andbT; case C23. -by rewrite (@ltr_le_trans _ x2) ?ltx23 // ltr_neqAle eqx12 ltx12. -Qed. - -Lemma lerif_le x y : x <= y -> x <= y ?= iff (x >= y). -Proof. by move=> lexy; split=> //; rewrite eqr_le lexy. Qed. - -Lemma lerif_eq x y : x <= y -> x <= y ?= iff (x == y). -Proof. by []. Qed. - -Lemma ger_lerif x y C : x <= y ?= iff C -> (y <= x) = C. -Proof. by case=> le_xy; rewrite eqr_le le_xy. Qed. - -Lemma ltr_lerif x y C : x <= y ?= iff C -> (x < y) = ~~ C. -Proof. by move=> le_xy; rewrite ltr_neqAle !le_xy andbT. Qed. +Proof. by rewrite /sg le_gtF // normr_eq0 mulrb if_neg. Qed. -Lemma lerif_nat m n C : (m%:R <= n%:R ?= iff C :> R) = (m <= n ?= iff C)%N. -Proof. by rewrite /lerif !ler_nat eqr_nat. Qed. +(* leif *) -Lemma mono_in_lerif (A : {pred R}) (f : R -> R) C : - {in A &, {mono f : x y / x <= y}} -> - {in A &, forall x y, (f x <= f y ?= iff C) = (x <= y ?= iff C)}. -Proof. -by move=> mf x y Ax Ay; rewrite /lerif mf ?(inj_in_eq (incr_inj_in mf)). -Qed. - -Lemma mono_lerif (f : R -> R) C : - {mono f : x y / x <= y} -> - forall x y, (f x <= f y ?= iff C) = (x <= y ?= iff C). -Proof. by move=> mf x y; rewrite /lerif mf (inj_eq (incr_inj _)). Qed. - -Lemma nmono_in_lerif (A : {pred R}) (f : R -> R) C : - {in A &, {mono f : x y /~ x <= y}} -> - {in A &, forall x y, (f x <= f y ?= iff C) = (y <= x ?= iff C)}. -Proof. -move=> mf x y Ax Ay; rewrite /lerif eq_sym mf //. -by rewrite ?(inj_in_eq (decr_inj_in mf)). -Qed. +Lemma leif_nat_r m n C : (m%:R <= n%:R ?= iff C :> R) = (m <= n ?= iff C)%N. +Proof. by rewrite /leif !ler_nat eqr_nat. Qed. -Lemma nmono_lerif (f : R -> R) C : - {mono f : x y /~ x <= y} -> - forall x y, (f x <= f y ?= iff C) = (y <= x ?= iff C). -Proof. by move=> mf x y; rewrite /lerif eq_sym mf ?(inj_eq (decr_inj mf)). Qed. +Lemma leif_subLR x y z C : (x - y <= z ?= iff C) = (x <= z + y ?= iff C). +Proof. by rewrite /leif !eq_le ler_subr_addr ler_subl_addr. Qed. -Lemma lerif_subLR x y z C : (x - y <= z ?= iff C) = (x <= z + y ?= iff C). -Proof. by rewrite /lerif !eqr_le ler_subr_addr ler_subl_addr. Qed. +Lemma leif_subRL x y z C : (x <= y - z ?= iff C) = (x + z <= y ?= iff C). +Proof. by rewrite -leif_subLR opprK. Qed. -Lemma lerif_subRL x y z C : (x <= y - z ?= iff C) = (x + z <= y ?= iff C). -Proof. by rewrite -lerif_subLR opprK. Qed. - -Lemma lerif_add x1 y1 C1 x2 y2 C2 : +Lemma leif_add x1 y1 C1 x2 y2 C2 : x1 <= y1 ?= iff C1 -> x2 <= y2 ?= iff C2 -> x1 + x2 <= y1 + y2 ?= iff C1 && C2. Proof. -rewrite -(mono_lerif _ (ler_add2r x2)) -(mono_lerif C2 (ler_add2l y1)). -exact: lerif_trans. +rewrite -(mono_leif (ler_add2r x2)) -(mono_leif (C := C2) (ler_add2l y1)). +exact: leif_trans. Qed. -Lemma lerif_sum (I : finType) (P C : pred I) (E1 E2 : I -> R) : +Lemma leif_sum (I : finType) (P C : pred I) (E1 E2 : I -> R) : (forall i, P i -> E1 i <= E2 i ?= iff C i) -> \sum_(i | P i) E1 i <= \sum_(i | P i) E2 i ?= iff [forall (i | P i), C i]. Proof. move=> leE12; rewrite -big_andE. -elim/big_rec3: _ => [|i Ci m2 m1 /leE12]; first by rewrite /lerif lerr eqxx. -exact: lerif_add. +elim/big_rec3: _ => [|i Ci m2 m1 /leE12]; first by rewrite /leif lexx eqxx. +exact: leif_add. Qed. -Lemma lerif_0_sum (I : finType) (P C : pred I) (E : I -> R) : +Lemma leif_0_sum (I : finType) (P C : pred I) (E : I -> R) : (forall i, P i -> 0 <= E i ?= iff C i) -> 0 <= \sum_(i | P i) E i ?= iff [forall (i | P i), C i]. -Proof. by move/lerif_sum; rewrite big1_eq. Qed. +Proof. by move/leif_sum; rewrite big1_eq. Qed. -Lemma real_lerif_norm x : x \is real -> x <= `|x| ?= iff (0 <= x). +Lemma real_leif_norm x : x \is real -> x <= `|x| ?= iff (0 <= x). Proof. -by move=> xR; rewrite ger0_def eq_sym; apply: lerif_eq; rewrite real_ler_norm. +by move=> xR; rewrite ger0_def eq_sym; apply: leif_eq; rewrite real_ler_norm. Qed. -Lemma lerif_pmul x1 x2 y1 y2 C1 C2 : +Lemma leif_pmul x1 x2 y1 y2 C1 C2 : 0 <= x1 -> 0 <= x2 -> x1 <= y1 ?= iff C1 -> x2 <= y2 ?= iff C2 -> x1 * x2 <= y1 * y2 ?= iff (y1 * y2 == 0) || C1 && C2. Proof. move=> x1_ge0 x2_ge0 le_xy1 le_xy2; have [y_0 | ] := altP (_ =P 0). - apply/lerifP; rewrite y_0 /= mulf_eq0 !eqr_le x1_ge0 x2_ge0 !andbT. + apply/leifP; rewrite y_0 /= mulf_eq0 !eq_le x1_ge0 x2_ge0 !andbT. move/eqP: y_0; rewrite mulf_eq0. by case/pred2P=> <-; rewrite (le_xy1, le_xy2) ?orbT. rewrite /= mulf_eq0 => /norP[y1nz y2nz]. -have y1_gt0: 0 < y1 by rewrite ltr_def y1nz (ler_trans _ le_xy1). +have y1_gt0: 0 < y1 by rewrite lt_def y1nz (le_trans _ le_xy1). have [x2_0 | x2nz] := eqVneq x2 0. - apply/lerifP; rewrite -le_xy2 x2_0 eq_sym (negPf y2nz) andbF mulr0. - by rewrite mulr_gt0 // ltr_def y2nz -x2_0 le_xy2. -have:= le_xy2; rewrite -(mono_lerif _ (ler_pmul2l y1_gt0)). -by apply: lerif_trans; rewrite (mono_lerif _ (ler_pmul2r _)) // ltr_def x2nz. + apply/leifP; rewrite -le_xy2 x2_0 eq_sym (negPf y2nz) andbF mulr0. + by rewrite mulr_gt0 // lt_def y2nz -x2_0 le_xy2. +have:= le_xy2; rewrite -(mono_leif (ler_pmul2l y1_gt0)). +by apply: leif_trans; rewrite (mono_leif (ler_pmul2r _)) // lt_def x2nz. Qed. -Lemma lerif_nmul x1 x2 y1 y2 C1 C2 : +Lemma leif_nmul x1 x2 y1 y2 C1 C2 : y1 <= 0 -> y2 <= 0 -> x1 <= y1 ?= iff C1 -> x2 <= y2 ?= iff C2 -> y1 * y2 <= x1 * x2 ?= iff (x1 * x2 == 0) || C1 && C2. Proof. rewrite -!oppr_ge0 -mulrNN -[x1 * x2]mulrNN => y1le0 y2le0 le_xy1 le_xy2. -by apply: lerif_pmul => //; rewrite (nmono_lerif _ ler_opp2). +by apply: leif_pmul => //; rewrite (nmono_leif ler_opp2). Qed. -Lemma lerif_pprod (I : finType) (P C : pred I) (E1 E2 : I -> R) : +Lemma leif_pprod (I : finType) (P C : pred I) (E1 E2 : I -> R) : (forall i, P i -> 0 <= E1 i) -> (forall i, P i -> E1 i <= E2 i ?= iff C i) -> let pi E := \prod_(i | P i) E i in @@ -3173,35 +3074,35 @@ Lemma lerif_pprod (I : finType) (P C : pred I) (E1 E2 : I -> R) : Proof. move=> E1_ge0 leE12 /=; rewrite -big_andE; elim/(big_load (fun x => 0 <= x)): _. elim/big_rec3: _ => [|i Ci m2 m1 Pi [m1ge0 le_m12]]. - by split=> //; apply/lerifP; rewrite orbT. + by split=> //; apply/leifP; rewrite orbT. have Ei_ge0 := E1_ge0 i Pi; split; first by rewrite mulr_ge0. -congr (lerif _ _ _): (lerif_pmul Ei_ge0 m1ge0 (leE12 i Pi) le_m12). +congr (leif _ _ _): (leif_pmul Ei_ge0 m1ge0 (leE12 i Pi) le_m12). by rewrite mulf_eq0 -!orbA; congr (_ || _); rewrite !orb_andr orbA orbb. Qed. (* Mean inequalities. *) -Lemma real_lerif_mean_square_scaled x y : +Lemma real_leif_mean_square_scaled x y : x \is real -> y \is real -> x * y *+ 2 <= x ^+ 2 + y ^+ 2 ?= iff (x == y). Proof. -move=> Rx Ry; rewrite -[_ *+ 2]add0r -lerif_subRL addrAC -sqrrB -subr_eq0. -by rewrite -sqrf_eq0 eq_sym; apply: lerif_eq; rewrite -realEsqr rpredB. +move=> Rx Ry; rewrite -[_ *+ 2]add0r -leif_subRL addrAC -sqrrB -subr_eq0. +by rewrite -sqrf_eq0 eq_sym; apply: leif_eq; rewrite -realEsqr rpredB. Qed. -Lemma real_lerif_AGM2_scaled x y : +Lemma real_leif_AGM2_scaled x y : x \is real -> y \is real -> x * y *+ 4 <= (x + y) ^+ 2 ?= iff (x == y). Proof. -move=> Rx Ry; rewrite sqrrD addrAC (mulrnDr _ 2) -lerif_subLR addrK. -exact: real_lerif_mean_square_scaled. +move=> Rx Ry; rewrite sqrrD addrAC (mulrnDr _ 2) -leif_subLR addrK. +exact: real_leif_mean_square_scaled. Qed. -Lemma lerif_AGM_scaled (I : finType) (A : {pred I}) (E : I -> R) (n := #|A|) : +Lemma leif_AGM_scaled (I : finType) (A : {pred I}) (E : I -> R) (n := #|A|) : {in A, forall i, 0 <= E i *+ n} -> \prod_(i in A) (E i *+ n) <= (\sum_(i in A) E i) ^+ n ?= iff [forall i in A, forall j in A, E i == E j]. Proof. have [m leAm] := ubnP #|A|; elim: m => // m IHm in A leAm E n * => Ege0. -apply/lerifP; case: ifPn => [/forall_inP-Econstant | Enonconstant]. +apply/leifP; case: ifPn => [/forall_inP-Econstant | Enonconstant]. have [i /= Ai | A0] := pickP (mem A); last by rewrite [n]eq_card0 ?big_pred0. have /eqfun_inP-E_i := Econstant i Ai; rewrite -(eq_bigr _ E_i) sumr_const. by rewrite exprMn_n prodrMn -(eq_bigr _ E_i) prodr_const. @@ -3211,9 +3112,9 @@ have{Enonconstant} has_cmp_mu e (s := (-1) ^+ e): {i | i \in A & cmp_mu s i}. apply/sig2W/exists_inP; apply: contraR Enonconstant => /exists_inPn-mu_s_A. have n_gt0 i: i \in A -> (0 < n)%N by rewrite [n](cardD1 i) => ->. have{mu_s_A} mu_s_A i: i \in A -> s * En i <= s * mu. - move=> Ai; rewrite real_lerNgt ?mu_s_A ?rpredMsign ?ger0_real ?Ege0 //. + move=> Ai; rewrite real_leNgt ?mu_s_A ?rpredMsign ?ger0_real ?Ege0 //. by rewrite -(pmulrn_lge0 _ (n_gt0 i Ai)) -sumrMnl sumr_ge0. - have [_ /esym/eqfun_inP] := lerif_sum (fun i Ai => lerif_eq (mu_s_A i Ai)). + have [_ /esym/eqfun_inP] := leif_sum (fun i Ai => leif_eq (mu_s_A i Ai)). rewrite sumr_const -/n -mulr_sumr sumrMnl -/mu mulrnAr eqxx => A_mu. apply/forall_inP=> i Ai; apply/eqfun_inP=> j Aj. by apply: (pmulrnI (n_gt0 i Ai)); apply: (can_inj (signrMK e)); rewrite !A_mu. @@ -3221,17 +3122,17 @@ have [[i Ai Ei_lt_mu] [j Aj Ej_gt_mu]] := (has_cmp_mu 1, has_cmp_mu 0)%N. rewrite {cmp_mu has_cmp_mu}/= !mul1r !mulN1r ltr_opp2 in Ei_lt_mu Ej_gt_mu. pose A' := [predD1 A & i]; pose n' := #|A'|. have [Dn n_gt0]: n = n'.+1 /\ (n > 0)%N by rewrite [n](cardD1 i) Ai. -have i'j: j != i by apply: contraTneq Ej_gt_mu => ->; rewrite ltr_gtF. +have i'j: j != i by apply: contraTneq Ej_gt_mu => ->; rewrite lt_gtF. have{i'j} A'j: j \in A' by rewrite !inE Aj i'j. -have mu_gt0: 0 < mu := ler_lt_trans (Ege0 i Ai) Ei_lt_mu. +have mu_gt0: 0 < mu := le_lt_trans (Ege0 i Ai) Ei_lt_mu. rewrite (bigD1 i) // big_andbC (bigD1 j) //= mulrA; set pi := \prod_(k | _) _. have [-> | nz_pi] := eqVneq pi 0; first by rewrite !mulr0 exprn_gt0. have{nz_pi} pi_gt0: 0 < pi. - by rewrite ltr_def nz_pi prodr_ge0 // => k /andP[/andP[_ /Ege0]]. + by rewrite lt_def nz_pi prodr_ge0 // => k /andP[/andP[_ /Ege0]]. rewrite -/(En i) -/(En j); pose E' := [eta En with j |-> En i + En j - mu]. have E'ge0 k: k \in A' -> E' k *+ n' >= 0. case/andP=> /= _ Ak; apply: mulrn_wge0; case: ifP => _; last exact: Ege0. - by rewrite subr_ge0 ler_paddl ?Ege0 // ltrW. + by rewrite subr_ge0 ler_paddl ?Ege0 // ltW. rewrite -/n Dn in leAm; have{leAm IHm E'ge0}: _ <= _ := IHm _ leAm _ E'ge0. have ->: \sum_(k in A') E' k = mu *+ n'. apply: (addrI mu); rewrite -mulrS -Dn -sumrMnl (bigD1 i Ai) big_andbC /=. @@ -3240,7 +3141,7 @@ have ->: \sum_(k in A') E' k = mu *+ n'. rewrite prodrMn exprMn_n -/n' ler_pmuln2r ?expn_gt0; last by case: (n'). have ->: \prod_(k in A') E' k = E' j * pi. by rewrite (bigD1 j) //=; congr *%R; apply: eq_bigr => k /andP[_ /negPf->]. -rewrite -(ler_pmul2l mu_gt0) -exprS -Dn mulrA; apply: ltr_le_trans. +rewrite -(ler_pmul2l mu_gt0) -exprS -Dn mulrA; apply: lt_le_trans. rewrite ltr_pmul2r //= eqxx -addrA mulrDr mulrC -ltr_subl_addl -mulrBl. by rewrite mulrC ltr_pmul2r ?subr_gt0. Qed. @@ -3252,9 +3153,9 @@ Implicit Type p : {poly R}. Lemma poly_disk_bound p b : {ub | forall x, `|x| <= b -> `|p.[x]| <= ub}. Proof. exists (\sum_(j < size p) `|p`_j| * b ^+ j) => x le_x_b. -rewrite horner_coef (ler_trans (ler_norm_sum _ _ _)) ?ler_sum // => j _. -rewrite normrM normrX ler_wpmul2l ?ler_expn2r ?unfold_in ?normr_ge0 //. -exact: ler_trans (normr_ge0 x) le_x_b. +rewrite horner_coef (le_trans (ler_norm_sum _ _ _)) ?ler_sum // => j _. +rewrite normrM normrX ler_wpmul2l ?ler_expn2r ?unfold_in //. +exact: le_trans (normr_ge0 x) le_x_b. Qed. End NumDomainOperationTheory. @@ -3265,13 +3166,9 @@ Arguments ltr_sqr {R} [x y]. Arguments signr_inj {R} [x1 x2]. Arguments real_ler_normlP {R x y}. Arguments real_ltr_normlP {R x y}. -Arguments lerif_refl {R x C}. -Arguments mono_in_lerif [R A f C]. -Arguments nmono_in_lerif [R A f C]. -Arguments mono_lerif [R f C]. -Arguments nmono_lerif [R f C]. Section NumDomainMonotonyTheoryForReals. +Local Open Scope order_scope. Variables (R R' : numDomainType) (D : pred R) (f : R -> R') (f' : R -> nat). Implicit Types (m n p : nat) (x y z : R) (u v w : R'). @@ -3279,17 +3176,17 @@ Implicit Types (m n p : nat) (x y z : R) (u v w : R'). Lemma real_mono : {homo f : x y / x < y} -> {in real &, {mono f : x y / x <= y}}. Proof. -move=> mf x y xR yR /=; have [lt_xy | le_yx] := real_lerP xR yR. - by rewrite ltrW_homo. -by rewrite ltr_geF ?mf. +move=> mf x y xR yR /=; have [lt_xy | le_yx] := real_leP xR yR. + by rewrite ltW_homo. +by rewrite lt_geF ?mf. Qed. Lemma real_nmono : {homo f : x y /~ x < y} -> {in real &, {mono f : x y /~ x <= y}}. Proof. -move=> mf x y xR yR /=; have [lt_xy|le_yx] := real_ltrP xR yR. - by rewrite ltr_geF ?mf. -by rewrite ltrW_nhomo. +move=> mf x y xR yR /=; have [lt_xy|le_yx] := real_ltP xR yR. + by rewrite lt_geF ?mf. +by rewrite ltW_nhomo. Qed. Lemma real_mono_in : @@ -3297,8 +3194,8 @@ Lemma real_mono_in : {in [pred x in D | x \is real] &, {mono f : x y / x <= y}}. Proof. move=> Dmf x y /andP[hx xR] /andP[hy yR] /=. -have [lt_xy|le_yx] := real_lerP xR yR; first by rewrite (ltrW_homo_in Dmf). -by rewrite ltr_geF ?Dmf. +have [lt_xy|le_yx] := real_leP xR yR; first by rewrite (ltW_homo_in Dmf). +by rewrite lt_geF ?Dmf. Qed. Lemma real_nmono_in : @@ -3306,40 +3203,40 @@ Lemma real_nmono_in : {in [pred x in D | x \is real] &, {mono f : x y /~ x <= y}}. Proof. move=> Dmf x y /andP[hx xR] /andP[hy yR] /=. -have [lt_xy|le_yx] := real_ltrP xR yR; last by rewrite (ltrW_nhomo_in Dmf). -by rewrite ltr_geF ?Dmf. +have [lt_xy|le_yx] := real_ltP xR yR; last by rewrite (ltW_nhomo_in Dmf). +by rewrite lt_geF ?Dmf. Qed. -Lemma realn_mono : {homo f' : x y / x < y >-> (x < y)%N} -> - {in real &, {mono f' : x y / x <= y >-> (x <= y)%N}}. +Lemma realn_mono : {homo f' : x y / x < y >-> (x < y)} -> + {in real &, {mono f' : x y / x <= y >-> (x <= y)}}. Proof. -move=> mf x y xR yR /=; have [lt_xy | le_yx] := real_lerP xR yR. - by rewrite ltrnW_homo. -by rewrite ltn_geF ?mf. +move=> mf x y xR yR /=; have [lt_xy | le_yx] := real_leP xR yR. + by rewrite ltW_homo. +by rewrite lt_geF ?mf. Qed. -Lemma realn_nmono : {homo f' : x y / y < x >-> (x < y)%N} -> - {in real &, {mono f' : x y / y <= x >-> (x <= y)%N}}. +Lemma realn_nmono : {homo f' : x y / y < x >-> (x < y)} -> + {in real &, {mono f' : x y / y <= x >-> (x <= y)}}. Proof. -move=> mf x y xR yR /=; have [lt_xy|le_yx] := real_ltrP xR yR. - by rewrite ltn_geF ?mf. -by rewrite ltrnW_nhomo. +move=> mf x y xR yR /=; have [lt_xy|le_yx] := real_ltP xR yR. + by rewrite lt_geF ?mf. +by rewrite ltW_nhomo. Qed. -Lemma realn_mono_in : {in D &, {homo f' : x y / x < y >-> (x < y)%N}} -> - {in [pred x in D | x \is real] &, {mono f' : x y / x <= y >-> (x <= y)%N}}. +Lemma realn_mono_in : {in D &, {homo f' : x y / x < y >-> (x < y)}} -> + {in [pred x in D | x \is real] &, {mono f' : x y / x <= y >-> (x <= y)}}. Proof. move=> Dmf x y /andP[hx xR] /andP[hy yR] /=. -have [lt_xy|le_yx] := real_lerP xR yR; first by rewrite (ltrnW_homo_in Dmf). -by rewrite ltn_geF ?Dmf. +have [lt_xy|le_yx] := real_leP xR yR; first by rewrite (ltW_homo_in Dmf). +by rewrite lt_geF ?Dmf. Qed. -Lemma realn_nmono_in : {in D &, {homo f' : x y / y < x >-> (x < y)%N}} -> - {in [pred x in D | x \is real] &, {mono f' : x y / y <= x >-> (x <= y)%N}}. +Lemma realn_nmono_in : {in D &, {homo f' : x y / y < x >-> (x < y)}} -> + {in [pred x in D | x \is real] &, {mono f' : x y / y <= x >-> (x <= y)}}. Proof. move=> Dmf x y /andP[hx xR] /andP[hy yR] /=. -have [lt_xy|le_yx] := real_ltrP xR yR; last by rewrite (ltrnW_nhomo_in Dmf). -by rewrite ltn_geF ?Dmf. +have [lt_xy|le_yx] := real_ltP xR yR; last by rewrite (ltW_nhomo_in Dmf). +by rewrite lt_geF ?Dmf. Qed. End NumDomainMonotonyTheoryForReals. @@ -3355,13 +3252,13 @@ Lemma natrG_gt0 G : #|G|%:R > 0 :> R. Proof. by rewrite ltr0n cardG_gt0. Qed. Lemma natrG_neq0 G : #|G|%:R != 0 :> R. -Proof. by rewrite gtr_eqF // natrG_gt0. Qed. +Proof. by rewrite gt_eqF // natrG_gt0. Qed. Lemma natr_indexg_gt0 G B : #|G : B|%:R > 0 :> R. Proof. by rewrite ltr0n indexg_gt0. Qed. Lemma natr_indexg_neq0 G B : #|G : B|%:R != 0 :> R. -Proof. by rewrite gtr_eqF // natr_indexg_gt0. Qed. +Proof. by rewrite gt_eqF // natr_indexg_gt0. Qed. End FinGroup. @@ -3371,10 +3268,10 @@ Variable F : numFieldType. Implicit Types x y z t : F. Lemma unitf_gt0 x : 0 < x -> x \is a GRing.unit. -Proof. by move=> hx; rewrite unitfE eq_sym ltr_eqF. Qed. +Proof. by move=> hx; rewrite unitfE eq_sym lt_eqF. Qed. Lemma unitf_lt0 x : x < 0 -> x \is a GRing.unit. -Proof. by move=> hx; rewrite unitfE ltr_eqF. Qed. +Proof. by move=> hx; rewrite unitfE lt_eqF. Qed. Lemma lef_pinv : {in pos &, {mono (@GRing.inv F) : x y /~ x <= y}}. Proof. by move=> x y hx hy /=; rewrite ler_pinv ?inE ?unitf_gt0. Qed. @@ -3383,10 +3280,10 @@ Lemma lef_ninv : {in neg &, {mono (@GRing.inv F) : x y /~ x <= y}}. Proof. by move=> x y hx hy /=; rewrite ler_ninv ?inE ?unitf_lt0. Qed. Lemma ltf_pinv : {in pos &, {mono (@GRing.inv F) : x y /~ x < y}}. -Proof. exact: lerW_nmono_in lef_pinv. Qed. +Proof. exact: leW_nmono_in lef_pinv. Qed. Lemma ltf_ninv: {in neg &, {mono (@GRing.inv F) : x y /~ x < y}}. -Proof. exact: lerW_nmono_in lef_ninv. Qed. +Proof. exact: leW_nmono_in lef_ninv. Qed. Definition ltef_pinv := (lef_pinv, ltf_pinv). Definition ltef_ninv := (lef_ninv, ltf_ninv). @@ -3410,18 +3307,18 @@ Definition invf_cp1 := (invf_gte1, invf_lte1). (* These lemma are all combinations of mono(LR|RL) with ler_[pn]mul2[rl]. *) Lemma ler_pdivl_mulr z x y : 0 < z -> (x <= y / z) = (x * z <= y). -Proof. by move=> z_gt0; rewrite -(@ler_pmul2r _ z) ?mulfVK ?gtr_eqF. Qed. +Proof. by move=> z_gt0; rewrite -(@ler_pmul2r _ z _ x) ?mulfVK ?gt_eqF. Qed. Lemma ltr_pdivl_mulr z x y : 0 < z -> (x < y / z) = (x * z < y). -Proof. by move=> z_gt0; rewrite -(@ltr_pmul2r _ z) ?mulfVK ?gtr_eqF. Qed. +Proof. by move=> z_gt0; rewrite -(@ltr_pmul2r _ z _ x) ?mulfVK ?gt_eqF. Qed. Definition lter_pdivl_mulr := (ler_pdivl_mulr, ltr_pdivl_mulr). Lemma ler_pdivr_mulr z x y : 0 < z -> (y / z <= x) = (y <= x * z). -Proof. by move=> z_gt0; rewrite -(@ler_pmul2r _ z) ?mulfVK ?gtr_eqF. Qed. +Proof. by move=> z_gt0; rewrite -(@ler_pmul2r _ z) ?mulfVK ?gt_eqF. Qed. Lemma ltr_pdivr_mulr z x y : 0 < z -> (y / z < x) = (y < x * z). -Proof. by move=> z_gt0; rewrite -(@ltr_pmul2r _ z) ?mulfVK ?gtr_eqF. Qed. +Proof. by move=> z_gt0; rewrite -(@ltr_pmul2r _ z) ?mulfVK ?gt_eqF. Qed. Definition lter_pdivr_mulr := (ler_pdivr_mulr, ltr_pdivr_mulr). @@ -3442,18 +3339,18 @@ Proof. by move=> z_gt0; rewrite mulrC ltr_pdivr_mulr ?[z * _]mulrC. Qed. Definition lter_pdivr_mull := (ler_pdivr_mull, ltr_pdivr_mull). Lemma ler_ndivl_mulr z x y : z < 0 -> (x <= y / z) = (y <= x * z). -Proof. by move=> z_lt0; rewrite -(@ler_nmul2r _ z) ?mulfVK ?ltr_eqF. Qed. +Proof. by move=> z_lt0; rewrite -(@ler_nmul2r _ z) ?mulfVK ?lt_eqF. Qed. Lemma ltr_ndivl_mulr z x y : z < 0 -> (x < y / z) = (y < x * z). -Proof. by move=> z_lt0; rewrite -(@ltr_nmul2r _ z) ?mulfVK ?ltr_eqF. Qed. +Proof. by move=> z_lt0; rewrite -(@ltr_nmul2r _ z) ?mulfVK ?lt_eqF. Qed. Definition lter_ndivl_mulr := (ler_ndivl_mulr, ltr_ndivl_mulr). Lemma ler_ndivr_mulr z x y : z < 0 -> (y / z <= x) = (x * z <= y). -Proof. by move=> z_lt0; rewrite -(@ler_nmul2r _ z) ?mulfVK ?ltr_eqF. Qed. +Proof. by move=> z_lt0; rewrite -(@ler_nmul2r _ z) ?mulfVK ?lt_eqF. Qed. Lemma ltr_ndivr_mulr z x y : z < 0 -> (y / z < x) = (x * z < y). -Proof. by move=> z_lt0; rewrite -(@ltr_nmul2r _ z) ?mulfVK ?ltr_eqF. Qed. +Proof. by move=> z_lt0; rewrite -(@ltr_nmul2r _ z) ?mulfVK ?lt_eqF. Qed. Definition lter_ndivr_mulr := (ler_ndivr_mulr, ltr_ndivr_mulr). @@ -3476,13 +3373,13 @@ Definition lter_ndivr_mull := (ler_ndivr_mull, ltr_ndivr_mull). Lemma natf_div m d : (d %| m)%N -> (m %/ d)%:R = m%:R / d%:R :> F. Proof. by apply: char0_natf_div; apply: (@char_num F). Qed. -Lemma normfV : {morph (@norm F) : x / x ^-1}. +Lemma normfV : {morph (@norm F F) : x / x ^-1}. Proof. move=> x /=; have [/normrV //|Nux] := boolP (x \is a GRing.unit). by rewrite !invr_out // unitfE normr_eq0 -unitfE. Qed. -Lemma normf_div : {morph (@norm F) : x y / x / y}. +Lemma normf_div : {morph (@norm F F) : x y / x / y}. Proof. by move=> x y /=; rewrite normrM normfV. Qed. Lemma invr_sg x : (sg x)^-1 = sgr x. @@ -3511,32 +3408,32 @@ Definition midf_lte := (midf_le, midf_lt). (* The AGM, unscaled but without the nth root. *) -Lemma real_lerif_mean_square x y : +Lemma real_leif_mean_square x y : x \is real -> y \is real -> x * y <= mid (x ^+ 2) (y ^+ 2) ?= iff (x == y). Proof. -move=> Rx Ry; rewrite -(mono_lerif (ler_pmul2r (ltr_nat F 0 2))). -by rewrite divfK ?pnatr_eq0 // mulr_natr; apply: real_lerif_mean_square_scaled. +move=> Rx Ry; rewrite -(mono_leif (ler_pmul2r (ltr_nat F 0 2))). +by rewrite divfK ?pnatr_eq0 // mulr_natr; apply: real_leif_mean_square_scaled. Qed. -Lemma real_lerif_AGM2 x y : +Lemma real_leif_AGM2 x y : x \is real -> y \is real -> x * y <= mid x y ^+ 2 ?= iff (x == y). Proof. -move=> Rx Ry; rewrite -(mono_lerif (ler_pmul2r (ltr_nat F 0 4))). +move=> Rx Ry; rewrite -(mono_leif (ler_pmul2r (ltr_nat F 0 4))). rewrite mulr_natr (natrX F 2 2) -exprMn divfK ?pnatr_eq0 //. -exact: real_lerif_AGM2_scaled. +exact: real_leif_AGM2_scaled. Qed. -Lemma lerif_AGM (I : finType) (A : {pred I}) (E : I -> F) : +Lemma leif_AGM (I : finType) (A : {pred I}) (E : I -> F) : let n := #|A| in let mu := (\sum_(i in A) E i) / n%:R in {in A, forall i, 0 <= E i} -> \prod_(i in A) E i <= mu ^+ n ?= iff [forall i in A, forall j in A, E i == E j]. Proof. move=> n mu Ege0; have [n0 | n_gt0] := posnP n. - by rewrite n0 -big_andE !(big_pred0 _ _ _ _ (card0_eq n0)); apply/lerifP. + by rewrite n0 -big_andE !(big_pred0 _ _ _ _ (card0_eq n0)); apply/leifP. pose E' i := E i / n%:R. have defE' i: E' i *+ n = E i by rewrite -mulr_natr divfK ?pnatr_eq0 -?lt0n. -have /lerif_AGM_scaled (i): i \in A -> 0 <= E' i *+ n by rewrite defE' => /Ege0. +have /leif_AGM_scaled (i): i \in A -> 0 <= E' i *+ n by rewrite defE' => /Ege0. rewrite -/n -mulr_suml (eq_bigr _ (in1W defE')); congr (_ <= _ ?= iff _). by do 2![apply: eq_forallb_in => ? _]; rewrite -(eqr_pmuln2r n_gt0) !defE'. Qed. @@ -3552,17 +3449,17 @@ have [q Dp]: {q | forall x, x != 0 -> p.[x] = (a - q.[x^-1] / x) * x ^+ n}. rewrite -/n -lead_coefE; congr (_ + _); apply: eq_bigr=> i _. by rewrite exprB ?unitfE // -exprVn mulrA mulrAC exprSr mulrA. have [b ub_q] := poly_disk_bound q 1; exists (b / `|a| + 1) => x px0. -have b_ge0: 0 <= b by rewrite (ler_trans (normr_ge0 q.[1])) ?ub_q ?normr1. -have{b_ge0} ba_ge0: 0 <= b / `|a| by rewrite divr_ge0 ?normr_ge0. -rewrite real_lerNgt ?rpredD ?rpred1 ?ger0_real ?normr_ge0 //. +have b_ge0: 0 <= b by rewrite (le_trans (normr_ge0 q.[1])) ?ub_q ?normr1. +have{b_ge0} ba_ge0: 0 <= b / `|a| by rewrite divr_ge0. +rewrite real_leNgt ?rpredD ?rpred1 ?ger0_real //. apply: contraL px0 => lb_x; rewrite rootE. -have x_ge1: 1 <= `|x| by rewrite (ler_trans _ (ltrW lb_x)) // ler_paddl. -have nz_x: x != 0 by rewrite -normr_gt0 (ltr_le_trans ltr01). +have x_ge1: 1 <= `|x| by rewrite (le_trans _ (ltW lb_x)) // ler_paddl. +have nz_x: x != 0 by rewrite -normr_gt0 (lt_le_trans ltr01). rewrite {}Dp // mulf_neq0 ?expf_neq0 // subr_eq0 eq_sym. -have: (b / `|a|) < `|x| by rewrite (ltr_trans _ lb_x) // ltr_spaddr ?ltr01. +have: (b / `|a|) < `|x| by rewrite (lt_trans _ lb_x) // ltr_spaddr ?ltr01. apply: contraTneq => /(canRL (divfK nz_x))Dax. rewrite ltr_pdivr_mulr ?normr_gt0 ?lead_coef_eq0 // mulrC -normrM -{}Dax. -by rewrite ler_gtF // ub_q // normfV invf_le1 ?normr_gt0. +by rewrite le_gtF // ub_q // normfV invf_le1 ?normr_gt0. Qed. Import GroupScope. @@ -3575,73 +3472,32 @@ End NumFieldTheory. Section RealDomainTheory. -Hint Resolve lerr : core. - Variable R : realDomainType. Implicit Types x y z t : R. Lemma num_real x : x \is real. Proof. exact: num_real. Qed. Hint Resolve num_real : core. -Lemma ler_total : total (@le R). Proof. by move=> x y; apply: real_leVge. Qed. - -Lemma ltr_total x y : x != y -> (x < y) || (y < x). -Proof. by rewrite !ltr_def [_ == y]eq_sym => ->; apply: ler_total. Qed. - -Lemma wlog_ler P : - (forall a b, P b a -> P a b) -> (forall a b, a <= b -> P a b) -> - forall a b : R, P a b. -Proof. by move=> sP hP a b; apply: real_wlog_ler. Qed. - -Lemma wlog_ltr P : - (forall a, P a a) -> - (forall a b, (P b a -> P a b)) -> (forall a b, a < b -> P a b) -> - forall a b : R, P a b. -Proof. by move=> rP sP hP a b; apply: real_wlog_ltr. Qed. - -Lemma ltrNge x y : (x < y) = ~~ (y <= x). Proof. exact: real_ltrNge. Qed. - -Lemma lerNgt x y : (x <= y) = ~~ (y < x). Proof. exact: real_lerNgt. Qed. - Lemma lerP x y : ler_xor_gt x y `|x - y| `|y - x| (x <= y) (y < x). -Proof. exact: real_lerP. Qed. +Proof. exact: real_leP. Qed. Lemma ltrP x y : ltr_xor_ge x y `|x - y| `|y - x| (y <= x) (x < y). -Proof. exact: real_ltrP. Qed. +Proof. exact: real_ltP. Qed. Lemma ltrgtP x y : comparer x y `|x - y| `|y - x| (y == x) (x == y) (x <= y) (y <= x) (x < y) (x > y) . -Proof. exact: real_ltrgtP. Qed. +Proof. exact: real_ltgtP. Qed. Lemma ger0P x : ger0_xor_lt0 x `|x| (x < 0) (0 <= x). -Proof. exact: real_ger0P. Qed. +Proof. exact: real_ge0P. Qed. Lemma ler0P x : ler0_xor_gt0 x `|x| (0 < x) (x <= 0). -Proof. exact: real_ler0P. Qed. +Proof. exact: real_le0P. Qed. Lemma ltrgt0P x : comparer0 x `|x| (0 == x) (x == 0) (x <= 0) (0 <= x) (x < 0) (x > 0). -Proof. exact: real_ltrgt0P. Qed. - -Lemma neqr_lt x y : (x != y) = (x < y) || (y < x). -Proof. exact: real_neqr_lt. Qed. - -Lemma eqr_leLR x y z t : - (x <= y -> z <= t) -> (y < x -> t < z) -> (x <= y) = (z <= t). -Proof. by move=> *; apply/idP/idP; rewrite // !lerNgt; apply: contra. Qed. - -Lemma eqr_leRL x y z t : - (x <= y -> z <= t) -> (y < x -> t < z) -> (z <= t) = (x <= y). -Proof. by move=> *; symmetry; apply: eqr_leLR. Qed. - -Lemma eqr_ltLR x y z t : - (x < y -> z < t) -> (y <= x -> t <= z) -> (x < y) = (z < t). -Proof. by move=> *; rewrite !ltrNge; congr negb; apply: eqr_leLR. Qed. - -Lemma eqr_ltRL x y z t : - (x < y -> z < t) -> (y <= x -> t <= z) -> (z < t) = (x < y). -Proof. by move=> *; symmetry; apply: eqr_ltLR. Qed. +Proof. exact: real_ltgt0P. Qed. (* sign *) @@ -3661,7 +3517,7 @@ Lemma mulr_sign_lt0 (b : bool) x : ((-1) ^+ b * x < 0) = (x != 0) && (b (+) (x < 0)%R). Proof. by rewrite mulr_lt0 signr_lt0 signr_eq0. Qed. -(* sign & norm*) +(* sign & norm *) Lemma mulr_sign_norm x : (-1) ^+ (x < 0)%R * `|x| = x. Proof. by rewrite real_mulr_sign_norm. Qed. @@ -3682,103 +3538,35 @@ End RealDomainTheory. Hint Resolve num_real : core. -Section RealDomainMonotony. - -Variables (R : realDomainType) (R' : numDomainType) (D : pred R). -Variables (f : R -> R') (f' : R -> nat). -Implicit Types (m n p : nat) (x y z : R) (u v w : R'). - -Hint Resolve (@num_real R) : core. - -Lemma ler_mono : {homo f : x y / x < y} -> {mono f : x y / x <= y}. -Proof. by move=> mf x y; apply: real_mono. Qed. - -Lemma ler_nmono : {homo f : x y /~ x < y} -> {mono f : x y /~ x <= y}. -Proof. by move=> mf x y; apply: real_nmono. Qed. - -Lemma ler_mono_in : - {in D &, {homo f : x y / x < y}} -> {in D &, {mono f : x y / x <= y}}. -Proof. -by move=> mf x y Dx Dy; apply: (real_mono_in mf); rewrite ?inE ?Dx ?Dy /=. -Qed. - -Lemma ler_nmono_in : - {in D &, {homo f : x y /~ x < y}} -> {in D &, {mono f : x y /~ x <= y}}. -Proof. -by move=> mf x y Dx Dy; apply: (real_nmono_in mf); rewrite ?inE ?Dx ?Dy /=. -Qed. - -Lemma lern_mono : {homo f' : m n / m < n >-> (m < n)%N} -> - {mono f' : m n / m <= n >-> (m <= n)%N}. -Proof. by move=> mf x y; apply: realn_mono. Qed. - -Lemma lern_nmono : {homo f' : m n / n < m >-> (m < n)%N} -> - {mono f' : m n / n <= m >-> (m <= n)%N}. -Proof. by move=> mf x y; apply: realn_nmono. Qed. - -Lemma lern_mono_in : {in D &, {homo f' : m n / m < n >-> (m < n)%N}} -> - {in D &, {mono f' : m n / m <= n >-> (m <= n)%N}}. -Proof. -by move=> mf x y Dx Dy; apply: (realn_mono_in mf); rewrite ?inE ?Dx ?Dy /=. -Qed. - -Lemma lern_nmono_in : {in D &, {homo f' : m n / n < m >-> (m < n)%N}} -> - {in D &, {mono f' : m n / n <= m >-> (m <= n)%N}}. -Proof. -by move=> mf x y Dx Dy; apply: (realn_nmono_in mf); rewrite ?inE ?Dx ?Dy /=. -Qed. - -End RealDomainMonotony. - -Section RealDomainArgExtremum. - -Context {R : realDomainType} {I : finType} (i0 : I). -Context (P : pred I) (F : I -> R) (Pi0 : P i0). - -Definition arg_minr := extremum <=%R i0 P F. -Definition arg_maxr := extremum >=%R i0 P F. - -Lemma arg_minrP: extremum_spec <=%R P F arg_minr. -Proof. by apply: extremumP => //; [apply: ler_trans|apply: ler_total]. Qed. - -Lemma arg_maxrP: extremum_spec >=%R P F arg_maxr. -Proof. -apply: extremumP => //; first exact: lerr. - by move=> ??? /(ler_trans _) le /le. -by move=> ??; apply: ler_total. -Qed. - -End RealDomainArgExtremum. +Section RealDomainOperations. -Notation "[ 'arg' 'minr_' ( i < i0 | P ) F ]" := - (arg_minr i0 (fun i => P%B) (fun i => F)) +Notation "[ 'arg' 'min_' ( i < i0 | P ) F ]" := + (arg_min (disp := ring_display) i0 (fun i => P%B) (fun i => F)) (at level 0, i, i0 at level 10, - format "[ 'arg' 'minr_' ( i < i0 | P ) F ]") : form_scope. + format "[ 'arg' 'min_' ( i < i0 | P ) F ]") : ring_scope. -Notation "[ 'arg' 'minr_' ( i < i0 'in' A ) F ]" := - [arg minr_(i < i0 | i \in A) F] +Notation "[ 'arg' 'min_' ( i < i0 'in' A ) F ]" := + [arg min_(i < i0 | i \in A) F] (at level 0, i, i0 at level 10, - format "[ 'arg' 'minr_' ( i < i0 'in' A ) F ]") : form_scope. + format "[ 'arg' 'min_' ( i < i0 'in' A ) F ]") : ring_scope. -Notation "[ 'arg' 'minr_' ( i < i0 ) F ]" := [arg minr_(i < i0 | true) F] +Notation "[ 'arg' 'min_' ( i < i0 ) F ]" := [arg min_(i < i0 | true) F] (at level 0, i, i0 at level 10, - format "[ 'arg' 'minr_' ( i < i0 ) F ]") : form_scope. + format "[ 'arg' 'min_' ( i < i0 ) F ]") : ring_scope. -Notation "[ 'arg' 'maxr_' ( i > i0 | P ) F ]" := - (arg_maxr i0 (fun i => P%B) (fun i => F)) +Notation "[ 'arg' 'max_' ( i > i0 | P ) F ]" := + (arg_max (disp := ring_display) i0 (fun i => P%B) (fun i => F)) (at level 0, i, i0 at level 10, - format "[ 'arg' 'maxr_' ( i > i0 | P ) F ]") : form_scope. + format "[ 'arg' 'max_' ( i > i0 | P ) F ]") : ring_scope. -Notation "[ 'arg' 'maxr_' ( i > i0 'in' A ) F ]" := - [arg maxr_(i > i0 | i \in A) F] +Notation "[ 'arg' 'max_' ( i > i0 'in' A ) F ]" := + [arg max_(i > i0 | i \in A) F] (at level 0, i, i0 at level 10, - format "[ 'arg' 'maxr_' ( i > i0 'in' A ) F ]") : form_scope. + format "[ 'arg' 'max_' ( i > i0 'in' A ) F ]") : ring_scope. -Notation "[ 'arg' 'maxr_' ( i > i0 ) F ]" := [arg maxr_(i > i0 | true) F] +Notation "[ 'arg' 'max_' ( i > i0 ) F ]" := [arg max_(i > i0 | true) F] (at level 0, i, i0 at level 10, - format "[ 'arg' 'maxr_' ( i > i0 ) F ]") : form_scope. - -Section RealDomainOperations. + format "[ 'arg' 'max_' ( i > i0 ) F ]") : ring_scope. (* sgr section *) @@ -3791,8 +3579,8 @@ Lemma sgr_cp0 x : ((sg x == -1) = (x < 0)) * ((sg x == 0) = (x == 0)). Proof. -rewrite -[1]/((-1) ^+ false) -signrN lt0r lerNgt sgr_def. -case: (x =P 0) => [-> | _]; first by rewrite !(eq_sym 0) !signr_eq0 ltrr eqxx. +rewrite -[1]/((-1) ^+ false) -signrN lt0r leNgt sgr_def. +case: (x =P 0) => [-> | _]; first by rewrite !(eq_sym 0) !signr_eq0 ltxx eqxx. by rewrite !(inj_eq signr_inj) eqb_id eqbF_neg signr_eq0 //. Qed. @@ -3841,7 +3629,7 @@ Lemma sgr_gt0 x : (sg x > 0) = (x > 0). Proof. by rewrite -sgr_cp0 sgr_id sgr_cp0. Qed. Lemma sgr_ge0 x : (sgr x >= 0) = (x >= 0). -Proof. by rewrite !lerNgt sgr_lt0. Qed. +Proof. by rewrite !leNgt sgr_lt0. Qed. (* norm section *) @@ -3871,10 +3659,10 @@ Proof. exact: real_ltr_normlP. Qed. Arguments ltr_normlP {x y}. Lemma ler_normr x y : (x <= `|y|) = (x <= y) || (x <= - y). -Proof. by rewrite lerNgt ltr_norml negb_and -!lerNgt orbC ler_oppr. Qed. +Proof. by rewrite leNgt ltr_norml negb_and -!leNgt orbC ler_oppr. Qed. Lemma ltr_normr x y : (x < `|y|) = (x < y) || (x < - y). -Proof. by rewrite ltrNge ler_norml negb_and -!ltrNge orbC ltr_oppr. Qed. +Proof. by rewrite ltNge ler_norml negb_and -!ltNge orbC ltr_oppr. Qed. Definition lter_normr := (ler_normr, ltr_normr). @@ -3917,45 +3705,23 @@ Lemma sqr_ge0 x : 0 <= x ^+ 2. Proof. by rewrite exprn_even_ge0. Qed. Lemma sqr_norm_eq1 x : (x ^+ 2 == 1) = (`|x| == 1). Proof. by rewrite sqrf_eq1 eqr_norml ler01 andbT. Qed. -Lemma lerif_mean_square_scaled x y : +Lemma leif_mean_square_scaled x y : x * y *+ 2 <= x ^+ 2 + y ^+ 2 ?= iff (x == y). -Proof. exact: real_lerif_mean_square_scaled. Qed. +Proof. exact: real_leif_mean_square_scaled. Qed. -Lemma lerif_AGM2_scaled x y : x * y *+ 4 <= (x + y) ^+ 2 ?= iff (x == y). -Proof. exact: real_lerif_AGM2_scaled. Qed. +Lemma leif_AGM2_scaled x y : x * y *+ 4 <= (x + y) ^+ 2 ?= iff (x == y). +Proof. exact: real_leif_AGM2_scaled. Qed. Section MinMax. (* GG: Many of the first lemmas hold unconditionally, and others hold for *) (* the real subset of a general domain. *) -Lemma minrC : @commutative R R min. -Proof. by move=> x y; rewrite /min; case: ltrgtP. Qed. - -Lemma minrr : @idempotent R min. -Proof. by move=> x; rewrite /min if_same. Qed. - -Lemma minr_l x y : x <= y -> min x y = x. -Proof. by rewrite /minr => ->. Qed. - -Lemma minr_r x y : y <= x -> min x y = y. -Proof. by move/minr_l; rewrite minrC. Qed. - -Lemma maxrC : @commutative R R max. -Proof. by move=> x y; rewrite /maxr; case: ltrgtP. Qed. - -Lemma maxrr : @idempotent R max. -Proof. by move=> x; rewrite /max if_same. Qed. - -Lemma maxr_l x y : y <= x -> max x y = x. -Proof. by move=> hxy; rewrite /max hxy. Qed. - -Lemma maxr_r x y : x <= y -> max x y = y. -Proof. by move=> hxy; rewrite maxrC maxr_l. Qed. Lemma addr_min_max x y : min x y + max x y = x + y. Proof. -case: (lerP x y)=> hxy; first by rewrite maxr_r ?minr_l. -by rewrite maxr_l ?minr_r ?ltrW // addrC. +case: (lerP x y)=> [| /ltW] hxy; + first by rewrite (meet_idPl hxy) (join_idPl hxy). +by rewrite (meet_idPr hxy) (join_idPr hxy) addrC. Qed. Lemma addr_max_min x y : max x y + min x y = x + y. @@ -3967,164 +3733,35 @@ Proof. by rewrite -[x + y]addr_min_max addrK. Qed. Lemma maxr_to_min x y : max x y = x + y - min x y. Proof. by rewrite -[x + y]addr_max_min addrK. Qed. -Lemma minrA x y z : min x (min y z) = min (min x y) z. +Lemma oppr_max : {morph -%R : x y / max x y >-> min x y : R}. Proof. -rewrite /min; case: (lerP y z) => [hyz | /ltrW hyz]. - by case: lerP => hxy; rewrite ?hyz // (@ler_trans _ y). -case: lerP=> hxz; first by rewrite !(ler_trans hxz). -case: (lerP x y)=> hxy; first by rewrite lerNgt hxz. -by case: ltrgtP hyz. +by move=> x y; case: leP; rewrite -lter_opp2 => hxy; + rewrite ?(meet_idPr hxy) ?(meet_idPl (ltW hxy)). Qed. -Lemma minrCA : @left_commutative R R min. -Proof. by move=> x y z; rewrite !minrA [minr x y]minrC. Qed. - -Lemma minrAC : @right_commutative R R min. -Proof. by move=> x y z; rewrite -!minrA [minr y z]minrC. Qed. - -Variant minr_spec x y : bool -> bool -> R -> Type := -| Minr_r of x <= y : minr_spec x y true false x -| Minr_l of y < x : minr_spec x y false true y. +Lemma oppr_min : {morph -%R : x y / min x y >-> max x y : R}. +Proof. by move=> x y; rewrite -[max _ _]opprK oppr_max !opprK. Qed. -Lemma minrP x y : minr_spec x y (x <= y) (y < x) (min x y). +Lemma addr_minl : @left_distributive R R +%R min. Proof. -case: lerP=> hxy; first by rewrite minr_l //; constructor. -by rewrite minr_r 1?ltrW //; constructor. +by move=> x y z; case: leP; case: leP => //; rewrite lter_add2; case: leP. Qed. -Lemma oppr_max x y : - max x y = min (- x) (- y). +Lemma addr_minr : @right_distributive R R +%R min. +Proof. by move=> x y z; rewrite !(addrC x) addr_minl. Qed. + +Lemma addr_maxl : @left_distributive R R +%R max. Proof. -case: minrP; rewrite lter_opp2 => hxy; first by rewrite maxr_l. -by rewrite maxr_r // ltrW. +by move=> x y z; case: leP; case: leP => //; rewrite lter_add2; case: leP. Qed. -Lemma oppr_min x y : - min x y = max (- x) (- y). -Proof. by rewrite -[maxr _ _]opprK oppr_max !opprK. Qed. - -Lemma maxrA x y z : max x (max y z) = max (max x y) z. -Proof. by apply/eqP; rewrite -eqr_opp !oppr_max minrA. Qed. - -Lemma maxrCA : @left_commutative R R max. -Proof. by move=> x y z; rewrite !maxrA [maxr x y]maxrC. Qed. - -Lemma maxrAC : @right_commutative R R max. -Proof. by move=> x y z; rewrite -!maxrA [maxr y z]maxrC. Qed. - -Variant maxr_spec x y : bool -> bool -> R -> Type := -| Maxr_r of y <= x : maxr_spec x y true false x -| Maxr_l of x < y : maxr_spec x y false true y. +Lemma addr_maxr : @right_distributive R R +%R max. +Proof. by move=> x y z; rewrite !(addrC x) addr_maxl. Qed. -Lemma maxrP x y : maxr_spec x y (y <= x) (x < y) (maxr x y). +Lemma minr_pmulr x y z : 0 <= x -> x * min y z = min (x * y) (x * z). Proof. -case: lerP => hxy; first by rewrite maxr_l //; constructor. -by rewrite maxr_r 1?ltrW //; constructor. -Qed. - -Lemma eqr_minl x y : (min x y == x) = (x <= y). -Proof. by case: minrP=> hxy; rewrite ?eqxx // ltr_eqF. Qed. - -Lemma eqr_minr x y : (min x y == y) = (y <= x). -Proof. by rewrite minrC eqr_minl. Qed. - -Lemma eqr_maxl x y : (max x y == x) = (y <= x). -Proof. by case: maxrP=> hxy; rewrite ?eqxx // eq_sym ltr_eqF. Qed. - -Lemma eqr_maxr x y : (max x y == y) = (x <= y). -Proof. by rewrite maxrC eqr_maxl. Qed. - -Lemma ler_minr x y z : (x <= min y z) = (x <= y) && (x <= z). -Proof. -case: minrP=> hyz. - by case: lerP=> hxy //; rewrite (ler_trans _ hyz). -by case: lerP=> hxz; rewrite andbC // (ler_trans hxz) // ltrW. -Qed. - -Lemma ler_minl x y z : (min y z <= x) = (y <= x) || (z <= x). -Proof. -case: minrP => hyz. - case: lerP => hyx //=; symmetry; apply: negbTE. - by rewrite -ltrNge (@ltr_le_trans _ y). -case: lerP => hzx; rewrite orbC //=; symmetry; apply: negbTE. -by rewrite -ltrNge (@ltr_trans _ z). -Qed. - -Lemma ler_maxr x y z : (x <= max y z) = (x <= y) || (x <= z). -Proof. by rewrite -lter_opp2 oppr_max ler_minl !ler_opp2. Qed. - -Lemma ler_maxl x y z : (max y z <= x) = (y <= x) && (z <= x). -Proof. by rewrite -lter_opp2 oppr_max ler_minr !ler_opp2. Qed. - -Lemma ltr_minr x y z : (x < min y z) = (x < y) && (x < z). -Proof. by rewrite !ltrNge ler_minl negb_or. Qed. - -Lemma ltr_minl x y z : (min y z < x) = (y < x) || (z < x). -Proof. by rewrite !ltrNge ler_minr negb_and. Qed. - -Lemma ltr_maxr x y z : (x < max y z) = (x < y) || (x < z). -Proof. by rewrite !ltrNge ler_maxl negb_and. Qed. - -Lemma ltr_maxl x y z : (max y z < x) = (y < x) && (z < x). -Proof. by rewrite !ltrNge ler_maxr negb_or. Qed. - -Definition lter_minr := (ler_minr, ltr_minr). -Definition lter_minl := (ler_minl, ltr_minl). -Definition lter_maxr := (ler_maxr, ltr_maxr). -Definition lter_maxl := (ler_maxl, ltr_maxl). - -Lemma addr_minl : @left_distributive R R +%R min. -Proof. -move=> x y z; case: minrP=> hxy; first by rewrite minr_l // ler_add2r. -by rewrite minr_r // ltrW // ltr_add2r. -Qed. - -Lemma addr_minr : @right_distributive R R +%R min. -Proof. -move=> x y z; case: minrP=> hxy; first by rewrite minr_l // ler_add2l. -by rewrite minr_r // ltrW // ltr_add2l. -Qed. - -Lemma addr_maxl : @left_distributive R R +%R max. -Proof. -move=> x y z; rewrite -[_ + _]opprK opprD oppr_max. -by rewrite addr_minl -!opprD oppr_min !opprK. -Qed. - -Lemma addr_maxr : @right_distributive R R +%R max. -Proof. -move=> x y z; rewrite -[_ + _]opprK opprD oppr_max. -by rewrite addr_minr -!opprD oppr_min !opprK. -Qed. - -Lemma minrK x y : max (min x y) x = x. -Proof. by case: minrP => hxy; rewrite ?maxrr ?maxr_r // ltrW. Qed. - -Lemma minKr x y : min y (max x y) = y. -Proof. by case: maxrP => hxy; rewrite ?minrr ?minr_l. Qed. - -Lemma maxr_minl : @left_distributive R R max min. -Proof. -move=> x y z; case: minrP => hxy. - by case: maxrP => hm; rewrite minr_l // ler_maxr (hxy, lerr) ?orbT. -by case: maxrP => hyz; rewrite minr_r // ler_maxr (ltrW hxy, lerr) ?orbT. -Qed. - -Lemma maxr_minr : @right_distributive R R max min. -Proof. by move=> x y z; rewrite maxrC maxr_minl ![_ _ x]maxrC. Qed. - -Lemma minr_maxl : @left_distributive R R min max. -Proof. -move=> x y z; rewrite -[min _ _]opprK !oppr_min [- max x y]oppr_max. -by rewrite maxr_minl !(oppr_max, oppr_min, opprK). -Qed. - -Lemma minr_maxr : @right_distributive R R min max. -Proof. by move=> x y z; rewrite minrC minr_maxl ![_ _ x]minrC. Qed. - -Lemma minr_pmulr x y z : 0 <= x -> x * min y z = min (x * y) (x * z). -Proof. -case: sgrP=> // hx _; first by rewrite hx !mul0r minrr. -case: minrP=> hyz; first by rewrite minr_l // ler_pmul2l. -by rewrite minr_r // ltrW // ltr_pmul2l. +case: sgrP=> // hx _; first by rewrite hx !mul0r meetxx. +by case: leP; case: leP => //; rewrite lter_pmul2l //; case: leP. Qed. Lemma minr_nmulr x y z : x <= 0 -> x * min y z = max (x * y) (x * z). @@ -4158,19 +3795,16 @@ Lemma maxr_nmull x y z : x <= 0 -> max y z * x = min (y * x) (z * x). Proof. by move=> *; rewrite mulrC maxr_nmulr // ![_ * x]mulrC. Qed. Lemma maxrN x : max x (- x) = `|x|. -Proof. -case: ger0P=> hx; first by rewrite maxr_l // ge0_cp //. -by rewrite maxr_r // le0_cp // ltrW. -Qed. +Proof. by case: ger0P=> [/ge0_cp [] | /lt0_cp []]; case: (leP (- x) x). Qed. Lemma maxNr x : max (- x) x = `|x|. -Proof. by rewrite maxrC maxrN. Qed. +Proof. by rewrite joinC maxrN. Qed. Lemma minrN x : min x (- x) = - `|x|. -Proof. by rewrite -[minr _ _]opprK oppr_min opprK maxNr. Qed. +Proof. by rewrite -[min _ _]opprK oppr_min opprK maxNr. Qed. Lemma minNr x : min (- x) x = - `|x|. -Proof. by rewrite -[minr _ _]opprK oppr_min opprK maxrN. Qed. +Proof. by rewrite -[min _ _]opprK oppr_min opprK maxrN. Qed. End MinMax. @@ -4180,8 +3814,8 @@ Variable p : {poly R}. Lemma poly_itv_bound a b : {ub | forall x, a <= x <= b -> `|p.[x]| <= ub}. Proof. -have [ub le_p_ub] := poly_disk_bound p (Num.max `|a| `|b|). -exists ub => x /andP[le_a_x le_x_b]; rewrite le_p_ub // ler_maxr !ler_normr. +have [ub le_p_ub] := poly_disk_bound p (`|a| `|` `|b|). +exists ub => x /andP[le_a_x le_x_b]; rewrite le_p_ub // lexU !ler_normr. by have [_|_] := ler0P x; rewrite ?ler_opp2 ?le_a_x ?le_x_b orbT. Qed. @@ -4192,16 +3826,16 @@ have [p_le1 | p_gt1] := leqP (size p) 1. exists 0 => x _; rewrite (size1_polyC p_le1) hornerC. by rewrite -[p`_0]lead_coefC -size1_polyC // mon_p ltr01. pose lb := \sum_(j < n.+1) `|p`_j|; exists (lb + 1) => x le_ub_x. -have x_ge1: 1 <= x; last have x_gt0 := ltr_le_trans ltr01 x_ge1. - by rewrite -(ler_add2l lb) ler_paddl ?sumr_ge0 // => j _; apply: normr_ge0. +have x_ge1: 1 <= x; last have x_gt0 := lt_le_trans ltr01 x_ge1. + by rewrite -(ler_add2l lb) ler_paddl ?sumr_ge0 // => j _. rewrite horner_coef -(subnK p_gt1) -/n addnS big_ord_recr /= addn1. rewrite [in p`__]subnSK // subn1 -lead_coefE mon_p mul1r -ltr_subl_addl sub0r. -apply: ler_lt_trans (_ : lb * x ^+ n < _); last first. +apply: le_lt_trans (_ : lb * x ^+ n < _); last first. rewrite exprS ltr_pmul2r ?exprn_gt0 ?(ltr_le_trans ltr01) //. by rewrite -(ltr_add2r 1) ltr_spaddr ?ltr01. -rewrite -sumrN mulr_suml ler_sum // => j _; apply: ler_trans (ler_norm _) _. -rewrite normrN normrM ler_wpmul2l ?normr_ge0 // normrX. -by rewrite ger0_norm ?(ltrW x_gt0) // ler_weexpn2l ?leq_ord. +rewrite -sumrN mulr_suml ler_sum // => j _; apply: le_trans (ler_norm _) _. +rewrite normrN normrM ler_wpmul2l // normrX. +by rewrite ger0_norm ?(ltW x_gt0) // ler_weexpn2l ?leq_ord. Qed. End PolyBounds. @@ -4212,11 +3846,11 @@ Section RealField. Variables (F : realFieldType) (x y : F). -Lemma lerif_mean_square : x * y <= (x ^+ 2 + y ^+ 2) / 2%:R ?= iff (x == y). -Proof. by apply: real_lerif_mean_square; apply: num_real. Qed. +Lemma leif_mean_square : x * y <= (x ^+ 2 + y ^+ 2) / 2%:R ?= iff (x == y). +Proof. by apply: real_leif_mean_square; apply: num_real. Qed. -Lemma lerif_AGM2 : x * y <= ((x + y) / 2%:R)^+ 2 ?= iff (x == y). -Proof. by apply: real_lerif_AGM2; apply: num_real. Qed. +Lemma leif_AGM2 : x * y <= ((x + y) / 2%:R)^+ 2 ?= iff (x == y). +Proof. by apply: real_leif_AGM2; apply: num_real. Qed. End RealField. @@ -4230,7 +3864,7 @@ Proof. by move/ger0_norm=> {1}<-; rewrite /bound; case: (sigW _). Qed. Lemma upper_nthrootP i : (bound x <= i)%N -> x < 2%:R ^+ i. Proof. rewrite /bound; case: (sigW _) => /= b le_x_b le_b_i. -apply: ler_lt_trans (ler_norm x) (ltr_trans le_x_b _ ). +apply: le_lt_trans (ler_norm x) (lt_trans le_x_b _ ). by rewrite -natrX ltr_nat (leq_ltn_trans le_b_i) // ltn_expl. Qed. @@ -4261,7 +3895,7 @@ by have [//|_ /eqP//|->] := ltrgt0P a; rewrite mulf_eq0 orbb => /eqP. Qed. Lemma ltr0_sqrtr a : a < 0 -> sqrt a = 0. -Proof. by move=> /ltrW; apply: ler0_sqrtr. Qed. +Proof. by move=> /ltW; apply: ler0_sqrtr. Qed. Variant sqrtr_spec a : R -> bool -> bool -> R -> Type := | IsNoSqrtr of a < 0 : sqrtr_spec a a false true 0 @@ -4298,13 +3932,13 @@ Proof. by move: (sqrtr_sqr 1); rewrite expr1n => ->; rewrite normr1. Qed. Lemma sqrtr_eq0 a : (sqrt a == 0) = (a <= 0). Proof. -case: sqrtrP => [/ltrW ->|b]; first by rewrite eqxx. -case: ltrgt0P => [b_gt0|//|->]; last by rewrite exprS mul0r lerr. -by rewrite ltr_geF ?pmulr_rgt0. +case: sqrtrP => [/ltW ->|b]; first by rewrite eqxx. +case: ltrgt0P => [b_gt0|//|->]; last by rewrite exprS mul0r lexx. +by rewrite lt_geF ?pmulr_rgt0. Qed. Lemma sqrtr_gt0 a : (0 < sqrt a) = (0 < a). -Proof. by rewrite lt0r sqrtr_ge0 sqrtr_eq0 -ltrNge andbT. Qed. +Proof. by rewrite lt0r sqrtr_ge0 sqrtr_eq0 -ltNge andbT. Qed. Lemma eqr_sqrt a b : 0 <= a -> 0 <= b -> (sqrt a == sqrt b) = (a == b). Proof. @@ -4315,29 +3949,29 @@ Qed. Lemma ler_wsqrtr : {homo @sqrt R : a b / a <= b}. Proof. move=> a b /= le_ab; case: (boolP (0 <= a))=> [pa|]; last first. - by rewrite -ltrNge; move/ltrW; rewrite -sqrtr_eq0; move/eqP->. + by rewrite -ltNge; move/ltW; rewrite -sqrtr_eq0; move/eqP->. rewrite -(@ler_pexpn2r R 2) ?nnegrE ?sqrtr_ge0 //. -by rewrite !sqr_sqrtr // (ler_trans pa). +by rewrite !sqr_sqrtr // (le_trans pa). Qed. Lemma ler_psqrt : {in @pos R &, {mono sqrt : a b / a <= b}}. Proof. -apply: ler_mono_in => x y x_gt0 y_gt0. -rewrite !ltr_neqAle => /andP[neq_xy le_xy]. -by rewrite ler_wsqrtr // eqr_sqrt ?ltrW // neq_xy. +apply: le_mono_in => x y x_gt0 y_gt0. +rewrite !lt_neqAle => /andP[neq_xy le_xy]. +by rewrite ler_wsqrtr // eqr_sqrt ?ltW // neq_xy. Qed. Lemma ler_sqrt a b : 0 < b -> (sqrt a <= sqrt b) = (a <= b). Proof. move=> b_gt0; have [a_le0|a_gt0] := ler0P a; last by rewrite ler_psqrt. -by rewrite ler0_sqrtr // sqrtr_ge0 (ler_trans a_le0) ?ltrW. +by rewrite ler0_sqrtr // sqrtr_ge0 (le_trans a_le0) ?ltW. Qed. Lemma ltr_sqrt a b : 0 < b -> (sqrt a < sqrt b) = (a < b). Proof. move=> b_gt0; have [a_le0|a_gt0] := ler0P a; last first. - by rewrite (lerW_mono_in ler_psqrt). -by rewrite ler0_sqrtr // sqrtr_gt0 b_gt0 (ler_lt_trans a_le0). + by rewrite (leW_mono_in ler_psqrt). +by rewrite ler0_sqrtr // sqrtr_gt0 b_gt0 (le_lt_trans a_le0). Qed. End RealClosedFieldTheory. @@ -4356,10 +3990,10 @@ Variable C : numClosedFieldType. Implicit Types a x y z : C. Definition normCK x : `|x| ^+ 2 = x * x^*. -Proof. by case: C x => ? [? ? []]. Qed. +Proof. by case: C x => ? [? ? ? []]. Qed. Lemma sqrCi : 'i ^+ 2 = -1 :> C. -Proof. by case: C => ? [? ? []]. Qed. +Proof. by case: C => ? [? ? ? []]. Qed. Lemma conjCK : involutive (@conjC C). Proof. @@ -4382,15 +4016,14 @@ Variant rootC_spec n (x : C) : Type := Fact rootC_subproof n x : rootC_spec n x. Proof. -have realRe2 u : Re2 u \is Num.real. - rewrite realEsqr expr2 {2}/Re2 -{2}[u]conjCK addrC -rmorphD -normCK. - by rewrite exprn_ge0 ?normr_ge0. +have realRe2 u : Re2 u \is Num.real by + rewrite realEsqr expr2 {2}/Re2 -{2}[u]conjCK addrC -rmorphD -normCK exprn_ge0. have argCle_total : total argCle. move=> u v; rewrite /total /argCle. by do 2!case: (nnegIm _) => //; rewrite ?orbT //= real_leVge. have argCle_trans : transitive argCle. move=> u v w /implyP geZuv /implyP geZvw; apply/implyP. - by case/geZvw/andP=> /geZuv/andP[-> geRuv] /ler_trans->. + by case/geZvw/andP=> /geZuv/andP[-> geRuv] /le_trans->. pose p := 'X^n - (x *+ (n > 0))%:P; have [r0 Dp] := closed_field_poly_normal p. have sz_p: size p = n.+1. rewrite size_addl ?size_polyXn // ltnS size_opp size_polyC mulrn_eq0. @@ -4407,7 +4040,7 @@ exists r`_0 => [|z n_gt0 /(mem_rP z n_gt0) r_z]. case: posnP => [n0 | n_gt0]; first by rewrite nth_default // sz_r n0. by apply/mem_rP=> //; rewrite mem_nth ?sz_r. case: {Dp mem_rP}r r_z r_arg => // y r1; rewrite inE => /predU1P[-> _|r1z]. - by apply/implyP=> ->; rewrite lerr. + by apply/implyP=> ->; rewrite lexx. by move/(order_path_min argCle_trans)/allP->. Qed. @@ -4426,7 +4059,7 @@ Let nz2 : 2%:R != 0 :> C. Proof. by rewrite pnatr_eq0. Qed. Lemma normCKC x : `|x| ^+ 2 = x^* * x. Proof. by rewrite normCK mulrC. Qed. Lemma mul_conjC_ge0 x : 0 <= x * x^*. -Proof. by rewrite -normCK exprn_ge0 ?normr_ge0. Qed. +Proof. by rewrite -normCK exprn_ge0. Qed. Lemma mul_conjC_gt0 x : (0 < x * x^*) = (x != 0). Proof. @@ -4508,16 +4141,13 @@ Proof. by move=> n_gt0; rewrite -{1}(rootC0 n) eqr_rootC. Qed. (* Rectangular coordinates. *) Lemma nonRealCi : ('i : C) \isn't real. -Proof. by rewrite realEsqr sqrCi oppr_ge0 ltr_geF ?ltr01. Qed. +Proof. by rewrite realEsqr sqrCi oppr_ge0 lt_geF ?ltr01. Qed. Lemma neq0Ci : 'i != 0 :> C. Proof. by apply: contraNneq nonRealCi => ->; apply: real0. Qed. Lemma normCi : `|'i| = 1 :> C. -Proof. -apply/eqP; rewrite -(@pexpr_eq1 _ _ 2) ?normr_ge0 //. -by rewrite -normrX sqrCi normrN1. -Qed. +Proof. by apply/eqP; rewrite -(@pexpr_eq1 _ _ 2) // -normrX sqrCi normrN1. Qed. Lemma invCi : 'i^-1 = - 'i :> C. Proof. by rewrite -div1r -[1]opprK -sqrCi mulNr mulfK ?neq0Ci. Qed. @@ -4645,19 +4275,19 @@ Proof. by move=> x y Rx Ry; rewrite /= invC_norm conjC_rect // mulrC normC2_rect. Qed. -Lemma lerif_normC_Re_Creal z : `|'Re z| <= `|z| ?= iff (z \is real). +Lemma leif_normC_Re_Creal z : `|'Re z| <= `|z| ?= iff (z \is real). Proof. -rewrite -(mono_in_lerif ler_sqr); try by rewrite qualifE normr_ge0. +rewrite -(mono_in_leif ler_sqr); try by rewrite qualifE. rewrite normCK conj_Creal // normC2_Re_Im -expr2. -rewrite addrC -lerif_subLR subrr (sameP (Creal_ImP _) eqP) -sqrf_eq0 eq_sym. -by apply: lerif_eq; rewrite -realEsqr. +rewrite addrC -leif_subLR subrr (sameP (Creal_ImP _) eqP) -sqrf_eq0 eq_sym. +by apply: leif_eq; rewrite -realEsqr. Qed. -Lemma lerif_Re_Creal z : 'Re z <= `|z| ?= iff (0 <= z). +Lemma leif_Re_Creal z : 'Re z <= `|z| ?= iff (0 <= z). Proof. have ubRe: 'Re z <= `|'Re z| ?= iff (0 <= 'Re z). - by rewrite ger0_def eq_sym; apply/lerif_eq/real_ler_norm. -congr (_ <= _ ?= iff _): (lerif_trans ubRe (lerif_normC_Re_Creal z)). + by rewrite ger0_def eq_sym; apply/leif_eq/real_ler_norm. +congr (_ <= _ ?= iff _): (leif_trans ubRe (leif_normC_Re_Creal z)). apply/andP/idP=> [[zRge0 /Creal_ReP <- //] | z_ge0]. by have Rz := ger0_real z_ge0; rewrite (Creal_ReP _ _). Qed. @@ -4708,50 +4338,50 @@ suffices /existsP[i ltRwi0]: [exists i : 'I_n, 'Re (w ^+ i) < 0]. by exists (w ^+ i) => //; rewrite exprAC wn1 expr1n. apply: contra_eqT (congr1 Re pw_0) => /existsPn geRw0. rewrite raddf_sum raddf0 /= (bigD1 (Ordinal (ltnW n_gt1))) //=. -rewrite (Creal_ReP _ _) ?rpred1 // gtr_eqF ?ltr_paddr ?ltr01 //=. -by apply: sumr_ge0 => i _; rewrite real_lerNgt ?rpred0. +rewrite (Creal_ReP _ _) ?rpred1 // gt_eqF ?ltr_paddr ?ltr01 //=. +by apply: sumr_ge0 => i _; rewrite real_leNgt ?rpred0. Qed. Lemma Im_rootC_ge0 n x : (n > 1)%N -> 0 <= 'Im (n.-root x). Proof. set y := n.-root x => n_gt1; have n_gt0 := ltnW n_gt1. -apply: wlog_neg; rewrite -real_ltrNge ?rpred0 // => ltIy0. +apply: wlog_neg; rewrite -real_ltNge ?rpred0 // => ltIy0. suffices [z zn_x leI0z]: exists2 z, z ^+ n = x & 'Im z >= 0. by rewrite /y; case_rootC => /= y1 _ /(_ z n_gt0 zn_x)/argCleP[]. have [w wn1 ltRw0] := neg_unity_root n_gt1. wlog leRI0yw: w wn1 ltRw0 / 0 <= 'Re y * 'Im w. move=> IHw; have: 'Re y * 'Im w \is real by rewrite rpredM. - case/real_ger0P=> [|/ltrW leRIyw0]; first exact: IHw. + case/real_ge0P=> [|/ltW leRIyw0]; first exact: IHw. apply: (IHw w^*); rewrite ?Re_conj ?Im_conj ?mulrN ?oppr_ge0 //. by rewrite -rmorphX wn1 rmorph1. exists (w * y); first by rewrite exprMn wn1 mul1r rootCK. rewrite [w]Crect [y]Crect mulC_rect. -by rewrite Im_rect ?rpredD ?rpredN 1?rpredM // addr_ge0 // ltrW ?nmulr_rgt0. +by rewrite Im_rect ?rpredD ?rpredN 1?rpredM // addr_ge0 // ltW ?nmulr_rgt0. Qed. Lemma rootC_lt0 n x : (1 < n)%N -> (n.-root x < 0) = false. Proof. set y := n.-root x => n_gt1; have n_gt0 := ltnW n_gt1. -apply: negbTE; apply: wlog_neg => /negbNE lt0y; rewrite ler_gtF //. +apply: negbTE; apply: wlog_neg => /negbNE lt0y; rewrite le_gtF //. have Rx: x \is real by rewrite -[x](rootCK n_gt0) rpredX // ltr0_real. have Re_y: 'Re y = y by apply/Creal_ReP; rewrite ltr0_real. have [z zn_x leR0z]: exists2 z, z ^+ n = x & 'Re z >= 0. have [w wn1 ltRw0] := neg_unity_root n_gt1. exists (w * y); first by rewrite exprMn wn1 mul1r rootCK. - by rewrite ReMr ?ltr0_real // ltrW // nmulr_lgt0. + by rewrite ReMr ?ltr0_real // ltW // nmulr_lgt0. without loss leI0z: z zn_x leR0z / 'Im z >= 0. move=> IHz; have: 'Im z \is real by []. - case/real_ger0P=> [|/ltrW leIz0]; first exact: IHz. + case/real_ge0P=> [|/ltW leIz0]; first exact: IHz. apply: (IHz z^*); rewrite ?Re_conj ?Im_conj ?oppr_ge0 //. by rewrite -rmorphX zn_x conj_Creal. -by apply: ler_trans leR0z _; rewrite -Re_y ?rootC_Re_max ?ltr0_real. +by apply: le_trans leR0z _; rewrite -Re_y ?rootC_Re_max ?ltr0_real. Qed. Lemma rootC_ge0 n x : (n > 0)%N -> (0 <= n.-root x) = (0 <= x). Proof. set y := n.-root x => n_gt0. apply/idP/idP=> [/(exprn_ge0 n) | x_ge0]; first by rewrite rootCK. -rewrite -(ger_lerif (lerif_Re_Creal y)). +rewrite -(ge_leif (leif_Re_Creal y)). have Ray: `|y| \is real by apply: normr_real. rewrite -(Creal_ReP _ Ray) rootC_Re_max ?(Creal_ImP _ Ray) //. by rewrite -normrX rootCK // ger0_norm. @@ -4762,25 +4392,25 @@ Proof. by move=> n_gt0; rewrite !lt0r rootC_ge0 ?rootC_eq0. Qed. Lemma rootC_le0 n x : (1 < n)%N -> (n.-root x <= 0) = (x == 0). Proof. -by move=> n_gt1; rewrite ler_eqVlt rootC_lt0 // orbF rootC_eq0 1?ltnW. +by move=> n_gt1; rewrite le_eqVlt rootC_lt0 // orbF rootC_eq0 1?ltnW. Qed. Lemma ler_rootCl n : (n > 0)%N -> {in Num.nneg, {mono n.-root : x y / x <= y}}. Proof. move=> n_gt0 x x_ge0 y; have [y_ge0 | not_y_ge0] := boolP (0 <= y). by rewrite -(ler_pexpn2r n_gt0) ?qualifE ?rootC_ge0 ?rootCK. -rewrite (contraNF (@ler_trans _ _ 0 _ _)) ?rootC_ge0 //. -by rewrite (contraNF (ler_trans x_ge0)). +rewrite (contraNF (@le_trans _ _ _ 0 _ _)) ?rootC_ge0 //. +by rewrite (contraNF (le_trans x_ge0)). Qed. Lemma ler_rootC n : (n > 0)%N -> {in Num.nneg &, {mono n.-root : x y / x <= y}}. Proof. by move=> n_gt0 x y x_ge0 _; apply: ler_rootCl. Qed. Lemma ltr_rootCl n : (n > 0)%N -> {in Num.nneg, {mono n.-root : x y / x < y}}. -Proof. by move=> n_gt0 x x_ge0 y; rewrite !ltr_def ler_rootCl ?eqr_rootC. Qed. +Proof. by move=> n_gt0 x x_ge0 y; rewrite !lt_def ler_rootCl ?eqr_rootC. Qed. Lemma ltr_rootC n : (n > 0)%N -> {in Num.nneg &, {mono n.-root : x y / x < y}}. -Proof. by move/ler_rootC/lerW_mono_in. Qed. +Proof. by move/ler_rootC/leW_mono_in. Qed. Lemma exprCK n x : (0 < n)%N -> 0 <= x -> n.-root (x ^+ n) = x. Proof. @@ -4791,8 +4421,7 @@ Qed. Lemma norm_rootC n x : `|n.-root x| = n.-root `|x|. Proof. have [-> | n_gt0] := posnP n; first by rewrite !root0C normr0. -apply/eqP; rewrite -(eqr_expn2 n_gt0) ?rootC_ge0 ?normr_ge0 //. -by rewrite -normrX !rootCK. +by apply/eqP; rewrite -(eqr_expn2 n_gt0) ?rootC_ge0 // -normrX !rootCK. Qed. Lemma rootCX n x k : (n > 0)%N -> 0 <= x -> n.-root (x ^+ k) = n.-root x ^+ k. @@ -4824,31 +4453,31 @@ by move=> n_gt0; rewrite -{1}(rootC1 n_gt0) ler_rootCl // qualifE ler01. Qed. Lemma rootC_gt1 n x : (n > 0)%N -> (n.-root x > 1) = (x > 1). -Proof. by move=> n_gt0; rewrite !ltr_def rootC_eq1 ?rootC_ge1. Qed. +Proof. by move=> n_gt0; rewrite !lt_def rootC_eq1 ?rootC_ge1. Qed. Lemma rootC_le1 n x : (n > 0)%N -> 0 <= x -> (n.-root x <= 1) = (x <= 1). Proof. by move=> n_gt0 x_ge0; rewrite -{1}(rootC1 n_gt0) ler_rootCl. Qed. Lemma rootC_lt1 n x : (n > 0)%N -> 0 <= x -> (n.-root x < 1) = (x < 1). -Proof. by move=> n_gt0 x_ge0; rewrite !ltr_neqAle rootC_eq1 ?rootC_le1. Qed. +Proof. by move=> n_gt0 x_ge0; rewrite !lt_neqAle rootC_eq1 ?rootC_le1. Qed. Lemma rootCMl n x z : 0 <= x -> n.-root (x * z) = n.-root x * n.-root z. Proof. rewrite le0r => /predU1P[-> | x_gt0]; first by rewrite !(mul0r, rootC0). have [| n_gt1 | ->] := ltngtP n 1; last by rewrite !root1C. by case: n => //; rewrite !root0C mul0r. -have [x_ge0 n_gt0] := (ltrW x_gt0, ltnW n_gt1). +have [x_ge0 n_gt0] := (ltW x_gt0, ltnW n_gt1). have nx_gt0: 0 < n.-root x by rewrite rootC_gt0. -have Rnx: n.-root x \is real by rewrite ger0_real ?ltrW. +have Rnx: n.-root x \is real by rewrite ger0_real ?ltW. apply: eqC_semipolar; last 1 first; try apply/eqP. - by rewrite ImMl // !(Im_rootC_ge0, mulr_ge0, rootC_ge0). -- by rewrite -(eqr_expn2 n_gt0) ?normr_ge0 // -!normrX exprMn !rootCK. -rewrite eqr_le; apply/andP; split; last first. +- by rewrite -(eqr_expn2 n_gt0) // -!normrX exprMn !rootCK. +rewrite eq_le; apply/andP; split; last first. rewrite rootC_Re_max ?exprMn ?rootCK ?ImMl //. - by rewrite mulr_ge0 ?Im_rootC_ge0 ?ltrW. -rewrite -[n.-root _](mulVKf (negbT (gtr_eqF nx_gt0))) !(ReMl Rnx) //. -rewrite ler_pmul2l // rootC_Re_max ?exprMn ?exprVn ?rootCK ?mulKf ?gtr_eqF //. -by rewrite ImMl ?rpredV // mulr_ge0 ?invr_ge0 ?Im_rootC_ge0 ?ltrW. + by rewrite mulr_ge0 ?Im_rootC_ge0 ?ltW. +rewrite -[n.-root _](mulVKf (negbT (gt_eqF nx_gt0))) !(ReMl Rnx) //. +rewrite ler_pmul2l // rootC_Re_max ?exprMn ?exprVn ?rootCK ?mulKf ?gt_eqF //. +by rewrite ImMl ?rpredV // mulr_ge0 ?invr_ge0 ?Im_rootC_ge0 ?ltW. Qed. Lemma rootCMr n x z : 0 <= x -> n.-root (z * x) = n.-root z * n.-root x. @@ -4865,18 +4494,18 @@ Qed. (* The proper form of the Arithmetic - Geometric Mean inequality. *) -Lemma lerif_rootC_AGM (I : finType) (A : {pred I}) (n := #|A|) E : +Lemma leif_rootC_AGM (I : finType) (A : {pred I}) (n := #|A|) E : {in A, forall i, 0 <= E i} -> n.-root (\prod_(i in A) E i) <= (\sum_(i in A) E i) / n%:R ?= iff [forall i in A, forall j in A, E i == E j]. Proof. move=> Ege0; have [n0 | n_gt0] := posnP n. - rewrite n0 root0C invr0 mulr0; apply/lerif_refl/forall_inP=> i. + rewrite n0 root0C invr0 mulr0; apply/leif_refl/forall_inP=> i. by rewrite (card0_eq n0). -rewrite -(mono_in_lerif (ler_pexpn2r n_gt0)) ?rootCK //=; first 1 last. +rewrite -(mono_in_leif (ler_pexpn2r n_gt0)) ?rootCK //=; first 1 last. - by rewrite qualifE rootC_ge0 // prodr_ge0. - by rewrite rpred_div ?rpred_nat ?rpred_sum. -exact: lerif_AGM. +exact: leif_AGM. Qed. (* Square root. *) @@ -4908,13 +4537,13 @@ Proof. apply: (iffP andP) => [[leI0x not_gt0x] | <-]; last first. by rewrite sqrtC_lt0 Im_rootC_ge0. have /eqP := sqrtCK (x ^+ 2); rewrite eqf_sqr => /pred2P[] // defNx. -apply: sqrCK; rewrite -real_lerNgt ?rpred0 // in not_gt0x; -apply/Creal_ImP/ler_anti; +apply: sqrCK; rewrite -real_leNgt ?rpred0 // in not_gt0x; +apply/Creal_ImP/le_anti; by rewrite leI0x -oppr_ge0 -raddfN -defNx Im_rootC_ge0. Qed. Lemma normC_def x : `|x| = sqrtC (x * x^*). -Proof. by rewrite -normCK sqrCK ?normr_ge0. Qed. +Proof. by rewrite -normCK sqrCK. Qed. Lemma norm_conjC x : `|x^*| = `|x|. Proof. by rewrite !normC_def conjCK mulrC. Qed. @@ -4947,7 +4576,7 @@ have def_xy: x * y^* = y * x^*. by rewrite mulrN mulrAC mulrA -mulrA mulrACA -!normCK mulNrn addNr. have{def_xy def2xy} def_yx: `|y * x| = y * x^*. by apply: (mulIf nz2); rewrite !mulr_natr mulrC normrM def2xy def_xy. -rewrite -{1}(divfK nz_x y) invC_norm mulrCA -{}def_yx !normrM invfM. +rewrite -{1}(divfK nz_x y) (invC_norm x) mulrCA -{}def_yx !normrM invfM. by rewrite mulrCA divfK ?normr_eq0 // mulrAC mulrA. Qed. @@ -4965,8 +4594,8 @@ have [Qj | /nandP[/negP[]// | /negbNE/eqP->]] := boolP (Q j); last first. by rewrite mulrC divfK. have: `|F i + F j| = `|F i| + `|F j|. do [rewrite !(bigD1 j Qj) /=; set z := \sum_(k | _) `|_|] in norm_sumF. - apply/eqP; rewrite eqr_le ler_norm_add -(ler_add2r z) -addrA -norm_sumF addrA. - by rewrite (ler_trans (ler_norm_add _ _)) // ler_add2l ler_norm_sum. + apply/eqP; rewrite eq_le ler_norm_add -(ler_add2r z) -addrA -norm_sumF addrA. + by rewrite (le_trans (ler_norm_add _ _)) // ler_add2l ler_norm_sum. by case/normC_add_eq=> k _ [/(canLR (mulKf nzFi)) <-]; rewrite -(mulrC (F i)). Qed. @@ -4985,14 +4614,14 @@ Lemma normC_sum_upper (I : finType) (P : pred I) (F G : I -> C) : forall i, P i -> F i = G i. Proof. set sumF := \sum_(i | _) _; set sumG := \sum_(i | _) _ => leFG eq_sumFG. -have posG i: P i -> 0 <= G i by move/leFG; apply: ler_trans; apply: normr_ge0. +have posG i: P i -> 0 <= G i by move/leFG; apply: le_trans. have norm_sumG: `|sumG| = sumG by rewrite ger0_norm ?sumr_ge0. have norm_sumF: `|sumF| = \sum_(i | P i) `|F i|. - apply/eqP; rewrite eqr_le ler_norm_sum eq_sumFG norm_sumG -subr_ge0 -sumrB. + apply/eqP; rewrite eq_le ler_norm_sum eq_sumFG norm_sumG -subr_ge0 -sumrB. by rewrite sumr_ge0 // => i Pi; rewrite subr_ge0 ?leFG. have [t _ defF] := normC_sum_eq norm_sumF. have [/(psumr_eq0P posG) G0 i Pi | nz_sumG] := eqVneq sumG 0. - by apply/eqP; rewrite G0 // -normr_eq0 eqr_le normr_ge0 -(G0 i Pi) leFG. + by apply/eqP; rewrite G0 // -normr_eq0 eq_le normr_ge0 -(G0 i Pi) leFG. have t1: t = 1. apply: (mulfI nz_sumG); rewrite mulr1 -{1}norm_sumG -eq_sumFG norm_sumF. by rewrite mulr_suml -(eq_bigr _ defF). @@ -5025,43 +4654,188 @@ Arguments sqrCK_P {C x}. End Theory. -(* TODO Kazuhiko: divide those Mixin builders into order.v and here *) +(*************) +(* FACTORIES *) +(*************) + +Module NumMixin. +Section NumMixin. +Variable (R : idomainType). + +Record of_ := Mixin { + le : rel R; + lt : rel R; + norm : R -> R; + normD : forall x y, le (norm (x + y)) (norm x + norm y); + addr_gt0 : forall x y, lt 0 x -> lt 0 y -> lt 0 (x + y); + norm_eq0 : forall x, norm x = 0 -> x = 0; + ger_total : forall x y, le 0 x -> le 0 y -> le x y || le y x; + normM : {morph norm : x y / x * y}; + le_def : forall x y, (le x y) = (norm (y - x) == y - x); + lt_def : forall x y, (lt x y) = (y != x) && (le x y) +}. + +Variable (m : of_). + +Local Notation "x <= y" := (le m x y). +Local Notation "x < y" := (lt m x y). +Local Notation "`| x |" := (norm m x) : ring_scope. + +Lemma ltrr x : x < x = false. Proof. by rewrite lt_def eqxx. Qed. + +Lemma ge0_def x : (0 <= x) = (`|x| == x). +Proof. by rewrite le_def subr0. Qed. + +Lemma subr_ge0 x y : (0 <= x - y) = (y <= x). +Proof. by rewrite ge0_def -le_def. Qed. + +Lemma subr_gt0 x y : (0 < y - x) = (x < y). +Proof. by rewrite !lt_def subr_eq0 subr_ge0. Qed. + +Lemma lt_trans : transitive (lt m). +Proof. +move=> y x z le_xy le_yz. +by rewrite -subr_gt0 -(subrK y z) -addrA addr_gt0 // subr_gt0. +Qed. + +Lemma le01 : 0 <= 1. +Proof. +have n1_nz: `|1| != 0 :> R by apply: contraNneq (@oner_neq0 R) => /norm_eq0->. +by rewrite ge0_def -(inj_eq (mulfI n1_nz)) -normM !mulr1. +Qed. + +Lemma lt01 : 0 < 1. +Proof. by rewrite lt_def oner_neq0 le01. Qed. + +Lemma ltW x y : x < y -> x <= y. Proof. by rewrite lt_def => /andP[]. Qed. + +Lemma lerr x : x <= x. +Proof. +have n2: `|2%:R| == 2%:R :> R by rewrite -ge0_def ltW ?addr_gt0 ?lt01. +rewrite le_def subrr -(inj_eq (addrI `|0|)) addr0 -mulr2n -mulr_natr. +by rewrite -(eqP n2) -normM mul0r. +Qed. + +Lemma le_def' x y : (x <= y) = (x == y) || (x < y). +Proof. +by rewrite eq_sym lt_def; case: eqP => //= ->; rewrite lerr. +Qed. + +Lemma le_trans : transitive (le m). +by move=> y x z; rewrite !le_def' => /predU1P [->|hxy] // /predU1P [<-|hyz]; + rewrite ?hxy ?(lt_trans hxy hyz) orbT. +Qed. + +Lemma normrMn x n : `|x *+ n| = `|x| *+ n. +Proof. +rewrite -mulr_natr -[RHS]mulr_natr normM. +congr (_ * _); apply/eqP; rewrite -ge0_def. +elim: n => [|n ih]; [exact: lerr | apply: (le_trans ih)]. +by rewrite le_def -natrB // subSnn -[_%:R]subr0 -le_def mulr1n le01. +Qed. + +Lemma normrN1 : `|-1| = 1 :> R. +Proof. +have: `|-1| ^+ 2 == 1 :> R + by rewrite expr2 /= -normM mulrNN mul1r -[1]subr0 -le_def le01. +rewrite sqrf_eq1 => /predU1P [] //; rewrite -[-1]subr0 -le_def. +have ->: 0 <= -1 = (-1 == 0 :> R) || (0 < -1) + by rewrite lt_def; case: eqP => // ->; rewrite lerr. +by rewrite oppr_eq0 oner_eq0 => /(addr_gt0 lt01); rewrite subrr ltrr. +Qed. + +Lemma normrN x : `|- x| = `|x|. +Proof. by rewrite -mulN1r normM -[RHS]mul1r normrN1. Qed. + +Definition porderMixin : ltPOrderMixin R := + LtPOrderMixin ltrr lt_trans le_def'. + +Definition normedDomainMixin : + @normed_mixin_of R R porderMixin := + @Num.NormedMixin _ _ porderMixin (norm m) + (normD m) (@norm_eq0 m) normrMn normrN. + +Definition numDomainMixin : + @mixin_of R porderMixin normedDomainMixin := + @Num.Mixin _ porderMixin normedDomainMixin (@addr_gt0 m) + (@ger_total m) (@normM m) (@le_def m). + +End NumMixin. + +Module Exports. +Notation numMixin := of_. +Notation NumMixin := Mixin. +Coercion porderMixin : numMixin >-> ltPOrderMixin. +Coercion normedDomainMixin : numMixin >-> normed_mixin_of. +Coercion numDomainMixin : numMixin >-> mixin_of. +End Exports. + +End NumMixin. Module RealMixin. +Section RealMixin. +Variables (R : numDomainType). + +Variable (real : real_axiom R). + +Lemma le_total : totalLatticeMixin R. +Proof. +move=> x y; move: (real (x - y)). +by rewrite unfold_in !ler_def subr0 add0r opprB orbC. +Qed. + +Definition totalMixin : + Order.Total.mixin_of (LatticeType R le_total) := le_total. + +End RealMixin. + +Module Exports. +Coercion le_total : real_axiom >-> totalLatticeMixin. +Coercion totalMixin : real_axiom >-> Order.Total.mixin_of. +End Exports. -Section RealMixins. +End RealMixin. -Variables (R : idomainType) (le : rel R) (lt : rel R) (norm : R -> R). -Local Infix "<=" := le. -Local Infix "<" := lt. -Local Notation "`| x |" := (norm x) : ring_scope. +Module RealLeMixin. +Section RealLeMixin. +Variables (R : idomainType). + +Record of_ := Mixin { + le : rel R; + lt : rel R; + norm : R -> R; + le0_add : forall x y, le 0 x -> le 0 y -> le 0 (x + y); + le0_mul : forall x y, le 0 x -> le 0 y -> le 0 (x * y); + le0_anti : forall x, le 0 x -> le x 0 -> x = 0; + sub_ge0 : forall x y, le 0 (y - x) = le x y; + le0_total : forall x, le 0 x || le x 0; + normN : forall x, norm (- x) = norm x; + ge0_norm : forall x, le 0 x -> norm x = x; + lt_def : forall x y, lt x y = (y != x) && le x y; +}. -Section LeMixin. +Variable (m : of_). -Hypothesis le0_add : forall x y, 0 <= x -> 0 <= y -> 0 <= x + y. -Hypothesis le0_mul : forall x y, 0 <= x -> 0 <= y -> 0 <= x * y. -Hypothesis le0_anti : forall x, 0 <= x -> x <= 0 -> x = 0. -Hypothesis sub_ge0 : forall x y, (0 <= y - x) = (x <= y). -Hypothesis le0_total : forall x, (0 <= x) || (x <= 0). -Hypothesis normN: forall x, `|- x| = `|x|. -Hypothesis ge0_norm : forall x, 0 <= x -> `|x| = x. -Hypothesis lt_def : forall x y, (x < y) = (y != x) && (x <= y). +Local Notation "x <= y" := (le m x y). +Local Notation "x < y" := (lt m x y). +Local Notation "`| x |" := (norm m x) : ring_scope. Let le0N x : (0 <= - x) = (x <= 0). Proof. by rewrite -sub0r sub_ge0. Qed. Let leN_total x : 0 <= x \/ 0 <= - x. Proof. by apply/orP; rewrite le0N le0_total. Qed. -Let le00 : (0 <= 0). Proof. by have:= le0_total 0; rewrite orbb. Qed. -Let le01 : (0 <= 1). +Let le00 : 0 <= 0. Proof. by have:= le0_total m 0; rewrite orbb. Qed. +Let le01 : 0 <= 1. Proof. -by case/orP: (le0_total 1)=> // ?; rewrite -[1]mul1r -mulrNN le0_mul ?le0N. +by case/orP: (le0_total m 1)=> // ?; rewrite -[1]mul1r -mulrNN le0_mul ?le0N. Qed. +Let lt01 : 0 < 1. Proof. by rewrite lt_def oner_eq0. Qed. Fact lt0_add x y : 0 < x -> 0 < y -> 0 < x + y. Proof. -rewrite !lt_def => /andP[x_neq0 l0x] /andP[y_neq0 l0y]; rewrite le0_add //. +rewrite !lt_def => /andP [x_neq0 l0x] /andP [y_neq0 l0y]; rewrite le0_add //. rewrite andbT addr_eq0; apply: contraNneq x_neq0 => hxy. -by rewrite [x]le0_anti // hxy -le0N opprK. +by rewrite [x](@le0_anti m) // hxy -le0N opprK. Qed. Fact eq0_norm x : `|x| = 0 -> x = 0. @@ -5077,7 +4851,7 @@ rewrite {x}subr0; apply/idP/eqP=> [/ge0_norm// | Dy]. by have [//| ny_ge0] := leN_total y; rewrite -Dy -normN ge0_norm. Qed. -Fact normM : {morph norm : x y / x * y}. +Fact normM : {morph norm m : x y / x * y}. Proof. move=> x y /=; wlog x_ge0 : x / 0 <= x. by move=> IHx; case: (leN_total x) => /IHx//; rewrite mulNr !normN. @@ -5096,73 +4870,761 @@ rewrite -normN ge0_norm //; have [hxy|hxy] := leN_total (x + y). by rewrite -normN ge0_norm // opprK addrCA addrNK le0_add. Qed. -Lemma le_total x y : (x <= y) || (y <= x). -Proof. by rewrite -sub_ge0 -opprB le0N orbC -sub_ge0 le0_total. Qed. +Fact le_total : total (le m). +Proof. by move=> x y; rewrite -sub_ge0 -opprB le0N orbC -sub_ge0 le0_total. Qed. + +Fact lerr : reflexive (le m). +Proof. by move=> x; move: (le_total x x); rewrite orbb. Qed. + +Fact le_anti : antisymmetric (le m). +Proof. +move=> x y /andP []. +rewrite -sub_ge0 -(sub_ge0 _ y) -opprB le0N => hxy hxy'. +by move/eqP: (le0_anti hxy' hxy); rewrite subr_eq0 => /eqP. +Qed. + +Fact le_trans : transitive (le m). +Proof. +by move=> x y z hyx hxz; rewrite -sub_ge0 -(subrK x z) -addrA le0_add ?sub_ge0. +Qed. + +Lemma ge0_def x : (0 <= x) = (`|x| == x). +Proof. by rewrite le_def subr0. Qed. + +Lemma normrMn x n : `|x *+ n| = `|x| *+ n. +Proof. +rewrite -mulr_natr -[RHS]mulr_natr normM. +congr (_ * _); apply/eqP; rewrite -ge0_def. +elim: n => [|n ih]; [exact: lerr | apply: (le_trans ih)]. +by rewrite le_def -natrB // subSnn -[_%:R]subr0 -le_def mulr1n le01. +Qed. + +Lemma normrN1 : `|-1| = 1 :> R. +Proof. +have: `|-1| ^+ 2 == 1 :> R + by rewrite expr2 /= -normM mulrNN mul1r -[1]subr0 -le_def le01. +rewrite sqrf_eq1 => /predU1P [] //; rewrite -[-1]subr0 -le_def. +have ->: 0 <= -1 = (-1 == 0 :> R) || (0 < -1) + by rewrite lt_def; case: eqP => // ->. +by rewrite oppr_eq0 oner_eq0 => /(lt0_add lt01); rewrite subrr lt_def eqxx. +Qed. + +Lemma normrN x : `|- x| = `|x|. +Proof. by rewrite -mulN1r normM -[RHS]mul1r normrN1. Qed. + +Definition orderMixin : leOrderMixin ring_display R := + LeOrderMixin ring_display + le_anti le_trans le_total (lt_def _) (rrefl _) (rrefl _). + +Definition normedDomainMixin : + @normed_mixin_of R R orderMixin := + @Num.NormedMixin _ _ orderMixin (norm m) + le_normD eq0_norm normrMn normrN. -Definition Le := - Mixin le_normD lt0_add eq0_norm (in2W le_total) normM le_def lt_def. +Definition numMixin : + @mixin_of R orderMixin normedDomainMixin := + @Num.Mixin _ orderMixin normedDomainMixin + lt0_add (in2W le_total) normM le_def. -Lemma Real (R' : numDomainType) & phant R' : - R' = NumDomainType R Le -> real_axiom R'. -Proof. by move->. Qed. +End RealLeMixin. -End LeMixin. +Module Exports. +Notation realLeMixin := of_. +Notation RealLeMixin := Mixin. +Coercion orderMixin : realLeMixin >-> leOrderMixin. +Coercion normedDomainMixin : realLeMixin >-> normed_mixin_of. +Coercion numMixin : realLeMixin >-> mixin_of. +End Exports. + +End RealLeMixin. + +Module RealLtMixin. +Section RealLtMixin. +Variables (R : idomainType). + +Record of_ := Mixin { + lt : rel R; + le : rel R; + norm : R -> R; + lt0_add : forall x y, lt 0 x -> lt 0 y -> lt 0 (x + y); + lt0_mul : forall x y, lt 0 x -> lt 0 y -> lt 0 (x * y); + lt0_ngt0 : forall x, lt 0 x -> ~~ (lt x 0); + sub_gt0 : forall x y, lt 0 (y - x) = lt x y; + lt0_total : forall x, x != 0 -> lt 0 x || lt x 0; + normN : forall x, norm (- x) = norm x; + ge0_norm : forall x, le 0 x -> norm x = x; + le_def : forall x y, le x y = (x == y) || lt x y; +}. + +Variable (m : of_). + +Local Notation "x < y" := (lt m x y). +Local Notation "x <= y" := (le m x y). +Local Notation "`| x |" := (norm m x) : ring_scope. + +Fact lt0N x : (- x < 0) = (0 < x). +Proof. by rewrite -sub_gt0 add0r opprK. Qed. +Let leN_total x : 0 <= x \/ 0 <= - x. +Proof. +rewrite !le_def [_ == - x]eq_sym oppr_eq0 eq_sym -[0 < - x]lt0N opprK. +apply/orP; case: (altP eqP) => //=; exact: lt0_total. +Qed. -Section LtMixin. +Let le00 : (0 <= 0). Proof. by rewrite le_def eqxx. Qed. +Let le01 : (0 <= 1). +Proof. +rewrite le_def eq_sym; case: (altP eqP) => // /(lt0_total m) /orP [] //= ?. +by rewrite -[1]mul1r -mulrNN lt0_mul -?lt0N ?opprK. +Qed. -Hypothesis lt0_add : forall x y, 0 < x -> 0 < y -> 0 < x + y. -Hypothesis lt0_mul : forall x y, 0 < x -> 0 < y -> 0 < x * y. -Hypothesis lt0_ngt0 : forall x, 0 < x -> ~~ (x < 0). -Hypothesis sub_gt0 : forall x y, (0 < y - x) = (x < y). -Hypothesis lt0_total : forall x, x != 0 -> (0 < x) || (x < 0). -Hypothesis normN : forall x, `|- x| = `|x|. -Hypothesis ge0_norm : forall x, 0 <= x -> `|x| = x. -Hypothesis le_def : forall x y, (x <= y) = (y == x) || (x < y). +Fact sub_ge0 x y : (0 <= y - x) = (x <= y). +Proof. by rewrite !le_def eq_sym subr_eq0 eq_sym sub_gt0. Qed. Fact le0_add x y : 0 <= x -> 0 <= y -> 0 <= x + y. Proof. -rewrite !le_def => /predU1P[->|x_gt0]; first by rewrite add0r. -by case/predU1P=> [->|y_gt0]; rewrite ?addr0 ?x_gt0 ?lt0_add // orbT. +rewrite !le_def => /predU1P [<-|x_gt0]; first by rewrite add0r. +by case/predU1P=> [<-|y_gt0]; rewrite ?addr0 ?x_gt0 ?lt0_add // orbT. Qed. Fact le0_mul x y : 0 <= x -> 0 <= y -> 0 <= x * y. Proof. -rewrite !le_def => /predU1P[->|x_gt0]; first by rewrite mul0r eqxx. -by case/predU1P=> [->|y_gt0]; rewrite ?mulr0 ?eqxx // orbC lt0_mul. +rewrite !le_def => /predU1P [<-|x_gt0]; first by rewrite mul0r eqxx. +by case/predU1P=> [<-|y_gt0]; rewrite ?mulr0 ?eqxx ?lt0_mul // orbT. +Qed. + +Fact normM : {morph norm m : x y / x * y}. +Proof. +move=> x y /=; wlog x_ge0 : x / 0 <= x. + by move=> IHx; case: (leN_total x) => /IHx//; rewrite mulNr !normN. +wlog y_ge0 : y / 0 <= y; last by rewrite ?ge0_norm ?le0_mul. +by move=> IHy; case: (leN_total y) => /IHy//; rewrite mulrN !normN. +Qed. + +Fact le_normD x y : `|x + y| <= `|x| + `|y|. +Proof. +wlog x_ge0 : x y / 0 <= x. + by move=> IH; case: (leN_total x) => /IH// /(_ (- y)); rewrite -opprD !normN. +rewrite -sub_ge0 ge0_norm //; have [y_ge0 | ny_ge0] := leN_total y. + by rewrite !ge0_norm ?subrr ?le0_add. +rewrite -normN ge0_norm //; have [hxy|hxy] := leN_total (x + y). + by rewrite ge0_norm // opprD addrCA -addrA addKr le0_add. +by rewrite -normN ge0_norm // opprK addrCA addrNK le0_add. Qed. -Fact le0_anti x : 0 <= x -> x <= 0 -> x = 0. -Proof. by rewrite !le_def => /predU1P[] // /lt0_ngt0/negPf-> /predU1P[]. Qed. +Fact eq0_norm x : `|x| = 0 -> x = 0. +Proof. +case: (leN_total x) => /ge0_norm => [-> // | Dnx nx0]. +by rewrite -[x]opprK -Dnx normN nx0 oppr0. +Qed. -Fact sub_ge0 x y : (0 <= y - x) = (x <= y). -Proof. by rewrite !le_def subr_eq0 sub_gt0. Qed. +Fact le_def' x y : (x <= y) = (`|y - x| == y - x). +Proof. +wlog ->: x y / x = 0 by move/(_ 0 (y - x)); rewrite subr0 sub_ge0 => ->. +rewrite {x}subr0; apply/idP/eqP=> [/ge0_norm// | Dy]. +by have [//| ny_ge0] := leN_total y; rewrite -Dy -normN ge0_norm. +Qed. Fact lt_def x y : (x < y) = (y != x) && (x <= y). Proof. -rewrite le_def; case: eqP => //= ->; rewrite -sub_gt0 subrr. +rewrite le_def eq_sym; case: eqP => //= ->; rewrite -sub_gt0 subrr. by apply/idP=> lt00; case/negP: (lt0_ngt0 lt00). Qed. -Fact le0_total x : (0 <= x) || (x <= 0). -Proof. by rewrite !le_def [0 == _]eq_sym; have [|/lt0_total] := altP eqP. Qed. +Fact lt_irr : irreflexive (lt m). +Proof. by move=> x; rewrite lt_def eqxx. Qed. -Definition Lt := - Le le0_add le0_mul le0_anti sub_ge0 le0_total normN ge0_norm lt_def. +Fact lt_asym x y : ~~ ((x < y) && (y < x)). +Proof. +rewrite -[x < _]sub_gt0 -[y < _]sub_gt0 -lt0N opprB andbC. +by apply/negP => /andP [] /lt0_ngt0; case: (_ < _). +Qed. + +Fact lt_trans : transitive (lt m). +Proof. +move=> y x z; rewrite -sub_gt0 -![_ < z]sub_gt0. +rewrite -[z - x](subrKA y) [_ - _ + _]addrC; exact: lt0_add. +Qed. -End LtMixin. +Lemma le_trans : transitive (le m). +by move=> y x z; rewrite !le_def => /predU1P [->|hxy] // /predU1P [<-|hyz]; + rewrite ?hxy ?(lt_trans hxy hyz) orbT. +Qed. -End RealMixins. +Fact lt_total x y : x != y -> (x < y) || (y < x). +Proof. +rewrite -subr_eq0 => /(lt0_total m). +by rewrite -(sub_gt0 _ (x - y)) sub0r opprB !sub_gt0 orbC. +Qed. -End RealMixin. +Fact le_total : total (le m). +Proof. +by move=> x y; rewrite !le_def [y == x]eq_sym; case: (altP eqP) => [|/lt_total]. +Qed. + +Let lt01 : 0 < 1. Proof. by rewrite lt_def oner_eq0. Qed. + +Lemma normrMn x n : `|x *+ n| = `|x| *+ n. +Proof. +rewrite -mulr_natr -[RHS]mulr_natr normM. +congr (_ * _); apply/eqP; rewrite -[n%:R]subr0 -le_def'. +elim: n => [|n ih]; [rewrite le_def eqxx // | apply: (le_trans ih)]. +by rewrite le_def' -natrB // subSnn -[_%:R]subr0 -le_def' mulr1n le01. +Qed. + +Definition orderMixin : ltOrderMixin ring_display R := + LtOrderMixin ring_display + lt_irr lt_trans lt_total (le_def m) (rrefl _) (rrefl _). + +Definition normedDomainMixin : + @normed_mixin_of R R orderMixin := + @Num.NormedMixin _ _ orderMixin (norm m) + le_normD eq0_norm normrMn (@normN m). + +Definition numMixin : + @mixin_of R orderMixin normedDomainMixin := + @Num.Mixin _ orderMixin normedDomainMixin + (@lt0_add m) (in2W le_total) normM le_def'. + +End RealLtMixin. + +Module Exports. +Notation realLtMixin := of_. +Notation RealLtMixin := Mixin. +Coercion orderMixin : realLtMixin >-> ltOrderMixin. +Coercion normedDomainMixin : realLtMixin >-> normed_mixin_of. +Coercion numMixin : realLtMixin >-> mixin_of. +End Exports. + +End RealLtMixin. End Num. -Export Num.NumDomain.Exports Num.NumField.Exports Num.ClosedField.Exports. +Export Num.NumDomain.Exports Num.NormedDomain.Exports. +Export Num.NumDomain_joins.Exports. +Export Num.NumField.Exports Num.ClosedField.Exports. Export Num.RealDomain.Exports Num.RealField.Exports. Export Num.ArchimedeanField.Exports Num.RealClosedField.Exports. Export Num.Syntax Num.PredInstances. +Export Num.NumMixin.Exports Num.RealMixin.Exports. +Export Num.RealLeMixin.Exports Num.RealLtMixin.Exports. -Notation RealLeMixin := Num.RealMixin.Le. -Notation RealLtMixin := Num.RealMixin.Lt. -Notation RealLeAxiom R := (Num.RealMixin.Real (Phant R) (erefl _)). Notation ImaginaryMixin := Num.ClosedField.ImaginaryMixin. + +(* compatibility module *) +Module mc_1_9. +Module Num. +(* If you failed to process the next line in the PG or the CoqIDE, replace *) +(* all the "ssrnum.Num" with "Top.Num" in this module to process them, and *) +(* revert them in order to compile and commit. This problem will be solved *) +(* in Coq 8.10. See also: https://github.com/math-comp/math-comp/pull/270. *) +Export ssrnum.Num. +Import ssrnum.Num.Def. + +Module Import Syntax. +Notation "`| x |" := + (@norm _ (@Num.NormedDomain.numDomain_normedDomainType _) x) : ring_scope. +End Syntax. + +Module Import Theory. +Export ssrnum.Num.Theory. + +Section NumIntegralDomainTheory. +Variable R : numDomainType. +Implicit Types x y z : R. +Definition ltr_def x y : (x < y) = (y != x) && (x <= y) := lt_def x y. +Definition gerE x y : ge x y = (y <= x) := geE x y. +Definition gtrE x y : gt x y = (y < x) := gtE x y. +Definition lerr x : x <= x := lexx x. +Definition ltrr x : x < x = false := ltxx x. +Definition ltrW x y : x < y -> x <= y := @ltW _ _ x y. +Definition ltr_neqAle x y : (x < y) = (x != y) && (x <= y) := lt_neqAle x y. +Definition ler_eqVlt x y : (x <= y) = (x == y) || (x < y) := le_eqVlt x y. +Definition gtr_eqF x y : y < x -> x == y = false := @gt_eqF _ _ x y. +Definition ltr_eqF x y : x < y -> x == y = false := @lt_eqF _ _ x y. +Definition ler_asym : antisymmetric (@ler R) := le_anti. +Definition eqr_le x y : (x == y) = (x <= y <= x) := eq_le x y. +Definition ltr_trans : transitive (@ltr R) := lt_trans. +Definition ler_lt_trans y x z : x <= y -> y < z -> x < z := + @le_lt_trans _ _ y x z. +Definition ltr_le_trans y x z : x < y -> y <= z -> x < z := + @lt_le_trans _ _ y x z. +Definition ler_trans : transitive (@ler R) := le_trans. +Definition lterr := (lerr, ltrr). +Definition lerifP x y C : + reflect (x <= y ?= iff C) (if C then x == y else x < y) := leifP. +Definition ltr_asym x y : x < y < x = false := lt_asym x y. +Definition ler_anti : antisymmetric (@ler R) := le_anti. +Definition ltr_le_asym x y : x < y <= x = false := lt_le_asym x y. +Definition ler_lt_asym x y : x <= y < x = false := le_lt_asym x y. +Definition lter_anti := (=^~ eqr_le, ltr_asym, ltr_le_asym, ler_lt_asym). +Definition ltr_geF x y : x < y -> y <= x = false := @lt_geF _ _ x y. +Definition ler_gtF x y : x <= y -> y < x = false := @le_gtF _ _ x y. +Definition ltr_gtF x y : x < y -> y < x = false := @lt_gtF _ _ x y. +Definition normr0 : `|0| = 0 :> R := normr0 _. +Definition normrMn x n : `|x *+ n| = `|x| *+ n := normrMn x n. +Definition normr0P {x} : reflect (`|x| = 0) (x == 0) := normr0P. +Definition normr_eq0 x : (`|x| == 0) = (x == 0) := normr_eq0 x. +Definition normrN x : `|- x| = `|x| := normrN x. +Definition distrC x y : `|x - y| = `|y - x| := distrC x y. +Definition normr_id x : `| `|x| | = `|x| := normr_id x. +Definition normr_ge0 x : 0 <= `|x| := normr_ge0 x. +Definition normr_le0 x : (`|x| <= 0) = (x == 0) := normr_le0 x. +Definition normr_lt0 x : `|x| < 0 = false := normr_lt0 x. +Definition normr_gt0 x : (`|x| > 0) = (x != 0) := normr_gt0 x. +Definition normrE := (normr_id, normr0, @normr1 R, @normrN1 R, normr_ge0, + normr_eq0, normr_lt0, normr_le0, normr_gt0, normrN). +End NumIntegralDomainTheory. + +Section NumIntegralDomainMonotonyTheory. +Variables R R' : numDomainType. +Section AcrossTypes. +Variables (D D' : pred R) (f : R -> R'). +Definition ltrW_homo : {homo f : x y / x < y} -> {homo f : x y / x <= y} := + ltW_homo (f := f). +Definition ltrW_nhomo : {homo f : x y /~ x < y} -> {homo f : x y /~ x <= y} := + ltW_nhomo (f := f). +Definition inj_homo_ltr : + injective f -> {homo f : x y / x <= y} -> {homo f : x y / x < y} := + inj_homo_lt (f := f). +Definition inj_nhomo_ltr : + injective f -> {homo f : x y /~ x <= y} -> {homo f : x y /~ x < y} := + inj_nhomo_lt (f := f). +Definition incr_inj : {mono f : x y / x <= y} -> injective f := + inc_inj (f := f). +Definition decr_inj : {mono f : x y /~ x <= y} -> injective f := + dec_inj (f := f). +Definition lerW_mono : {mono f : x y / x <= y} -> {mono f : x y / x < y} := + leW_mono (f := f). +Definition lerW_nmono : {mono f : x y /~ x <= y} -> {mono f : x y /~ x < y} := + leW_nmono (f := f). +Definition ltrW_homo_in : + {in D & D', {homo f : x y / x < y}} -> {in D & D', {homo f : x y / x <= y}} := + ltW_homo_in (f := f). +Definition ltrW_nhomo_in : + {in D & D', {homo f : x y /~ x < y}} -> + {in D & D', {homo f : x y /~ x <= y}} := + ltW_nhomo_in (f := f). +Definition inj_homo_ltr_in : + {in D & D', injective f} -> {in D & D', {homo f : x y / x <= y}} -> + {in D & D', {homo f : x y / x < y}} := + inj_homo_lt_in (f := f). +Definition inj_nhomo_ltr_in : + {in D & D', injective f} -> {in D & D', {homo f : x y /~ x <= y}} -> + {in D & D', {homo f : x y /~ x < y}} := + inj_nhomo_lt_in (f := f). +Definition incr_inj_in : + {in D &, {mono f : x y / x <= y}} -> {in D &, injective f} := + inc_inj_in (f := f). +Definition decr_inj_in : + {in D &, {mono f : x y /~ x <= y}} -> {in D &, injective f} := + dec_inj_in (f := f). +Definition lerW_mono_in : + {in D &, {mono f : x y / x <= y}} -> {in D &, {mono f : x y / x < y}} := + leW_mono_in (f := f). +Definition lerW_nmono_in : + {in D &, {mono f : x y /~ x <= y}} -> {in D &, {mono f : x y /~ x < y}} := + leW_nmono_in (f := f). +End AcrossTypes. +Section NatToR. +Variables (D D' : pred nat) (f : nat -> R). +Definition ltnrW_homo : + {homo f : m n / (m < n)%N >-> m < n} -> + {homo f : m n / (m <= n)%N >-> m <= n} := + ltW_homo (f := f). +Definition ltnrW_nhomo : + {homo f : m n / (n < m)%N >-> m < n} -> + {homo f : m n / (n <= m)%N >-> m <= n} := + ltW_nhomo (f := f). +Definition inj_homo_ltnr : injective f -> + {homo f : m n / (m <= n)%N >-> m <= n} -> + {homo f : m n / (m < n)%N >-> m < n} := + inj_homo_lt (f := f). +Definition inj_nhomo_ltnr : injective f -> + {homo f : m n / (n <= m)%N >-> m <= n} -> + {homo f : m n / (n < m)%N >-> m < n} := + inj_nhomo_lt (f := f). +Definition incnr_inj : + {mono f : m n / (m <= n)%N >-> m <= n} -> injective f := + inc_inj (f := f). +Definition decnr_inj : + {mono f : m n / (n <= m)%N >-> m <= n} -> injective f := + dec_inj (f := f). +Definition decnr_inj_inj := decnr_inj. +Definition lenrW_mono : {mono f : m n / (m <= n)%N >-> m <= n} -> + {mono f : m n / (m < n)%N >-> m < n} := + leW_mono (f := f). +Definition lenrW_nmono : {mono f : m n / (n <= m)%N >-> m <= n} -> + {mono f : m n / (n < m)%N >-> m < n} := + leW_nmono (f := f). +Definition lenr_mono : {homo f : m n / (m < n)%N >-> m < n} -> + {mono f : m n / (m <= n)%N >-> m <= n} := + le_mono (f := f). +Definition lenr_nmono : + {homo f : m n / (n < m)%N >-> m < n} -> + {mono f : m n / (n <= m)%N >-> m <= n} := + le_nmono (f := f). +Definition ltnrW_homo_in : + {in D & D', {homo f : m n / (m < n)%N >-> m < n}} -> + {in D & D', {homo f : m n / (m <= n)%N >-> m <= n}} := + ltW_homo_in (f := f). +Definition ltnrW_nhomo_in : + {in D & D', {homo f : m n / (n < m)%N >-> m < n}} -> + {in D & D', {homo f : m n / (n <= m)%N >-> m <= n}} := + ltW_nhomo_in (f := f). +Definition inj_homo_ltnr_in : {in D & D', injective f} -> + {in D & D', {homo f : m n / (m <= n)%N >-> m <= n}} -> + {in D & D', {homo f : m n / (m < n)%N >-> m < n}} := + inj_homo_lt_in (f := f). +Definition inj_nhomo_ltnr_in : {in D & D', injective f} -> + {in D & D', {homo f : m n / (n <= m)%N >-> m <= n}} -> + {in D & D', {homo f : m n / (n < m)%N >-> m < n}} := + inj_nhomo_lt_in (f := f). +Definition incnr_inj_in : + {in D &, {mono f : m n / (m <= n)%N >-> m <= n}} -> {in D &, injective f} := + inc_inj_in (f := f). +Definition decnr_inj_in : + {in D &, {mono f : m n / (n <= m)%N >-> m <= n}} -> {in D &, injective f} := + dec_inj_in (f := f). +Definition decnr_inj_inj_in := decnr_inj_in. +Definition lenrW_mono_in : + {in D &, {mono f : m n / (m <= n)%N >-> m <= n}} -> + {in D &, {mono f : m n / (m < n)%N >-> m < n}} := + leW_mono_in (f := f). +Definition lenrW_nmono_in : + {in D &, {mono f : m n / (n <= m)%N >-> m <= n}} -> + {in D &, {mono f : m n / (n < m)%N >-> m < n}} := + leW_nmono_in (f := f). +Definition lenr_mono_in : + {in D &, {homo f : m n / (m < n)%N >-> m < n}} -> + {in D &, {mono f : m n / (m <= n)%N >-> m <= n}} := + le_mono_in (f := f). +Definition lenr_nmono_in : + {in D &, {homo f : m n / (n < m)%N >-> m < n}} -> + {in D &, {mono f : m n / (n <= m)%N >-> m <= n}} := + le_nmono_in (f := f). +End NatToR. +Section RToNat. +Variables (D D' : pred R) (f : R -> nat). +Definition ltrnW_homo : + {homo f : m n / m < n >-> (m < n)%N} -> + {homo f : m n / m <= n >-> (m <= n)%N} := + ltW_homo (f := f). +Definition ltrnW_nhomo : + {homo f : m n / n < m >-> (m < n)%N} -> + {homo f : m n / n <= m >-> (m <= n)%N} := + ltW_nhomo (f := f). +Definition inj_homo_ltrn : injective f -> + {homo f : m n / m <= n >-> (m <= n)%N} -> + {homo f : m n / m < n >-> (m < n)%N} := + inj_homo_lt (f := f). +Definition inj_nhomo_ltrn : injective f -> + {homo f : m n / n <= m >-> (m <= n)%N} -> + {homo f : m n / n < m >-> (m < n)%N} := + inj_nhomo_lt (f := f). +Definition incrn_inj : {mono f : m n / m <= n >-> (m <= n)%N} -> injective f := + inc_inj (f := f). +Definition decrn_inj : {mono f : m n / n <= m >-> (m <= n)%N} -> injective f := + dec_inj (f := f). +Definition lernW_mono : + {mono f : m n / m <= n >-> (m <= n)%N} -> + {mono f : m n / m < n >-> (m < n)%N} := + leW_mono (f := f). +Definition lernW_nmono : + {mono f : m n / n <= m >-> (m <= n)%N} -> + {mono f : m n / n < m >-> (m < n)%N} := + leW_nmono (f := f). +Definition ltrnW_homo_in : + {in D & D', {homo f : m n / m < n >-> (m < n)%N}} -> + {in D & D', {homo f : m n / m <= n >-> (m <= n)%N}} := + ltW_homo_in (f := f). +Definition ltrnW_nhomo_in : + {in D & D', {homo f : m n / n < m >-> (m < n)%N}} -> + {in D & D', {homo f : m n / n <= m >-> (m <= n)%N}} := + ltW_nhomo_in (f := f). +Definition inj_homo_ltrn_in : {in D & D', injective f} -> + {in D & D', {homo f : m n / m <= n >-> (m <= n)%N}} -> + {in D & D', {homo f : m n / m < n >-> (m < n)%N}} := + inj_homo_lt_in (f := f). +Definition inj_nhomo_ltrn_in : {in D & D', injective f} -> + {in D & D', {homo f : m n / n <= m >-> (m <= n)%N}} -> + {in D & D', {homo f : m n / n < m >-> (m < n)%N}} := + inj_nhomo_lt_in (f := f). +Definition incrn_inj_in : + {in D &, {mono f : m n / m <= n >-> (m <= n)%N}} -> {in D &, injective f} := + inc_inj_in (f := f). +Definition decrn_inj_in : + {in D &, {mono f : m n / n <= m >-> (m <= n)%N}} -> {in D &, injective f} := + dec_inj_in (f := f). +Definition lernW_mono_in : + {in D &, {mono f : m n / m <= n >-> (m <= n)%N}} -> + {in D &, {mono f : m n / m < n >-> (m < n)%N}} := + leW_mono_in (f := f). +Definition lernW_nmono_in : + {in D &, {mono f : m n / n <= m >-> (m <= n)%N}} -> + {in D &, {mono f : m n / n < m >-> (m < n)%N}} := + leW_nmono_in (f := f). +End RToNat. +End NumIntegralDomainMonotonyTheory. + +Section NumDomainOperationTheory. +Variable R : numDomainType. +Implicit Types x y z t : R. +Definition real_lerP := real_leP. +Definition real_ltrP := real_ltP. +Definition real_ltrNge := real_ltNge. +Definition real_lerNgt := real_leNgt. +Definition real_ltrgtP := real_ltgtP. +Definition real_ger0P := real_ge0P. +Definition real_ltrgt0P := real_ltgt0P. +Definition lerif_refl x C : reflect (x <= x ?= iff C) C := leif_refl. +Definition lerif_trans x1 x2 x3 C12 C23 : + x1 <= x2 ?= iff C12 -> x2 <= x3 ?= iff C23 -> x1 <= x3 ?= iff C12 && C23 := + @leif_trans _ _ x1 x2 x3 C12 C23. +Definition lerif_le x y : x <= y -> x <= y ?= iff (x >= y) := @leif_le _ _ x y. +Definition lerif_eq x y : x <= y -> x <= y ?= iff (x == y) := @leif_eq _ _ x y. +Definition ger_lerif x y C : x <= y ?= iff C -> (y <= x) = C := + @ge_leif _ _ x y C. +Definition ltr_lerif x y C : x <= y ?= iff C -> (x < y) = ~~ C := + @lt_leif _ _ x y C. +Definition normr_real x : `|x| \is real := normr_real x. +Definition ler_norm_sum I r (G : I -> R) (P : pred I): + `|\sum_(i <- r | P i) G i| <= \sum_(i <- r | P i) `|G i| := + ler_norm_sum r G P. +Definition ler_norm_sub x y : `|x - y| <= `|x| + `|y| := ler_norm_sub x y. +Definition ler_dist_add z x y : `|x - y| <= `|x - z| + `|z - y| := + ler_dist_add z x y. +Definition ler_sub_norm_add x y : `|x| - `|y| <= `|x + y| := + ler_sub_norm_add x y. +Definition ler_sub_dist x y : `|x| - `|y| <= `|x - y| := ler_sub_dist x y. +Definition ler_dist_dist x y : `| `|x| - `|y| | <= `|x - y| := + ler_dist_dist x y. +Definition ler_dist_norm_add x y : `| `|x| - `|y| | <= `|x + y| := + ler_dist_norm_add x y. +Definition ler_nnorml x y : y < 0 -> `|x| <= y = false := @ler_nnorml _ _ x y. +Definition ltr_nnorml x y : y <= 0 -> `|x| < y = false := @ltr_nnorml _ _ x y. +Definition lter_nnormr := (ler_nnorml, ltr_nnorml). +Definition lerif_nat m n C : + (m%:R <= n%:R ?= iff C :> R) = (m <= n ?= iff C)%N := + leif_nat_r _ m n C. +Definition mono_in_lerif (A : pred R) (f : R -> R) C : + {in A &, {mono f : x y / x <= y}} -> + {in A &, forall x y, (f x <= f y ?= iff C) = (x <= y ?= iff C)} := + @mono_in_leif _ _ A f C. +Definition mono_lerif (f : R -> R) C : + {mono f : x y / x <= y} -> + forall x y, (f x <= f y ?= iff C) = (x <= y ?= iff C) := + @mono_leif _ _ f C. +Definition nmono_in_lerif (A : pred R) (f : R -> R) C : + {in A &, {mono f : x y /~ x <= y}} -> + {in A &, forall x y, (f x <= f y ?= iff C) = (y <= x ?= iff C)} := + @nmono_in_leif _ _ A f C. +Definition nmono_lerif (f : R -> R) C : + {mono f : x y /~ x <= y} -> + forall x y, (f x <= f y ?= iff C) = (y <= x ?= iff C) := + @nmono_leif _ _ f C. +Definition lerif_subLR := leif_subLR. +Definition lerif_subRL := leif_subRL. +Definition lerif_add := leif_add. +Definition lerif_sum := leif_sum. +Definition lerif_0_sum := leif_0_sum. +Definition real_lerif_norm := real_leif_norm. +Definition lerif_pmul := leif_pmul. +Definition lerif_nmul := leif_nmul. +Definition lerif_pprod := leif_pprod. +Definition real_lerif_mean_square_scaled := real_leif_mean_square_scaled. +Definition real_lerif_AGM2_scaled := real_leif_AGM2_scaled. +Definition lerif_AGM_scaled := leif_AGM_scaled. +End NumDomainOperationTheory. + +Section NumFieldTheory. +Definition real_lerif_mean_square := real_leif_mean_square. +Definition real_lerif_AGM2 := real_leif_AGM2. +Definition lerif_AGM := leif_AGM. +End NumFieldTheory. + +Section RealDomainTheory. +Variable R : realDomainType. +Implicit Types x y z t : R. +Definition ler_total : total (@ler R) := le_total. +Definition ltr_total x y : x != y -> (x < y) || (y < x) := + @lt_total _ _ x y. +Definition wlog_ler P : + (forall a b, P b a -> P a b) -> (forall a b, a <= b -> P a b) -> + forall a b : R, P a b := + @wlog_le _ _ P. +Definition wlog_ltr P : + (forall a, P a a) -> + (forall a b, (P b a -> P a b)) -> (forall a b, a < b -> P a b) -> + forall a b : R, P a b := + @wlog_lt _ _ P. +Definition ltrNge x y : (x < y) = ~~ (y <= x) := @ltNge _ _ x y. +Definition lerNgt x y : (x <= y) = ~~ (y < x) := @leNgt _ _ x y. +Definition neqr_lt x y : (x != y) = (x < y) || (y < x) := @neq_lt _ _ x y. +Definition eqr_leLR x y z t : + (x <= y -> z <= t) -> (y < x -> t < z) -> (x <= y) = (z <= t) := + @eq_leLR _ _ x y z t. +Definition eqr_leRL x y z t : + (x <= y -> z <= t) -> (y < x -> t < z) -> (z <= t) = (x <= y) := + @eq_leRL _ _ x y z t. +Definition eqr_ltLR x y z t : + (x < y -> z < t) -> (y <= x -> t <= z) -> (x < y) = (z < t) := + @eq_ltLR _ _ x y z t. +Definition eqr_ltRL x y z t : + (x < y -> z < t) -> (y <= x -> t <= z) -> (z < t) = (x < y) := + @eq_ltRL _ _ x y z t. +End RealDomainTheory. + +Section RealDomainMonotony. +Variables (R : realDomainType) (R' : numDomainType) (D : pred R). +Variables (f : R -> R') (f' : R -> nat). +Definition ler_mono : {homo f : x y / x < y} -> {mono f : x y / x <= y} := + le_mono (f := f). +Definition homo_mono := ler_mono. +Definition ler_nmono : {homo f : x y /~ x < y} -> {mono f : x y /~ x <= y} := + le_nmono (f := f). +Definition nhomo_mono := ler_nmono. +Definition ler_mono_in : + {in D &, {homo f : x y / x < y}} -> {in D &, {mono f : x y / x <= y}} := + le_mono_in (f := f). +Definition homo_mono_in := ler_mono_in. +Definition ler_nmono_in : + {in D &, {homo f : x y /~ x < y}} -> {in D &, {mono f : x y /~ x <= y}} := + le_nmono_in (f := f). +Definition nhomo_mono_in := ler_nmono_in. +Definition lern_mono : + {homo f' : m n / m < n >-> (m < n)%N} -> + {mono f' : m n / m <= n >-> (m <= n)%N} := + le_mono (f := f'). +Definition lern_nmono : + {homo f' : m n / n < m >-> (m < n)%N} -> + {mono f' : m n / n <= m >-> (m <= n)%N} := + le_nmono (f := f'). +Definition lern_mono_in : + {in D &, {homo f' : m n / m < n >-> (m < n)%N}} -> + {in D &, {mono f' : m n / m <= n >-> (m <= n)%N}} := + le_mono_in (f := f'). +Definition lern_nmono_in : + {in D &, {homo f' : m n / n < m >-> (m < n)%N}} -> + {in D &, {mono f' : m n / n <= m >-> (m <= n)%N}} := + le_nmono_in (f := f'). +End RealDomainMonotony. + +Section RealDomainOperations. +Variable R : realDomainType. +Implicit Types x y z : R. +Definition lerif_mean_square_scaled := leif_mean_square_scaled. +Definition lerif_AGM2_scaled := leif_AGM2_scaled. +Section MinMax. +Definition minrC : @commutative R R min := @meetC _ R. +Definition minrr : @idempotent R min := @meetxx _ R. +Definition minr_l x y : x <= y -> min x y = x := elimT meet_idPl. +Definition minr_r x y : y <= x -> min x y = y := elimT meet_idPr. +Definition maxrC : @commutative R R max := @joinC _ R. +Definition maxrr : @idempotent R max := @joinxx _ R. +Definition maxr_l x y : y <= x -> max x y = x := elimT join_idPr. +Definition maxr_r x y : x <= y -> max x y = y := elimT join_idPl. +Definition minrA x y z : min x (min y z) = min (min x y) z := meetA x y z. +Definition minrCA : @left_commutative R R min := meetCA. +Definition minrAC : @right_commutative R R min := meetAC. +Definition maxrA x y z : max x (max y z) = max (max x y) z := joinA x y z. +Definition maxrCA : @left_commutative R R max := joinCA. +Definition maxrAC : @right_commutative R R max := joinAC. +Definition eqr_minl x y : (min x y == x) = (x <= y) := eq_meetl x y. +Definition eqr_minr x y : (min x y == y) = (y <= x) := eq_meetr x y. +Definition eqr_maxl x y : (max x y == x) = (y <= x) := eq_joinl x y. +Definition eqr_maxr x y : (max x y == y) = (x <= y) := eq_joinr x y. +Definition ler_minr x y z : (x <= min y z) = (x <= y) && (x <= z) := lexI x y z. +Definition ler_minl x y z : (min y z <= x) = (y <= x) || (z <= x) := leIx x y z. +Definition ler_maxr x y z : (x <= max y z) = (x <= y) || (x <= z) := lexU x y z. +Definition ler_maxl x y z : (max y z <= x) = (y <= x) && (z <= x) := leUx y z x. +Definition ltr_minr x y z : (x < min y z) = (x < y) && (x < z) := ltxI x y z. +Definition ltr_minl x y z : (min y z < x) = (y < x) || (z < x) := ltIx x y z. +Definition ltr_maxr x y z : (x < max y z) = (x < y) || (x < z) := ltxU x y z. +Definition ltr_maxl x y z : (max y z < x) = (y < x) && (z < x) := ltUx x y z. +Definition lter_minr := (ler_minr, ltr_minr). +Definition lter_minl := (ler_minl, ltr_minl). +Definition lter_maxr := (ler_maxr, ltr_maxr). +Definition lter_maxl := (ler_maxl, ltr_maxl). +Definition minrK x y : max (min x y) x = x := meetUKC y x. +Definition minKr x y : min y (max x y) = y := joinKIC x y. +Definition maxr_minl : @left_distributive R R max min := @joinIl _ R. +Definition maxr_minr : @right_distributive R R max min := @joinIr _ R. +Definition minr_maxl : @left_distributive R R min max := @meetUl _ R. +Definition minr_maxr : @right_distributive R R min max := @meetUr _ R. +Variant minr_spec x y : bool -> bool -> R -> Type := +| Minr_r of x <= y : minr_spec x y true false x +| Minr_l of y < x : minr_spec x y false true y. +Lemma minrP x y : minr_spec x y (x <= y) (y < x) (min x y). +Proof. by case: leP; constructor. Qed. +Variant maxr_spec x y : bool -> bool -> R -> Type := +| Maxr_r of y <= x : maxr_spec x y true false x +| Maxr_l of x < y : maxr_spec x y false true y. +Lemma maxrP x y : maxr_spec x y (y <= x) (x < y) (max x y). +Proof. by case: (leP y); constructor. Qed. +End MinMax. +End RealDomainOperations. + +Section RealField. +Definition lerif_mean_square := leif_mean_square. +Definition lerif_AGM2 := leif_AGM2. +End RealField. + +Section RealClosedFieldTheory. +Definition lerif_normC_Re_Creal := leif_normC_Re_Creal. +Definition lerif_Re_Creal := leif_Re_Creal. +Definition lerif_rootC_AGM := leif_rootC_AGM. +End RealClosedFieldTheory. + +Arguments lerifP {R x y C}. +Arguments lerif_refl {R x C}. +Arguments mono_in_lerif [R A f C]. +Arguments nmono_in_lerif [R A f C]. +Arguments mono_lerif [R f C]. +Arguments nmono_lerif [R f C]. + +Section RealDomainArgExtremum. + +Context {R : realDomainType} {I : finType} (i0 : I). +Context (P : pred I) (F : I -> R) (Pi0 : P i0). + +Definition arg_minr := extremum <=%R i0 P F. +Definition arg_maxr := extremum >=%R i0 P F. +Definition arg_minrP : extremum_spec <=%R P F arg_minr := arg_minP F Pi0. +Definition arg_maxrP : extremum_spec >=%R P F arg_maxr := arg_maxP F Pi0. + +End RealDomainArgExtremum. + +End Theory. + +Notation "[ 'arg' 'minr_' ( i < i0 | P ) F ]" := + (arg_minr i0 (fun i => P%B) (fun i => F)) + (at level 0, i, i0 at level 10, + format "[ 'arg' 'minr_' ( i < i0 | P ) F ]") : form_scope. + +Notation "[ 'arg' 'minr_' ( i < i0 'in' A ) F ]" := + [arg minr_(i < i0 | i \in A) F] + (at level 0, i, i0 at level 10, + format "[ 'arg' 'minr_' ( i < i0 'in' A ) F ]") : form_scope. + +Notation "[ 'arg' 'minr_' ( i < i0 ) F ]" := [arg minr_(i < i0 | true) F] + (at level 0, i, i0 at level 10, + format "[ 'arg' 'minr_' ( i < i0 ) F ]") : form_scope. + +Notation "[ 'arg' 'maxr_' ( i > i0 | P ) F ]" := + (arg_maxr i0 (fun i => P%B) (fun i => F)) + (at level 0, i, i0 at level 10, + format "[ 'arg' 'maxr_' ( i > i0 | P ) F ]") : form_scope. + +Notation "[ 'arg' 'maxr_' ( i > i0 'in' A ) F ]" := + [arg maxr_(i > i0 | i \in A) F] + (at level 0, i, i0 at level 10, + format "[ 'arg' 'maxr_' ( i > i0 'in' A ) F ]") : form_scope. + +Notation "[ 'arg' 'maxr_' ( i > i0 ) F ]" := [arg maxr_(i > i0 | true) F] + (at level 0, i, i0 at level 10, + format "[ 'arg' 'maxr_' ( i > i0 ) F ]") : form_scope. + +End Num. +End mc_1_9. + +Export mc_1_9 mc_1_9.Num.Syntax. diff --git a/mathcomp/character/character.v b/mathcomp/character/character.v index c95d03b..78c5295 100644 --- a/mathcomp/character/character.v +++ b/mathcomp/character/character.v @@ -1,9 +1,9 @@ (* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import ssreflect ssrbool ssrfun eqtype choice ssrnat seq. -From mathcomp Require Import path div fintype tuple finfun bigop prime ssralg. -From mathcomp Require Import poly finset gproduct fingroup morphism perm. -From mathcomp Require Import automorphism quotient finalg action zmodp. +From mathcomp Require Import path div fintype tuple finfun bigop prime order. +From mathcomp Require Import ssralg poly finset gproduct fingroup morphism. +From mathcomp Require Import perm automorphism quotient finalg action zmodp. From mathcomp Require Import commutator cyclic center pgroup nilpotent sylow. From mathcomp Require Import abelian matrix mxalgebra mxpoly mxrepresentation. From mathcomp Require Import vector ssrnum algC classfun. @@ -67,7 +67,7 @@ Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. -Import GroupScope GRing.Theory Num.Theory. +Import Order.TTheory GroupScope GRing.Theory Num.Theory. Local Open Scope ring_scope. Local Notation algCF := [fieldType of algC]. @@ -656,7 +656,7 @@ Lemma irr1_gt0 i : 0 < 'chi_i 1%g. Proof. by rewrite irr1_degree ltr0n irr_degree_gt0. Qed. Lemma irr1_neq0 i : 'chi_i 1%g != 0. -Proof. by rewrite eqr_le ltr_geF ?irr1_gt0. Qed. +Proof. by rewrite eq_le lt_geF ?irr1_gt0. Qed. Lemma irr_neq0 i : 'chi_i != 0. Proof. by apply: contraNneq (irr1_neq0 i) => ->; rewrite cfunE. Qed. @@ -880,7 +880,7 @@ Lemma char1_eq0 chi : chi \is a character -> (chi 1%g == 0) = (chi == 0). Proof. case/char_sum_irr=> r ->; apply/idP/idP=> [|/eqP->]; last by rewrite cfunE. case: r => [|i r]; rewrite ?big_nil // sum_cfunE big_cons. -rewrite paddr_eq0 ?sumr_ge0 => // [||j _]; rewrite 1?ltrW ?irr1_gt0 //. +rewrite paddr_eq0 ?sumr_ge0 => // [||j _]; rewrite 1?ltW ?irr1_gt0 //. by rewrite (negbTE (irr1_neq0 i)). Qed. @@ -1021,7 +1021,7 @@ Proof. by move=> Gx; rewrite -lin_charX // expg_order lin_char1. Qed. Lemma normC_lin_char x : x \in G -> `|xi x| = 1. Proof. -move=> Gx; apply/eqP; rewrite -(@pexpr_eq1 _ _ #[x]) ?normr_ge0 //. +move=> Gx; apply/eqP; rewrite -(@pexpr_eq1 _ _ #[x]) //. by rewrite -normrX // lin_char_unity_root ?normr1. Qed. @@ -1163,12 +1163,11 @@ have exp_e j: e 0 j ^+ #[x] = 1. rewrite expgS repr_mxM ?groupX // {1}rGx -!mulmxA mulKVmx //. by rewrite mul_diag_mx mulmxA [M in _ = M]mxE -IHn exprS {1}mxE eqxx. have norm1_e j: `|e 0 j| = 1. - apply/eqP; rewrite -(@pexpr_eq1 _ _ #[x]) ?normr_ge0 //. - by rewrite -normrX exp_e normr1. + by apply/eqP; rewrite -(@pexpr_eq1 _ _ #[x]) // -normrX exp_e normr1. exists e; split=> //; first by exists B. rewrite cfRepr1 !cfunE Gx rGx mxtrace_mulC mulKVmx // mxtrace_diag. - split=> //=; apply: (ler_trans (ler_norm_sum _ _ _)). - by rewrite (eq_bigr _ (in1W norm1_e)) sumr_const card_ord lerr. + split=> //=; apply: (le_trans (ler_norm_sum _ _ _)). + by rewrite (eq_bigr _ (in1W norm1_e)) sumr_const card_ord lexx. rewrite !cfunE groupV !mulrb Gx rGx mxtrace_mulC mulKVmx //. rewrite -trace_map_mx map_diag_mx; set d' := diag_mx _. rewrite -[d'](mulKVmx unitB) mxtrace_mulC -[_ *m _](repr_mxK rG Gx) rGx. @@ -1559,7 +1558,7 @@ Lemma constt_ortho_char (phi psi : 'CF(G)) i j : Proof. move=> _ _ /constt_charP[//|phi1 Nphi1 ->] /constt_charP[//|psi1 Npsi1 ->]. rewrite cfdot_irr; case: eqP => // -> /eqP/idPn[]. -rewrite cfdotDl !cfdotDr cfnorm_irr -addrA gtr_eqF ?ltr_paddr ?ltr01 //. +rewrite cfdotDl !cfdotDr cfnorm_irr -addrA gt_eqF ?ltr_paddr ?ltr01 //. by rewrite Cnat_ge0 ?rpredD ?Cnat_cfdot_char ?irr_char. Qed. @@ -1756,7 +1755,7 @@ Lemma constt_Res_trans j psi : psi \is a character -> j \in irr_constt psi -> {subset irr_constt ('Res[H, G] 'chi_j) <= irr_constt ('Res[H] psi)}. Proof. -move=> Npsi Cj i; apply: contraNneq; rewrite eqr_le => {1}<-. +move=> Npsi Cj i; apply: contraNneq; rewrite eq_le => {1}<-. rewrite cfdot_Res_ge_constt ?Cnat_ge0 ?Cnat_cfdot_char_irr //. by rewrite cfRes_char ?irr_char. Qed. @@ -2859,18 +2858,18 @@ by rewrite cfcenter_eq_center subsetIr. Qed. (* This is Isaacs (2.29). *) -Lemma cfnorm_Res_lerif H phi : +Lemma cfnorm_Res_leif H phi : H \subset G -> '['Res[H] phi] <= #|G : H|%:R * '[phi] ?= iff (phi \in 'CF(G, H)). Proof. move=> sHG; rewrite cfun_onE mulrCA natf_indexg // -mulrA mulKf ?neq0CG //. rewrite (big_setID H) (setIidPr sHG) /= addrC. -rewrite (mono_lerif (ler_pmul2l _)) ?invr_gt0 ?gt0CG // -lerif_subLR -sumrB. +rewrite (mono_leif (ler_pmul2l _)) ?invr_gt0 ?gt0CG // -leif_subLR -sumrB. rewrite big1 => [|x Hx]; last by rewrite !cfResE ?subrr. have ->: (support phi \subset H) = (G :\: H \subset [set x | phi x == 0]). rewrite subDset setUC -subDset; apply: eq_subset => x. by rewrite !inE (andb_idr (contraR _)) // => /cfun0->. -rewrite (sameP subsetP forall_inP); apply: lerif_0_sum => x _. +rewrite (sameP subsetP forall_inP); apply: leif_0_sum => x _. by rewrite !inE /] := cfcenter_Res 'chi_i. have /irrP[j ->] := lin_char_irr Lxi; rewrite cfdotZl cfdotZr cfdot_irr eqxx. by rewrite mulr1 irr1_degree conjC_nat. diff --git a/mathcomp/character/classfun.v b/mathcomp/character/classfun.v index 3f461e3..c8ae7b1 100644 --- a/mathcomp/character/classfun.v +++ b/mathcomp/character/classfun.v @@ -1,7 +1,7 @@ (* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import ssreflect ssrbool ssrfun eqtype ssrnat seq path. -From mathcomp Require Import div choice fintype tuple finfun bigop prime. +From mathcomp Require Import div choice fintype tuple finfun bigop prime order. From mathcomp Require Import ssralg poly finset fingroup morphism perm. From mathcomp Require Import automorphism quotient finalg action gproduct. From mathcomp Require Import zmodp commutator cyclic center pgroup sylow. @@ -91,7 +91,7 @@ Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. -Import GroupScope GRing.Theory Num.Theory. +Import Order.TTheory GroupScope GRing.Theory Num.Theory. Local Open Scope ring_scope. Delimit Scope cfun_scope with CF. @@ -900,7 +900,7 @@ by rewrite phi0 // => y _; apply: mul_conjC_ge0. Qed. Lemma cfnorm_gt0 phi : ('[phi] > 0) = (phi != 0). -Proof. by rewrite ltr_def cfnorm_ge0 cfnorm_eq0 andbT. Qed. +Proof. by rewrite lt_def cfnorm_ge0 cfnorm_eq0 andbT. Qed. Lemma sqrt_cfnorm_ge0 phi : 0 <= sqrtC '[phi]. Proof. by rewrite sqrtC_ge0 cfnorm_ge0. Qed. @@ -944,7 +944,7 @@ Lemma cfCauchySchwarz phi psi : Proof. rewrite free_cons span_seq1 seq1_free -negb_or negbK orbC. have [-> | nz_psi] /= := altP (psi =P 0). - by apply/lerifP; rewrite !cfdot0r normCK mul0r mulr0. + by apply/leifP; rewrite !cfdot0r normCK mul0r mulr0. without loss ophi: phi / '[phi, psi] = 0. move=> IHo; pose a := '[phi, psi] / '[psi]; pose phi1 := phi - a *: psi. have ophi: '[phi1, psi] = 0. @@ -952,7 +952,7 @@ without loss ophi: phi / '[phi, psi] = 0. rewrite (canRL (subrK _) (erefl phi1)) rpredDr ?rpredZ ?memv_line //. rewrite cfdotDl ophi add0r cfdotZl normrM (ger0_norm (cfnorm_ge0 _)). rewrite exprMn mulrA -cfnormZ cfnormDd; last by rewrite cfdotZr ophi mulr0. - by have:= IHo _ ophi; rewrite mulrDl -lerif_subLR subrr ophi normCK mul0r. + by have:= IHo _ ophi; rewrite mulrDl -leif_subLR subrr ophi normCK mul0r. rewrite ophi normCK mul0r; split; first by rewrite mulr_ge0 ?cfnorm_ge0. rewrite eq_sym mulf_eq0 orbC cfnorm_eq0 (negPf nz_psi) /=. apply/idP/idP=> [|/vlineP[a {2}->]]; last by rewrite cfdotZr ophi mulr0. @@ -963,20 +963,19 @@ Lemma cfCauchySchwarz_sqrt phi psi : `|'[phi, psi]| <= sqrtC '[phi] * sqrtC '[psi] ?= iff ~~ free (phi :: psi). Proof. rewrite -(sqrCK (normr_ge0 _)) -sqrtCM ?qualifE ?cfnorm_ge0 //. -rewrite (mono_in_lerif (@ler_sqrtC _)) 1?rpredM ?qualifE; -rewrite ?normr_ge0 ?cfnorm_ge0 //. +rewrite (mono_in_leif (@ler_sqrtC _)) 1?rpredM ?qualifE ?cfnorm_ge0 //. exact: cfCauchySchwarz. Qed. -Lemma cf_triangle_lerif phi psi : +Lemma cf_triangle_leif phi psi : sqrtC '[phi + psi] <= sqrtC '[phi] + sqrtC '[psi] ?= iff ~~ free (phi :: psi) && (0 <= coord [tuple psi] 0 phi). Proof. -rewrite -(mono_in_lerif ler_sqr) ?rpredD ?qualifE ?sqrtC_ge0 ?cfnorm_ge0 //. -rewrite andbC sqrrD !sqrtCK addrAC cfnormD (mono_lerif (ler_add2l _)). +rewrite -(mono_in_leif ler_sqr) ?rpredD ?qualifE ?sqrtC_ge0 ?cfnorm_ge0 //. +rewrite andbC sqrrD !sqrtCK addrAC cfnormD (mono_leif (ler_add2l _)). rewrite -mulr_natr -[_ + _](divfK (negbT (eqC_nat 2 0))) -/('Re _). -rewrite (mono_lerif (ler_pmul2r _)) ?ltr0n //. -have:= lerif_trans (lerif_Re_Creal '[phi, psi]) (cfCauchySchwarz_sqrt phi psi). +rewrite (mono_leif (ler_pmul2r _)) ?ltr0n //. +have:= leif_trans (leif_Re_Creal '[phi, psi]) (cfCauchySchwarz_sqrt phi psi). congr (_ <= _ ?= iff _); apply: andb_id2r. rewrite free_cons span_seq1 seq1_free -negb_or negbK orbC. have [-> | nz_psi] := altP (psi =P 0); first by rewrite cfdot0r coord0. diff --git a/mathcomp/character/inertia.v b/mathcomp/character/inertia.v index c644150..3809e73 100644 --- a/mathcomp/character/inertia.v +++ b/mathcomp/character/inertia.v @@ -1,7 +1,7 @@ (* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq path. -From mathcomp Require Import choice div fintype tuple finfun bigop prime. +From mathcomp Require Import choice fintype div tuple finfun bigop prime order. From mathcomp Require Import ssralg ssrnum finset fingroup morphism perm. From mathcomp Require Import automorphism quotient action zmodp cyclic center. From mathcomp Require Import gproduct commutator gseries nilpotent pgroup. @@ -12,7 +12,7 @@ Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. -Import GroupScope GRing.Theory Num.Theory. +Import Order.TTheory GroupScope GRing.Theory Num.Theory. Local Open Scope ring_scope. (******************************************************************************) @@ -938,7 +938,7 @@ have AtoB_P s (psi := 'chi_s) (chi := 'Ind[G] psi): s \in calA -> have ub_chi_r: 'chi_r 1%g <= chi 1%g ?= iff ('chi_r == chi). have Nchi: chi \is a character by rewrite cfInd_char ?irr_char. have [chi1 Nchi1->] := constt_charP _ Nchi sGr. - rewrite addrC cfunE -lerif_subLR subrr eq_sym -subr_eq0 addrK. + rewrite addrC cfunE -leif_subLR subrr eq_sym -subr_eq0 addrK. by split; rewrite ?char1_ge0 // eq_sym char1_eq0. have lb_chi_r: chi 1%g <= 'chi_r 1%g ?= iff (f == e). rewrite cfInd1 // -(cfRes1 H) DpsiH -(cfRes1 H 'chi_r) DrH !cfunE sum_cfunE. @@ -946,10 +946,10 @@ have AtoB_P s (psi := 'chi_s) (chi := 'Ind[G] psi): s \in calA -> by case/cfclassP=> y _ ->; rewrite cfConjg1. rewrite reindex_cfclass //= sumr_const -(eq_card (cfclass_IirrE _ _)). rewrite mulr_natl mulrnAr card_cfclass_Iirr //. - rewrite (mono_lerif (ler_pmuln2r (indexg_gt0 G T))). - rewrite (mono_lerif (ler_pmul2r (irr1_gt0 t))); apply: lerif_eq. + rewrite (mono_leif (ler_pmuln2r (indexg_gt0 G T))). + rewrite (mono_leif (ler_pmul2r (irr1_gt0 t))); apply: leif_eq. by rewrite /e -(cfResRes _ sHT) ?cfdot_Res_ge_constt. - have [_ /esym] := lerif_trans ub_chi_r lb_chi_r; rewrite eqxx. + have [_ /esym] := leif_trans ub_chi_r lb_chi_r; rewrite eqxx. by case/andP=> /eqP Dchi /eqP->; rewrite cfIirrE -/chi -?Dchi ?mem_irr. have part_c: {in calA, forall s (chi := 'Ind[G] 'chi_s), [predI irr_constt ('Res[T] chi) & calA] =i pred1 s}. @@ -957,14 +957,14 @@ have part_c: {in calA, forall s (chi := 'Ind[G] 'chi_s), have chiTs: s \in irr_constt ('Res[T] chi). by rewrite irr_consttE cfdot_Res_l irrWnorm ?oner_eq0. apply/andP/eqP=> [[/= chiTs1 As1] | -> //]. - apply: contraTeq Dchi_theta => s's1; rewrite ltr_eqF // -/chi. + apply: contraTeq Dchi_theta => s's1; rewrite lt_eqF // -/chi. have [|phi Nphi DchiT] := constt_charP _ _ chiTs. by rewrite cfRes_char ?cfInd_char ?irr_char. have [|phi1 Nphi1 Dphi] := constt_charP s1 Nphi _. rewrite irr_consttE -(canLR (addKr _) DchiT) addrC cfdotBl cfdot_irr. by rewrite mulrb ifN_eqC ?subr0. rewrite -(cfResRes chi sHT sTG) DchiT Dphi !rmorphD !cfdotDl /=. - rewrite -ltr_subl_addl subrr ltr_paddr ?ltr_def //; + rewrite -ltr_subl_addl subrr ltr_paddr ?lt_def //; rewrite Cnat_ge0 ?Cnat_cfdot_char ?cfRes_char ?irr_char //. by rewrite andbT -irr_consttE -constt_Ind_Res. do [split=> //; try by move=> s /AtoB_P[]] => [s1 s2 As1 As2 | r]. @@ -1039,8 +1039,8 @@ have [_]: '['Ind[G] phi] <= '['Ind[G] psi] ?= iff d_delta. rewrite DpsiG cfdot_suml; apply: eq_bigr => b _. rewrite -scalerAl cfdotZl cfdot_sumr; congr (_ * _). by apply: eq_bigr => g _; rewrite -scalerAl cfdotZr conj_Cnat. - have eMmono := mono_lerif (ler_pmul2l (egt0 _ _)). - apply: lerif_sum => b /eMmono->; apply: lerif_sum => g /eMmono->. + have eMmono := mono_leif (ler_pmul2l (egt0 _ _)). + apply: leif_sum => b /eMmono->; apply: leif_sum => g /eMmono->. split; last exact: eq_sym. have /CnatP[n Dd]: d b g \in Cnat by rewrite Cnat_cfdot_char. have [Db | _] := eqP; rewrite Dd leC_nat // -ltC_nat -Dd Db cfnorm_gt0. @@ -1059,7 +1059,7 @@ apply/idP/idP=> [|/imageP[b Sb ->]]. apply: contraR => N'i; rewrite big1 // => b Sb. rewrite cfdotZl cfdot_irr mulrb ifN_eqC ?mulr0 //. by apply: contraNneq N'i => ->; apply: image_f. -rewrite gtr_eqF // (bigD1 b) //= cfdotZl cfnorm_irr mulr1 ltr_paddr ?egt0 //. +rewrite gt_eqF // (bigD1 b) //= cfdotZl cfnorm_irr mulr1 ltr_paddr ?egt0 //. apply: sumr_ge0 => g /andP[Sg _]; rewrite cfdotZl cfdot_irr. by rewrite mulr_ge0 ?ler0n ?Cnat_ge0. Qed. @@ -1186,7 +1186,7 @@ have ltUK: U \proper K. rewrite Dmu subGcfker -irr_eq1 -Dmu cfMod_eq1 //. by rewrite (can2_eq (divrK Uj) (mulrK Uj)) mul1r (inj_eq irr_inj). suffices: theta \in 'CF(K, L). - rewrite -cfnorm_Res_lerif // DthL cfnormZ !cfnorm_irr !mulr1 normr_nat. + rewrite -cfnorm_Res_leif // DthL cfnormZ !cfnorm_irr !mulr1 normr_nat. by rewrite -natrX eqC_nat => /eqP. have <-: gcore U G = L. apply: maxL; last by rewrite sub_gcore ?cfker_mod. diff --git a/mathcomp/character/integral_char.v b/mathcomp/character/integral_char.v index 22bd171..1022afa 100644 --- a/mathcomp/character/integral_char.v +++ b/mathcomp/character/integral_char.v @@ -1,7 +1,7 @@ (* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import ssreflect ssrbool ssrfun eqtype ssrnat seq path. -From mathcomp Require Import div choice fintype tuple finfun bigop prime. +From mathcomp Require Import div choice fintype tuple finfun bigop prime order. From mathcomp Require Import ssralg poly finset fingroup morphism perm. From mathcomp Require Import automorphism quotient action finalg zmodp. From mathcomp Require Import commutator cyclic center pgroup sylow gseries. @@ -34,7 +34,7 @@ Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. -Import GroupScope GRing.Theory Num.Theory. +Import Order.TTheory GroupScope GRing.Theory Num.Theory. Local Open Scope ring_scope. Lemma group_num_field_exists (gT : finGroupType) (G : {group gT}) : @@ -274,7 +274,7 @@ have nz_m: m%:R != 0 :> algC by rewrite pnatr_eq0 -lt0n. pose alpha := 'chi_i g / m%:R. have a_lt1: `|alpha| < 1. rewrite normrM normfV normr_nat -{2}(divff nz_m). - rewrite ltr_def (can_eq (mulfVK nz_m)) eq_sym -{1}Dm -irr_cfcenterE // notZg. + rewrite lt_def (can_eq (mulfVK nz_m)) eq_sym -{1}Dm -irr_cfcenterE // notZg. by rewrite ler_pmul2r ?invr_gt0 ?ltr0n // -Dm char1_ge_norm ?irr_char. have Za: alpha \in Aint. have [u _ /dvdnP[v eq_uv]] := Bezoutl #|g ^: G| m_gt0. @@ -304,13 +304,13 @@ have Zbeta: beta \in Cint. have [|nz_a] := boolP (alpha == 0). by rewrite (can2_eq (divfK _) (mulfK _)) // mul0r => /eqP. have: beta != 0 by rewrite Dbeta; apply/prodf_neq0 => nu _; rewrite fmorph_eq0. -move/(norm_Cint_ge1 Zbeta); rewrite ltr_geF //; apply: ler_lt_trans a_lt1. +move/(norm_Cint_ge1 Zbeta); rewrite lt_geF //; apply: le_lt_trans a_lt1. rewrite -[`|alpha|]mulr1 Dbeta (bigD1 1%g) ?group1 //= -Da. -case: (gQnC _) => /= _ <-; rewrite gal_id normrM. -rewrite -subr_ge0 -mulrBr mulr_ge0 ?normr_ge0 // Da subr_ge0. -elim/big_rec: _ => [|nu c _]; first by rewrite normr1 lerr. -apply: ler_trans; rewrite -subr_ge0 -{1}[`|c|]mul1r normrM -mulrBl. -by rewrite mulr_ge0 ?normr_ge0 // subr_ge0 norm_a_nu. +case: (gQnC _) => /= _ <-. +rewrite gal_id normrM -subr_ge0 -mulrBr mulr_ge0 // Da subr_ge0. +elim/big_rec: _ => [|nu c _]; first by rewrite normr1 lexx. +apply: le_trans; rewrite -subr_ge0 -{1}[`|c|]mul1r normrM -mulrBl. +by rewrite mulr_ge0 // subr_ge0 norm_a_nu. Qed. End GringIrrMode. @@ -677,18 +677,18 @@ have{pi1 Zpi1} pi2_ge1: 1 <= pi2. by rewrite Cint_normK // sqr_Cint_ge1 //; apply/prodf_neq0. have Sgt0: (#|S| > 0)%N by rewrite (cardD1 g) [g \in S]Sg. rewrite -mulr_natr -ler_pdivl_mulr ?ltr0n //. -have n2chi_ge0 s: s \in S -> 0 <= `|chi s| ^+ 2 by rewrite exprn_ge0 ?normr_ge0. +have n2chi_ge0 s: s \in S -> 0 <= `|chi s| ^+ 2 by rewrite exprn_ge0. rewrite -(expr_ge1 Sgt0); last by rewrite divr_ge0 ?ler0n ?sumr_ge0. -by rewrite (ler_trans pi2_ge1) // lerif_AGM. +by rewrite (le_trans pi2_ge1) // leif_AGM. Qed. (* This is Burnside's vanishing theorem (Isaacs, Theorem (3.15)). *) Theorem nonlinear_irr_vanish gT (G : {group gT}) i : 'chi[G]_i 1%g > 1 -> exists2 x, x \in G & 'chi_i x = 0. Proof. -move=> chi1gt1; apply/exists_eq_inP; apply: contraFT (ltr_geF chi1gt1). -move/exists_inPn => -nz_chi. -rewrite -(norm_Cnat (Cnat_irr1 i)) -(@expr_le1 _ 2) ?normr_ge0 //. +move=> chi1gt1; apply/exists_eq_inP; apply: contraFT (lt_geF chi1gt1). +move=> /exists_inPn-nz_chi. +rewrite -(norm_Cnat (Cnat_irr1 i)) -(@expr_le1 _ 2)//. rewrite -(ler_add2r (#|G|%:R * '['chi_i])) {1}cfnorm_irr mulr1. rewrite (cfnormE (cfun_onG _)) mulVKf ?neq0CG // (big_setD1 1%g) //=. rewrite addrCA ler_add2l (cardsD1 1%g) group1 mulrS ler_add2l. diff --git a/mathcomp/character/vcharacter.v b/mathcomp/character/vcharacter.v index 72bacc3..e886c5a 100644 --- a/mathcomp/character/vcharacter.v +++ b/mathcomp/character/vcharacter.v @@ -1,7 +1,7 @@ (* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import ssreflect ssrbool ssrfun eqtype ssrnat seq path. -From mathcomp Require Import div choice fintype tuple finfun bigop prime. +From mathcomp Require Import div choice fintype tuple finfun bigop prime order. From mathcomp Require Import ssralg poly finset fingroup morphism perm. From mathcomp Require Import automorphism quotient finalg action gproduct. From mathcomp Require Import zmodp commutator cyclic center pgroup sylow. @@ -40,7 +40,7 @@ Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. -Import GroupScope GRing.Theory Num.Theory. +Import Order.Theory GroupScope GRing.Theory Num.Theory. Local Open Scope ring_scope. Section Basics. @@ -225,8 +225,8 @@ exists chi1; last exists (- nchi2); last by rewrite opprK. apply: rpred_sum => i zi_ge0; rewrite -tnth_nth rpredZ_Cnat ?irr_char //. by rewrite CnatEint Zz. rewrite -sumrN rpred_sum // => i zi_lt0; rewrite -scaleNr -tnth_nth. -rewrite rpredZ_Cnat ?irr_char // CnatEint rpredN Zz oppr_ge0 ltrW //. -by rewrite real_ltrNge ?Creal_Cint. +rewrite rpredZ_Cnat ?irr_char // CnatEint rpredN Zz oppr_ge0 ltW //. +by rewrite real_ltNge ?Creal_Cint. Qed. Lemma Aint_vchar phi x : phi \in 'Z[irr G] -> phi x \in Aint. @@ -501,8 +501,8 @@ have neq_ji: j != i. by rewrite signr_eq0. have neq_bc: b != c. apply: contraTneq phi1_0; rewrite def_phi def_chi def_xi => ->. - rewrite -scalerDr !cfunE mulf_eq0 signr_eq0 eqr_le ltr_geF //. - by rewrite ltr_paddl ?ltrW ?irr1_gt0. + rewrite -scalerDr !cfunE mulf_eq0 signr_eq0 eq_le lt_geF //. + by rewrite ltr_paddl ?ltW ?irr1_gt0. rewrite {}def_phi {}def_chi {}def_xi !scaler_sign. case: b c neq_bc => [|] [|] // _; last by exists i, j. by exists j, i; rewrite 1?eq_sym // addrC. @@ -691,8 +691,8 @@ have def_phi: {in H, phi =1 'chi_i}. have [j def_chi_j]: {j | 'chi_j = phi}. apply/sig_eqW; have [[] [j]] := vchar_norm1P Zphi n1phi; last first. by rewrite scale1r; exists j. - move/cfunP/(_ 1%g)/eqP; rewrite scaleN1r def_phi // cfunE -addr_eq0 eqr_le. - by rewrite ltr_geF // ltr_paddl ?ltrW ?irr1_gt0. + move/cfunP/(_ 1%g)/eqP; rewrite scaleN1r def_phi // cfunE -addr_eq0 eq_le. + by rewrite lt_geF // ltr_paddl ?ltW ?irr1_gt0. exists j; rewrite ?cfkerEirr def_chi_j //; apply/subsetP => x /setDP[Gx notHx]. rewrite inE cfunE def_phi // cfunE -/a cfun1E // Gx mulr1 cfIndE //. rewrite big1 ?mulr0 ?add0r // => y Gy; apply/theta0/(contra _ notHx) => Hxy. @@ -834,7 +834,7 @@ Proof. by rewrite inE. Qed. Lemma Cnat_dirr (phi : 'CF(G)) i : phi \in 'Z[irr G] -> i \in dirr_constt phi -> '[phi, dchi i] \in Cnat. Proof. -move=> PiZ; rewrite CnatEint dirr_consttE andbC => /ltrW -> /=. +move=> PiZ; rewrite CnatEint dirr_consttE andbC => /ltW -> /=. by case: i => b i; rewrite cfdotZr rmorph_sign rpredMsign Cint_cfdot_vchar_irr. Qed. @@ -846,15 +846,14 @@ Lemma dirr_constt_oppI (phi: 'CF(G)) : dirr_constt phi :&: dirr_constt (-phi) = set0. Proof. apply/setP=> i; rewrite inE !dirr_consttE cfdotNl inE. -apply/idP=> /andP [L1 L2]; have := ltr_paddl (ltrW L1) L2. -by rewrite subrr ltr_def eqxx. +apply/idP=> /andP [L1 L2]; have := ltr_paddl (ltW L1) L2. +by rewrite subrr lt_def eqxx. Qed. Lemma dirr_constt_oppl (phi: 'CF(G)) i : - i \in dirr_constt phi -> (ndirr i) \notin dirr_constt phi. + i \in dirr_constt phi -> (ndirr i) \notin dirr_constt phi. Proof. -rewrite !dirr_consttE dchi_ndirrE cfdotNr oppr_gt0. -by move/ltrW=> /ler_gtF ->. +by rewrite !dirr_consttE dchi_ndirrE cfdotNr oppr_gt0 => /ltW /le_gtF ->. Qed. Definition to_dirr (B : {set gT}) (phi : 'CF(B)) (i : Iirr B) : dIirr B := @@ -876,7 +875,7 @@ Lemma of_irrK (phi: 'CF(G)) : {in dirr_constt phi, cancel (@of_irr G) (to_dirr phi)}. Proof. case=> b i; rewrite dirr_consttE cfdotZr rmorph_sign /= /to_dirr mulr_sign. -by rewrite fun_if oppr_gt0; case: b => [|/ltrW/ler_gtF] ->. +by rewrite fun_if oppr_gt0; case: b => [|/ltW/le_gtF] ->. Qed. Lemma cfdot_todirrE (phi: 'CF(G)) i (phi_i := dchi (to_dirr phi i)) : @@ -913,7 +912,7 @@ Lemma dirr_small_norm (phi : 'CF(G)) n : Proof. move=> PiZ Pln; rewrite ltnNge -leC_nat => Nl4. suffices Fd i: i \in dirr_constt phi -> '[phi, dchi i] = 1. - split; last 2 [by apply/setP=> u; rewrite !inE cfdotNl oppr_gt0 ltr_asym]. + split; last 2 [by apply/setP=> u; rewrite !inE cfdotNl oppr_gt0 lt_asym]. apply/eqP; rewrite -eqC_nat -sumr_const -Pln (cnorm_dconstt PiZ). by apply/eqP/eq_bigr=> i Hi; rewrite Fd // expr1n. rewrite {1}[phi]cfun_sum_dconstt //. diff --git a/mathcomp/field/algC.v b/mathcomp/field/algC.v index e1fd4d1..8c1fd96 100644 --- a/mathcomp/field/algC.v +++ b/mathcomp/field/algC.v @@ -1,9 +1,9 @@ (* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import ssreflect ssrbool ssrfun ssrnat eqtype seq choice. -From mathcomp Require Import div fintype path bigop finset prime ssralg poly. -From mathcomp Require Import polydiv mxpoly generic_quotient countalg ssrnum. -From mathcomp Require Import closed_field ssrint rat intdiv. +From mathcomp Require Import div fintype path bigop finset prime order ssralg. +From mathcomp Require Import poly polydiv mxpoly generic_quotient countalg. +From mathcomp Require Import ssrnum closed_field ssrint rat intdiv. From mathcomp Require Import algebraics_fundamentals. (******************************************************************************) @@ -53,14 +53,14 @@ Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. -Import GRing.Theory Num.Theory. +Import Order.Theory GRing.Theory Num.Theory. Local Open Scope ring_scope. (* The Num mixin for an algebraically closed field with an automorphism of *) (* order 2, making it into a field of complex numbers. *) Lemma ComplexNumMixin (L : closedFieldType) (conj : {rmorphism L -> L}) : involutive conj -> ~ conj =1 id -> - {numL | forall x : NumDomainType L numL, `|x| ^+ 2 = x * conj x}. + {numL : numMixin L | forall x : NumDomainType L numL, `|x| ^+ 2 = x * conj x}. Proof. move=> conjK conj_nt. have nz2: 2%:R != 0 :> L. @@ -184,7 +184,7 @@ have normD x y : le (norm (x + y)) (norm x + norm y). apply/posP; exists (i * (x * conj y - y * conj x)); congr (_ * _). rewrite !(rmorphM, rmorphB) iJ !conjK mulNr -mulrN opprB. by rewrite (mulrC x) (mulrC y). -by exists (Num.Mixin normD sposD norm_eq0 pos_linear normM (rrefl _) (rrefl _)). +by exists (NumMixin normD sposD norm_eq0 pos_linear normM (rrefl _) (rrefl _)). Qed. Module Algebraics. @@ -229,8 +229,10 @@ Canonical decFieldType := DecFieldType type decFieldMixin. Axiom closedFieldAxiom : GRing.ClosedField.axiom ringType. Canonical closedFieldType := ClosedFieldType type closedFieldAxiom. -Parameter numMixin : Num.mixin_of ringType. +Parameter numMixin : numMixin idomainType. +Canonical porderType := POrderType ring_display type numMixin. Canonical numDomainType := NumDomainType type numMixin. +Canonical normedDomainType := NormedDomainType type type numMixin. Canonical numFieldType := [numFieldType of type]. Parameter conjMixin : Num.ClosedField.imaginary_mixin_of numDomainType. @@ -422,13 +424,15 @@ have [i i2]: exists i : type, i ^+ 2 = -1. have [i] := @solve_monicpoly _ 2 (nth 0 [:: -1 : type]) isT. by rewrite !big_ord_recl big_ord0 /= mul0r mulr1 !addr0; exists i. move/(_ i)/(congr1 CtoL); rewrite LtoC_K => iL_J. -have/ltr_geF/idP[] := @ltr01 Lnum; rewrite -oppr_ge0 -(rmorphN1 CtoL_rmorphism). -rewrite -i2 rmorphX /= expr2 -{2}iL_J -(svalP LnumMixin). -by rewrite exprn_ge0 ?normr_ge0. +have/lt_geF/idP[] := @ltr01 Lnum; rewrite -oppr_ge0 -(rmorphN1 CtoL_rmorphism). +by rewrite -i2 rmorphX /= expr2 -{2}iL_J -(svalP LnumMixin) exprn_ge0. Qed. -Definition numMixin := sval (ComplexNumMixin conjK conj_nt). +Definition numMixin : numMixin closedFieldType := + sval (ComplexNumMixin conjK conj_nt). +Canonical porderType := POrderType ring_display type numMixin. Canonical numDomainType := NumDomainType type numMixin. +Canonical normedDomainType := NormedDomainType type type numMixin. Canonical numFieldType := [numFieldType of type]. Lemma normK u : `|u| ^+ 2 = u * conj u. @@ -480,18 +484,18 @@ Fact floorC_subproof x : {m | x \is Creal -> ZtoC m <= x < ZtoC (m + 1)}. Proof. have [Rx | _] := boolP (x \is Creal); last by exists 0. without loss x_ge0: x Rx / x >= 0. - have [x_ge0 | /ltrW x_le0] := real_ger0P Rx; first exact. + have [x_ge0 | /ltW x_le0] := real_ge0P Rx; first exact. case/(_ (- x)) => [||m /(_ isT)]; rewrite ?rpredN ?oppr_ge0 //. - rewrite ler_oppr ltr_oppl -!rmorphN opprD /= ltr_neqAle ler_eqVlt. + rewrite ler_oppr ltr_oppl -!rmorphN opprD /= lt_neqAle le_eqVlt. case: eqP => [-> _ | _ /and3P[lt_x_m _ le_m_x]]. - by exists (- m) => _; rewrite lerr rmorphD ltr_addl ltr01. + by exists (- m) => _; rewrite lexx rmorphD ltr_addl ltr01. by exists (- m - 1); rewrite le_m_x subrK. have /ex_minnP[n lt_x_n1 min_n]: exists n, x < n.+1%:R. have [n le_x_n] := rat_algebraic_archimedean algebraic x. - by exists n; rewrite -(ger0_norm x_ge0) (ltr_trans le_x_n) ?ltr_nat. + by exists n; rewrite -(ger0_norm x_ge0) (lt_trans le_x_n) ?ltr_nat. exists n%:Z => _; rewrite addrC -intS lt_x_n1 andbT. case Dn: n => // [n1]; rewrite -Dn. -have [||//|] := @real_lerP _ n%:R x; rewrite ?rpred_nat //. +have [||//|] := @real_leP _ n%:R x; rewrite ?rpred_nat //. by rewrite Dn => /min_n; rewrite Dn ltnn. Qed. @@ -535,7 +539,9 @@ Canonical unitRingType. Canonical comRingType. Canonical comUnitRingType. Canonical idomainType. +Canonical porderType. Canonical numDomainType. +Canonical normedDomainType. Canonical fieldType. Canonical numFieldType. Canonical decFieldType. @@ -663,15 +669,15 @@ Proof. by rewrite /floorC => Rx; case: (floorC_subproof x) => //= m; apply. Qed. Lemma floorC_def x m : m%:~R <= x < (m + 1)%:~R -> floorC x = m. Proof. -case/andP=> lemx ltxm1; apply/eqP; rewrite eqr_le -!ltz_addr1. +case/andP=> lemx ltxm1; apply/eqP; rewrite eq_le -!ltz_addr1. have /floorC_itv/andP[lefx ltxf1]: x \is Creal. by rewrite -[x](subrK m%:~R) rpredD ?realz ?ler_sub_real. -by rewrite -!(ltr_int [numFieldType of algC]) 2?(@ler_lt_trans _ x). +by rewrite -!(ltr_int [numFieldType of algC]) 2?(@le_lt_trans _ _ x). Qed. Lemma intCK : cancel intr floorC. Proof. -by move=> m; apply: floorC_def; rewrite ler_int ltr_int ltz_addr1 lerr. +by move=> m; apply: floorC_def; rewrite ler_int ltr_int ltz_addr1 lexx. Qed. Lemma floorCK : {in Cint, cancel floorC intr}. Proof. by move=> z /eqP. Qed. @@ -757,17 +763,17 @@ Lemma truncC_itv x : 0 <= x -> (truncC x)%:R <= x < (truncC x).+1%:R. Proof. move=> x_ge0; have /andP[lemx ltxm1] := floorC_itv (ger0_real x_ge0). rewrite /truncC x_ge0 -addn1 !pmulrn PoszD gez0_abs ?lemx //. -by rewrite -ltz_addr1 -(ltr_int [numFieldType of algC]) (ler_lt_trans x_ge0). +by rewrite -ltz_addr1 -(ltr_int [numFieldType of algC]) (le_lt_trans x_ge0). Qed. Lemma truncC_def x n : n%:R <= x < n.+1%:R -> truncC x = n. Proof. move=> ivt_n_x; have /andP[lenx _] := ivt_n_x. -by rewrite /truncC (ler_trans (ler0n _ n)) // (@floorC_def _ n) // addrC -intS. +by rewrite /truncC (le_trans (ler0n _ n)) // (@floorC_def _ n) // addrC -intS. Qed. Lemma natCK n : truncC n%:R = n. -Proof. by apply: truncC_def; rewrite lerr ltr_nat /=. Qed. +Proof. by apply: truncC_def; rewrite lexx ltr_nat /=. Qed. Lemma CnatP x : reflect (exists n, x = n%:R) (x \in Cnat). Proof. @@ -782,9 +788,9 @@ Proof. apply/idP/idP=> [m_gt0 | x_ge1]. have /truncC_itv/andP[lemx _]: 0 <= x. by move: m_gt0; rewrite /truncC; case: ifP. - by apply: ler_trans lemx; rewrite ler1n. -have /truncC_itv/andP[_ ltxm1]:= ler_trans ler01 x_ge1. -by rewrite -ltnS -ltC_nat (ler_lt_trans x_ge1). + by apply: le_trans lemx; rewrite ler1n. +have /truncC_itv/andP[_ ltxm1]:= le_trans ler01 x_ge1. +by rewrite -ltnS -ltC_nat (le_lt_trans x_ge1). Qed. Lemma truncC0Pn x : reflect (truncC x = 0%N) (~~ (1 <= x)). @@ -912,14 +918,12 @@ by rewrite pnatr_eq0 ler1n lt0n. Qed. Lemma sqr_Cint_ge1 x : x \in Cint -> x != 0 -> 1 <= x ^+ 2. -Proof. -by move=> Zx nz_x; rewrite -Cint_normK // expr_ge1 ?normr_ge0 ?norm_Cint_ge1. -Qed. +Proof. by move=> Zx nz_x; rewrite -Cint_normK // expr_ge1 ?norm_Cint_ge1. Qed. Lemma Cint_ler_sqr x : x \in Cint -> x <= x ^+ 2. Proof. move=> Zx; have [-> | nz_x] := eqVneq x 0; first by rewrite expr0n. -apply: ler_trans (_ : `|x| <= _); first by rewrite real_ler_norm ?Creal_Cint. +apply: le_trans (_ : `|x| <= _); first by rewrite real_ler_norm ?Creal_Cint. by rewrite -Cint_normK // ler_eexpr // norm_Cint_ge1. Qed. @@ -937,7 +941,7 @@ Lemma dvdCP_nat x y : 0 <= x -> 0 <= y -> (x %| y)%C -> {n | y = n%:R * x}. Proof. move=> x_ge0 y_ge0 x_dv_y; apply: sig_eqW. case/dvdCP: x_dv_y => z Zz -> in y_ge0 *; move: x_ge0 y_ge0 Zz. -rewrite ler_eqVlt => /predU1P[<- | ]; first by exists 22; rewrite !mulr0. +rewrite le_eqVlt => /predU1P[<- | ]; first by exists 22; rewrite !mulr0. by move=> /pmulr_lge0-> /CintEge0-> /CnatP[n ->]; exists n. Qed. diff --git a/mathcomp/field/algebraics_fundamentals.v b/mathcomp/field/algebraics_fundamentals.v index acafd8f..e8521ec 100644 --- a/mathcomp/field/algebraics_fundamentals.v +++ b/mathcomp/field/algebraics_fundamentals.v @@ -1,11 +1,11 @@ (* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import ssreflect ssrbool ssrfun ssrnat eqtype seq choice. -From mathcomp Require Import div fintype path tuple bigop finset prime ssralg. -From mathcomp Require Import poly polydiv mxpoly countalg closed_field ssrnum. -From mathcomp Require Import ssrint rat intdiv fingroup finalg zmodp cyclic. -From mathcomp Require Import pgroup sylow vector falgebra fieldext separable. -From mathcomp Require Import galois. +From mathcomp Require Import div fintype path tuple bigop finset prime order. +From mathcomp Require Import ssralg poly polydiv mxpoly countalg closed_field. +From mathcomp Require Import ssrnum ssrint rat intdiv fingroup finalg zmodp. +From mathcomp Require Import cyclic pgroup sylow vector falgebra fieldext. +From mathcomp Require Import separable galois. (******************************************************************************) (* The main result in this file is the existence theorem that underpins the *) @@ -112,7 +112,7 @@ Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. -Import GroupScope GRing.Theory Num.Theory. +Import Order.Theory Order.Syntax GroupScope GRing.Theory Num.Theory. Local Open Scope ring_scope. Local Notation "p ^ f" := (map_poly f p) : ring_scope. @@ -124,25 +124,25 @@ Lemma rat_algebraic_archimedean (C : numFieldType) (QtoC : Qmorphism C) : integralRange QtoC -> Num.archimedean_axiom C. Proof. move=> algC x. -without loss x_ge0: x / 0 <= x by rewrite -normr_id; apply; apply: normr_ge0. +without loss x_ge0: x / 0 <= x by rewrite -normr_id; apply. have [-> | nz_x] := eqVneq x 0; first by exists 1%N; rewrite normr0. have [p mon_p px0] := algC x; exists (\sum_(j < size p) `|numq p`_j|)%N. -rewrite ger0_norm // real_ltrNge ?rpred_nat ?ger0_real //. -apply: contraL px0 => lb_x; rewrite rootE gtr_eqF // horner_coef size_map_poly. -have x_gt0 k: 0 < x ^+ k by rewrite exprn_gt0 // ltr_def nz_x. +rewrite ger0_norm // real_ltNge ?rpred_nat ?ger0_real //. +apply: contraL px0 => lb_x; rewrite rootE gt_eqF // horner_coef size_map_poly. +have x_gt0 k: 0 < x ^+ k by rewrite exprn_gt0 // lt_def nz_x. move: lb_x; rewrite polySpred ?monic_neq0 // !big_ord_recr coef_map /=. rewrite -lead_coefE (monicP mon_p) natrD rmorph1 mul1r => lb_x. case: _.-1 (lb_x) => [|n]; first by rewrite !big_ord0 !add0r ltr01. rewrite -ltr_subl_addl add0r -(ler_pmul2r (x_gt0 n)) -exprS. -apply: ltr_le_trans; rewrite mulrDl mul1r ltr_spaddr // -sumrN. +apply: lt_le_trans; rewrite mulrDl mul1r ltr_spaddr // -sumrN. rewrite natr_sum mulr_suml ler_sum // => j _. -rewrite coef_map /= fmorph_eq_rat (ler_trans (real_ler_norm _)) //. +rewrite coef_map /= fmorph_eq_rat (le_trans (real_ler_norm _)) //. by rewrite rpredN rpredM ?rpred_rat ?rpredX // ger0_real. -rewrite normrN normrM ler_pmul //=. +rewrite normrN normrM ler_pmul //. rewrite normf_div -!intr_norm -!abszE ler_pimulr ?ler0n //. by rewrite invf_le1 ?ler1n ?ltr0n ?absz_gt0 ?denq_eq0. rewrite normrX ger0_norm ?(ltrW x_gt0) // ler_weexpn2l ?leq_ord //. -by rewrite (ler_trans _ lb_x) // -natrD addn1 ler1n. +by rewrite (le_trans _ lb_x) // -natrD addn1 ler1n. Qed. Definition decidable_embedding sT T (f : sT -> T) := @@ -161,8 +161,8 @@ have [n ub_n]: {n | forall y, root q y -> `|y| < n}. have /monic_Cauchy_bound[n2 ub_n2]: (-1) ^+ d *: (q \Po - 'X) \is monic. rewrite monicE lead_coefZ lead_coef_comp ?size_opp ?size_polyX // -/d. by rewrite lead_coef_opp lead_coefX (monicP mon_q) (mulrC 1) signrMK. - exists (Num.max n1 n2) => y; rewrite ltrNge ler_normr !ler_maxl rootE. - apply: contraL => /orP[]/andP[] => [/ub_n1/gtr_eqF->// | _ /ub_n2/gtr_eqF]. + exists (n1 `|` n2) => y; rewrite ltNge ler_normr !leUx rootE. + apply: contraL => /orP[]/andP[] => [/ub_n1/gt_eqF->// | _ /ub_n2/gt_eqF]. by rewrite hornerZ horner_comp !hornerE opprK mulf_eq0 signr_eq0 => /= ->. have [p [a nz_a Dq]] := rat_poly_scale q; pose N := Num.bound `|n * a%:~R|. pose xa : seq rat := [seq (m%:R - N%:R) / a%:~R | m <- iota 0 N.*2]. @@ -193,13 +193,13 @@ have Dm: m%:R = `|y * a%:~R + N%:R|. by rewrite pmulrn abszE intr_norm Da rmorphD !rmorphM /= numqE mulrAC mulrA. have ltr_Qnat n1 n2 : (n1%:R < n2%:R :> rat = _) := ltr_nat _ n1 n2. have ub_y: `|y * a%:~R| < N%:R. - apply: ler_lt_trans (archi_boundP (normr_ge0 _)); rewrite !normrM. - by rewrite ler_pmul ?normr_ge0 // (ler_trans _ (ler_norm n)) ?ltrW ?ub_n. + apply: le_lt_trans (archi_boundP (normr_ge0 _)); rewrite !normrM. + by rewrite ler_pmul // (le_trans _ (ler_norm n)) ?ltW ?ub_n. apply/mapP; exists m. rewrite mem_iota /= add0n -addnn -ltr_Qnat Dm natrD. - by rewrite (ler_lt_trans (ler_norm_add _ _)) // normr_nat ltr_add2r. + by rewrite (le_lt_trans (ler_norm_add _ _)) // normr_nat ltr_add2r. rewrite Dm ger0_norm ?addrK ?mulfK ?intr_eq0 // -ler_subl_addl sub0r. -by rewrite (ler_trans (ler_norm _)) ?normrN ?ltrW. +by rewrite (le_trans (ler_norm _)) ?normrN ?ltW. Qed. Lemma minPoly_decidable_closure @@ -397,7 +397,7 @@ have add_Rroot xR p c: {yR | extendsR xR yR & has_Rroot xR p c -> root_in yR p}. elim: d => // d IHd in p mon_p s_p p0_le0 *; rewrite ltnS => le_p_d. have /closed_rootP/sig_eqW[y py0]: size (p ^ ofQ x) != 1%N. rewrite size_map_poly size_poly_eq1 eqp_monic ?rpred1 //. - by apply: contraTneq p0_le0 => ->; rewrite rmorph1 hornerC ltr_geF ?ltr01. + by apply: contraTneq p0_le0 => ->; rewrite rmorph1 hornerC lt_geF ?ltr01. have /s_p s_y := py0; have /z_s/sQ_inQ[u Dy] := s_y. have /pQwx[q Dq] := minPolyOver Qx u. have mon_q: q \is monic by have:= monic_minPoly Qx u; rewrite Dq map_monic. @@ -441,10 +441,10 @@ have add_Rroot xR p c: {yR | extendsR xR yR & has_Rroot xR p c -> root_in yR p}. case: (find k q _) => c d [[/= qc_le0 qd_ge0 le_cd] [/= le_ac le_db] Dcd]. have [/= le_ce le_ed] := midf_le le_cd; set e := _ / _ in le_ce le_ed. rewrite expnSr natrM invfM mulrA -{}Dcd /narrow /= -[mid _]/e. - have [qe_ge0 // | /ltrW qe_le0] := lerP 0 q.[e]. - do ?split=> //=; [exact: (ler_trans le_ed) | apply: canRL (mulfK nz2) _]. + have [qe_ge0 // | /ltW qe_le0] := lerP 0 q.[e]. + do ?split=> //=; [exact: (le_trans le_ed) | apply: canRL (mulfK nz2) _]. by rewrite mulrBl divfK // mulr_natr opprD addrACA subrr add0r. - do ?split=> //=; [exact: (ler_trans le_ac) | apply: canRL (mulfK nz2) _]. + do ?split=> //=; [exact: (le_trans le_ac) | apply: canRL (mulfK nz2) _]. by rewrite mulrBl divfK // mulr_natr opprD addrACA subrr addr0. have find_root r q ab: xup q ab -> {n | forall x, x \in itv (find n q ab) ->`|(r * q).[x]| < h2}. @@ -457,39 +457,39 @@ have add_Rroot xR p c: {yR | extendsR xR yR & has_Rroot xR p c -> root_in yR p}. have{xab} [[]] := findP n _ _ xab; case: (find n q ab) => a1 b1 /=. rewrite -/d => qa1_le0 qb1_ge0 le_ab1 [/= le_aa1 le_b1b] Dab1 le_a1c le_cb1. have /MuP lbMu: c \in itv ab. - by rewrite !inE (ler_trans le_aa1) ?(ler_trans le_cb1). - have Mu_ge0: 0 <= Mu by rewrite (ler_trans _ lbMu) ?normr_ge0. + by rewrite !inE (le_trans le_aa1) ?(le_trans le_cb1). + have Mu_ge0: 0 <= Mu by rewrite (le_trans _ lbMu). have Mdq_ge0: 0 <= Mdq. - by rewrite (ler_trans _ (MdqP 0 _)) ?normr_ge0 ?normr0. + by rewrite (le_trans _ (MdqP 0 _)) ?normr0. suffices lb1 a2 b2 (ab1 := (a1, b1)) (ab2 := (a2, b2)) : xup q ab2 /\ sub_itv ab2 ab1 -> q.[b2] - q.[a2] <= Mdq * wid ab1. - + apply: ler_lt_trans (_ : Mu * Mdq * wid (a1, b1) < h2); last first. + + apply: le_lt_trans (_ : Mu * Mdq * wid (a1, b1) < h2); last first. rewrite {}Dab1 mulrA ltr_pdivr_mulr ?ltr0n ?expn_gt0 //. - rewrite (ltr_le_trans (archi_boundP _)) ?mulr_ge0 ?ltr_nat // -/n. + rewrite (lt_le_trans (archi_boundP _)) ?mulr_ge0 ?ltr_nat // -/n. rewrite ler_pdivl_mull ?ltr0n // -natrM ler_nat. by case: n => // n; rewrite expnS leq_pmul2l // ltn_expl. - rewrite -mulrA hornerM normrM ler_pmul ?normr_ge0 //. - have [/ltrW qc_le0 | qc_ge0] := ltrP q.[c] 0. - by apply: ler_trans (lb1 c b1 _); rewrite ?ler0_norm ?ler_paddl. - by apply: ler_trans (lb1 a1 c _); rewrite ?ger0_norm ?ler_paddr ?oppr_ge0. + rewrite -mulrA hornerM normrM ler_pmul //. + have [/ltW qc_le0 | qc_ge0] := ltrP q.[c] 0. + by apply: le_trans (lb1 c b1 _); rewrite ?ler0_norm ?ler_paddl. + by apply: le_trans (lb1 a1 c _); rewrite ?ger0_norm ?ler_paddr ?oppr_ge0. case{c le_a1c le_cb1 lbMu}=> [[/=qa2_le0 qb2_ge0 le_ab2] [/=le_a12 le_b21]]. pose h := b2 - a2; have h_ge0: 0 <= h by rewrite subr_ge0. have [-> | nz_q] := eqVneq q 0. by rewrite !horner0 subrr mulr_ge0 ?subr_ge0. rewrite -(subrK a2 b2) (addrC h) (nderiv_taylor q (mulrC a2 h)). rewrite (polySpred nz_q) big_ord_recl /= mulr1 nderivn0 addrC addKr. - have [le_aa2 le_b2b] := (ler_trans le_aa1 le_a12, ler_trans le_b21 le_b1b). - have /MqP MqPx1: a2 \in itv ab by rewrite inE le_aa2 (ler_trans le_ab2). - apply: ler_trans (ler_trans (ler_norm _) (ler_norm_sum _ _ _)) _. - apply: ler_trans (_ : `|dq.[h] * h| <= _); last first. + have [le_aa2 le_b2b] := (le_trans le_aa1 le_a12, le_trans le_b21 le_b1b). + have /MqP MqPx1: a2 \in itv ab by rewrite inE le_aa2 (le_trans le_ab2). + apply: le_trans (le_trans (ler_norm _) (ler_norm_sum _ _ _)) _. + apply: le_trans (_ : `|dq.[h] * h| <= _); last first. by rewrite normrM ler_pmul ?normr_ge0 ?MdqP // ?ger0_norm ?ler_sub ?h_ge0. rewrite horner_poly ger0_norm ?mulr_ge0 ?sumr_ge0 // => [|j _]; last first. - by rewrite mulr_ge0 ?exprn_ge0 // (ler_trans _ (MqPx1 _)) ?normr_ge0. + by rewrite mulr_ge0 ?exprn_ge0 // (le_trans _ (MqPx1 _)). rewrite mulr_suml ler_sum // => j _; rewrite normrM -mulrA -exprSr. - by rewrite ler_pmul ?normr_ge0 // normrX ger0_norm. + by rewrite ler_pmul // normrX ger0_norm. have [ab0 xab0]: {ab | xup (p ^ QxR) ab}. have /monic_Cauchy_bound[b pb_gt0]: p ^ QxR \is monic by apply: monic_map. - by exists (0, `|b|); rewrite /xup normr_ge0 p0_le0 ltrW ?pb_gt0 ?ler_norm. + by exists (0, `|b|); rewrite /xup normr_ge0 p0_le0 ltW ?pb_gt0 ?ler_norm. pose ab_ n := find n (p ^ QxR) ab0; pose Iab_ n := itv (ab_ n). pose lim v a := (q_ v ^ QxR).[a]; pose nlim v n := lim v (ab_ n).2. have lim0 a: lim 0 a = 0. @@ -505,57 +505,57 @@ have add_Rroot xR p c: {yR | extendsR xR yR & has_Rroot xR p c -> root_in yR p}. have /(find_root r.1)[n ub_rp] := xab0; exists n. have [M Mgt0 ubM]: {M | 0 < M & {in Iab_ n, forall a, `|r.2.[a]| <= M}}. have [M ubM] := poly_itv_bound r.2 (ab_ n).1 (ab_ n).2. - exists (Num.max 1 M) => [|s /ubM vM]; first by rewrite ltr_maxr ltr01. - by rewrite ler_maxr orbC vM. + exists (1 `|` M) => [|s /ubM vM]; first by rewrite ltxU ltr01. + by rewrite lexU orbC vM. exists (h2 / M) => [|a xn_a]; first by rewrite divr_gt0 ?invr_gt0 ?ltr0n. rewrite ltr_pdivr_mulr // -(ltr_add2l h2) -mulr2n -mulr_natl divff //. rewrite -normr1 -(hornerC 1 a) -[1%:P]r_pq_1 hornerD. - rewrite ?(ler_lt_trans (ler_norm_add _ _)) ?ltr_le_add ?ub_rp //. + rewrite ?(le_lt_trans (ler_norm_add _ _)) ?ltr_le_add ?ub_rp //. by rewrite mulrC hornerM normrM ler_wpmul2l ?ubM. have ab_le m n: (m <= n)%N -> (ab_ n).2 \in Iab_ m. move/subnKC=> <-; move: {n}(n - m)%N => n; rewrite /ab_. have /(findP m)[/(findP n)[[_ _]]] := xab0. rewrite /find -iter_add -!/(find _ _) -!/(ab_ _) addnC !inE. - by move: (ab_ _) => /= ab_mn le_ab_mn [/ler_trans->]. + by move: (ab_ _) => /= ab_mn le_ab_mn [/le_trans->]. pose lt v w := 0 < nlim (w - v) (n_ (w - v)). have posN v: lt 0 (- v) = lt v 0 by rewrite /lt subr0 add0r. have posB v w: lt 0 (w - v) = lt v w by rewrite /lt subr0. have posE n v: (n_ v <= n)%N -> lt 0 v = (0 < nlim v n). rewrite /lt subr0 /nlim => /ab_le; set a := _.2; set b := _.2 => Iv_a. - have [-> | /nzP[e e_gt0]] := eqVneq v 0; first by rewrite !lim0 ltrr. + have [-> | /nzP[e e_gt0]] := eqVneq v 0; first by rewrite !lim0 ltxx. move: (n_ v) => m in Iv_a b * => v_gte. without loss lt0v: v v_gte / 0 < lim v b. - move=> IHv; apply/idP/idP => [v_gt0 | /ltrW]; first by rewrite -IHv. - rewrite ltr_def -normr_gt0 ?(ltr_trans _ (v_gte _ _)) ?ab_le //=. - rewrite !lerNgt -!oppr_gt0 -!limN; apply: contra => v_lt0. + move=> IHv; apply/idP/idP => [v_gt0 | /ltW]; first by rewrite -IHv. + rewrite lt_def -normr_gt0 ?(lt_trans _ (v_gte _ _)) ?ab_le //=. + rewrite !leNgt -!oppr_gt0 -!limN; apply: contra => v_lt0. by rewrite -IHv // => c /v_gte; rewrite limN normrN. - rewrite lt0v (ltr_trans e_gt0) ?(ltr_le_trans (v_gte a Iv_a)) //. - rewrite ger0_norm // lerNgt; apply/negP=> /ltrW lev0. + rewrite lt0v (lt_trans e_gt0) ?(lt_le_trans (v_gte a Iv_a)) //. + rewrite ger0_norm // leNgt; apply/negP=> /ltW lev0. have [le_a le_ab] : _ /\ a <= b := andP Iv_a. - have xab: xup (q_ v ^ QxR) (a, b) by move/ltrW in lt0v. + have xab: xup (q_ v ^ QxR) (a, b) by move/ltW in lt0v. have /(find_root (h2 / e)%:P)[n1] := xab; have /(findP n1)[[_ _]] := xab. case: (find _ _ _) => c d /= le_cd [/= le_ac le_db] _ /(_ c)/implyP. - rewrite inE lerr le_cd hornerM hornerC normrM ler_gtF //. - rewrite ger0_norm ?divr_ge0 ?invr_ge0 ?ler0n ?(ltrW e_gt0) // mulrAC. - rewrite ler_pdivl_mulr // ler_wpmul2l ?invr_ge0 ?ler0n // ltrW // v_gte //=. - by rewrite inE -/b (ler_trans le_a) //= (ler_trans le_cd). + rewrite inE lexx le_cd hornerM hornerC normrM le_gtF //. + rewrite ger0_norm ?divr_ge0 ?invr_ge0 ?ler0n ?(ltW e_gt0) // mulrAC. + rewrite ler_pdivl_mulr // ler_wpmul2l ?invr_ge0 ?ler0n // ltW // v_gte //=. + by rewrite inE -/b (le_trans le_a) //= (le_trans le_cd). pose lim_pos m v := exists2 e, e > 0 & forall n, (m <= n)%N -> e < nlim v n. have posP v: reflect (exists m, lim_pos m v) (lt 0 v). apply: (iffP idP) => [v_gt0|[m [e e_gt0 v_gte]]]; last first. - by rewrite (posE _ _ (leq_maxl _ m)) (ltr_trans e_gt0) ?v_gte ?leq_maxr. + by rewrite (posE _ _ (leq_maxl _ m)) (lt_trans e_gt0) ?v_gte ?leq_maxr. have [|e e_gt0 v_gte] := nzP v. - by apply: contraTneq v_gt0 => ->; rewrite /lt subr0 /nlim lim0 ltrr. + by apply: contraTneq v_gt0 => ->; rewrite /lt subr0 /nlim lim0 ltxx. exists (n_ v), e => // n le_vn; rewrite (posE n) // in v_gt0. - by rewrite -(ger0_norm (ltrW v_gt0)) v_gte ?ab_le. + by rewrite -(ger0_norm (ltW v_gt0)) v_gte ?ab_le. have posNneg v: lt 0 v -> ~~ lt v 0. case/posP=> m [d d_gt0 v_gtd]; rewrite -posN. apply: contraL d_gt0 => /posP[n [e e_gt0 nv_gte]]. - rewrite ltr_gtF // (ltr_trans (v_gtd _ (leq_maxl m n))) // -oppr_gt0. - by rewrite /nlim -limN (ltr_trans e_gt0) ?nv_gte ?leq_maxr. + rewrite lt_gtF // (lt_trans (v_gtd _ (leq_maxl m n))) // -oppr_gt0. + by rewrite /nlim -limN (lt_trans e_gt0) ?nv_gte ?leq_maxr. have posVneg v: v != 0 -> lt 0 v || lt v 0. case/nzP=> e e_gt0 v_gte; rewrite -posN; set w := - v. have [m [le_vm le_wm _]] := maxn3 (n_ v) (n_ w) 0%N; rewrite !(posE m) //. - by rewrite /nlim limN -ltr_normr (ltr_trans e_gt0) ?v_gte ?ab_le. + by rewrite /nlim limN -ltr_normr (lt_trans e_gt0) ?v_gte ?ab_le. have posD v w: lt 0 v -> lt 0 w -> lt 0 (v + w). move=> /posP[m [d d_gt0 v_gtd]] /posP[n [e e_gt0 w_gte]]. apply/posP; exists (maxn m n), (d + e) => [|k]; first exact: addr_gt0. @@ -575,20 +575,23 @@ have add_Rroot xR p c: {yR | extendsR xR yR & has_Rroot xR p c -> root_in yR p}. rewrite !geq_max => /and3P[/ab_le/ub_rp{ub_rp}ub_rp le_mk le_nk]. rewrite -(ltr_add2r f) -mulr2n -mulr_natr divfK // /nlim /lim Dqvw. rewrite rmorphD hornerD /= -addrA -ltr_subl_addl ler_lt_add //. - by rewrite rmorphM hornerM ler_pmul ?ltrW ?v_gtd ?w_gte. - rewrite -ltr_pdivr_mull ?mulr_gt0 // (ler_lt_trans _ ub_rp) //. + by rewrite rmorphM hornerM ler_pmul ?ltW ?v_gtd ?w_gte. + rewrite -ltr_pdivr_mull ?mulr_gt0 // (le_lt_trans _ ub_rp) //. by rewrite -scalerAl hornerZ -rmorphM mulrN -normrN ler_norm. - pose le v w := (w == v) || lt v w. + pose le v w := (v == w) || lt v w. pose abs v := if le 0 v then v else - v. have absN v: abs (- v) = abs v. - rewrite /abs /le oppr_eq0 opprK posN. + rewrite /abs /le !(eq_sym 0) oppr_eq0 opprK posN. have [-> | /posVneg/orP[v_gt0 | v_lt0]] := altP eqP; first by rewrite oppr0. by rewrite v_gt0 /= -if_neg posNneg. by rewrite v_lt0 /= -if_neg -(opprK v) posN posNneg ?posN. have absE v: le 0 v -> abs v = v by rewrite /abs => ->. - pose QyNum := RealLtMixin posD posM posNneg posB posVneg absN absE (rrefl _). - pose QyNumField := [numFieldType of NumDomainType (Q y) QyNum]. - pose Ry := [realFieldType of RealDomainType _ (RealLeAxiom QyNumField)]. + pose QyNum : realLtMixin (Q y) := + RealLtMixin posD posM posNneg posB posVneg absN absE (rrefl _). + pose QyOrder := + OrderType (LatticeType (POrderType ring_display (Q y) QyNum) QyNum) QyNum. + pose QyNumField := [numFieldType of NumDomainType QyOrder QyNum]. + pose Ry := [realFieldType of [realDomainType of QyNumField]]. have archiRy := @rat_algebraic_archimedean Ry _ alg_integral. by exists (ArchiFieldType Ry archiRy); apply: [rmorphism of idfun]. have some_realC: realC. @@ -626,7 +629,7 @@ have sCle m n: (m <= n)%N -> {subset sQ (z_ m) <= sQ (z_ n)}. have R'i n: i \notin sQ (x_ n). rewrite /x_; case: (xR n) => x [Rn QxR] /=. apply: contraL (@ltr01 Rn) => /sQ_inQ[v Di]. - suffices /eqP <-: - QxR v ^+ 2 == 1 by rewrite oppr_gt0 -lerNgt sqr_ge0. + suffices /eqP <-: - QxR v ^+ 2 == 1 by rewrite oppr_gt0 -leNgt sqr_ge0. rewrite -rmorphX -rmorphN fmorph_eq1 -(fmorph_eq1 (ofQ x)) rmorphN eqr_oppLR. by rewrite rmorphX Di Di2. have szX2_1: size ('X^2 + 1) = 3. diff --git a/mathcomp/field/algnum.v b/mathcomp/field/algnum.v index c191a0e..be7dd6c 100644 --- a/mathcomp/field/algnum.v +++ b/mathcomp/field/algnum.v @@ -358,7 +358,8 @@ pose Saut (mu : subAut) : {rmorphism Sdom mu -> Sdom mu} := (projT2 mu).2. have SinjZ Qr (QrC : numF_inj Qr) a x: QrC (a *: x) = QtoC a * QrC x. rewrite mulrAC; apply: canRL (mulfK _) _. by rewrite intr_eq0 denq_neq0. - by rewrite mulrzr mulrzl -!rmorphMz scalerMzl -scaler_int -mulrzr -numqE. + by rewrite mulrzr mulrzl -!rmorphMz scalerMzl -[x *~ _]scaler_int -mulrzr + -numqE. have Sinj_poly Qr (QrC : numF_inj Qr) p: map_poly QrC (map_poly (in_alg Qr) p) = pQtoC p. - rewrite -map_poly_comp; apply: eq_map_poly => a. diff --git a/mathcomp/field/finfield.v b/mathcomp/field/finfield.v index 19871cb..efe5cea 100644 --- a/mathcomp/field/finfield.v +++ b/mathcomp/field/finfield.v @@ -568,7 +568,7 @@ End FinFieldExists. Section FinDomain. -Import ssrnum ssrint algC cyclotomic Num.Theory. +Import order ssrnum ssrint algC cyclotomic Order.Theory Num.Theory. Local Infix "%|" := dvdn. (* Hide polynomial divisibility. *) Variable R : finUnitRingType. @@ -625,18 +625,18 @@ without loss n_gt1: / (1 < n)%N by rewrite ltnNge; apply: wlog_neg. have [q_gt0 n_gt0] := (ltnW q_gt1, ltnW n_gt1). have [z z_prim] := C_prim_root_exists n_gt0. have zn1: z ^+ n = 1 by apply: prim_expr_order. -have /eqP-n1z: `|z| == 1. - by rewrite -(pexpr_eq1 n_gt0) ?normr_ge0 // -normrX zn1 normr1. -suffices /eqP/normC_sub_eq[t n1t [Dq Dz]]: `|q%:R - z| == `|q%:R| - `|z|. +have /eqP-n1z: `|z| == 1 by rewrite -(pexpr_eq1 n_gt0) // -normrX zn1 normr1. +suffices /eqP/normC_sub_eq[t n1t [Dq Dz]]: + `|q%:R - z : algC| == `|q%:R : algC| - `|z|. suffices z1: z == 1 by rewrite leq_eqVlt -dvdn1 (prim_order_dvd z_prim) z1. by rewrite Dz n1z mul1r -(eqr_pmuln2r q_gt0) Dq normr_nat mulr_natl. pose aq d : algC := (cyclotomic (z ^+ (n %/ d)) d).[q%:R]. suffices: `|aq n| <= (q - 1)%:R. - rewrite eqr_le ler_sub_dist andbT n1z normr_nat natrB //; apply: ler_trans. + rewrite eq_le ler_sub_dist andbT n1z normr_nat natrB //; apply: le_trans. rewrite {}/aq horner_prod divnn n_gt0 expr1 normr_prod. rewrite (bigD1 (Ordinal n_gt1)) ?coprime1n //= !hornerE ler_pemulr //. elim/big_ind: _ => // [|d _]; first exact: mulr_ege1. - rewrite !hornerE; apply: ler_trans (ler_sub_dist _ _). + rewrite !hornerE; apply: le_trans (ler_sub_dist _ _). by rewrite normr_nat normrX n1z expr1n ler_subr_addl (leC_nat 2). have Zaq d: d %| n -> aq d \in Cint. move/(dvdn_prim_root z_prim)=> zd_prim. diff --git a/mathcomp/ssreflect/all_ssreflect.v b/mathcomp/ssreflect/all_ssreflect.v index aae57ca..318d5ef 100644 --- a/mathcomp/ssreflect/all_ssreflect.v +++ b/mathcomp/ssreflect/all_ssreflect.v @@ -14,5 +14,6 @@ Require Export finfun. Require Export bigop. Require Export prime. Require Export finset. +Require Export order. Require Export binomial. Require Export generic_quotient. diff --git a/mathcomp/ssreflect/fintype.v b/mathcomp/ssreflect/fintype.v index b6f618d..5a42c80 100644 --- a/mathcomp/ssreflect/fintype.v +++ b/mathcomp/ssreflect/fintype.v @@ -1051,16 +1051,16 @@ End Extremum. Notation "[ 'arg[' ord ]_( i < i0 | P ) F ]" := (extremum ord i0 (fun i => P%B) (fun i => F)) (at level 0, ord, i, i0 at level 10, - format "[ 'arg[' ord ]_( i < i0 | P ) F ]") : form_scope. + format "[ 'arg[' ord ]_( i < i0 | P ) F ]") : nat_scope. Notation "[ 'arg[' ord ]_( i < i0 'in' A ) F ]" := [arg[ord]_(i < i0 | i \in A) F] (at level 0, ord, i, i0 at level 10, - format "[ 'arg[' ord ]_( i < i0 'in' A ) F ]") : form_scope. + format "[ 'arg[' ord ]_( i < i0 'in' A ) F ]") : nat_scope. Notation "[ 'arg[' ord ]_( i < i0 ) F ]" := [arg[ord]_(i < i0 | true) F] (at level 0, ord, i, i0 at level 10, - format "[ 'arg[' ord ]_( i < i0 ) F ]") : form_scope. + format "[ 'arg[' ord ]_( i < i0 ) F ]") : nat_scope. Section ArgMinMax. @@ -1086,30 +1086,30 @@ End Extrema. Notation "[ 'arg' 'min_' ( i < i0 | P ) F ]" := (arg_min i0 (fun i => P%B) (fun i => F)) (at level 0, i, i0 at level 10, - format "[ 'arg' 'min_' ( i < i0 | P ) F ]") : form_scope. + format "[ 'arg' 'min_' ( i < i0 | P ) F ]") : nat_scope. Notation "[ 'arg' 'min_' ( i < i0 'in' A ) F ]" := [arg min_(i < i0 | i \in A) F] (at level 0, i, i0 at level 10, - format "[ 'arg' 'min_' ( i < i0 'in' A ) F ]") : form_scope. + format "[ 'arg' 'min_' ( i < i0 'in' A ) F ]") : nat_scope. Notation "[ 'arg' 'min_' ( i < i0 ) F ]" := [arg min_(i < i0 | true) F] (at level 0, i, i0 at level 10, - format "[ 'arg' 'min_' ( i < i0 ) F ]") : form_scope. + format "[ 'arg' 'min_' ( i < i0 ) F ]") : nat_scope. Notation "[ 'arg' 'max_' ( i > i0 | P ) F ]" := (arg_max i0 (fun i => P%B) (fun i => F)) (at level 0, i, i0 at level 10, - format "[ 'arg' 'max_' ( i > i0 | P ) F ]") : form_scope. + format "[ 'arg' 'max_' ( i > i0 | P ) F ]") : nat_scope. Notation "[ 'arg' 'max_' ( i > i0 'in' A ) F ]" := [arg max_(i > i0 | i \in A) F] (at level 0, i, i0 at level 10, - format "[ 'arg' 'max_' ( i > i0 'in' A ) F ]") : form_scope. + format "[ 'arg' 'max_' ( i > i0 'in' A ) F ]") : nat_scope. Notation "[ 'arg' 'max_' ( i > i0 ) F ]" := [arg max_(i > i0 | true) F] (at level 0, i, i0 at level 10, - format "[ 'arg' 'max_' ( i > i0 ) F ]") : form_scope. + format "[ 'arg' 'max_' ( i > i0 ) F ]") : nat_scope. (**********************************************************************) (* *) diff --git a/mathcomp/ssreflect/order.v b/mathcomp/ssreflect/order.v index cd8d8d8..d6202c3 100644 --- a/mathcomp/ssreflect/order.v +++ b/mathcomp/ssreflect/order.v @@ -17,61 +17,103 @@ (* You should have received a copy of the GNU General Public License *) (* along with this program. If not, see . *) (*************************************************************************) - -From mathcomp -Require Import ssreflect ssrbool eqtype ssrfun ssrnat choice seq. -From mathcomp -Require Import fintype tuple bigop path finset. - -(*****************************************************************************) -(* This files definies a ordered and decidable relations on a *) -(* type as canonical structure. One need to import Order.Theory to get *) -(* the theory of such relations. The scope order_scope (%O) contains *) -(* fancier notation for this kind of ordeering. *) -(* *) -(* porderType == the type of partially ordered types *) -(* orderType == the type of totally ordered types *) -(* latticeType == the type of distributive lattices *) -(* blatticeType == ... with a bottom elemnt *) -(* tlatticeType == ... with a top element *) -(* tblatticeType == ... with both a top and a bottom *) -(* cblatticeType == ... with a complement to, and bottom *) -(* tcblatticeType == ... with a top, bottom, and general complement *) -(* *) -(* Each of these structure take a first argument named display, of type unit *) -(* instanciating it with tt or an unknown key will lead to a default display *) -(* Optionally, one can configure the display by setting one owns notation *) -(* on operators instanciated for their particular display *) -(* One example of this is the reverse display ^r, every notation with the *) -(* suffix ^r (e.g. x <=^r y) is about the reversal order, in order not to *) -(* confuse the normal order with its reversal. *) -(* *) -(* PorderType pord_mixin == builds an ordtype from a a partial order mixin *) -(* containing le, lt and refl, antisym, trans of le *) -(* LatticeType lat_mixin == builds a distributive lattice from a porderType *) -(* meet and join and axioms *) -(* OrderType le_total == builds an order type from a lattice *) -(* and from a proof of totality *) -(* ... *) -(* *) -(* We provide a canonical structure of orderType for natural numbers (nat) *) -(* for finType and for pairs of ordType by lexicographic orderering. *) -(* *) -(* leP ltP ltgtP are the three main lemmas for case analysis *) -(* *) -(* We also provide specialized version of some theorems from path.v. *) -(* *) -(* There are three distinct uses of the symbols <, <=, > and >=: *) -(* 0-ary, unary (prefix) and binary (infix). *) -(* 0. <%O, <=%O, >%O, >=%O stand respectively for lt, le, gt and ge. *) -(* 1. (< x), (<= x), (> x), (>= x) stand respectively for *) -(* (gt x), (ge x), (lt x), (le x). *) -(* So (< x) is a predicate characterizing elements smaller than x. *) -(* 2. (x < y), (x <= y), ... mean what they are expected to. *) -(* These convention are compatible with haskell's, *) -(* where ((< y) x) = (x < y) = ((<) x y), *) -(* except that we write <%O instead of (<). *) -(*****************************************************************************) +From mathcomp Require Import ssreflect ssrbool eqtype ssrfun ssrnat choice seq. +From mathcomp Require Import fintype tuple bigop path finset. + +(******************************************************************************) +(* This files definies a ordered and decidable relations on a type as *) +(* canonical structure. One need to import some of the following modules to *) +(* get the definitions, notations, and theory of such relations. *) +(* Order.Def: definitions of basic operations. *) +(* Order.Syntax: fancy notations for ordering declared in the order_scope *) +(* (%O). *) +(* Order.LTheory: theory of partially ordered types and lattices excluding *) +(* complement and totality related theorems. *) +(* Order.CTheory: theory of complemented lattices including Order.LTheory. *) +(* Order.TTheory: theory of totally ordered types including Order.LTheory. *) +(* Order.Theory: theory of ordered types including all of the above *) +(* theory modules. *) +(* *) +(* We provide the following structures of ordered types *) +(* porderType == the type of partially ordered types *) +(* orderType == the type of totally ordered types *) +(* latticeType == the type of distributive lattices *) +(* blatticeType == ... with a bottom elemnt *) +(* tblatticeType == ... with both a top and a bottom *) +(* cblatticeType == the type of sectionally complemented lattices *) +(* (lattices with a complement to, and bottom) *) +(* ctblatticeType == the type of complemented lattices *) +(* (lattices with a top, bottom, and general complement) *) +(* finPOerderType == the type of partially ordered finite types *) +(* finLatticeType == the type of nonempty finite lattices *) +(* finClatticeType == the type of nonempty finite complemented lattices *) +(* finOrderType == the type of nonempty totally ordered finite types *) +(* *) +(* Each of these structure take a first argument named display, of type unit *) +(* instanciating it with tt or an unknown key will lead to a default display. *) +(* Optionally, one can configure the display by setting one owns notation on *) +(* operators instanciated for their particular display. *) +(* One example of this is the converse display ^c, every notation with the *) +(* suffix ^c (e.g. x <=^c y) is about the converse order, in order not to *) +(* confuse the normal order with its converse. *) +(* *) +(* PorderType pord_mixin == builds a porderType from a partial order mixin *) +(* containing le, lt and refl, antisym, trans of le *) +(* LatticeType lat_mixin == builds a distributive lattice from a porderType *) +(* meet and join and axioms *) +(* OrderType le_total == builds an order type from a latticeType and from *) +(* a proof of totality *) +(* ... *) +(* *) +(* Over these structures, we have the following operations *) +(* x <= y <-> x is less than or equal to y. *) +(* x < y <-> x is less than y (:= (y != x) && (x <= y)). *) +(* x >= y <-> x is greater than or equal to y (:= y <= x). *) +(* x > y <-> x is greater than y (:= y < x). *) +(* x <= y ?= iff C <-> x is less than y, or equal iff C is true. *) +(* x >=< y <-> x and y are comparable (:= (x <= y) || (y <= x)). *) +(* x >< y <-> x and y are incomparable. *) +(* For lattices we provide the following operations *) +(* x `&` y == the meet of x and y. *) +(* x `|` y == the join of x and y. *) +(* 0 == the bottom element. *) +(* 1 == the top element. *) +(* x `\` y == the (sectional) complement of y in [0, x]. *) +(* ~` x == the complement of x in [0, 1]. *) +(* \meet_ e == iterated meet of a lattice with a top. *) +(* \join_ e == iterated join of a lattice with a bottom. *) +(* For orderType we provide the following operations *) +(* [arg minr_(i < i0 | P) M] == a value i : T minimizing M : R, subject to *) +(* the condition P (i may appear in P and M), and *) +(* provided P holds for i0. *) +(* [arg maxr_(i > i0 | P) M] == a value i maximizing M subject to P and *) +(* provided P holds for i0. *) +(* [arg min_(i < i0 in A) M] == an i \in A minimizing M if i0 \in A. *) +(* [arg max_(i > i0 in A) M] == an i \in A maximizing M if i0 \in A. *) +(* [arg min_(i < i0) M] == an i : T minimizing M, given i0 : T. *) +(* [arg max_(i > i0) M] == an i : T maximizing M, given i0 : T. *) +(* *) +(* There are three distinct uses of the symbols *) +(* <, <=, >, >=, _ <= _ ?= iff _, >=<, and ><: *) +(* 0-ary, unary (prefix), and binary (infix). *) +(* 0. <%O, <=%O, >%O, >=%O, =<%O, and ><%O stand respectively for *) +(* lt, le, gt, ge, leif (_ <= _ ?= iff _), comparable, and incomparable. *) +(* 1. (< x), (<= x), (> x), (>= x), (>=< x), and (>< x) stand respectively *) +(* for (>%O x), (>=%O x), (<%O x), (<=%O x), (>=<%O x), and (><%O x). *) +(* So (< x) is a predicate characterizing elements smaller than x. *) +(* 2. (x < y), (x <= y), ... mean what they are expected to. *) +(* These convention are compatible with Haskell's, *) +(* where ((< y) x) = (x < y) = ((<) x y), *) +(* except that we write <%O instead of (<). *) +(* *) +(* We provide the following canonical instances of ordered types *) +(* - porderType, latticeType, orderType, blatticeType of nat *) +(* - porderType of seq (lexicographic ordering) *) +(* *) +(* leP ltP ltgtP are the three main lemmas for case analysis. *) +(* *) +(* We also provide specialized version of some theorems from path.v. *) +(******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. @@ -95,37 +137,37 @@ Reserved Notation "x >< y" (at level 70, no associativity). Reserved Notation ">< x" (at level 35). Reserved Notation ">< y :> T" (at level 35, y at next level). -Reserved Notation "x <=^r y" (at level 70, y at next level). -Reserved Notation "x >=^r y" (at level 70, y at next level, only parsing). -Reserved Notation "x <^r y" (at level 70, y at next level). -Reserved Notation "x >^r y" (at level 70, y at next level, only parsing). -Reserved Notation "x <=^r y :> T" (at level 70, y at next level). -Reserved Notation "x >=^r y :> T" (at level 70, y at next level, only parsing). -Reserved Notation "x <^r y :> T" (at level 70, y at next level). -Reserved Notation "x >^r y :> T" (at level 70, y at next level, only parsing). -Reserved Notation "<=^r y" (at level 35). -Reserved Notation ">=^r y" (at level 35). -Reserved Notation "<^r y" (at level 35). -Reserved Notation ">^r y" (at level 35). -Reserved Notation "<=^r y :> T" (at level 35, y at next level). -Reserved Notation ">=^r y :> T" (at level 35, y at next level). -Reserved Notation "<^r y :> T" (at level 35, y at next level). -Reserved Notation ">^r y :> T" (at level 35, y at next level). -Reserved Notation "x >=<^r y" (at level 70, no associativity). -Reserved Notation ">=<^r x" (at level 35). -Reserved Notation ">=<^r y :> T" (at level 35, y at next level). -Reserved Notation "x ><^r y" (at level 70, no associativity). -Reserved Notation "><^r x" (at level 35). -Reserved Notation "><^r y :> T" (at level 35, y at next level). - -Reserved Notation "x <=^r y <=^r z" (at level 70, y, z at next level). -Reserved Notation "x <^r y <=^r z" (at level 70, y, z at next level). -Reserved Notation "x <=^r y <^r z" (at level 70, y, z at next level). -Reserved Notation "x <^r y <^r z" (at level 70, y, z at next level). -Reserved Notation "x <=^r y ?= 'iff' c" (at level 70, y, c at next level, - format "x '[hv' <=^r y '/' ?= 'iff' c ']'"). -Reserved Notation "x <=^r y ?= 'iff' c :> T" (at level 70, y, c at next level, - format "x '[hv' <=^r y '/' ?= 'iff' c :> T ']'"). +Reserved Notation "x <=^c y" (at level 70, y at next level). +Reserved Notation "x >=^c y" (at level 70, y at next level, only parsing). +Reserved Notation "x <^c y" (at level 70, y at next level). +Reserved Notation "x >^c y" (at level 70, y at next level, only parsing). +Reserved Notation "x <=^c y :> T" (at level 70, y at next level). +Reserved Notation "x >=^c y :> T" (at level 70, y at next level, only parsing). +Reserved Notation "x <^c y :> T" (at level 70, y at next level). +Reserved Notation "x >^c y :> T" (at level 70, y at next level, only parsing). +Reserved Notation "<=^c y" (at level 35). +Reserved Notation ">=^c y" (at level 35). +Reserved Notation "<^c y" (at level 35). +Reserved Notation ">^c y" (at level 35). +Reserved Notation "<=^c y :> T" (at level 35, y at next level). +Reserved Notation ">=^c y :> T" (at level 35, y at next level). +Reserved Notation "<^c y :> T" (at level 35, y at next level). +Reserved Notation ">^c y :> T" (at level 35, y at next level). +Reserved Notation "x >=<^c y" (at level 70, no associativity). +Reserved Notation ">=<^c x" (at level 35). +Reserved Notation ">=<^c y :> T" (at level 35, y at next level). +Reserved Notation "x ><^c y" (at level 70, no associativity). +Reserved Notation "><^c x" (at level 35). +Reserved Notation "><^c y :> T" (at level 35, y at next level). + +Reserved Notation "x <=^c y <=^c z" (at level 70, y, z at next level). +Reserved Notation "x <^c y <=^c z" (at level 70, y, z at next level). +Reserved Notation "x <=^c y <^c z" (at level 70, y, z at next level). +Reserved Notation "x <^c y <^c z" (at level 70, y, z at next level). +Reserved Notation "x <=^c y ?= 'iff' c" (at level 70, y, c at next level, + format "x '[hv' <=^c y '/' ?= 'iff' c ']'"). +Reserved Notation "x <=^c y ?= 'iff' c :> T" (at level 70, y, c at next level, + format "x '[hv' <=^c y '/' ?= 'iff' c :> T ']'"). (* Reserved notation for lattice operations. *) Reserved Notation "A `&` B" (at level 48, left associativity). @@ -133,11 +175,11 @@ Reserved Notation "A `|` B" (at level 52, left associativity). Reserved Notation "A `\` B" (at level 50, left associativity). Reserved Notation "~` A" (at level 35, right associativity). -(* Reserved notation for reverse lattice operations. *) -Reserved Notation "A `&^r` B" (at level 48, left associativity). -Reserved Notation "A `|^r` B" (at level 52, left associativity). -Reserved Notation "A `\^r` B" (at level 50, left associativity). -Reserved Notation "~^r` A" (at level 35, right associativity). +(* Reserved notation for converse lattice operations. *) +Reserved Notation "A `&^c` B" (at level 48, left associativity). +Reserved Notation "A `|^c` B" (at level 52, left associativity). +Reserved Notation "A `\^c` B" (at level 50, left associativity). +Reserved Notation "~^c` A" (at level 35, right associativity). Reserved Notation "\meet_ i F" (at level 41, F at level 41, i at level 0, @@ -213,82 +255,79 @@ Reserved Notation "\join_ ( i 'in' A ) F" (at level 41, F at level 41, i, A at level 50, format "'[' \join_ ( i 'in' A ) '/ ' F ']'"). -Reserved Notation "\meet^r_ i F" +Reserved Notation "\meet^c_ i F" (at level 41, F at level 41, i at level 0, - format "'[' \meet^r_ i '/ ' F ']'"). -Reserved Notation "\meet^r_ ( i <- r | P ) F" + format "'[' \meet^c_ i '/ ' F ']'"). +Reserved Notation "\meet^c_ ( i <- r | P ) F" (at level 41, F at level 41, i, r at level 50, - format "'[' \meet^r_ ( i <- r | P ) '/ ' F ']'"). -Reserved Notation "\meet^r_ ( i <- r ) F" + format "'[' \meet^c_ ( i <- r | P ) '/ ' F ']'"). +Reserved Notation "\meet^c_ ( i <- r ) F" (at level 41, F at level 41, i, r at level 50, - format "'[' \meet^r_ ( i <- r ) '/ ' F ']'"). -Reserved Notation "\meet^r_ ( m <= i < n | P ) F" + format "'[' \meet^c_ ( i <- r ) '/ ' F ']'"). +Reserved Notation "\meet^c_ ( m <= i < n | P ) F" (at level 41, F at level 41, i, m, n at level 50, - format "'[' \meet^r_ ( m <= i < n | P ) '/ ' F ']'"). -Reserved Notation "\meet^r_ ( m <= i < n ) F" + format "'[' \meet^c_ ( m <= i < n | P ) '/ ' F ']'"). +Reserved Notation "\meet^c_ ( m <= i < n ) F" (at level 41, F at level 41, i, m, n at level 50, - format "'[' \meet^r_ ( m <= i < n ) '/ ' F ']'"). -Reserved Notation "\meet^r_ ( i | P ) F" + format "'[' \meet^c_ ( m <= i < n ) '/ ' F ']'"). +Reserved Notation "\meet^c_ ( i | P ) F" (at level 41, F at level 41, i at level 50, - format "'[' \meet^r_ ( i | P ) '/ ' F ']'"). -Reserved Notation "\meet^r_ ( i : t | P ) F" + format "'[' \meet^c_ ( i | P ) '/ ' F ']'"). +Reserved Notation "\meet^c_ ( i : t | P ) F" (at level 41, F at level 41, i at level 50, only parsing). -Reserved Notation "\meet^r_ ( i : t ) F" +Reserved Notation "\meet^c_ ( i : t ) F" (at level 41, F at level 41, i at level 50, only parsing). -Reserved Notation "\meet^r_ ( i < n | P ) F" +Reserved Notation "\meet^c_ ( i < n | P ) F" (at level 41, F at level 41, i, n at level 50, - format "'[' \meet^r_ ( i < n | P ) '/ ' F ']'"). -Reserved Notation "\meet^r_ ( i < n ) F" + format "'[' \meet^c_ ( i < n | P ) '/ ' F ']'"). +Reserved Notation "\meet^c_ ( i < n ) F" (at level 41, F at level 41, i, n at level 50, - format "'[' \meet^r_ ( i < n ) F ']'"). -Reserved Notation "\meet^r_ ( i 'in' A | P ) F" + format "'[' \meet^c_ ( i < n ) F ']'"). +Reserved Notation "\meet^c_ ( i 'in' A | P ) F" (at level 41, F at level 41, i, A at level 50, - format "'[' \meet^r_ ( i 'in' A | P ) '/ ' F ']'"). -Reserved Notation "\meet^r_ ( i 'in' A ) F" + format "'[' \meet^c_ ( i 'in' A | P ) '/ ' F ']'"). +Reserved Notation "\meet^c_ ( i 'in' A ) F" (at level 41, F at level 41, i, A at level 50, - format "'[' \meet^r_ ( i 'in' A ) '/ ' F ']'"). + format "'[' \meet^c_ ( i 'in' A ) '/ ' F ']'"). -Reserved Notation "\join^r_ i F" +Reserved Notation "\join^c_ i F" (at level 41, F at level 41, i at level 0, - format "'[' \join^r_ i '/ ' F ']'"). -Reserved Notation "\join^r_ ( i <- r | P ) F" + format "'[' \join^c_ i '/ ' F ']'"). +Reserved Notation "\join^c_ ( i <- r | P ) F" (at level 41, F at level 41, i, r at level 50, - format "'[' \join^r_ ( i <- r | P ) '/ ' F ']'"). -Reserved Notation "\join^r_ ( i <- r ) F" + format "'[' \join^c_ ( i <- r | P ) '/ ' F ']'"). +Reserved Notation "\join^c_ ( i <- r ) F" (at level 41, F at level 41, i, r at level 50, - format "'[' \join^r_ ( i <- r ) '/ ' F ']'"). -Reserved Notation "\join^r_ ( m <= i < n | P ) F" + format "'[' \join^c_ ( i <- r ) '/ ' F ']'"). +Reserved Notation "\join^c_ ( m <= i < n | P ) F" (at level 41, F at level 41, i, m, n at level 50, - format "'[' \join^r_ ( m <= i < n | P ) '/ ' F ']'"). -Reserved Notation "\join^r_ ( m <= i < n ) F" + format "'[' \join^c_ ( m <= i < n | P ) '/ ' F ']'"). +Reserved Notation "\join^c_ ( m <= i < n ) F" (at level 41, F at level 41, i, m, n at level 50, - format "'[' \join^r_ ( m <= i < n ) '/ ' F ']'"). -Reserved Notation "\join^r_ ( i | P ) F" + format "'[' \join^c_ ( m <= i < n ) '/ ' F ']'"). +Reserved Notation "\join^c_ ( i | P ) F" (at level 41, F at level 41, i at level 50, - format "'[' \join^r_ ( i | P ) '/ ' F ']'"). -Reserved Notation "\join^r_ ( i : t | P ) F" + format "'[' \join^c_ ( i | P ) '/ ' F ']'"). +Reserved Notation "\join^c_ ( i : t | P ) F" (at level 41, F at level 41, i at level 50, only parsing). -Reserved Notation "\join^r_ ( i : t ) F" +Reserved Notation "\join^c_ ( i : t ) F" (at level 41, F at level 41, i at level 50, only parsing). -Reserved Notation "\join^r_ ( i < n | P ) F" +Reserved Notation "\join^c_ ( i < n | P ) F" (at level 41, F at level 41, i, n at level 50, - format "'[' \join^r_ ( i < n | P ) '/ ' F ']'"). -Reserved Notation "\join^r_ ( i < n ) F" + format "'[' \join^c_ ( i < n | P ) '/ ' F ']'"). +Reserved Notation "\join^c_ ( i < n ) F" (at level 41, F at level 41, i, n at level 50, - format "'[' \join^r_ ( i < n ) F ']'"). -Reserved Notation "\join^r_ ( i 'in' A | P ) F" + format "'[' \join^c_ ( i < n ) F ']'"). +Reserved Notation "\join^c_ ( i 'in' A | P ) F" (at level 41, F at level 41, i, A at level 50, - format "'[' \join^r_ ( i 'in' A | P ) '/ ' F ']'"). -Reserved Notation "\join^r_ ( i 'in' A ) F" + format "'[' \join^c_ ( i 'in' A | P ) '/ ' F ']'"). +Reserved Notation "\join^c_ ( i 'in' A ) F" (at level 41, F at level 41, i, A at level 50, - format "'[' \join^r_ ( i 'in' A ) '/ ' F ']'"). - -Fact unit_irrelevance (x y : unit) : x = y. -Proof. by case: x; case: y. Qed. + format "'[' \join^c_ ( i 'in' A ) '/ ' F ']'"). Module Order. @@ -298,10 +337,10 @@ Module Order. Module POrder. Section ClassDef. -Structure mixin_of (T : eqType) := Mixin { +Record mixin_of (T : eqType) := Mixin { le : rel T; lt : rel T; - _ : forall x y, lt x y = (x != y) && (le x y); + _ : forall x y, lt x y = (y != x) && (le x y); _ : reflexive le; _ : antisymmetric le; _ : transitive le @@ -321,54 +360,53 @@ Local Coercion sort : type >-> Sortclass. Variables (T : Type) (disp : unit) (cT : type disp). Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. -Definition clone disp' c of (disp = disp') & phant_id class c := - @Pack disp' T c. +Definition clone c of phant_id class c := @Pack disp T c. +Definition clone_with disp' c of phant_id class c := @Pack disp' T c. Let xT := let: Pack T _ := cT in T. Notation xclass := (class : class_of xT). -Definition pack disp := - fun b bT & phant_id (Choice.class bT) b => +Definition pack := + fun bT b & phant_id (Choice.class bT) b => fun m => Pack disp (@Class T b m). Definition eqType := @Equality.Pack cT xclass. Definition choiceType := @Choice.Pack cT xclass. End ClassDef. -Module Import Exports. -Coercion base : class_of >-> Choice.class_of. -Coercion mixin : class_of >-> mixin_of. -Coercion sort : type >-> Sortclass. +Module Exports. +Coercion base : class_of >-> Choice.class_of. +Coercion mixin : class_of >-> mixin_of. +Coercion sort : type >-> Sortclass. Coercion eqType : type >-> Equality.type. Coercion choiceType : type >-> Choice.type. - Canonical eqType. Canonical choiceType. - Notation porderType := type. Notation porderMixin := mixin_of. Notation POrderMixin := Mixin. Notation POrderType disp T m := (@pack T disp _ _ id m). - -Notation "[ 'porderType' 'of' T 'for' cT ]" := (@clone T _ cT _ _ erefl id) +Notation "[ 'porderType' 'of' T 'for' cT ]" := (@clone T _ cT _ id) (at level 0, format "[ 'porderType' 'of' T 'for' cT ]") : form_scope. Notation "[ 'porderType' 'of' T 'for' cT 'with' disp ]" := - (@clone T _ cT disp _ (unit_irrelevance _ _) id) - (at level 0, format "[ 'porderType' 'of' T 'for' cT 'with' disp ]") : form_scope. + (@clone_with T _ cT disp _ id) + (at level 0, format "[ 'porderType' 'of' T 'for' cT 'with' disp ]") : + form_scope. Notation "[ 'porderType' 'of' T ]" := [porderType of T for _] (at level 0, format "[ 'porderType' 'of' T ]") : form_scope. -Notation "[ 'porderType' 'of' T 'with' disp ]" := [porderType of T for _ with disp] +Notation "[ 'porderType' 'of' T 'with' disp ]" := + [porderType of T for _ with disp] (at level 0, format "[ 'porderType' 'of' T 'with' disp ]") : form_scope. End Exports. -End POrder. +End POrder. Import POrder.Exports. Bind Scope cpo_sort with POrder.sort. Module Import POrderDef. Section Def. -Variable (display : unit). -Local Notation porderType := (porderType display). +Variable (disp : unit). +Local Notation porderType := (porderType disp). Variable (T : porderType). Definition le (R : porderType) : rel R := POrder.le (POrder.class R). @@ -388,15 +426,15 @@ Definition leif (x y : T) C : Prop := ((x <= y) * ((x == y) = C))%type. Definition le_of_leif x y C (le_xy : @leif x y C) := le_xy.1 : le x y. -CoInductive le_xor_gt (x y : T) : bool -> bool -> Set := +Variant le_xor_gt (x y : T) : bool -> bool -> Set := | LerNotGt of x <= y : le_xor_gt x y true false | GtrNotLe of y < x : le_xor_gt x y false true. -CoInductive lt_xor_ge (x y : T) : bool -> bool -> Set := +Variant lt_xor_ge (x y : T) : bool -> bool -> Set := | LtrNotGe of x < y : lt_xor_ge x y false true | GerNotLt of y <= x : lt_xor_ge x y true false. -CoInductive comparer (x y : T) : +Variant comparer (x y : T) : bool -> bool -> bool -> bool -> bool -> bool -> Set := | ComparerEq of x = y : comparer x y true true true true false false @@ -405,7 +443,7 @@ CoInductive comparer (x y : T) : | ComparerGt of y < x : comparer x y false false false true false true. -CoInductive incomparer (x y : T) : +Variant incomparer (x y : T) : bool -> bool -> bool -> bool -> bool -> bool -> bool -> bool -> Set := | InComparerEq of x = y : incomparer x y true true true true false false true true @@ -462,7 +500,7 @@ Notation "x <= y < z" := ((x <= y) && (y < z)) : order_scope. Notation "x < y < z" := ((x < y) && (y < z)) : order_scope. Notation "x <= y ?= 'iff' C" := (leif x y C) : order_scope. -Notation "x <= y ?= 'iff' C :> R" := ((x : R) <= (y : R) ?= iff C) +Notation "x <= y ?= 'iff' C :> T" := ((x : T) <= (y : T) ?= iff C) (only parsing) : order_scope. Notation ">=< x" := (comparable x) : order_scope. @@ -473,14 +511,16 @@ Notation ">< x" := (fun y => ~~ (comparable x y)) : order_scope. Notation ">< x :> T" := (>< (x : T)) (only parsing) : order_scope. Notation "x >< y" := (~~ (comparable x y)) : order_scope. -Coercion le_of_leif : leif >-> is_true. - End POSyntax. +Module POCoercions. +Coercion le_of_leif : leif >-> is_true. +End POCoercions. + Module Lattice. Section ClassDef. -Structure mixin_of d (T : porderType d) := Mixin { +Record mixin_of d (T : porderType d) := Mixin { meet : T -> T -> T; join : T -> T -> T; _ : commutative meet; @@ -493,72 +533,103 @@ Structure mixin_of d (T : porderType d) := Mixin { _ : left_distributive meet join; }. -Record class_of d (T : Type) := Class { +Record class_of (T : Type) := Class { base : POrder.class_of T; - mixin : mixin_of (POrder.Pack d base) + mixin_disp : unit; + mixin : mixin_of (POrder.Pack mixin_disp base) }. Local Coercion base : class_of >-> POrder.class_of. -Structure type (display : unit) := - Pack { sort; _ : class_of display sort }. +Structure type (disp : unit) := Pack { sort; _ : class_of sort }. Local Coercion sort : type >-> Sortclass. Variables (T : Type) (disp : unit) (cT : type disp). -Definition class := let: Pack _ c as cT' := cT return class_of _ cT' in c. -Definition clone disp' c of (disp = disp') & phant_id class c := - @Pack disp' T c. +Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. +Definition clone c of phant_id class c := @Pack disp T c. +Definition clone_with disp' c of phant_id class c := @Pack disp' T c. Let xT := let: Pack T _ := cT in T. -Notation xclass := (class : class_of _ xT). +Notation xclass := (class : class_of xT). Definition pack b0 (m0 : mixin_of (@POrder.Pack disp T b0)) := fun bT b & phant_id (@POrder.class disp bT) b => - fun m & phant_id m0 m => Pack (@Class disp T b m). + fun disp' m & phant_id m0 m => Pack disp (@Class T b disp' m). Definition eqType := @Equality.Pack cT xclass. Definition choiceType := @Choice.Pack cT xclass. Definition porderType := @POrder.Pack disp cT xclass. End ClassDef. -Module Import Exports. -Coercion base : class_of >-> POrder.class_of. -Coercion mixin : class_of >-> mixin_of. -Coercion sort : type >-> Sortclass. -Coercion eqType : type >-> Equality.type. +Module Exports. +Coercion base : class_of >-> POrder.class_of. +Coercion mixin : class_of >-> mixin_of. +Coercion sort : type >-> Sortclass. +Coercion eqType : type >-> Equality.type. Coercion choiceType : type >-> Choice.type. Coercion porderType : type >-> POrder.type. - Canonical eqType. Canonical choiceType. Canonical porderType. - Notation latticeType := type. Notation latticeMixin := mixin_of. Notation LatticeMixin := Mixin. -Notation LatticeType T m := (@pack T _ _ m _ _ id _ id). - -Notation "[ 'latticeType' 'of' T 'for' cT ]" := (@clone T _ cT _ _ erefl id) +Notation LatticeType T m := (@pack T _ _ m _ _ id _ _ id). +Notation "[ 'latticeType' 'of' T 'for' cT ]" := (@clone T _ cT _ id) (at level 0, format "[ 'latticeType' 'of' T 'for' cT ]") : form_scope. Notation "[ 'latticeType' 'of' T 'for' cT 'with' disp ]" := - (@clone T _ cT disp _ (unit_irrelevance _ _) id) - (at level 0, format "[ 'latticeType' 'of' T 'for' cT 'with' disp ]") : form_scope. + (@clone_with T _ cT disp _ id) + (at level 0, format "[ 'latticeType' 'of' T 'for' cT 'with' disp ]") : + form_scope. Notation "[ 'latticeType' 'of' T ]" := [latticeType of T for _] (at level 0, format "[ 'latticeType' 'of' T ]") : form_scope. -Notation "[ 'latticeType' 'of' T 'with' disp ]" := [latticeType of T for _ with disp] +Notation "[ 'latticeType' 'of' T 'with' disp ]" := + [latticeType of T for _ with disp] (at level 0, format "[ 'latticeType' 'of' T 'with' disp ]") : form_scope. End Exports. -End Lattice. +End Lattice. Export Lattice.Exports. Module Import LatticeDef. Section LatticeDef. -Context {display : unit}. -Local Notation latticeType := (latticeType display). -Definition meet {T : latticeType} : T -> T -> T := Lattice.meet (Lattice.class T). -Definition join {T : latticeType} : T -> T -> T := Lattice.join (Lattice.class T). +Context {disp : unit}. +Local Notation latticeType := (latticeType disp). +Context {T : latticeType}. +Definition meet : T -> T -> T := Lattice.meet (Lattice.class T). +Definition join : T -> T -> T := Lattice.join (Lattice.class T). + +Variant le_xor_gt (x y : T) : bool -> bool -> T -> T -> T -> T -> Set := + | LerNotGt of x <= y : le_xor_gt x y true false x x y y + | GtrNotLe of y < x : le_xor_gt x y false true y y x x. + +Variant lt_xor_ge (x y : T) : bool -> bool -> T -> T -> T -> T -> Set := + | LtrNotGe of x < y : lt_xor_ge x y false true x x y y + | GerNotLt of y <= x : lt_xor_ge x y true false y y x x. + +Variant comparer (x y : T) : + bool -> bool -> bool -> bool -> bool -> bool -> T -> T -> T -> T -> Set := + | ComparerEq of x = y : comparer x y + true true true true false false x x x x + | ComparerLt of x < y : comparer x y + false false true false true false x x y y + | ComparerGt of y < x : comparer x y + false false false true false true y y x x. + +Variant incomparer (x y : T) : + bool -> bool -> bool -> bool -> bool -> bool -> bool -> bool -> + T -> T -> T -> T -> Set := + | InComparerEq of x = y : incomparer x y + true true true true false false true true x x x x + | InComparerLt of x < y : incomparer x y + false false true false true false true true x x y y + | InComparerGt of y < x : incomparer x y + false false false true false true true true y y x x + | InComparer of x >< y : incomparer x y + false false false false false false false false + (meet x y) (meet x y) (join x y) (join x y). + End LatticeDef. End LatticeDef. @@ -570,31 +641,32 @@ Notation "x `|` y" := (join x y). End LatticeSyntax. Module Total. +Definition mixin_of d (T : latticeType d) := (total (<=%O : rel T)). Section ClassDef. -Local Notation mixin_of T := (total (<=%O : rel T)). -Record class_of d (T : Type) := Class { - base : Lattice.class_of d T; - mixin : total (<=%O : rel (POrder.Pack d base)) +Record class_of (T : Type) := Class { + base : Lattice.class_of T; + mixin_disp : unit; + mixin : mixin_of (Lattice.Pack mixin_disp base) }. Local Coercion base : class_of >-> Lattice.class_of. -Structure type d := Pack { sort; _ : class_of d sort }. +Structure type (d : unit) := Pack { sort; _ : class_of sort }. Local Coercion sort : type >-> Sortclass. Variables (T : Type) (disp : unit) (cT : type disp). -Definition class := let: Pack _ c as cT' := cT return class_of _ cT' in c. -Definition clone disp' c of (disp = disp') & phant_id class c := - @Pack disp' T c. +Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. +Definition clone disp' c & phant_id class c := @Pack disp' T c. +Definition clone_with disp' c & phant_id class c := @Pack disp' T c. Let xT := let: Pack T _ := cT in T. -Notation xclass := (class : class_of _ xT). +Notation xclass := (class : class_of xT). Definition pack b0 (m0 : mixin_of (@Lattice.Pack disp T b0)) := fun bT b & phant_id (@Lattice.class disp bT) b => - fun m & phant_id m0 m => Pack (@Class disp T b m). + fun disp' m & phant_id m0 m => Pack disp (@Class T b disp' m). Definition eqType := @Equality.Pack cT xclass. Definition choiceType := @Choice.Pack cT xclass. @@ -603,66 +675,140 @@ Definition latticeType := @Lattice.Pack disp cT xclass. End ClassDef. -Module Import Exports. -Coercion base : class_of >-> Lattice.class_of. -Coercion sort : type >-> Sortclass. -Coercion eqType : type >-> Equality.type. +Module Exports. +Coercion base : class_of >-> Lattice.class_of. +Coercion sort : type >-> Sortclass. +Coercion eqType : type >-> Equality.type. Coercion choiceType : type >-> Choice.type. Coercion porderType : type >-> POrder.type. Coercion latticeType : type >-> Lattice.type. - Canonical eqType. Canonical choiceType. Canonical porderType. Canonical latticeType. - Notation orderType := type. -Notation OrderType T m := (@pack T _ _ m _ _ id _ id). - -Notation "[ 'orderType' 'of' T 'for' cT ]" := (@clone T _ cT _ _ erefl id) +Notation OrderType T m := (@pack T _ _ m _ _ id _ _ id). +Notation "[ 'orderType' 'of' T 'for' cT ]" := (@clone T _ cT _ _ id) (at level 0, format "[ 'orderType' 'of' T 'for' cT ]") : form_scope. Notation "[ 'orderType' 'of' T 'for' cT 'with' disp ]" := - (@clone T _ cT disp _ (unit_irrelevance _ _) id) - (at level 0, format "[ 'orderType' 'of' T 'for' cT 'with' disp ]") : form_scope. + (@clone_with T _ cT disp _ id) + (at level 0, format "[ 'orderType' 'of' T 'for' cT 'with' disp ]") : + form_scope. Notation "[ 'orderType' 'of' T ]" := [orderType of T for _] (at level 0, format "[ 'orderType' 'of' T ]") : form_scope. -Notation "[ 'orderType' 'of' T 'with' disp ]" := [orderType of T for _ with disp] +Notation "[ 'orderType' 'of' T 'with' disp ]" := + [orderType of T for _ with disp] (at level 0, format "[ 'orderType' 'of' T 'with' disp ]") : form_scope. - End Exports. -End Total. +End Total. Import Total.Exports. +Module Import TotalDef. +Section TotalDef. +Context {disp : unit} {T : orderType disp} {I : finType}. +Definition arg_min := @extremum T I <=%O. +Definition arg_max := @extremum T I >=%O. +End TotalDef. +End TotalDef. + +Module Import TotalSyntax. + +Fact total_display : unit. Proof. exact: tt. Qed. + +Notation max := (@join total_display _). +Notation "@ 'max' R" := + (@join total_display R) (at level 10, R at level 8, only parsing). +Notation min := (@meet total_display _). +Notation "@ 'min' R" := + (@meet total_display R) (at level 10, R at level 8, only parsing). + +Notation "\max_ ( i <- r | P ) F" := + (\big[@join total_display _/0%O]_(i <- r | P%B) F%O) : order_scope. +Notation "\max_ ( i <- r ) F" := + (\big[@join total_display _/0%O]_(i <- r) F%O) : order_scope. +Notation "\max_ ( i | P ) F" := + (\big[@join total_display _/0%O]_(i | P%B) F%O) : order_scope. +Notation "\max_ i F" := + (\big[@join total_display _/0%O]_i F%O) : order_scope. +Notation "\max_ ( i : I | P ) F" := + (\big[@join total_display _/0%O]_(i : I | P%B) F%O) (only parsing) : + order_scope. +Notation "\max_ ( i : I ) F" := + (\big[@join total_display _/0%O]_(i : I) F%O) (only parsing) : order_scope. +Notation "\max_ ( m <= i < n | P ) F" := + (\big[@join total_display _/0%O]_(m <= i < n | P%B) F%O) : order_scope. +Notation "\max_ ( m <= i < n ) F" := + (\big[@join total_display _/0%O]_(m <= i < n) F%O) : order_scope. +Notation "\max_ ( i < n | P ) F" := + (\big[@join total_display _/0%O]_(i < n | P%B) F%O) : order_scope. +Notation "\max_ ( i < n ) F" := + (\big[@join total_display _/0%O]_(i < n) F%O) : order_scope. +Notation "\max_ ( i 'in' A | P ) F" := + (\big[@join total_display _/0%O]_(i in A | P%B) F%O) : order_scope. +Notation "\max_ ( i 'in' A ) F" := + (\big[@join total_display _/0%O]_(i in A) F%O) : order_scope. + +Notation "[ 'arg' 'min_' ( i < i0 | P ) F ]" := + (arg_min i0 (fun i => P%B) (fun i => F)) + (at level 0, i, i0 at level 10, + format "[ 'arg' 'min_' ( i < i0 | P ) F ]") : order_scope. + +Notation "[ 'arg' 'min_' ( i < i0 'in' A ) F ]" := + [arg min_(i < i0 | i \in A) F] + (at level 0, i, i0 at level 10, + format "[ 'arg' 'min_' ( i < i0 'in' A ) F ]") : order_scope. + +Notation "[ 'arg' 'min_' ( i < i0 ) F ]" := [arg min_(i < i0 | true) F] + (at level 0, i, i0 at level 10, + format "[ 'arg' 'min_' ( i < i0 ) F ]") : order_scope. + +Notation "[ 'arg' 'max_' ( i > i0 | P ) F ]" := + (arg_max i0 (fun i => P%B) (fun i => F)) + (at level 0, i, i0 at level 10, + format "[ 'arg' 'max_' ( i > i0 | P ) F ]") : order_scope. + +Notation "[ 'arg' 'max_' ( i > i0 'in' A ) F ]" := + [arg max_(i > i0 | i \in A) F] + (at level 0, i, i0 at level 10, + format "[ 'arg' 'max_' ( i > i0 'in' A ) F ]") : order_scope. + +Notation "[ 'arg' 'max_' ( i > i0 ) F ]" := [arg max_(i > i0 | true) F] + (at level 0, i, i0 at level 10, + format "[ 'arg' 'max_' ( i > i0 ) F ]") : order_scope. + +End TotalSyntax. + Module BLattice. Section ClassDef. -Structure mixin_of d (T : porderType d) := Mixin { +Record mixin_of d (T : porderType d) := Mixin { bottom : T; _ : forall x, bottom <= x; }. -Record class_of d (T : Type) := Class { - base : Lattice.class_of d T; - mixin : mixin_of (POrder.Pack d base) +Record class_of (T : Type) := Class { + base : Lattice.class_of T; + mixin_disp : unit; + mixin : mixin_of (POrder.Pack mixin_disp base) }. Local Coercion base : class_of >-> Lattice.class_of. -Structure type d := Pack { sort; _ : class_of d sort}. +Structure type (d : unit) := Pack { sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Variables (T : Type) (disp : unit) (cT : type disp). -Definition class := let: Pack _ c as cT' := cT return class_of _ cT' in c. -Definition clone disp' c of (disp = disp') & phant_id class c := - @Pack disp' T c. +Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. +Definition clone c of phant_id class c := @Pack disp T c. +Definition clone_with disp' c of phant_id class c := @Pack disp' T c. Let xT := let: Pack T _ := cT in T. -Notation xclass := (class : class_of _ xT). +Notation xclass := (class : class_of xT). Definition pack b0 (m0 : mixin_of (@Lattice.Pack disp T b0)) := fun bT b & phant_id (@Lattice.class disp bT) b => - fun m & phant_id m0 m => Pack (@Class disp T b m). + fun disp' m & phant_id m0 m => Pack disp (@Class T b disp' m). Definition eqType := @Equality.Pack cT xclass. Definition choiceType := @Choice.Pack cT xclass. @@ -670,37 +816,36 @@ Definition porderType := @POrder.Pack disp cT xclass. Definition latticeType := @Lattice.Pack disp cT xclass. End ClassDef. -Module Import Exports. -Coercion base : class_of >-> Lattice.class_of. -Coercion mixin : class_of >-> mixin_of. -Coercion sort : type >-> Sortclass. -Coercion eqType : type >-> Equality.type. +Module Exports. +Coercion base : class_of >-> Lattice.class_of. +Coercion mixin : class_of >-> mixin_of. +Coercion sort : type >-> Sortclass. +Coercion eqType : type >-> Equality.type. Coercion choiceType : type >-> Choice.type. Coercion porderType : type >-> POrder.type. Coercion latticeType : type >-> Lattice.type. - Canonical eqType. Canonical choiceType. Canonical porderType. Canonical latticeType. - Notation blatticeType := type. Notation blatticeMixin := mixin_of. Notation BLatticeMixin := Mixin. -Notation BLatticeType T m := (@pack T _ _ m _ _ id _ id). - -Notation "[ 'blatticeType' 'of' T 'for' cT ]" := (@clone T _ cT _ _ erefl id) +Notation BLatticeType T m := (@pack T _ _ m _ _ id _ _ id). +Notation "[ 'blatticeType' 'of' T 'for' cT ]" := (@clone T _ cT _ id) (at level 0, format "[ 'blatticeType' 'of' T 'for' cT ]") : form_scope. Notation "[ 'blatticeType' 'of' T 'for' cT 'with' disp ]" := - (@clone T _ cT disp _ (unit_irrelevance _ _) id) - (at level 0, format "[ 'blatticeType' 'of' T 'for' cT 'with' disp ]") : form_scope. + (@clone_with T _ cT disp _ id) + (at level 0, format "[ 'blatticeType' 'of' T 'for' cT 'with' disp ]") : + form_scope. Notation "[ 'blatticeType' 'of' T ]" := [blatticeType of T for _] (at level 0, format "[ 'blatticeType' 'of' T ]") : form_scope. -Notation "[ 'blatticeType' 'of' T 'with' disp ]" := [blatticeType of T for _ with disp] +Notation "[ 'blatticeType' 'of' T 'with' disp ]" := + [blatticeType of T for _ with disp] (at level 0, format "[ 'blatticeType' 'of' T 'with' disp ]") : form_scope. End Exports. -End BLattice. +End BLattice. Export BLattice.Exports. Module Import BLatticeDef. @@ -724,49 +869,50 @@ Notation "\join_ ( i : I | P ) F" := Notation "\join_ ( i : I ) F" := (\big[@join _ _/0%O]_(i : I) F%O) (only parsing) : order_scope. Notation "\join_ ( m <= i < n | P ) F" := - (\big[@join _ _/0%O]_(m <= i < n | P%B) F%O) : order_scope. + (\big[@join _ _/0%O]_(m <= i < n | P%B) F%O) : order_scope. Notation "\join_ ( m <= i < n ) F" := - (\big[@join _ _/0%O]_(m <= i < n) F%O) : order_scope. + (\big[@join _ _/0%O]_(m <= i < n) F%O) : order_scope. Notation "\join_ ( i < n | P ) F" := - (\big[@join _ _/0%O]_(i < n | P%B) F%O) : order_scope. + (\big[@join _ _/0%O]_(i < n | P%B) F%O) : order_scope. Notation "\join_ ( i < n ) F" := - (\big[@join _ _/0%O]_(i < n) F%O) : order_scope. + (\big[@join _ _/0%O]_(i < n) F%O) : order_scope. Notation "\join_ ( i 'in' A | P ) F" := - (\big[@join _ _/0%O]_(i in A | P%B) F%O) : order_scope. + (\big[@join _ _/0%O]_(i in A | P%B) F%O) : order_scope. Notation "\join_ ( i 'in' A ) F" := - (\big[@join _ _/0%O]_(i in A) F%O) : order_scope. + (\big[@join _ _/0%O]_(i in A) F%O) : order_scope. End BLatticeSyntax. Module TBLattice. Section ClassDef. -Structure mixin_of d (T : porderType d) := Mixin { +Record mixin_of d (T : porderType d) := Mixin { top : T; _ : forall x, x <= top; }. -Record class_of d (T : Type) := Class { - base : BLattice.class_of d T; - mixin : mixin_of (POrder.Pack d base) +Record class_of (T : Type) := Class { + base : BLattice.class_of T; + mixin_disp : unit; + mixin : mixin_of (POrder.Pack mixin_disp base) }. Local Coercion base : class_of >-> BLattice.class_of. -Structure type d := Pack { sort; _ : class_of d sort }. +Structure type (d : unit) := Pack { sort; _ : class_of sort }. Local Coercion sort : type >-> Sortclass. Variables (T : Type) (disp : unit) (cT : type disp). -Definition class := let: Pack _ c as cT' := cT return class_of _ cT' in c. -Definition clone disp' c of (disp = disp') & phant_id class c := - @Pack disp' T c. +Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. +Definition clone c of phant_id class c := @Pack disp T c. +Definition clone_with disp' c of phant_id class c := @Pack disp' T c. Let xT := let: Pack T _ := cT in T. -Notation xclass := (class : class_of _ xT). +Notation xclass := (class : class_of xT). Definition pack b0 (m0 : mixin_of (@BLattice.Pack disp T b0)) := fun bT b & phant_id (@BLattice.class disp bT) b => - fun m & phant_id m0 m => Pack (@Class disp T b m). + fun disp' m & phant_id m0 m => Pack disp (@Class T b disp' m). Definition eqType := @Equality.Pack cT xclass. Definition choiceType := @Choice.Pack cT xclass. @@ -775,39 +921,37 @@ Definition latticeType := @Lattice.Pack disp cT xclass. Definition blatticeType := @BLattice.Pack disp cT xclass. End ClassDef. -Module Import Exports. -Coercion base : class_of >-> BLattice.class_of. -Coercion mixin : class_of >-> mixin_of. -Coercion sort : type >-> Sortclass. -Coercion eqType : type >-> Equality.type. +Module Exports. +Coercion base : class_of >-> BLattice.class_of. +Coercion mixin : class_of >-> mixin_of. +Coercion sort : type >-> Sortclass. +Coercion eqType : type >-> Equality.type. Coercion porderType : type >-> POrder.type. Coercion latticeType : type >-> Lattice.type. Coercion blatticeType : type >-> BLattice.type. - Canonical eqType. Canonical choiceType. Canonical porderType. Canonical latticeType. Canonical blatticeType. - Notation tblatticeType := type. Notation tblatticeMixin := mixin_of. Notation TBLatticeMixin := Mixin. -Notation TBLatticeType T m := (@pack T _ _ m _ _ id _ id). - -Notation "[ 'tblatticeType' 'of' T 'for' cT ]" := (@clone T _ cT _ _ erefl id) +Notation TBLatticeType T m := (@pack T _ _ m _ _ id _ _ id). +Notation "[ 'tblatticeType' 'of' T 'for' cT ]" := (@clone T _ cT _ id) (at level 0, format "[ 'tblatticeType' 'of' T 'for' cT ]") : form_scope. Notation "[ 'tblatticeType' 'of' T 'for' cT 'with' disp ]" := - (@clone T _ cT disp _ (unit_irrelevance _ _) id) - (at level 0, format "[ 'tblatticeType' 'of' T 'for' cT 'with' disp ]") : form_scope. + (@clone_with T _ cT disp _ id) + (at level 0, format "[ 'tblatticeType' 'of' T 'for' cT 'with' disp ]") : + form_scope. Notation "[ 'tblatticeType' 'of' T ]" := [tblatticeType of T for _] (at level 0, format "[ 'tblatticeType' 'of' T ]") : form_scope. -Notation "[ 'tblatticeType' 'of' T 'with' disp ]" := [tblatticeType of T for _ with disp] +Notation "[ 'tblatticeType' 'of' T 'with' disp ]" := + [tblatticeType of T for _ with disp] (at level 0, format "[ 'tblatticeType' 'of' T 'with' disp ]") : form_scope. - End Exports. -End TBLattice. +End TBLattice. Export TBLattice.Exports. Module Import TBLatticeDef. @@ -848,34 +992,35 @@ End TBLatticeSyntax. Module CBLattice. Section ClassDef. -Structure mixin_of d (T : blatticeType d) := Mixin { +Record mixin_of d (T : blatticeType d) := Mixin { sub : T -> T -> T; _ : forall x y, y `&` sub x y = bottom; _ : forall x y, (x `&` y) `|` sub x y = x }. -Record class_of d (T : Type) := Class { - base : BLattice.class_of d T; - mixin : mixin_of (BLattice.Pack base) +Record class_of (T : Type) := Class { + base : BLattice.class_of T; + mixin_disp : unit; + mixin : mixin_of (BLattice.Pack mixin_disp base) }. Local Coercion base : class_of >-> BLattice.class_of. -Structure type d := Pack { sort; _ : class_of d sort }. +Structure type (d : unit) := Pack { sort; _ : class_of sort }. Local Coercion sort : type >-> Sortclass. Variables (T : Type) (disp : unit) (cT : type disp). -Definition class := let: Pack _ c as cT' := cT return class_of _ cT' in c. -Definition clone disp' c of (disp = disp') & phant_id class c := - @Pack disp' T c. +Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. +Definition clone c of phant_id class c := @Pack disp T c. +Definition clone_with disp' c of phant_id class c := @Pack disp' T c. Let xT := let: Pack T _ := cT in T. -Notation xclass := (class : class_of _ xT). +Notation xclass := (class : class_of xT). Definition pack b0 (m0 : mixin_of (@BLattice.Pack disp T b0)) := fun bT b & phant_id (@BLattice.class disp bT) b => - fun m & phant_id m0 m => Pack (@Class disp T b m). + fun disp' m & phant_id m0 m => Pack disp (@Class T b disp' m). Definition eqType := @Equality.Pack cT xclass. Definition choiceType := @Choice.Pack cT xclass. @@ -884,40 +1029,38 @@ Definition latticeType := @Lattice.Pack disp cT xclass. Definition blatticeType := @BLattice.Pack disp cT xclass. End ClassDef. -Module Import Exports. -Coercion base : class_of >-> BLattice.class_of. -Coercion mixin : class_of >-> mixin_of. -Coercion sort : type >-> Sortclass. -Coercion eqType : type >-> Equality.type. +Module Exports. +Coercion base : class_of >-> BLattice.class_of. +Coercion mixin : class_of >-> mixin_of. +Coercion sort : type >-> Sortclass. +Coercion eqType : type >-> Equality.type. Coercion choiceType : type >-> Choice.type. Coercion porderType : type >-> POrder.type. Coercion latticeType : type >-> Lattice.type. Coercion blatticeType : type >-> BLattice.type. - Canonical eqType. Canonical choiceType. Canonical porderType. Canonical latticeType. Canonical blatticeType. - Notation cblatticeType := type. Notation cblatticeMixin := mixin_of. Notation CBLatticeMixin := Mixin. -Notation CBLatticeType T m := (@pack T _ _ m _ _ id _ id). - -Notation "[ 'cblatticeType' 'of' T 'for' cT ]" := (@clone T _ cT _ _ erefl id) +Notation CBLatticeType T m := (@pack T _ _ m _ _ id _ _ id). +Notation "[ 'cblatticeType' 'of' T 'for' cT ]" := (@clone T _ cT _ id) (at level 0, format "[ 'cblatticeType' 'of' T 'for' cT ]") : form_scope. Notation "[ 'cblatticeType' 'of' T 'for' cT 'with' disp ]" := - (@clone T _ cT disp _ (unit_irrelevance _ _) id) - (at level 0, format "[ 'cblatticeType' 'of' T 'for' cT 'with' disp ]") : form_scope. + (@clone_with T _ cT disp _ id) + (at level 0, format "[ 'cblatticeType' 'of' T 'for' cT 'with' disp ]") : + form_scope. Notation "[ 'cblatticeType' 'of' T ]" := [cblatticeType of T for _] (at level 0, format "[ 'cblatticeType' 'of' T ]") : form_scope. -Notation "[ 'cblatticeType' 'of' T 'with' disp ]" := [cblatticeType of T for _ with disp] +Notation "[ 'cblatticeType' 'of' T 'with' disp ]" := + [cblatticeType of T for _ with disp] (at level 0, format "[ 'cblatticeType' 'of' T 'with' disp ]") : form_scope. - End Exports. -End CBLattice. +End CBLattice. Export CBLattice.Exports. Module Import CBLatticeDef. @@ -936,35 +1079,35 @@ Record mixin_of d (T : tblatticeType d) (sub : T -> T -> T) := Mixin { _ : forall x, compl x = sub top x }. -Record class_of d (T : Type) := Class { - base : TBLattice.class_of d T; - mixin1 : CBLattice.mixin_of (BLattice.Pack base); - mixin2 : @mixin_of d (TBLattice.Pack base) (CBLattice.sub mixin1) +Record class_of (T : Type) := Class { + base : TBLattice.class_of T; + mixin1_disp : unit; + mixin1 : CBLattice.mixin_of (BLattice.Pack mixin1_disp base); + mixin2_disp : unit; + mixin2 : @mixin_of _ (TBLattice.Pack mixin2_disp base) (CBLattice.sub mixin1) }. Local Coercion base : class_of >-> TBLattice.class_of. -Local Coercion base2 d T (c : class_of d T) := +Local Coercion base2 T (c : class_of T) : CBLattice.class_of T := CBLattice.Class (mixin1 c). -Structure type d := Pack { sort; _ : class_of d sort }. +Structure type (d : unit) := Pack { sort; _ : class_of sort }. Local Coercion sort : type >-> Sortclass. Variables (T : Type) (disp : unit) (cT : type disp). -Definition class := let: Pack _ c as cT' := cT return class_of _ cT' in c. -Definition clone disp' c of (disp = disp') & phant_id class c := - @Pack disp' T c. +Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. +Definition clone c of phant_id class c := @Pack disp T c. +Definition clone_with disp' c of phant_id class c := @Pack disp' T c. Let xT := let: Pack T _ := cT in T. -Notation xclass := (class : class_of _ xT). +Notation xclass := (class : class_of xT). Definition pack := - fun bT b & phant_id (@TBLattice.class disp bT) - (b : TBLattice.class_of disp T) => - fun m1T m1 & phant_id (@CBLattice.class disp m1T) - (@CBLattice.Class disp T b m1) => - fun (m2 : @mixin_of disp (@TBLattice.Pack disp T b) (CBLattice.sub m1)) => - Pack (@Class disp T b m1 m2). + fun bT b & phant_id (@TBLattice.class disp bT) b => + fun disp1 m1T m1 & phant_id (@CBLattice.class disp1 m1T) + (@CBLattice.Class _ _ _ m1) => + fun disp2 m2 => Pack disp (@Class T b disp1 m1 disp2 m2). Definition eqType := @Equality.Pack cT xclass. Definition choiceType := @Choice.Pack cT xclass. @@ -977,20 +1120,19 @@ Definition tbd_cblatticeType := @CBLattice.Pack disp tblatticeType xclass. End ClassDef. -Module Import Exports. -Coercion base : class_of >-> TBLattice.class_of. -Coercion base2 : class_of >-> CBLattice.class_of. -Coercion mixin1 : class_of >-> CBLattice.mixin_of. -Coercion mixin2 : class_of >-> mixin_of. -Coercion sort : type >-> Sortclass. -Coercion eqType : type >-> Equality.type. +Module Exports. +Coercion base : class_of >-> TBLattice.class_of. +Coercion base2 : class_of >-> CBLattice.class_of. +Coercion mixin1 : class_of >-> CBLattice.mixin_of. +Coercion mixin2 : class_of >-> mixin_of. +Coercion sort : type >-> Sortclass. +Coercion eqType : type >-> Equality.type. Coercion choiceType : type >-> Choice.type. Coercion porderType : type >-> POrder.type. Coercion latticeType : type >-> Lattice.type. Coercion blatticeType : type >-> BLattice.type. Coercion tblatticeType : type >-> TBLattice.type. Coercion cblatticeType : type >-> CBLattice.type. - Canonical eqType. Canonical choiceType. Canonical porderType. @@ -999,29 +1141,28 @@ Canonical blatticeType. Canonical tblatticeType. Canonical cblatticeType. Canonical tbd_cblatticeType. - Notation ctblatticeType := type. Notation ctblatticeMixin := mixin_of. Notation CTBLatticeMixin := Mixin. -Notation CTBLatticeType T m := (@pack T _ _ _ id _ _ id m). - -Notation "[ 'cblatticeType' 'of' T 'for' cT ]" := (@clone T _ cT _ _ erefl id) - (at level 0, format "[ 'cblatticeType' 'of' T 'for' cT ]") : form_scope. -Notation "[ 'cblatticeType' 'of' T 'for' cT 'with' disp ]" := - (@clone T _ cT disp _ (unit_irrelevance _ _) id) - (at level 0, format "[ 'cblatticeType' 'of' T 'for' cT 'with' disp ]") : form_scope. -Notation "[ 'cblatticeType' 'of' T ]" := [cblatticeType of T for _] - (at level 0, format "[ 'cblatticeType' 'of' T ]") : form_scope. -Notation "[ 'cblatticeType' 'of' T 'with' disp ]" := [cblatticeType of T for _ with disp] - (at level 0, format "[ 'cblatticeType' 'of' T 'with' disp ]") : form_scope. - +Notation CTBLatticeType T m := (@pack T _ _ _ id _ _ _ id _ m). +Notation "[ 'ctblatticeType' 'of' T 'for' cT ]" := (@clone T _ cT _ id) + (at level 0, format "[ 'ctblatticeType' 'of' T 'for' cT ]") : form_scope. +Notation "[ 'ctblatticeType' 'of' T 'for' cT 'with' disp ]" := + (@clone_with T _ cT disp _ id) + (at level 0, format "[ 'ctblatticeType' 'of' T 'for' cT 'with' disp ]") + : form_scope. +Notation "[ 'ctblatticeType' 'of' T ]" := [ctblatticeType of T for _] + (at level 0, format "[ 'ctblatticeType' 'of' T ]") : form_scope. +Notation "[ 'ctblatticeType' 'of' T 'with' disp ]" := + [ctblatticeType of T for _ with disp] + (at level 0, format "[ 'ctblatticeType' 'of' T 'with' disp ]") : + form_scope. Notation "[ 'default_ctblatticeType' 'of' T ]" := - (@pack T _ _ _ id _ _ id (fun=> erefl)) + (@pack T _ _ _ id _ _ id (Mixin (fun=> erefl))) (at level 0, format "[ 'default_ctblatticeType' 'of' T ]") : form_scope. - End Exports. -End CTBLattice. +End CTBLattice. Export CTBLattice.Exports. Module Import CTBLatticeDef. @@ -1041,13 +1182,13 @@ Module FinPOrder. Section ClassDef. Record class_of T := Class { - base : Finite.class_of T; - mixin : POrder.mixin_of (Equality.Pack base) + base : POrder.class_of T; + mixin : Finite.mixin_of (Equality.Pack base) }. -Local Coercion base : class_of >-> Finite.class_of. -Definition base2 T (c : class_of T) := (POrder.Class (mixin c)). -Local Coercion base2 : class_of >-> POrder.class_of. +Local Coercion base : class_of >-> POrder.class_of. +Local Coercion base2 T (c : class_of T) : Finite.class_of T := + Finite.Class (mixin c). Structure type (disp : unit) := Pack { sort; _ : class_of sort }. @@ -1060,615 +1201,437 @@ Let xT := let: Pack T _ := cT in T. Notation xclass := (class : class_of xT). Definition pack := - fun b bT & phant_id (Finite.class bT) b => - fun m mT & phant_id (POrder.mixin_of mT) m => + fun bT b & phant_id (@POrder.class disp bT) b => + fun mT m & phant_id (@Finite.class mT) (@Finite.Class _ _ m) => Pack disp (@Class T b m). Definition eqType := @Equality.Pack cT xclass. -Definition finType := @Finite.Pack cT xclass. Definition choiceType := @Choice.Pack cT xclass. +Definition countType := @Countable.Pack cT xclass. +Definition finType := @Finite.Pack cT xclass. Definition porderType := @POrder.Pack disp cT xclass. +Definition count_porderType := @POrder.Pack disp countType xclass. Definition fin_porderType := @POrder.Pack disp finType xclass. End ClassDef. -Module Import Exports. -Coercion base : class_of >-> Finite.class_of. -Coercion base2 : class_of >-> POrder.class_of. -Coercion sort : type >-> Sortclass. +Module Exports. +Coercion base : class_of >-> POrder.class_of. +Coercion base2 : class_of >-> Finite.class_of. +Coercion sort : type >-> Sortclass. Coercion eqType : type >-> Equality.type. -Coercion finType : type >-> Finite.type. Coercion choiceType : type >-> Choice.type. +Coercion countType : type >-> Countable.type. +Coercion finType : type >-> Finite.type. Coercion porderType : type >-> POrder.type. - Canonical eqType. -Canonical finType. Canonical choiceType. +Canonical countType. +Canonical finType. Canonical porderType. +Canonical count_porderType. Canonical fin_porderType. - Notation finPOrderType := type. -Notation "[ 'finPOrderType' 'of' T ]" := (@pack T _ _ erefl _ _ phant_id _ _ phant_id) +Notation "[ 'finPOrderType' 'of' T ]" := (@pack T _ _ _ id _ _ id) (at level 0, format "[ 'finPOrderType' 'of' T ]") : form_scope. - End Exports. -End FinPOrder. +End FinPOrder. Import FinPOrder.Exports. Bind Scope cpo_sort with FinPOrder.sort. Module FinLattice. Section ClassDef. -Record class_of d (T : Type) := Class { - base : FinPOrder.class_of T; - mixin : Lattice.mixin_of (POrder.Pack d base) +Record class_of (T : Type) := Class { + base : TBLattice.class_of T; + mixin : Finite.mixin_of (Equality.Pack base); }. -Local Coercion base : class_of >-> FinPOrder.class_of. -Definition base2 d T (c : class_of d T) := (Lattice.Class (mixin c)). -Local Coercion base2 : class_of >-> Lattice.class_of. +Local Coercion base : class_of >-> TBLattice.class_of. +Local Coercion base2 T (c : class_of T) : Finite.class_of T := + Finite.Class (mixin c). +Local Coercion base3 T (c : class_of T) : FinPOrder.class_of T := + @FinPOrder.Class T c c. -Structure type (display : unit) := - Pack { sort; _ : class_of display sort }. +Structure type (disp : unit) := Pack { sort; _ : class_of sort }. Local Coercion sort : type >-> Sortclass. Variables (T : Type) (disp : unit) (cT : type disp). -Definition class := let: Pack _ c as cT' := cT return class_of _ cT' in c. +Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Let xT := let: Pack T _ := cT in T. -Notation xclass := (class : class_of _ xT). +Notation xclass := (class : class_of xT). -Definition pack disp := - fun bT b & phant_id (@FinPOrder.class disp bT) b => - fun mT m & phant_id (@Lattice.mixin disp mT) m => - Pack (@Class disp T b m). +Definition pack := + fun bT b & phant_id (@TBLattice.class disp bT) b => + fun mT m & phant_id (@Finite.class mT) (@Finite.Class _ _ m) => + Pack disp (@Class T b m). Definition eqType := @Equality.Pack cT xclass. -Definition finType := @Finite.Pack cT xclass. Definition choiceType := @Choice.Pack cT xclass. +Definition countType := @Countable.Pack cT xclass. +Definition finType := @Finite.Pack cT xclass. Definition porderType := @POrder.Pack disp cT xclass. Definition finPOrderType := @FinPOrder.Pack disp cT xclass. Definition latticeType := @Lattice.Pack disp cT xclass. -Definition fin_latticeType := @Lattice.Pack disp finPOrderType xclass. +Definition blatticeType := @BLattice.Pack disp cT xclass. +Definition tblatticeType := @TBLattice.Pack disp cT xclass. +Definition count_latticeType := @Lattice.Pack disp countType xclass. +Definition count_blatticeType := @BLattice.Pack disp countType xclass. +Definition count_tblatticeType := @TBLattice.Pack disp countType xclass. +Definition fin_latticeType := @Lattice.Pack disp finType xclass. +Definition fin_blatticeType := @BLattice.Pack disp finType xclass. +Definition fin_tblatticeType := @TBLattice.Pack disp finType xclass. +Definition finPOrder_latticeType := @Lattice.Pack disp finPOrderType xclass. +Definition finPOrder_blatticeType := @BLattice.Pack disp finPOrderType xclass. +Definition finPOrder_tblatticeType := @TBLattice.Pack disp finPOrderType xclass. End ClassDef. -Module Import Exports. -Coercion base : class_of >-> FinPOrder.class_of. -Coercion base2 : class_of >-> Lattice.class_of. -Coercion sort : type >-> Sortclass. -Coercion eqType : type >-> Equality.type. -Coercion finType : type >-> Finite.type. +Module Exports. +Coercion base : class_of >-> TBLattice.class_of. +Coercion base2 : class_of >-> Finite.class_of. +Coercion base3 : class_of >-> FinPOrder.class_of. +Coercion sort : type >-> Sortclass. +Coercion eqType : type >-> Equality.type. Coercion choiceType : type >-> Choice.type. +Coercion countType : type >-> Countable.type. +Coercion finType : type >-> Finite.type. Coercion porderType : type >-> POrder.type. Coercion finPOrderType : type >-> FinPOrder.type. Coercion latticeType : type >-> Lattice.type. - +Coercion blatticeType : type >-> BLattice.type. +Coercion tblatticeType : type >-> TBLattice.type. Canonical eqType. -Canonical finType. Canonical choiceType. +Canonical countType. +Canonical finType. Canonical porderType. Canonical finPOrderType. Canonical latticeType. +Canonical blatticeType. +Canonical tblatticeType. +Canonical count_latticeType. +Canonical count_blatticeType. +Canonical count_tblatticeType. Canonical fin_latticeType. - +Canonical fin_blatticeType. +Canonical fin_tblatticeType. +Canonical finPOrder_latticeType. +Canonical finPOrder_blatticeType. +Canonical finPOrder_tblatticeType. Notation finLatticeType := type. - -Notation "[ 'finLatticeType' 'of' T ]" := (@pack T _ _ erefl _ _ phant_id _ _ phant_id) +Notation "[ 'finLatticeType' 'of' T ]" := (@pack T _ _ _ id _ _ id) (at level 0, format "[ 'finLatticeType' 'of' T ]") : form_scope. End Exports. -End FinLattice. +End FinLattice. Export FinLattice.Exports. -Module FinTotal. +Module FinCLattice. Section ClassDef. -Record class_of d (T : Type) := Class { - base : FinLattice.class_of d T; - mixin : total (<=%O : rel (POrder.Pack d base)) +Record class_of (T : Type) := Class { + base : CTBLattice.class_of T; + mixin : Finite.mixin_of (Equality.Pack base); }. -Local Coercion base : class_of >-> FinLattice.class_of. -Definition base2 d T (c : class_of d T) := - (@Total.Class _ _ (FinLattice.base2 c) (@mixin _ _ c)). -Local Coercion base2 : class_of >-> Total.class_of. +Local Coercion base : class_of >-> CTBLattice.class_of. +Local Coercion base2 T (c : class_of T) : Finite.class_of T := + Finite.Class (mixin c). +Local Coercion base3 T (c : class_of T) : FinLattice.class_of T := + @FinLattice.Class T c c. -Structure type (display : unit) := - Pack { sort; _ : class_of display sort }. +Structure type (disp : unit) := Pack { sort; _ : class_of sort }. Local Coercion sort : type >-> Sortclass. Variables (T : Type) (disp : unit) (cT : type disp). -Definition class := let: Pack _ c as cT' := cT return class_of _ cT' in c. +Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Let xT := let: Pack T _ := cT in T. -Notation xclass := (class : class_of _ xT). +Notation xclass := (class : class_of xT). -Definition pack disp := - fun bT b & phant_id (@FinPOrder.class disp bT) b => - fun mT m & phant_id (@Total.mixin disp mT) m => - Pack (@Class disp T b m). +Definition pack := + fun bT b & phant_id (@CTBLattice.class disp bT) b => + fun mT m & phant_id (@Finite.class mT) (@Finite.Class _ _ m) => + Pack disp (@Class T b m). Definition eqType := @Equality.Pack cT xclass. -Definition finType := @Finite.Pack cT xclass. Definition choiceType := @Choice.Pack cT xclass. +Definition countType := @Countable.Pack cT xclass. +Definition finType := @Finite.Pack cT xclass. Definition porderType := @POrder.Pack disp cT xclass. Definition finPOrderType := @FinPOrder.Pack disp cT xclass. Definition latticeType := @Lattice.Pack disp cT xclass. +Definition blatticeType := @BLattice.Pack disp cT xclass. +Definition tblatticeType := @TBLattice.Pack disp cT xclass. Definition finLatticeType := @FinLattice.Pack disp cT xclass. -Definition orderType := @Total.Pack disp cT xclass. -Definition fin_orderType := @Total.Pack disp finLatticeType xclass. +Definition cblatticeType := @CBLattice.Pack disp cT xclass. +Definition ctblatticeType := @CTBLattice.Pack disp cT xclass. +Definition count_cblatticeType := @CBLattice.Pack disp countType xclass. +Definition count_ctblatticeType := @CTBLattice.Pack disp countType xclass. +Definition fin_cblatticeType := @CBLattice.Pack disp finType xclass. +Definition fin_ctblatticeType := @CTBLattice.Pack disp finType xclass. +Definition finPOrder_cblatticeType := @CBLattice.Pack disp finPOrderType xclass. +Definition finPOrder_ctblatticeType := + @CTBLattice.Pack disp finPOrderType xclass. +Definition finLattice_cblatticeType := + @CBLattice.Pack disp finLatticeType xclass. +Definition finLattice_ctblatticeType := + @CTBLattice.Pack disp finLatticeType xclass. End ClassDef. -Module Import Exports. -Coercion base : class_of >-> FinLattice.class_of. -Coercion base2 : class_of >-> Total.class_of. -Coercion sort : type >-> Sortclass. -Coercion eqType : type >-> Equality.type. -Coercion finType : type >-> Finite.type. +Module Exports. +Coercion base : class_of >-> CTBLattice.class_of. +Coercion base2 : class_of >-> Finite.class_of. +Coercion base3 : class_of >-> FinLattice.class_of. +Coercion sort : type >-> Sortclass. +Coercion eqType : type >-> Equality.type. Coercion choiceType : type >-> Choice.type. +Coercion countType : type >-> Countable.type. +Coercion finType : type >-> Finite.type. Coercion porderType : type >-> POrder.type. Coercion finPOrderType : type >-> FinPOrder.type. Coercion latticeType : type >-> Lattice.type. +Coercion blatticeType : type >-> BLattice.type. +Coercion tblatticeType : type >-> TBLattice.type. Coercion finLatticeType : type >-> FinLattice.type. -Coercion orderType : type >-> Total.type. - +Coercion cblatticeType : type >-> CBLattice.type. +Coercion ctblatticeType : type >-> CTBLattice.type. Canonical eqType. -Canonical finType. Canonical choiceType. +Canonical countType. +Canonical finType. Canonical porderType. Canonical finPOrderType. Canonical latticeType. +Canonical blatticeType. +Canonical tblatticeType. Canonical finLatticeType. -Canonical orderType. -Canonical fin_orderType. - -Notation finOrderType := type. - -Notation "[ 'finOrderType' 'of' T ]" := (@pack T _ _ erefl _ _ phant_id _ _ phant_id) - (at level 0, format "[ 'finOrderType' 'of' T ]") : form_scope. +Canonical cblatticeType. +Canonical ctblatticeType. +Canonical count_cblatticeType. +Canonical count_ctblatticeType. +Canonical fin_cblatticeType. +Canonical fin_ctblatticeType. +Canonical finPOrder_cblatticeType. +Canonical finPOrder_ctblatticeType. +Canonical finLattice_cblatticeType. +Canonical finLattice_ctblatticeType. +Notation finCLatticeType := type. +Notation "[ 'finCLatticeType' 'of' T ]" := (@pack T _ _ _ id _ _ id) + (at level 0, format "[ 'finCLatticeType' 'of' T ]") : form_scope. End Exports. -End FinTotal. -Export Total.Exports. +End FinCLattice. +Export FinCLattice.Exports. -Module FinBLattice. +Module FinTotal. Section ClassDef. -Record class_of d (T : Type) := Class { - base : FinLattice.class_of d T; - mixin : BLattice.mixin_of (FinPOrder.Pack d base) +Record class_of (T : Type) := Class { + base : FinLattice.class_of T; + mixin_disp : unit; + mixin : Total.mixin_of (Lattice.Pack mixin_disp base) }. Local Coercion base : class_of >-> FinLattice.class_of. -Definition base2 d T (c : class_of d T) := - (@BLattice.Class _ _ (FinLattice.base2 c) (@mixin _ _ c)). -Local Coercion base2 : class_of >-> BLattice.class_of. +Local Coercion base2 T (c : class_of T) : Total.class_of T := + @Total.Class _ c _ (mixin (c := c)). -Structure type (display : unit) := - Pack { sort; _ : class_of display sort }. +Structure type (disp : unit) := Pack { sort; _ : class_of sort }. Local Coercion sort : type >-> Sortclass. Variables (T : Type) (disp : unit) (cT : type disp). -Definition class := let: Pack _ c as cT' := cT return class_of _ cT' in c. +Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Let xT := let: Pack T _ := cT in T. -Notation xclass := (class : class_of _ xT). +Notation xclass := (class : class_of xT). -Definition pack disp := - fun bT b & phant_id (@FinPOrder.class disp bT) b => - fun mT m & phant_id (@BLattice.mixin disp mT) m => - Pack (@Class disp T b m). +Definition pack := + fun bT b & phant_id (@FinLattice.class disp bT) b => + fun disp' mT m & phant_id (@Total.class disp mT) (@Total.Class _ _ _ m) => + Pack disp (@Class T b disp' m). Definition eqType := @Equality.Pack cT xclass. -Definition finType := @Finite.Pack cT xclass. Definition choiceType := @Choice.Pack cT xclass. +Definition countType := @Countable.Pack cT xclass. +Definition finType := @Finite.Pack cT xclass. Definition porderType := @POrder.Pack disp cT xclass. Definition finPOrderType := @FinPOrder.Pack disp cT xclass. Definition latticeType := @Lattice.Pack disp cT xclass. -Definition finLatticeType := @FinLattice.Pack disp cT xclass. Definition blatticeType := @BLattice.Pack disp cT xclass. -Definition fin_blatticeType := @BLattice.Pack disp finLatticeType xclass. +Definition tblatticeType := @TBLattice.Pack disp cT xclass. +Definition finLatticeType := @FinLattice.Pack disp cT xclass. +Definition orderType := @Total.Pack disp cT xclass. +Definition order_countType := @Countable.Pack orderType xclass. +Definition order_finType := @Finite.Pack orderType xclass. +Definition order_finPOrderType := @FinPOrder.Pack disp orderType xclass. +Definition order_blatticeType := @BLattice.Pack disp orderType xclass. +Definition order_tblatticeType := @TBLattice.Pack disp orderType xclass. +Definition order_finLatticeType := @FinLattice.Pack disp orderType xclass. End ClassDef. -Module Import Exports. -Coercion base : class_of >-> FinLattice.class_of. -Coercion base2 : class_of >-> BLattice.class_of. -Coercion sort : type >-> Sortclass. -Coercion eqType : type >-> Equality.type. -Coercion finType : type >-> Finite.type. +Module Exports. +Coercion base : class_of >-> FinLattice.class_of. +Coercion base2 : class_of >-> Total.class_of. +Coercion sort : type >-> Sortclass. +Coercion eqType : type >-> Equality.type. Coercion choiceType : type >-> Choice.type. +Coercion countType : type >-> Countable.type. +Coercion finType : type >-> Finite.type. Coercion porderType : type >-> POrder.type. Coercion finPOrderType : type >-> FinPOrder.type. Coercion latticeType : type >-> Lattice.type. -Coercion finLatticeType : type >-> FinLattice.type. Coercion blatticeType : type >-> BLattice.type. - +Coercion tblatticeType : type >-> TBLattice.type. +Coercion finLatticeType : type >-> FinLattice.type. +Coercion orderType : type >-> Total.type. Canonical eqType. -Canonical finType. Canonical choiceType. +Canonical countType. +Canonical finType. Canonical porderType. Canonical finPOrderType. Canonical latticeType. -Canonical finLatticeType. Canonical blatticeType. -Canonical fin_blatticeType. - -Notation finBLatticeType := type. - -Notation "[ 'finBLatticeType' 'of' T ]" := (@pack T _ _ erefl _ _ phant_id _ _ phant_id) - (at level 0, format "[ 'finBLatticeType' 'of' T ]") : form_scope. +Canonical tblatticeType. +Canonical finLatticeType. +Canonical orderType. +Canonical order_countType. +Canonical order_finType. +Canonical order_finPOrderType. +Canonical order_blatticeType. +Canonical order_tblatticeType. +Canonical order_finLatticeType. +Notation finOrderType := type. +Notation "[ 'finOrderType' 'of' T ]" := (@pack T _ _ _ id _ _ _ id) + (at level 0, format "[ 'finOrderType' 'of' T ]") : form_scope. End Exports. -End FinBLattice. -Export FinBLattice.Exports. +End FinTotal. +Export Total.Exports. -Module FinTBLattice. -Section ClassDef. +(************) +(* CONVERSE *) +(************) -Record class_of d (T : Type) := Class { - base : FinBLattice.class_of d T; - mixin : TBLattice.mixin_of (FinPOrder.Pack d base) -}. +Definition converse T : Type := T. +Definition converse_display : unit -> unit. Proof. exact. Qed. +Local Notation "T ^c" := (converse T) (at level 2, format "T ^c") : type_scope. -Local Coercion base : class_of >-> FinBLattice.class_of. -Definition base2 d T (c : class_of d T) := - (@TBLattice.Class _ _ c (@mixin _ _ c)). -Local Coercion base2 : class_of >-> TBLattice.class_of. +Module Import ConverseSyntax. -Structure type (display : unit) := - Pack { sort; _ : class_of display sort }. +Notation "<=^c%O" := (@le (converse_display _) _) : order_scope. +Notation ">=^c%O" := (@ge (converse_display _) _) : order_scope. +Notation ">=^c%O" := (@ge (converse_display _) _) : order_scope. +Notation "<^c%O" := (@lt (converse_display _) _) : order_scope. +Notation ">^c%O" := (@gt (converse_display _) _) : order_scope. +Notation "=<^c%O" := (@comparable (converse_display _) _) : order_scope. +Notation "><^c%O" := (fun x y => ~~ (@comparable (converse_display _) _ x y)) : + order_scope. -Local Coercion sort : type >-> Sortclass. +Notation "<=^c y" := (>=^c%O y) : order_scope. +Notation "<=^c y :> T" := (<=^c (y : T)) : order_scope. +Notation ">=^c y" := (<=^c%O y) : order_scope. +Notation ">=^c y :> T" := (>=^c (y : T)) : order_scope. -Variables (T : Type) (disp : unit) (cT : type disp). +Notation "<^c y" := (>^c%O y) : order_scope. +Notation "<^c y :> T" := (<^c (y : T)) : order_scope. +Notation ">^c y" := (<^c%O y) : order_scope. +Notation ">^c y :> T" := (>^c (y : T)) : order_scope. -Definition class := let: Pack _ c as cT' := cT return class_of _ cT' in c. -Let xT := let: Pack T _ := cT in T. -Notation xclass := (class : class_of _ xT). +Notation ">=<^c y" := (>=<^c%O y) : order_scope. +Notation ">=<^c y :> T" := (>=<^c (y : T)) : order_scope. -Definition pack disp := - fun bT b & phant_id (@FinBLattice.class disp bT) b => - fun mT m & phant_id (@TBLattice.mixin disp mT) m => - Pack (@Class disp T b m). +Notation "x <=^c y" := (<=^c%O x y) : order_scope. +Notation "x <=^c y :> T" := ((x : T) <=^c (y : T)) : order_scope. +Notation "x >=^c y" := (y <=^c x) (only parsing) : order_scope. +Notation "x >=^c y :> T" := ((x : T) >=^c (y : T)) (only parsing) : order_scope. -Definition eqType := @Equality.Pack cT xclass. -Definition finType := @Finite.Pack cT xclass. -Definition choiceType := @Choice.Pack cT xclass. -Definition porderType := @POrder.Pack disp cT xclass. -Definition finPOrderType := @FinPOrder.Pack disp cT xclass. -Definition latticeType := @Lattice.Pack disp cT xclass. -Definition finLatticeType := @FinLattice.Pack disp cT xclass. -Definition blatticeType := @BLattice.Pack disp cT xclass. -Definition finBLatticeType := @FinBLattice.Pack disp cT xclass. -Definition tblatticeType := @TBLattice.Pack disp cT xclass. -Definition fin_blatticeType := @TBLattice.Pack disp finBLatticeType xclass. +Notation "x <^c y" := (<^c%O x y) : order_scope. +Notation "x <^c y :> T" := ((x : T) <^c (y : T)) : order_scope. +Notation "x >^c y" := (y <^c x) (only parsing) : order_scope. +Notation "x >^c y :> T" := ((x : T) >^c (y : T)) (only parsing) : order_scope. -End ClassDef. +Notation "x <=^c y <=^c z" := ((x <=^c y) && (y <=^c z)) : order_scope. +Notation "x <^c y <=^c z" := ((x <^c y) && (y <=^c z)) : order_scope. +Notation "x <=^c y <^c z" := ((x <=^c y) && (y <^c z)) : order_scope. +Notation "x <^c y <^c z" := ((x <^c y) && (y <^c z)) : order_scope. -Module Import Exports. -Coercion base : class_of >-> FinBLattice.class_of. -Coercion base2 : class_of >-> TBLattice.class_of. -Coercion sort : type >-> Sortclass. -Coercion eqType : type >-> Equality.type. -Coercion finType : type >-> Finite.type. -Coercion choiceType : type >-> Choice.type. -Coercion porderType : type >-> POrder.type. -Coercion finPOrderType : type >-> FinPOrder.type. -Coercion latticeType : type >-> Lattice.type. -Coercion finLatticeType : type >-> FinLattice.type. -Coercion blatticeType : type >-> BLattice.type. -Coercion finBLatticeType : type >-> FinBLattice.type. -Coercion tblatticeType : type >-> TBLattice.type. +Notation "x <=^c y ?= 'iff' C" := ( R" := ((x : R) <=^c (y : R) ?= iff C) + (only parsing) : order_scope. -Canonical eqType. -Canonical finType. -Canonical choiceType. -Canonical porderType. -Canonical finPOrderType. -Canonical latticeType. -Canonical finLatticeType. -Canonical blatticeType. -Canonical finBLatticeType. -Canonical tblatticeType. -Canonical fin_blatticeType. +Notation ">=<^c x" := (>=<^c%O x) : order_scope. +Notation ">=<^c x :> T" := (>=<^c (x : T)) (only parsing) : order_scope. +Notation "x >=<^c y" := (>=<^c%O x y) : order_scope. -Notation finTBLatticeType := type. +Notation "><^c x" := (fun y => ~~ (>=<^c%O x y)) : order_scope. +Notation "><^c x :> T" := (><^c (x : T)) (only parsing) : order_scope. +Notation "x ><^c y" := (~~ (><^c%O x y)) : order_scope. -Notation "[ 'finTBLatticeType' 'of' T ]" := (@pack T _ _ erefl _ _ phant_id _ _ phant_id) - (at level 0, format "[ 'finTBLatticeType' 'of' T ]") : form_scope. -End Exports. -End FinTBLattice. +Notation "x `&^c` y" := (@meet (converse_display _) _ x y). +Notation "x `|^c` y" := (@join (converse_display _) _ x y). -Export FinTBLattice.Exports. +End ConverseSyntax. -Module FinCBLattice. -Section ClassDef. +(**********) +(* THEORY *) +(**********) -Record class_of d (T : Type) := Class { - base : FinBLattice.class_of d T; - mixin : CBLattice.mixin_of (BLattice.Pack base) -}. +Module Import POrderTheory. +Section POrderTheory. +Import POrderDef. -Local Coercion base : class_of >-> FinBLattice.class_of. -Definition base2 d T (c : class_of d T) := - (@CBLattice.Class _ _ c (@mixin _ _ c)). -Local Coercion base2 : class_of >-> CBLattice.class_of. - -Structure type (display : unit) := - Pack { sort; _ : class_of display sort }. - -Local Coercion sort : type >-> Sortclass. - -Variables (T : Type) (disp : unit) (cT : type disp). - -Definition class := let: Pack _ c as cT' := cT return class_of _ cT' in c. -Let xT := let: Pack T _ := cT in T. -Notation xclass := (class : class_of _ xT). - -Definition pack disp := - fun bT b & phant_id (@FinBLattice.class disp bT) b => - fun mT m & phant_id (@CBLattice.mixin disp mT) m => - Pack (@Class disp T b m). - -Definition eqType := @Equality.Pack cT xclass. -Definition finType := @Finite.Pack cT xclass. -Definition choiceType := @Choice.Pack cT xclass. -Definition porderType := @POrder.Pack disp cT xclass. -Definition finPOrderType := @FinPOrder.Pack disp cT xclass. -Definition latticeType := @Lattice.Pack disp cT xclass. -Definition finLatticeType := @FinLattice.Pack disp cT xclass. -Definition blatticeType := @BLattice.Pack disp cT xclass. -Definition finBLatticeType := @FinBLattice.Pack disp cT xclass. -Definition cblatticeType := @CBLattice.Pack disp cT xclass. -Definition fin_blatticeType := @CBLattice.Pack disp finBLatticeType xclass. - -End ClassDef. - -Module Import Exports. -Coercion base : class_of >-> FinBLattice.class_of. -Coercion base2 : class_of >-> CBLattice.class_of. -Coercion sort : type >-> Sortclass. -Coercion eqType : type >-> Equality.type. -Coercion finType : type >-> Finite.type. -Coercion choiceType : type >-> Choice.type. -Coercion porderType : type >-> POrder.type. -Coercion finPOrderType : type >-> FinPOrder.type. -Coercion latticeType : type >-> Lattice.type. -Coercion finLatticeType : type >-> FinLattice.type. -Coercion blatticeType : type >-> BLattice.type. -Coercion finBLatticeType : type >-> FinBLattice.type. -Coercion cblatticeType : type >-> CBLattice.type. - -Canonical eqType. -Canonical finType. -Canonical choiceType. -Canonical porderType. -Canonical finPOrderType. -Canonical latticeType. -Canonical finLatticeType. -Canonical blatticeType. -Canonical finBLatticeType. -Canonical cblatticeType. -Canonical fin_blatticeType. - -Notation finCBLatticeType := type. - -Notation "[ 'finCBLatticeType' 'of' T ]" := (@pack T _ _ erefl _ _ phant_id _ _ phant_id) - (at level 0, format "[ 'finCBLatticeType' 'of' T ]") : form_scope. -End Exports. -End FinCBLattice. - -Export FinCBLattice.Exports. - -Module FinCTBLattice. -Section ClassDef. - -Record class_of d (T : Type) := Class { - base : FinTBLattice.class_of d T; - mixin1 : CBLattice.mixin_of (BLattice.Pack base); - mixin2 : @CTBLattice.mixin_of d (TBLattice.Pack base) (CBLattice.sub mixin1) -}. - -Local Coercion base : class_of >-> FinTBLattice.class_of. -Definition base1 d T (c : class_of d T) := - (@FinCBLattice.Class _ _ c (@mixin1 _ _ c)). -Local Coercion base1 : class_of >-> FinCBLattice.class_of. -Definition base2 d T (c : class_of d T) := - (@CTBLattice.Class _ _ c (@mixin1 _ _ c) (@mixin2 _ _ c)). -Local Coercion base2 : class_of >-> CTBLattice.class_of. - -Structure type (display : unit) := - Pack { sort; _ : class_of display sort }. - -Local Coercion sort : type >-> Sortclass. - -Variables (T : Type) (disp : unit) (cT : type disp). - -Definition class := let: Pack _ c as cT' := cT return class_of _ cT' in c. -Let xT := let: Pack T _ := cT in T. -Notation xclass := (class : class_of _ xT). - -Definition pack disp := - fun bT b & phant_id (@FinTBLattice.class disp bT) b => - fun m1T m1 & phant_id (@CTBLattice.mixin1 disp m1T) m1 => - fun m2T m2 & phant_id (@CTBLattice.mixin2 disp m2T) m2 => - Pack (@Class disp T b m1 m2). - -Definition eqType := @Equality.Pack cT xclass. -Definition finType := @Finite.Pack cT xclass. -Definition choiceType := @Choice.Pack cT xclass. -Definition porderType := @POrder.Pack disp cT xclass. -Definition finPOrderType := @FinPOrder.Pack disp cT xclass. -Definition latticeType := @Lattice.Pack disp cT xclass. -Definition finLatticeType := @FinLattice.Pack disp cT xclass. -Definition blatticeType := @BLattice.Pack disp cT xclass. -Definition finBLatticeType := @FinBLattice.Pack disp cT xclass. -Definition cblatticeType := @CBLattice.Pack disp cT xclass. -Definition tblatticeType := @TBLattice.Pack disp cT xclass. -Definition finTBLatticeType := @FinTBLattice.Pack disp cT xclass. -Definition finCBLatticeType := @FinCBLattice.Pack disp cT xclass. -Definition ctblatticeType := @CTBLattice.Pack disp cT xclass. -Definition fintb_ctblatticeType := @CTBLattice.Pack disp finTBLatticeType xclass. -Definition fincb_ctblatticeType := @CTBLattice.Pack disp finCBLatticeType xclass. - -End ClassDef. - -Module Import Exports. -Coercion base : class_of >-> FinTBLattice.class_of. -Coercion base1 : class_of >-> FinCBLattice.class_of. -Coercion base2 : class_of >-> CTBLattice.class_of. -Coercion sort : type >-> Sortclass. - -Coercion eqType : type >-> Equality.type. -Coercion finType : type >-> Finite.type. -Coercion choiceType : type >-> Choice.type. -Coercion porderType : type >-> POrder.type. -Coercion finPOrderType : type >-> FinPOrder.type. -Coercion latticeType : type >-> Lattice.type. -Coercion finLatticeType : type >-> FinLattice.type. -Coercion blatticeType : type >-> BLattice.type. -Coercion finBLatticeType : type >-> FinBLattice.type. -Coercion cblatticeType : type >-> CBLattice.type. -Coercion tblatticeType : type >-> TBLattice.type. -Coercion finTBLatticeType : type >-> FinTBLattice.type. -Coercion finCBLatticeType : type >-> FinCBLattice.type. -Coercion ctblatticeType : type >-> CTBLattice.type. -Coercion fintb_ctblatticeType : type >-> CTBLattice.type. -Coercion fincb_ctblatticeType : type >-> CTBLattice.type. - - -Canonical eqType. -Canonical finType. -Canonical choiceType. -Canonical porderType. -Canonical finPOrderType. -Canonical latticeType. -Canonical finLatticeType. -Canonical blatticeType. -Canonical finBLatticeType. -Canonical cblatticeType. -Canonical tblatticeType. -Canonical finTBLatticeType. -Canonical finCBLatticeType. -Canonical ctblatticeType. -Canonical fintb_ctblatticeType. -Canonical fincb_ctblatticeType. - -Notation finCTBLatticeType := type. - -Notation "[ 'finCTBLatticeType' 'of' T ]" := - (@pack T _ _ erefl _ _ phant_id _ _ phant_id _ _ phant_id) - (at level 0, format "[ 'finCTBLatticeType' 'of' T ]") : form_scope. -End Exports. -End FinCTBLattice. - -Export FinCTBLattice.Exports. - -(***********) -(* REVERSE *) -(***********) - -Definition reverse T : Type := T. -Definition reverse_display : unit -> unit. Proof. exact. Qed. -Local Notation "T ^r" := (reverse T) (at level 2, format "T ^r") : type_scope. - -Module Import ReverseSyntax. - -Notation "<=^r%O" := (@le (reverse_display _) _) : order_scope. -Notation ">=^r%O" := (@ge (reverse_display _) _) : order_scope. -Notation ">=^r%O" := (@ge (reverse_display _) _) : order_scope. -Notation "<^r%O" := (@lt (reverse_display _) _) : order_scope. -Notation ">^r%O" := (@gt (reverse_display _) _) : order_scope. -Notation "=<^r%O" := (@comparable (reverse_display _) _) : order_scope. -Notation "><^r%O" := (fun x y => ~~ (@comparable (reverse_display _) _ x y)) : - order_scope. - -Notation "<=^r y" := (>=^r%O y) : order_scope. -Notation "<=^r y :> T" := (<=^r (y : T)) : order_scope. -Notation ">=^r y" := (<=^r%O y) : order_scope. -Notation ">=^r y :> T" := (>=^r (y : T)) : order_scope. - -Notation "<^r y" := (>^r%O y) : order_scope. -Notation "<^r y :> T" := (<^r (y : T)) : order_scope. -Notation ">^r y" := (<^r%O y) : order_scope. -Notation ">^r y :> T" := (>^r (y : T)) : order_scope. - -Notation ">=<^r y" := (>=<^r%O y) : order_scope. -Notation ">=<^r y :> T" := (>=<^r (y : T)) : order_scope. - -Notation "x <=^r y" := (<=^r%O x y) : order_scope. -Notation "x <=^r y :> T" := ((x : T) <=^r (y : T)) : order_scope. -Notation "x >=^r y" := (y <=^r x) (only parsing) : order_scope. -Notation "x >=^r y :> T" := ((x : T) >=^r (y : T)) (only parsing) : order_scope. - -Notation "x <^r y" := (<^r%O x y) : order_scope. -Notation "x <^r y :> T" := ((x : T) <^r (y : T)) : order_scope. -Notation "x >^r y" := (y <^r x) (only parsing) : order_scope. -Notation "x >^r y :> T" := ((x : T) >^r (y : T)) (only parsing) : order_scope. - -Notation "x <=^r y <=^r z" := ((x <=^r y) && (y <=^r z)) : order_scope. -Notation "x <^r y <=^r z" := ((x <^r y) && (y <=^r z)) : order_scope. -Notation "x <=^r y <^r z" := ((x <=^r y) && (y <^r z)) : order_scope. -Notation "x <^r y <^r z" := ((x <^r y) && (y <^r z)) : order_scope. - -Notation "x <=^r y ?= 'iff' C" := ( R" := ((x : R) <=^r (y : R) ?= iff C) - (only parsing) : order_scope. - -Notation ">=<^r x" := (>=<^r%O x) : order_scope. -Notation ">=<^r x :> T" := (>=<^r (x : T)) (only parsing) : order_scope. -Notation "x >=<^r y" := (>=<^r%O x y) : order_scope. - -Notation "><^r x" := (fun y => ~~ (>=<^r%O x y)) : order_scope. -Notation "><^r x :> T" := (><^r (x : T)) (only parsing) : order_scope. -Notation "x ><^r y" := (~~ (><^r%O x y)) : order_scope. - -Notation "x `&^r` y" := (@meet (reverse_display _) _ x y). -Notation "x `|^r` y" := (@join (reverse_display _) _ x y). - -End ReverseSyntax. - -(**********) -(* THEORY *) -(**********) - -Module Import POrderTheory. -Section POrderTheory. - -Context {display : unit}. -Local Notation porderType := (porderType display). +Context {disp : unit}. +Local Notation porderType := (porderType disp). Context {T : porderType}. Implicit Types x y : T. +Lemma geE x y : ge x y = (y <= x). Proof. by []. Qed. +Lemma gtE x y : gt x y = (y < x). Proof. by []. Qed. + Lemma lexx (x : T) : x <= x. Proof. by case: T x => ? [? []]. Qed. -Hint Resolve lexx. +Hint Resolve lexx : core. Definition le_refl : reflexive le := lexx. -Hint Resolve le_refl. +Definition ge_refl : reflexive ge := lexx. +Hint Resolve le_refl : core. Lemma le_anti: antisymmetric (<=%O : rel T). Proof. by case: T => ? [? []]. Qed. +Lemma ge_anti: antisymmetric (>=%O : rel T). +Proof. by move=> x y /le_anti. Qed. + Lemma le_trans: transitive (<=%O : rel T). Proof. by case: T => ? [? []]. Qed. -Lemma lt_neqAle x y: (x < y) = (x != y) && (x <= y). +Lemma ge_trans: transitive (>=%O : rel T). +Proof. by move=> ? ? ? ? /le_trans; apply. Qed. + +Lemma lt_def x y: (x < y) = (y != x) && (x <= y). Proof. by case: T x y => ? [? []]. Qed. +Lemma lt_neqAle x y: (x < y) = (x != y) && (x <= y). +Proof. by rewrite lt_def eq_sym. Qed. + Lemma ltxx x: x < x = false. -Proof. by rewrite lt_neqAle eqxx. Qed. +Proof. by rewrite lt_def eqxx. Qed. Definition lt_irreflexive : irreflexive lt := ltxx. -Hint Resolve lt_irreflexive. +Hint Resolve lt_irreflexive : core. + +Definition ltexx := (lexx, ltxx). Lemma le_eqVlt x y: (x <= y) = (x == y) || (x < y). Proof. by rewrite lt_neqAle; case: eqP => //= ->; rewrite lexx. Qed. @@ -1700,6 +1663,9 @@ Proof. by rewrite le_eqVlt => /orP [/eqP ->|/lt_trans t /t]. Qed. Lemma lt_nsym x y : x < y -> y < x -> False. Proof. by move=> xy /(lt_trans xy); rewrite ltxx. Qed. +Lemma lt_asym x y : x < y < x = false. +Proof. by apply/negP => /andP []; apply: lt_nsym. Qed. + Lemma le_gtF x y: x <= y -> y < x = false. Proof. by move=> le_xy; apply/negP => /lt_le_trans /(_ le_xy); rewrite ltxx. @@ -1719,11 +1685,13 @@ by rewrite lt_neqAle lexy andbT; apply: contraNneq Nleyx => ->. Qed. Lemma lt_le_asym x y : x < y <= x = false. -Proof. by rewrite lt_neqAle -andbA -eq_le eq_sym; case: (_ == _). Qed. +Proof. by rewrite lt_neqAle -andbA -eq_le eq_sym andNb. Qed. Lemma le_lt_asym x y : x <= y < x = false. Proof. by rewrite andbC lt_le_asym. Qed. +Definition lte_anti := (=^~ eq_le, lt_asym, lt_le_asym, le_lt_asym). + Lemma lt_sorted_uniq_le (s : seq T) : sorted lt s = uniq s && sorted le s. Proof. @@ -1818,58 +1786,183 @@ rewrite /leif le_eqVlt; apply: (iffP idP)=> [|[]]. by move=> /orP[/eqP->|lxy] <-; rewrite ?eqxx // lt_eqF. Qed. +Lemma leif_refl x C : reflect (x <= x ?= iff C) C. +Proof. by apply: (iffP idP) => [-> | <-] //; split; rewrite ?eqxx. Qed. + +Lemma leif_trans x1 x2 x3 C12 C23 : + x1 <= x2 ?= iff C12 -> x2 <= x3 ?= iff C23 -> x1 <= x3 ?= iff C12 && C23. +Proof. +move=> ltx12 ltx23; apply/leifP; rewrite -ltx12. +case eqx12: (x1 == x2). + by rewrite (eqP eqx12) lt_neqAle !ltx23 andbT; case C23. +by rewrite (@lt_le_trans x2) ?ltx23 // lt_neqAle eqx12 ltx12. +Qed. + +Lemma leif_le x y : x <= y -> x <= y ?= iff (x >= y). +Proof. by move=> lexy; split=> //; rewrite eq_le lexy. Qed. + +Lemma leif_eq x y : x <= y -> x <= y ?= iff (x == y). +Proof. by []. Qed. + +Lemma ge_leif x y C : x <= y ?= iff C -> (y <= x) = C. +Proof. by case=> le_xy; rewrite eq_le le_xy. Qed. + +Lemma lt_leif x y C : x <= y ?= iff C -> (x < y) = ~~ C. +Proof. by move=> le_xy; rewrite lt_neqAle !le_xy andbT. Qed. + +Lemma mono_in_leif (A : {pred T}) (f : T -> T) C : + {in A &, {mono f : x y / x <= y}} -> + {in A &, forall x y, (f x <= f y ?= iff C) = (x <= y ?= iff C)}. +Proof. by move=> mf x y Ax Ay; rewrite /leif !eq_le !mf. Qed. + +Lemma mono_leif (f : T -> T) C : + {mono f : x y / x <= y} -> + forall x y, (f x <= f y ?= iff C) = (x <= y ?= iff C). +Proof. by move=> mf x y; rewrite /leif !eq_le !mf. Qed. + +Lemma nmono_in_leif (A : {pred T}) (f : T -> T) C : + {in A &, {mono f : x y /~ x <= y}} -> + {in A &, forall x y, (f x <= f y ?= iff C) = (y <= x ?= iff C)}. +Proof. by move=> mf x y Ax Ay; rewrite /leif !eq_le !mf. Qed. + +Lemma nmono_leif (f : T -> T) C : + {mono f : x y /~ x <= y} -> + forall x y, (f x <= f y ?= iff C) = (y <= x ?= iff C). +Proof. by move=> mf x y; rewrite /leif !eq_le !mf. Qed. + End POrderTheory. +Section POrderMonotonyTheory. + +Context {disp disp' : unit}. +Context {T : porderType disp} {T' : porderType disp'}. +Implicit Types (m n p : nat) (x y z : T) (u v w : T'). +Variables (D D' : {pred T}) (f : T -> T'). + +Hint Resolve lexx lt_neqAle (@le_anti _ T) (@le_anti _ T') lt_def : core. + +Let ge_antiT : antisymmetric (>=%O : rel T). +Proof. by move=> ? ? /le_anti. Qed. + +Lemma ltW_homo : {homo f : x y / x < y} -> {homo f : x y / x <= y}. +Proof. exact: homoW. Qed. + +Lemma ltW_nhomo : {homo f : x y /~ x < y} -> {homo f : x y /~ x <= y}. +Proof. exact: homoW. Qed. + +Lemma inj_homo_lt : + injective f -> {homo f : x y / x <= y} -> {homo f : x y / x < y}. +Proof. exact: inj_homo. Qed. + +Lemma inj_nhomo_lt : + injective f -> {homo f : x y /~ x <= y} -> {homo f : x y /~ x < y}. +Proof. exact: inj_homo. Qed. + +Lemma inc_inj : {mono f : x y / x <= y} -> injective f. +Proof. exact: mono_inj. Qed. + +Lemma dec_inj : {mono f : x y /~ x <= y} -> injective f. +Proof. exact: mono_inj. Qed. + +Lemma leW_mono : {mono f : x y / x <= y} -> {mono f : x y / x < y}. +Proof. exact: anti_mono. Qed. + +Lemma leW_nmono : {mono f : x y /~ x <= y} -> {mono f : x y /~ x < y}. +Proof. exact: anti_mono. Qed. + +(* Monotony in D D' *) +Lemma ltW_homo_in : + {in D & D', {homo f : x y / x < y}} -> {in D & D', {homo f : x y / x <= y}}. +Proof. exact: homoW_in. Qed. + +Lemma ltW_nhomo_in : + {in D & D', {homo f : x y /~ x < y}} -> {in D & D', {homo f : x y /~ x <= y}}. +Proof. exact: homoW_in. Qed. + +Lemma inj_homo_lt_in : + {in D & D', injective f} -> {in D & D', {homo f : x y / x <= y}} -> + {in D & D', {homo f : x y / x < y}}. +Proof. exact: inj_homo_in. Qed. + +Lemma inj_nhomo_lt_in : + {in D & D', injective f} -> {in D & D', {homo f : x y /~ x <= y}} -> + {in D & D', {homo f : x y /~ x < y}}. +Proof. exact: inj_homo_in. Qed. + +Lemma inc_inj_in : {in D &, {mono f : x y / x <= y}} -> + {in D &, injective f}. +Proof. exact: mono_inj_in. Qed. + +Lemma dec_inj_in : + {in D &, {mono f : x y /~ x <= y}} -> {in D &, injective f}. +Proof. exact: mono_inj_in. Qed. + +Lemma leW_mono_in : + {in D &, {mono f : x y / x <= y}} -> {in D &, {mono f : x y / x < y}}. +Proof. exact: anti_mono_in. Qed. + +Lemma leW_nmono_in : + {in D &, {mono f : x y /~ x <= y}} -> {in D &, {mono f : x y /~ x < y}}. +Proof. exact: anti_mono_in. Qed. + +End POrderMonotonyTheory. + End POrderTheory. -Hint Resolve lexx le_refl lt_irreflexive. +Hint Resolve lexx le_refl ltxx lt_irreflexive ltW lt_eqF : core. +Arguments leifP {disp T x y C}. +Arguments leif_refl {disp T x C}. +Arguments mono_in_leif [disp T A f C]. +Arguments nmono_in_leif [disp T A f C]. +Arguments mono_leif [disp T f C]. +Arguments nmono_leif [disp T f C]. -Module Import ReversePOrder. -Section ReversePOrder. -Canonical reverse_eqType (T : eqType) := EqType T [eqMixin of T^r]. -Canonical reverse_choiceType (T : choiceType) := [choiceType of T^r]. +Module Import ConversePOrder. +Section ConversePOrder. +Canonical converse_eqType (T : eqType) := EqType T [eqMixin of T^c]. +Canonical converse_choiceType (T : choiceType) := [choiceType of T^c]. -Context {display : unit}. -Local Notation porderType := (porderType display). +Context {disp : unit}. +Local Notation porderType := (porderType disp). Variable T : porderType. -Definition reverse_le (x y : T) := (y <= x). -Definition reverse_lt (x y : T) := (y < x). +Definition converse_le (x y : T) := (y <= x). +Definition converse_lt (x y : T) := (y < x). -Lemma reverse_lt_neqAle (x y : T) : reverse_lt x y = (x != y) && (reverse_le x y). -Proof. by rewrite eq_sym; apply: lt_neqAle. Qed. +Lemma converse_lt_def (x y : T) : + converse_lt x y = (y != x) && (converse_le x y). +Proof. by apply: lt_neqAle. Qed. -Fact reverse_le_anti : antisymmetric reverse_le. +Fact converse_le_anti : antisymmetric converse_le. Proof. by move=> x y /andP [xy yx]; apply/le_anti/andP; split. Qed. -Definition reverse_porderMixin := - POrderMixin reverse_lt_neqAle (lexx : reflexive reverse_le) reverse_le_anti +Definition converse_porderMixin := + POrderMixin converse_lt_def (lexx : reflexive converse_le) converse_le_anti (fun y z x zy yx => @le_trans _ _ y x z yx zy). -Canonical reverse_porderType := - POrderType (reverse_display display) (T^r) reverse_porderMixin. - -End ReversePOrder. -End ReversePOrder. +Canonical converse_porderType := + POrderType (converse_display disp) (T^c) converse_porderMixin. -Definition LePOrderMixin T le rle ale tle := - @POrderMixin T le _ (fun _ _ => erefl) rle ale tle. +End ConversePOrder. +End ConversePOrder. -Module Import ReverseLattice. -Section ReverseLattice. -Context {display : unit}. -Local Notation latticeType := (latticeType display). +Module Import ConverseLattice. +Section ConverseLattice. +Context {disp : unit}. +Local Notation latticeType := (latticeType disp). Variable L : latticeType. Implicit Types (x y : L). -Lemma meetC : commutative (@meet _ L). Proof. by case: L => [?[?[]]]. Qed. -Lemma joinC : commutative (@join _ L). Proof. by case: L => [?[?[]]]. Qed. +Lemma meetC : commutative (@meet _ L). Proof. by case: L => [?[? ?[]]]. Qed. +Lemma joinC : commutative (@join _ L). Proof. by case: L => [?[? ?[]]]. Qed. -Lemma meetA : associative (@meet _ L). Proof. by case: L => [?[?[]]]. Qed. -Lemma joinA : associative (@join _ L). Proof. by case: L => [?[?[]]]. Qed. +Lemma meetA : associative (@meet _ L). Proof. by case: L => [?[? ?[]]]. Qed. +Lemma joinA : associative (@join _ L). Proof. by case: L => [?[? ?[]]]. Qed. -Lemma joinKI y x : x `&` (x `|` y) = x. Proof. by case: L x y => [?[?[]]]. Qed. -Lemma meetKU y x : x `|` (x `&` y) = x. Proof. by case: L x y => [?[?[]]]. Qed. +Lemma joinKI y x : x `&` (x `|` y) = x. +Proof. by case: L x y => [?[? ?[]]]. Qed. +Lemma meetKU y x : x `|` (x `&` y) = x. +Proof. by case: L x y => [?[? ?[]]]. Qed. Lemma joinKIC y x : x `&` (y `|` x) = x. Proof. by rewrite joinC joinKI. Qed. Lemma meetKUC y x : x `|` (y `&` x) = x. Proof. by rewrite meetC meetKU. Qed. @@ -1883,13 +1976,13 @@ Lemma meetUKC x y : (y `&` x) `|` y = y. Proof. by rewrite meetC meetUK. Qed. Lemma joinIKC x y : (y `|` x) `&` y = y. Proof. by rewrite joinC joinIK. Qed. Lemma leEmeet x y : (x <= y) = (x `&` y == x). -Proof. by case: L x y => [?[?[]]]. Qed. +Proof. by case: L x y => [?[? ?[]]]. Qed. Lemma leEjoin x y : (x <= y) = (x `|` y == y). Proof. by rewrite leEmeet; apply/eqP/eqP => <-; rewrite (joinKI, meetUK). Qed. Lemma meetUl : left_distributive (@meet _ L) (@join _ L). -Proof. by case: L => [?[?[]]]. Qed. +Proof. by case: L => [?[? ?[]]]. Qed. Lemma meetUr : right_distributive (@meet _ L) (@join _ L). Proof. by move=> x y z; rewrite meetC meetUl ![_ `&` x]meetC. Qed. @@ -1897,20 +1990,20 @@ Proof. by move=> x y z; rewrite meetC meetUl ![_ `&` x]meetC. Qed. Lemma joinIl : left_distributive (@join _ L) (@meet _ L). Proof. by move=> x y z; rewrite meetUr joinIK meetUl -joinA meetUKC. Qed. -Fact reverse_leEmeet (x y : L^r) : (x <= y) = (x `|` y == x). +Fact converse_leEmeet (x y : L^c) : (x <= y) = (x `|` y == x). Proof. by rewrite [LHS]leEjoin joinC. Qed. -Definition reverse_latticeMixin := - @LatticeMixin _ [porderType of L^r] _ _ joinC meetC - joinA meetA meetKU joinKI reverse_leEmeet joinIl. -Canonical reverse_latticeType := LatticeType L^r reverse_latticeMixin. -End ReverseLattice. -End ReverseLattice. +Definition converse_latticeMixin := + @LatticeMixin _ [porderType of L^c] _ _ joinC meetC + joinA meetA meetKU joinKI converse_leEmeet joinIl. +Canonical converse_latticeType := LatticeType L^c converse_latticeMixin. +End ConverseLattice. +End ConverseLattice. Module Import LatticeTheoryMeet. Section LatticeTheoryMeet. -Context {display : unit}. -Local Notation latticeType := (latticeType display). +Context {disp : unit}. +Local Notation latticeType := (latticeType disp). Context {L : latticeType}. Implicit Types (x y : L). @@ -1936,16 +2029,6 @@ Proof. by rewrite meetAC meetC meetxx. Qed. (* interaction with order *) -Lemma meet_idPl {x y} : reflect (x `&` y = x) (x <= y). -Proof. by rewrite leEmeet; apply/eqP. Qed. -Lemma meet_idPr {x y} : reflect (y `&` x = x) (x <= y). -Proof. by rewrite meetC; apply/meet_idPl. Qed. - -Lemma leIidl x y : (x <= x `&` y) = (x <= y). -Proof. by rewrite !leEmeet meetKI. Qed. -Lemma leIidr x y : (x <= y `&` x) = (x <= y). -Proof. by rewrite !leEmeet meetKIC. Qed. - Lemma lexI x y z : (x <= y `&` z) = (x <= y) && (x <= z). Proof. rewrite !leEmeet; apply/idP/idP => [/eqP<-|/andP[/eqP<- /eqP<-]]. @@ -1953,192 +2036,295 @@ rewrite !leEmeet; apply/idP/idP => [/eqP<-|/andP[/eqP<- /eqP<-]]. by rewrite -[X in X `&` _]meetA meetIK meetA. Qed. -Lemma leIx x y z : (y <= x) || (z <= x) -> y `&` z <= x. -Proof. -rewrite !leEmeet => /orP [/eqP <-|/eqP <-]. - by rewrite -meetA meetACA meetxx meetAC. -by rewrite -meetA meetIK. -Qed. +Lemma leIxl x y z : y <= x -> y `&` z <= x. +Proof. by rewrite !leEmeet meetAC => /eqP ->. Qed. + +Lemma leIxr x y z : z <= x -> y `&` z <= x. +Proof. by rewrite !leEmeet -meetA => /eqP ->. Qed. + +Lemma leIx2 x y z : (y <= x) || (z <= x) -> y `&` z <= x. +Proof. by case/orP => [/leIxl|/leIxr]. Qed. Lemma leIr x y : y `&` x <= x. -Proof. by rewrite leIx ?lexx ?orbT. Qed. +Proof. by rewrite leIx2 ?lexx ?orbT. Qed. Lemma leIl x y : x `&` y <= x. -Proof. by rewrite leIx ?lexx ?orbT. Qed. +Proof. by rewrite leIx2 ?lexx ?orbT. Qed. + +Lemma meet_idPl {x y} : reflect (x `&` y = x) (x <= y). +Proof. by rewrite leEmeet; apply/eqP. Qed. +Lemma meet_idPr {x y} : reflect (y `&` x = x) (x <= y). +Proof. by rewrite meetC; apply/meet_idPl. Qed. + +Lemma leIidl x y : (x <= x `&` y) = (x <= y). +Proof. by rewrite !leEmeet meetKI. Qed. +Lemma leIidr x y : (x <= y `&` x) = (x <= y). +Proof. by rewrite !leEmeet meetKIC. Qed. + +Lemma eq_meetl x y : (x `&` y == x) = (x <= y). +Proof. by apply/esym/leEmeet. Qed. + +Lemma eq_meetr x y : (x `&` y == y) = (y <= x). +Proof. by rewrite meetC eq_meetl. Qed. Lemma leI2 x y z t : x <= z -> y <= t -> x `&` y <= z `&` t. -Proof. by move=> xz yt; rewrite lexI !leIx ?xz ?yt ?orbT //. Qed. +Proof. by move=> xz yt; rewrite lexI !leIx2 ?xz ?yt ?orbT //. Qed. End LatticeTheoryMeet. End LatticeTheoryMeet. Module Import LatticeTheoryJoin. Section LatticeTheoryJoin. -Context {display : unit}. -Local Notation latticeType := (latticeType display). +Import LatticeDef. +Context {disp : unit}. +Local Notation latticeType := (latticeType disp). Context {L : latticeType}. Implicit Types (x y : L). (* lattice theory *) Lemma joinAC : right_commutative (@join _ L). -Proof. exact: (@meetAC _ [latticeType of L^r]). Qed. +Proof. exact: (@meetAC _ [latticeType of L^c]). Qed. Lemma joinCA : left_commutative (@join _ L). -Proof. exact: (@meetCA _ [latticeType of L^r]). Qed. +Proof. exact: (@meetCA _ [latticeType of L^c]). Qed. Lemma joinACA : interchange (@join _ L) (@join _ L). -Proof. exact: (@meetACA _ [latticeType of L^r]). Qed. +Proof. exact: (@meetACA _ [latticeType of L^c]). Qed. Lemma joinxx x : x `|` x = x. -Proof. exact: (@meetxx _ [latticeType of L^r]). Qed. +Proof. exact: (@meetxx _ [latticeType of L^c]). Qed. Lemma joinKU y x : x `|` (x `|` y) = x `|` y. -Proof. exact: (@meetKI _ [latticeType of L^r]). Qed. +Proof. exact: (@meetKI _ [latticeType of L^c]). Qed. Lemma joinUK y x : (x `|` y) `|` y = x `|` y. -Proof. exact: (@meetIK _ [latticeType of L^r]). Qed. +Proof. exact: (@meetIK _ [latticeType of L^c]). Qed. Lemma joinKUC y x : x `|` (y `|` x) = x `|` y. -Proof. exact: (@meetKIC _ [latticeType of L^r]). Qed. +Proof. exact: (@meetKIC _ [latticeType of L^c]). Qed. Lemma joinUKC y x : y `|` x `|` y = x `|` y. -Proof. exact: (@meetIKC _ [latticeType of L^r]). Qed. +Proof. exact: (@meetIKC _ [latticeType of L^c]). Qed. (* interaction with order *) +Lemma leUx x y z : (x `|` y <= z) = (x <= z) && (y <= z). +Proof. exact: (@lexI _ [latticeType of L^c]). Qed. +Lemma lexUl x y z : x <= y -> x <= y `|` z. +Proof. exact: (@leIxl _ [latticeType of L^c]). Qed. +Lemma lexUr x y z : x <= z -> x <= y `|` z. +Proof. exact: (@leIxr _ [latticeType of L^c]). Qed. +Lemma lexU2 x y z : (x <= y) || (x <= z) -> x <= y `|` z. +Proof. exact: (@leIx2 _ [latticeType of L^c]). Qed. + +Lemma leUr x y : x <= y `|` x. +Proof. exact: (@leIr _ [latticeType of L^c]). Qed. +Lemma leUl x y : x <= x `|` y. +Proof. exact: (@leIl _ [latticeType of L^c]). Qed. + Lemma join_idPl {x y} : reflect (x `|` y = y) (x <= y). -Proof. exact: (@meet_idPr _ [latticeType of L^r]). Qed. +Proof. exact: (@meet_idPr _ [latticeType of L^c]). Qed. Lemma join_idPr {x y} : reflect (y `|` x = y) (x <= y). -Proof. exact: (@meet_idPl _ [latticeType of L^r]). Qed. +Proof. exact: (@meet_idPl _ [latticeType of L^c]). Qed. Lemma leUidl x y : (x `|` y <= y) = (x <= y). -Proof. exact: (@leIidr _ [latticeType of L^r]). Qed. +Proof. exact: (@leIidr _ [latticeType of L^c]). Qed. Lemma leUidr x y : (y `|` x <= y) = (x <= y). -Proof. exact: (@leIidl _ [latticeType of L^r]). Qed. - -Lemma leUx x y z : (x `|` y <= z) = (x <= z) && (y <= z). -Proof. exact: (@lexI _ [latticeType of L^r]). Qed. +Proof. exact: (@leIidl _ [latticeType of L^c]). Qed. -Lemma lexU x y z : (x <= y) || (x <= z) -> x <= y `|` z. -Proof. exact: (@leIx _ [latticeType of L^r]). Qed. - -Lemma leUr x y : x <= y `|` x. -Proof. exact: (@leIr _ [latticeType of L^r]). Qed. - -Lemma leUl x y : x <= x `|` y. -Proof. exact: (@leIl _ [latticeType of L^r]). Qed. +Lemma eq_joinl x y : (x `|` y == x) = (y <= x). +Proof. exact: (@eq_meetl _ [latticeType of L^c]). Qed. +Lemma eq_joinr x y : (x `|` y == y) = (x <= y). +Proof. exact: (@eq_meetr _ [latticeType of L^c]). Qed. Lemma leU2 x y z t : x <= z -> y <= t -> x `|` y <= z `|` t. -Proof. exact: (@leI2 _ [latticeType of L^r]). Qed. +Proof. exact: (@leI2 _ [latticeType of L^c]). Qed. (* Distributive lattice theory *) Lemma joinIr : right_distributive (@join _ L) (@meet _ L). -Proof. exact: (@meetUr _ [latticeType of L^r]). Qed. +Proof. exact: (@meetUr _ [latticeType of L^c]). Qed. + +Lemma lcomparableP x y : incomparer x y + (y == x) (x == y) (x <= y) (y <= x) (x < y) (x > y) + (y >=< x) (x >=< y) (y `&` x) (x `&` y) (y `|` x) (x `|` y). +Proof. +by case: (comparableP x) => [-> | hxy | hxy | hxy]; do 1?have hxy' := ltW hxy; + rewrite ?(meetxx, joinxx, meetC y, joinC y) + ?(meet_idPl hxy', meet_idPr hxy', join_idPl hxy', join_idPr hxy'); + constructor. +Qed. + +Lemma lcomparable_ltgtP x y : x >=< y -> + comparer x y (y == x) (x == y) (x <= y) (y <= x) (x < y) (x > y) + (y `&` x) (x `&` y) (y `|` x) (x `|` y). +Proof. by case: (lcomparableP x) => // *; constructor. Qed. + +Lemma lcomparable_leP x y : x >=< y -> + le_xor_gt x y (x <= y) (y < x) (y `&` x) (x `&` y) (y `|` x) (x `|` y). +Proof. by move/lcomparable_ltgtP => [->|/ltW xy|xy]; constructor => //. Qed. + +Lemma lcomparable_ltP x y : x >=< y -> + lt_xor_ge x y (y <= x) (x < y) (y `&` x) (x `&` y) (y `|` x) (x `|` y). +Proof. by move=> /lcomparable_ltgtP [->|xy|/ltW xy]; constructor => //. Qed. End LatticeTheoryJoin. End LatticeTheoryJoin. -Module TotalLattice. -Section TotalLattice. -Context {display : unit}. -Local Notation porderType := (porderType display). -Context {T : porderType}. -Implicit Types (x y z : T). -Hypothesis le_total : total (<=%O : rel T). +Module Import TotalTheory. +Section TotalTheory. +Context {disp : unit}. +Local Notation orderType := (orderType disp). +Context {T : orderType}. +Implicit Types (x y z t : T). -Fact comparableT x y : x >=< y. Proof. exact: le_total. Qed. -Hint Resolve comparableT. +Lemma le_total : total (<=%O : rel T). Proof. by case: T => [? [?]]. Qed. +Hint Resolve le_total : core. -Fact ltgtP x y : - comparer x y (y == x) (x == y) (x <= y) (y <= x) (x < y) (x > y). -Proof. exact: comparable_ltgtP. Qed. +Lemma ge_total : total (>=%O : rel T). +Proof. by move=> ? ?; apply: le_total. Qed. +Hint Resolve ge_total : core. -Fact leP x y : le_xor_gt x y (x <= y) (y < x). -Proof. exact: comparable_leP. Qed. +Lemma comparableT x y : x >=< y. Proof. exact: le_total. Qed. +Hint Resolve comparableT : core. -Fact ltP x y : lt_xor_ge x y (y <= x) (x < y). -Proof. exact: comparable_ltP. Qed. +Lemma sort_le_sorted (s : seq T) : sorted <=%O (sort <=%O s). +Proof. exact: sort_sorted. Qed. -Definition meet x y := if x <= y then x else y. -Definition join x y := if y <= x then x else y. +Lemma sort_lt_sorted (s : seq T) : sorted lt (sort le s) = uniq s. +Proof. by rewrite lt_sorted_uniq_le sort_uniq sort_le_sorted andbT. Qed. -Fact meetC : commutative meet. -Proof. by move=> x y; rewrite /meet; have [] := ltgtP. Qed. +Lemma sort_le_id (s : seq T) : sorted le s -> sort le s = s. +Proof. +by move=> ss; apply: eq_sorted_le; rewrite ?sort_le_sorted // perm_sort. +Qed. -Fact joinC : commutative join. -Proof. by move=> x y; rewrite /join; have [] := ltgtP. Qed. +Lemma leNgt x y : (x <= y) = ~~ (y < x). Proof. exact: comparable_leNgt. Qed. -Fact meetA : associative meet. +Lemma ltNge x y : (x < y) = ~~ (y <= x). Proof. exact: comparable_ltNge. Qed. + +Lemma wlog_le P : + (forall x y, P y x -> P x y) -> (forall x y, x <= y -> P x y) -> + forall x y, P x y. Proof. -move=> x y z; rewrite /meet; case: (leP y z) => yz; case: (leP x y) => xy //=. -- by rewrite (le_trans xy). -- by rewrite yz. -by rewrite !lt_geF // (lt_trans yz). +move=> sP hP x y; case hxy: (x <= y); last apply/sP; apply/hP => //. +by move/negbT: hxy; rewrite -ltNge; apply/ltW. Qed. -Fact joinA : associative join. +Lemma wlog_lt P : + (forall x, P x x) -> + (forall x y, (P y x -> P x y)) -> (forall x y, x < y -> P x y) -> + forall x y, P x y. Proof. -move=> x y z; rewrite /join; case: (leP z y) => yz; case: (leP y x) => xy //=. -- by rewrite (le_trans yz). -- by rewrite yz. -by rewrite !lt_geF // (lt_trans xy). +move=> rP sP hP x y; case hxy: (x < y); first by apply/hP. +case hxy': (x == y); first by move/eqP: hxy' => <-; apply: rP. +by apply/sP/hP; rewrite lt_def leNgt hxy hxy'. Qed. -Fact joinKI y x : meet x (join x y) = x. -Proof. by rewrite /meet /join; case: (leP y x) => yx; rewrite ?lexx ?ltW. Qed. +Definition ltgtP x y := LatticeTheoryJoin.lcomparable_ltgtP (comparableT x y). +Definition leP x y := LatticeTheoryJoin.lcomparable_leP (comparableT x y). +Definition ltP x y := LatticeTheoryJoin.lcomparable_ltP (comparableT x y). -Fact meetKU y x : join x (meet x y) = x. -Proof. by rewrite /meet /join; case: (leP x y) => yx; rewrite ?lexx ?ltW. Qed. +Lemma neq_lt x y : (x != y) = (x < y) || (y < x). Proof. by case: ltgtP. Qed. -Fact leEmeet x y : (x <= y) = (meet x y == x). -Proof. by rewrite /meet; case: leP => ?; rewrite ?eqxx ?lt_eqF. Qed. +Lemma lt_total x y : x != y -> (x < y) || (y < x). Proof. by case: ltgtP. Qed. -Fact meetUl : left_distributive meet join. +Lemma eq_leLR x y z t : + (x <= y -> z <= t) -> (y < x -> t < z) -> (x <= y) = (z <= t). +Proof. by move=> *; apply/idP/idP; rewrite // !leNgt; apply: contra. Qed. + +Lemma eq_leRL x y z t : + (x <= y -> z <= t) -> (y < x -> t < z) -> (z <= t) = (x <= y). +Proof. by move=> *; symmetry; apply: eq_leLR. Qed. + +Lemma eq_ltLR x y z t : + (x < y -> z < t) -> (y <= x -> t <= z) -> (x < y) = (z < t). +Proof. by move=> *; rewrite !ltNge; congr negb; apply: eq_leLR. Qed. + +Lemma eq_ltRL x y z t : + (x < y -> z < t) -> (y <= x -> t <= z) -> (z < t) = (x < y). +Proof. by move=> *; symmetry; apply: eq_ltLR. Qed. + +(* interaction with lattice operations *) + +Lemma leIx x y z : (meet y z <= x) = (y <= x) || (z <= x). Proof. -move=> x y z; rewrite /meet /join. -case: (leP y z) => yz; case: (leP y x) => xy //=; first 1 last. -- by rewrite yz [x <= z](le_trans _ yz) ?[x <= y]ltW // lt_geF. -- by rewrite lt_geF ?lexx // (lt_le_trans yz). -- by rewrite lt_geF //; have [->|/lt_geF->|] := (ltgtP x z); rewrite ?lexx. -- by have [] := (leP x z); rewrite ?xy ?yz. +by case: (leP y z) => hyz; case: leP => ?; + rewrite ?(orbT, orbF) //=; apply/esym/negbTE; + rewrite -ltNge ?(lt_le_trans _ hyz) ?(lt_trans _ hyz). Qed. -Definition Mixin := LatticeMixin meetC joinC meetA joinA joinKI meetKU leEmeet meetUl. +Lemma lexU x y z : (x <= join y z) = (x <= y) || (x <= z). +Proof. +by case: (leP y z) => hyz; case: leP => ?; + rewrite ?(orbT, orbF) //=; apply/esym/negbTE; + rewrite -ltNge ?(le_lt_trans hyz) ?(lt_trans hyz). +Qed. -End TotalLattice. -End TotalLattice. +Lemma ltxI x y z : (x < meet y z) = (x < y) && (x < z). +Proof. by rewrite !ltNge leIx negb_or. Qed. -Module TotalTheory. -Section TotalTheory. -Context {display : unit}. -Local Notation orderType := (orderType display). -Context {T : orderType}. -Implicit Types (x y : T). +Lemma ltIx x y z : (meet y z < x) = (y < x) || (z < x). +Proof. by rewrite !ltNge lexI negb_and. Qed. -Lemma le_total : total (<=%O : rel T). Proof. by case: T => [? [?]]. Qed. -Hint Resolve le_total. +Lemma ltxU x y z : (x < join y z) = (x < y) || (x < z). +Proof. by rewrite !ltNge leUx negb_and. Qed. -Lemma comparableT x y : x >=< y. Proof. exact: le_total. Qed. -Hint Resolve comparableT. +Lemma ltUx x y z : (join y z < x) = (y < x) && (z < x). +Proof. by rewrite !ltNge lexU negb_or. Qed. -Lemma sort_le_sorted (s : seq T) : sorted <=%O (sort <=%O s). -Proof. exact: sort_sorted. Qed. +Definition ltexI := (@lexI _ T, ltxI). +Definition lteIx := (leIx, ltIx). +Definition ltexU := (lexU, ltxU). +Definition lteUx := (@leUx _ T, ltUx). -Lemma sort_lt_sorted (s : seq T) : sorted lt (sort le s) = uniq s. -Proof. by rewrite lt_sorted_uniq_le sort_uniq sort_le_sorted andbT. Qed. +Section ArgExtremum. -Lemma sort_le_id (s : seq T) : sorted le s -> sort le s = s. +Context (I : finType) (i0 : I) (P : {pred I}) (F : I -> T) (Pi0 : P i0). + +Lemma arg_minP: extremum_spec <=%O P F (arg_min i0 P F). +Proof. by apply: extremumP => //; apply: le_trans. Qed. + +Lemma arg_maxP: extremum_spec >=%O P F (arg_max i0 P F). +Proof. by apply: extremumP => //; [apply: ge_refl | apply: ge_trans]. Qed. + +End ArgExtremum. + +End TotalTheory. +Section TotalMonotonyTheory. + +Context {disp : unit} {disp' : unit}. +Context {T : orderType disp} {T' : porderType disp'}. +Variables (D : {pred T}) (f : T -> T'). +Implicit Types (x y z : T) (u v w : T'). + +Lemma le_mono : {homo f : x y / x < y} -> {mono f : x y / x <= y}. Proof. -by move=> ss; apply: eq_sorted_le; rewrite ?sort_le_sorted // perm_sort. +move=> mf x y; case: ltgtP; first (by move=> ->; apply/lexx); move/mf => fxy. +- by rewrite comparable_leNgt /comparable 1?(le_eqVlt (f y)) fxy ?orbT. +- by apply/ltW. Qed. -Lemma leNgt x y : (x <= y) = ~~ (y < x). -Proof. by rewrite comparable_leNgt. Qed. +Lemma le_nmono : {homo f : x y /~ x < y} -> {mono f : x y /~ x <= y}. +Proof. +move=> mf x y; case: ltgtP; first (by move=> ->; apply/lexx); move/mf => fxy. +- by rewrite comparable_leNgt /comparable 1?(le_eqVlt (f y)) fxy ?orbT. +- by apply/ltW. +Qed. -Lemma ltNge x y : (x < y) = ~~ (y <= x). -Proof. by rewrite comparable_ltNge. Qed. +Lemma le_mono_in : + {in D &, {homo f : x y / x < y}} -> {in D &, {mono f : x y / x <= y}}. +Proof. +move=> mf x y Dx Dy; case: ltgtP; + first (by move=> ->; apply/lexx); move/mf => fxy. +- by rewrite comparable_leNgt /comparable 1?(le_eqVlt (f y)) fxy ?orbT. +- by apply/ltW/fxy. +Qed. -Definition ltgtP := TotalLattice.ltgtP le_total. -Definition leP := TotalLattice.leP le_total. -Definition ltP := TotalLattice.ltP le_total. +Lemma le_nmono_in : + {in D &, {homo f : x y /~ x < y}} -> {in D &, {mono f : x y /~ x <= y}}. +Proof. +move=> mf x y Dx Dy; case: ltgtP; + first (by move=> ->; apply/lexx); move/mf => fxy. +- by rewrite comparable_leNgt /comparable 1?(le_eqVlt (f y)) fxy ?orbT. +- by apply/ltW/fxy. +Qed. +End TotalMonotonyTheory. End TotalTheory. -End TotalTheory. - Module Import BLatticeTheory. Section BLatticeTheory. @@ -2149,8 +2335,8 @@ Implicit Types (x y z : L). Local Notation "0" := bottom. (* Distributive lattice theory with 0 & 1*) -Lemma le0x x : 0 <= x. Proof. by case: L x => [?[?[]]]. Qed. -Hint Resolve le0x. +Lemma le0x x : 0 <= x. Proof. by case: L x => [?[? ?[]]]. Qed. +Hint Resolve le0x : core. Lemma lex0 x : (x <= 0) = (x == 0). Proof. by rewrite le_eqVlt (le_gtF (le0x _)) orbF. Qed. @@ -2183,7 +2369,7 @@ Proof. by rewrite joinC [_ `|` z]joinC => /leU2l_le H /H. Qed. Lemma lexUl z x y : x `&` z = 0 -> (x <= y `|` z) = (x <= y). Proof. -move=> xz0; apply/idP/idP=> xy; last by rewrite lexU ?xy. +move=> xz0; apply/idP/idP=> xy; last by rewrite lexU2 ?xy. by apply: (@leU2l_le x z); rewrite ?joinxx. Qed. @@ -2193,7 +2379,7 @@ Proof. by move=> xz0; rewrite joinC; rewrite lexUl. Qed. Lemma leU2E x y z t : x `&` t = 0 -> y `&` z = 0 -> (x `|` y <= z `|` t) = (x <= z) && (y <= t). Proof. -move=> dxt dyz; apply/idP/andP; last by case=> ??; exact: leU2. +move=> dxt dyz; apply/idP/andP; last by case=> ? ?; exact: leU2. by move=> lexyzt; rewrite (leU2l_le _ lexyzt) // (leU2r_le _ lexyzt). Qed. @@ -2203,7 +2389,7 @@ apply/idP/idP; last by move=> /andP [/eqP-> /eqP->]; rewrite joinx0. by move=> /eqP xUy0; rewrite -!lex0 -!xUy0 ?leUl ?leUr. Qed. -CoInductive eq0_xor_gt0 x : bool -> bool -> Set := +Variant eq0_xor_gt0 x : bool -> bool -> Set := Eq0NotPOs : x = 0 -> eq0_xor_gt0 x true false | POsNotEq0 : 0 < x -> eq0_xor_gt0 x false true. @@ -2213,15 +2399,15 @@ Proof. by rewrite lt0x; have [] := altP eqP; constructor; rewrite ?lt0x. Qed. Canonical join_monoid := Monoid.Law (@joinA _ _) join0x joinx0. Canonical join_comoid := Monoid.ComLaw (@joinC _ _). -Lemma join_sup (I : finType) (j : I) (P : pred I) (F : I -> L) : +Lemma join_sup (I : finType) (j : I) (P : {pred I}) (F : I -> L) : P j -> F j <= \join_(i | P i) F i. -Proof. by move=> Pj; rewrite (bigD1 j) //= lexU ?lexx. Qed. +Proof. by move=> Pj; rewrite (bigD1 j) //= lexU2 ?lexx. Qed. -Lemma join_min (I : finType) (j : I) (l : L) (P : pred I) (F : I -> L) : +Lemma join_min (I : finType) (j : I) (l : L) (P : {pred I}) (F : I -> L) : P j -> l <= F j -> l <= \join_(i | P i) F i. Proof. by move=> Pj /le_trans -> //; rewrite join_sup. Qed. -Lemma joinsP (I : finType) (u : L) (P : pred I) (F : I -> L) : +Lemma joinsP (I : finType) (u : L) (P : {pred I}) (F : I -> L) : reflect (forall i : I, P i -> F i <= u) (\join_(i | P i) F i <= u). Proof. have -> : \join_(i | P i) F i <= u = (\big[andb/true]_(i | P i) (F i <= u)). @@ -2238,7 +2424,7 @@ move=> AsubB; rewrite -(setID B A). rewrite [X in _ <= X](eq_bigl [predU B :&: A & B :\: A]); last first. by move=> i; rewrite !inE. rewrite bigU //=; last by rewrite -setI_eq0 setDE setIACA setICr setI0. -by rewrite lexU // (setIidPr _) // lexx. +by rewrite lexU2 // (setIidPr _) // lexx. Qed. Lemma joins_setU (I : finType) (A B : {set I}) (F : I -> L) : @@ -2246,7 +2432,7 @@ Lemma joins_setU (I : finType) (A B : {set I}) (F : I -> L) : Proof. apply/eqP; rewrite eq_le leUx !le_joins ?subsetUl ?subsetUr ?andbT //. apply/joinsP => i; rewrite inE; move=> /orP. -by case=> ?; rewrite lexU //; [rewrite join_sup|rewrite orbC join_sup]. +by case=> ?; rewrite lexU2 //; [rewrite join_sup|rewrite orbC join_sup]. Qed. Lemma join_seq (I : finType) (r : seq I) (F : I -> L) : @@ -2256,11 +2442,11 @@ rewrite [RHS](eq_bigl (mem [set i | i \in r])); last by move=> i; rewrite !inE. elim: r => [|i r ihr]; first by rewrite big_nil big1 // => i; rewrite ?inE. rewrite big_cons {}ihr; apply/eqP; rewrite eq_le set_cons. rewrite leUx join_sup ?inE ?eqxx // le_joins //= ?subsetUr //. -apply/joinsP => j; rewrite !inE => /predU1P [->|jr]; rewrite ?lexU ?lexx //. +apply/joinsP => j; rewrite !inE => /predU1P [->|jr]; rewrite ?lexU2 ?lexx //. by rewrite join_sup ?orbT ?inE. Qed. -Lemma joins_disjoint (I : finType) (d : L) (P : pred I) (F : I -> L) : +Lemma joins_disjoint (I : finType) (d : L) (P : {pred I}) (F : I -> L) : (forall i : I, P i -> d `&` F i = 0) -> d `&` \join_(i | P i) F i = 0. Proof. move=> d_Fi_disj; have : \big[andb/true]_(i | P i) (d `&` F i == 0). @@ -2274,84 +2460,84 @@ Qed. End BLatticeTheory. End BLatticeTheory. -Module Import ReverseTBLattice. -Section ReverseTBLattice. +Module Import ConverseTBLattice. +Section ConverseTBLattice. Context {disp : unit}. Local Notation tblatticeType := (tblatticeType disp). Context {L : tblatticeType}. -Lemma lex1 (x : L) : x <= top. Proof. by case: L x => [?[?[]]]. Qed. +Lemma lex1 (x : L) : x <= top. Proof. by case: L x => [?[? ?[]]]. Qed. -Definition reverse_blatticeMixin := - @BLatticeMixin _ [latticeType of L^r] top lex1. -Canonical reverse_blatticeType := BLatticeType L^r reverse_blatticeMixin. +Definition converse_blatticeMixin := + @BLatticeMixin _ [latticeType of L^c] top lex1. +Canonical converse_blatticeType := BLatticeType L^c converse_blatticeMixin. -Definition reverse_tblatticeMixin := - @TBLatticeMixin _ [latticeType of L^r] (bottom : L) (@le0x _ L). -Canonical reverse_tblatticeType := TBLatticeType L^r reverse_tblatticeMixin. +Definition converse_tblatticeMixin := + @TBLatticeMixin _ [latticeType of L^c] (bottom : L) (@le0x _ L). +Canonical converse_tblatticeType := TBLatticeType L^c converse_tblatticeMixin. -End ReverseTBLattice. -End ReverseTBLattice. +End ConverseTBLattice. +End ConverseTBLattice. -Module Import ReverseTBLatticeSyntax. -Section ReverseTBLatticeSyntax. +Module Import ConverseTBLatticeSyntax. +Section ConverseTBLatticeSyntax. Local Notation "0" := bottom. Local Notation "1" := top. -Local Notation join := (@join (reverse_display _) _). -Local Notation meet := (@meet (reverse_display _) _). +Local Notation join := (@join (converse_display _) _). +Local Notation meet := (@meet (converse_display _) _). -Notation "\join^r_ ( i <- r | P ) F" := +Notation "\join^c_ ( i <- r | P ) F" := (\big[join/0]_(i <- r | P%B) F%O) : order_scope. -Notation "\join^r_ ( i <- r ) F" := +Notation "\join^c_ ( i <- r ) F" := (\big[join/0]_(i <- r) F%O) : order_scope. -Notation "\join^r_ ( i | P ) F" := +Notation "\join^c_ ( i | P ) F" := (\big[join/0]_(i | P%B) F%O) : order_scope. -Notation "\join^r_ i F" := +Notation "\join^c_ i F" := (\big[join/0]_i F%O) : order_scope. -Notation "\join^r_ ( i : I | P ) F" := +Notation "\join^c_ ( i : I | P ) F" := (\big[join/0]_(i : I | P%B) F%O) (only parsing) : order_scope. -Notation "\join^r_ ( i : I ) F" := +Notation "\join^c_ ( i : I ) F" := (\big[join/0]_(i : I) F%O) (only parsing) : order_scope. -Notation "\join^r_ ( m <= i < n | P ) F" := +Notation "\join^c_ ( m <= i < n | P ) F" := (\big[join/0]_(m <= i < n | P%B) F%O) : order_scope. -Notation "\join^r_ ( m <= i < n ) F" := +Notation "\join^c_ ( m <= i < n ) F" := (\big[join/0]_(m <= i < n) F%O) : order_scope. -Notation "\join^r_ ( i < n | P ) F" := +Notation "\join^c_ ( i < n | P ) F" := (\big[join/0]_(i < n | P%B) F%O) : order_scope. -Notation "\join^r_ ( i < n ) F" := +Notation "\join^c_ ( i < n ) F" := (\big[join/0]_(i < n) F%O) : order_scope. -Notation "\join^r_ ( i 'in' A | P ) F" := +Notation "\join^c_ ( i 'in' A | P ) F" := (\big[join/0]_(i in A | P%B) F%O) : order_scope. -Notation "\join^r_ ( i 'in' A ) F" := +Notation "\join^c_ ( i 'in' A ) F" := (\big[join/0]_(i in A) F%O) : order_scope. -Notation "\meet^r_ ( i <- r | P ) F" := +Notation "\meet^c_ ( i <- r | P ) F" := (\big[meet/1]_(i <- r | P%B) F%O) : order_scope. -Notation "\meet^r_ ( i <- r ) F" := +Notation "\meet^c_ ( i <- r ) F" := (\big[meet/1]_(i <- r) F%O) : order_scope. -Notation "\meet^r_ ( i | P ) F" := +Notation "\meet^c_ ( i | P ) F" := (\big[meet/1]_(i | P%B) F%O) : order_scope. -Notation "\meet^r_ i F" := +Notation "\meet^c_ i F" := (\big[meet/1]_i F%O) : order_scope. -Notation "\meet^r_ ( i : I | P ) F" := +Notation "\meet^c_ ( i : I | P ) F" := (\big[meet/1]_(i : I | P%B) F%O) (only parsing) : order_scope. -Notation "\meet^r_ ( i : I ) F" := +Notation "\meet^c_ ( i : I ) F" := (\big[meet/1]_(i : I) F%O) (only parsing) : order_scope. -Notation "\meet^r_ ( m <= i < n | P ) F" := +Notation "\meet^c_ ( m <= i < n | P ) F" := (\big[meet/1]_(m <= i < n | P%B) F%O) : order_scope. -Notation "\meet^r_ ( m <= i < n ) F" := +Notation "\meet^c_ ( m <= i < n ) F" := (\big[meet/1]_(m <= i < n) F%O) : order_scope. -Notation "\meet^r_ ( i < n | P ) F" := +Notation "\meet^c_ ( i < n | P ) F" := (\big[meet/1]_(i < n | P%B) F%O) : order_scope. -Notation "\meet^r_ ( i < n ) F" := +Notation "\meet^c_ ( i < n ) F" := (\big[meet/1]_(i < n) F%O) : order_scope. -Notation "\meet^r_ ( i 'in' A | P ) F" := +Notation "\meet^c_ ( i 'in' A | P ) F" := (\big[meet/1]_(i in A | P%B) F%O) : order_scope. -Notation "\meet^r_ ( i 'in' A ) F" := +Notation "\meet^c_ ( i 'in' A ) F" := (\big[meet/1]_(i in A) F%O) : order_scope. -End ReverseTBLatticeSyntax. -End ReverseTBLatticeSyntax. +End ConverseTBLatticeSyntax. +End ConverseTBLatticeSyntax. Module Import TBLatticeTheory. Section TBLatticeTheory. @@ -2362,43 +2548,43 @@ Implicit Types (x y : L). Local Notation "1" := top. -Hint Resolve le0x lex1. +Hint Resolve le0x lex1 : core. Lemma meetx1 : right_id 1 (@meet _ L). -Proof. exact: (@joinx0 _ [tblatticeType of L^r]). Qed. +Proof. exact: (@joinx0 _ [tblatticeType of L^c]). Qed. Lemma meet1x : left_id 1 (@meet _ L). -Proof. exact: (@join0x _ [tblatticeType of L^r]). Qed. +Proof. exact: (@join0x _ [tblatticeType of L^c]). Qed. Lemma joinx1 : right_zero 1 (@join _ L). -Proof. exact: (@meetx0 _ [tblatticeType of L^r]). Qed. +Proof. exact: (@meetx0 _ [tblatticeType of L^c]). Qed. Lemma join1x : left_zero 1 (@join _ L). -Proof. exact: (@meet0x _ [tblatticeType of L^r]). Qed. +Proof. exact: (@meet0x _ [tblatticeType of L^c]). Qed. Lemma le1x x : (1 <= x) = (x == 1). -Proof. exact: (@lex0 _ [tblatticeType of L^r]). Qed. +Proof. exact: (@lex0 _ [tblatticeType of L^c]). Qed. Lemma leI2l_le y t x z : y `|` z = 1 -> x `&` y <= z `&` t -> x <= z. -Proof. rewrite joinC; exact: (@leU2l_le _ [tblatticeType of L^r]). Qed. +Proof. rewrite joinC; exact: (@leU2l_le _ [tblatticeType of L^c]). Qed. Lemma leI2r_le y t x z : y `|` z = 1 -> y `&` x <= t `&` z -> x <= z. -Proof. rewrite joinC; exact: (@leU2r_le _ [tblatticeType of L^r]). Qed. +Proof. rewrite joinC; exact: (@leU2r_le _ [tblatticeType of L^c]). Qed. Lemma lexIl z x y : z `|` y = 1 -> (x `&` z <= y) = (x <= y). -Proof. rewrite joinC; exact: (@lexUl _ [tblatticeType of L^r]). Qed. +Proof. rewrite joinC; exact: (@lexUl _ [tblatticeType of L^c]). Qed. Lemma lexIr z x y : z `|` y = 1 -> (z `&` x <= y) = (x <= y). -Proof. rewrite joinC; exact: (@lexUr _ [tblatticeType of L^r]). Qed. +Proof. rewrite joinC; exact: (@lexUr _ [tblatticeType of L^c]). Qed. Lemma leI2E x y z t : x `|` t = 1 -> y `|` z = 1 -> (x `&` y <= z `&` t) = (x <= z) && (y <= t). Proof. -by move=> ? ?; apply: (@leU2E _ [tblatticeType of L^r]); rewrite meetC. +by move=> ? ?; apply: (@leU2E _ [tblatticeType of L^c]); rewrite meetC. Qed. Lemma meet_eq1 x y : (x `&` y == 1) = (x == 1) && (y == 1). -Proof. exact: (@join_eq0 _ [tblatticeType of L^r]). Qed. +Proof. exact: (@join_eq0 _ [tblatticeType of L^c]). Qed. Canonical meet_monoid := Monoid.Law (@meetA _ _) meet1x meetx1. Canonical meet_comoid := Monoid.ComLaw (@meetC _ _). @@ -2408,33 +2594,33 @@ Canonical join_muloid := Monoid.MulLaw join1x joinx1. Canonical join_addoid := Monoid.AddLaw (@meetUl _ L) (@meetUr _ _). Canonical meet_addoid := Monoid.AddLaw (@joinIl _ L) (@joinIr _ _). -Lemma meets_inf (I : finType) (j : I) (P : pred I) (F : I -> L) : +Lemma meets_inf (I : finType) (j : I) (P : {pred I}) (F : I -> L) : P j -> \meet_(i | P i) F i <= F j. -Proof. exact: (@join_sup _ [tblatticeType of L^r]). Qed. +Proof. exact: (@join_sup _ [tblatticeType of L^c]). Qed. -Lemma meets_max (I : finType) (j : I) (u : L) (P : pred I) (F : I -> L) : +Lemma meets_max (I : finType) (j : I) (u : L) (P : {pred I}) (F : I -> L) : P j -> F j <= u -> \meet_(i | P i) F i <= u. -Proof. exact: (@join_min _ [tblatticeType of L^r]). Qed. +Proof. exact: (@join_min _ [tblatticeType of L^c]). Qed. -Lemma meetsP (I : finType) (l : L) (P : pred I) (F : I -> L) : +Lemma meetsP (I : finType) (l : L) (P : {pred I}) (F : I -> L) : reflect (forall i : I, P i -> l <= F i) (l <= \meet_(i | P i) F i). -Proof. exact: (@joinsP _ [tblatticeType of L^r]). Qed. +Proof. exact: (@joinsP _ [tblatticeType of L^c]). Qed. Lemma le_meets (I : finType) (A B : {set I}) (F : I -> L) : A \subset B -> \meet_(i in B) F i <= \meet_(i in A) F i. -Proof. exact: (@le_joins _ [tblatticeType of L^r]). Qed. +Proof. exact: (@le_joins _ [tblatticeType of L^c]). Qed. Lemma meets_setU (I : finType) (A B : {set I}) (F : I -> L) : \meet_(i in (A :|: B)) F i = \meet_(i in A) F i `&` \meet_(i in B) F i. -Proof. exact: (@joins_setU _ [tblatticeType of L^r]). Qed. +Proof. exact: (@joins_setU _ [tblatticeType of L^c]). Qed. Lemma meet_seq (I : finType) (r : seq I) (F : I -> L) : \meet_(i <- r) F i = \meet_(i in r) F i. -Proof. exact: (@join_seq _ [tblatticeType of L^r]). Qed. +Proof. exact: (@join_seq _ [tblatticeType of L^c]). Qed. -Lemma meets_total (I : finType) (d : L) (P : pred I) (F : I -> L) : +Lemma meets_total (I : finType) (d : L) (P : {pred I}) (F : I -> L) : (forall i : I, P i -> d `|` F i = 1) -> d `|` \meet_(i | P i) F i = 1. -Proof. exact: (@joins_disjoint _ [tblatticeType of L^r]). Qed. +Proof. exact: (@joins_disjoint _ [tblatticeType of L^c]). Qed. End TBLatticeTheory. End TBLatticeTheory. @@ -2448,7 +2634,7 @@ Implicit Types (x y z : L). Local Notation "0" := bottom. Lemma subKI x y : y `&` (x `\` y) = 0. -Proof. by case: L x y => ? [? []]. Qed. +Proof. by case: L x y => ? [? ?[]]. Qed. Lemma subIK x y : (x `\` y) `&` y = 0. Proof. by rewrite meetC subKI. Qed. @@ -2460,7 +2646,7 @@ Lemma meetBI z x y : (x `\` y) `&` (z `&` y) = 0. Proof. by rewrite meetC meetIB. Qed. Lemma joinIB y x : (x `&` y) `|` (x `\` y) = x. -Proof. by case: L x y => ? [? []]. Qed. +Proof. by case: L x y => ? [? ?[]]. Qed. Lemma joinBI y x : (x `\` y) `|` (x `&` y) = x. Proof. by rewrite joinC joinIB. Qed. @@ -2472,8 +2658,8 @@ Lemma joinBIC y x : (x `\` y) `|` (y `&` x) = x. Proof. by rewrite meetC joinBI. Qed. Lemma leBx x y : x `\` y <= x. -Proof. by rewrite -{2}[x](joinIB y) lexU // lexx orbT. Qed. -Hint Resolve leBx. +Proof. by rewrite -{2}[x](joinIB y) lexU2 // lexx orbT. Qed. +Hint Resolve leBx : core. Lemma subxx x : x `\` x = 0. Proof. by have := subKI x x; rewrite (meet_idPr _). Qed. @@ -2522,7 +2708,7 @@ Proof. by rewrite ![_ `|` x]joinC ![_ `&` x]meetC joinxB. Qed. Lemma leBr z x y : x <= y -> z `\` y <= z `\` x. Proof. -by move=> lexy; rewrite leBLR joinxB (meet_idPr _) ?leBUK ?leUr ?lexU ?lexy. +by move=> lexy; rewrite leBLR joinxB (meet_idPr _) ?leBUK ?leUr ?lexU2 ?lexy. Qed. Lemma leB2 x y z t : x <= z -> t <= y -> x `\` y <= z `\` t. @@ -2546,7 +2732,7 @@ Proof. by rewrite eq_le leBLR leBRL andbCA andbA. Qed. Lemma subxU x y z : z `\` (x `|` y) = (z `\` x) `&` (z `\` y). Proof. apply/eqP; rewrite eq_le lexI !leBr ?leUl ?leUr //=. -rewrite leBRL leIx ?leBx //= meetUr meetAC subIK -meetA subIK. +rewrite leBRL leIx2 ?leBx //= meetUr meetAC subIK -meetA subIK. by rewrite meet0x meetx0 joinx0. Qed. @@ -2628,7 +2814,7 @@ Local Notation "0" := bottom. Local Notation "1" := top. Lemma complE x : ~` x = 1 `\` x. -Proof. by case: L x => [? [? ? []]]. Qed. +Proof. by case: L x => [?[? ? ? ?[]]]. Qed. Lemma sub1x x : 1 `\` x = ~` x. Proof. by rewrite complE. Qed. @@ -2688,107 +2874,753 @@ Proof. by rewrite !complE !leBLR joinC. Qed. Lemma lexC x y : (x <= ~` y) = (y <= ~` x). Proof. by rewrite !complE !leBRL !lex1 meetC. Qed. -Lemma compl_joins (J : Type) (r : seq J) (P : pred J) (F : J -> L) : +Lemma compl_joins (J : Type) (r : seq J) (P : {pred J}) (F : J -> L) : ~` (\join_(j <- r | P j) F j) = \meet_(j <- r | P j) ~` F j. Proof. by elim/big_rec2: _=> [|i x y ? <-]; rewrite ?compl0 ?complU. Qed. -Lemma compl_meets (J : Type) (r : seq J) (P : pred J) (F : J -> L) : +Lemma compl_meets (J : Type) (r : seq J) (P : {pred J}) (F : J -> L) : ~` (\meet_(j <- r | P j) F j) = \join_(j <- r | P j) ~` F j. Proof. by elim/big_rec2: _=> [|i x y ? <-]; rewrite ?compl1 ?complI. Qed. End CTBLatticeTheory. End CTBLatticeTheory. +(*************) +(* FACTORIES *) +(*************) + +Module TotalLatticeMixin. +Section TotalLatticeMixin. +Import POrderDef. +Variable (disp : unit) (T : porderType disp). +Definition of_ := total (<=%O : rel T). +Variable (m : of_). +Implicit Types (x y z : T). + +Let comparableT x y : x >=< y := m x y. + +Fact ltgtP x y : + comparer x y (y == x) (x == y) (x <= y) (y <= x) (x < y) (x > y). +Proof. exact: comparable_ltgtP. Qed. + +Fact leP x y : le_xor_gt x y (x <= y) (y < x). +Proof. exact: comparable_leP. Qed. + +Fact ltP x y : lt_xor_ge x y (y <= x) (x < y). +Proof. exact: comparable_ltP. Qed. + +Definition meet x y := if x <= y then x else y. +Definition join x y := if y <= x then x else y. + +Fact meetC : commutative meet. +Proof. by move=> x y; rewrite /meet; have [] := ltgtP. Qed. + +Fact joinC : commutative join. +Proof. by move=> x y; rewrite /join; have [] := ltgtP. Qed. + +Fact meetA : associative meet. +Proof. +move=> x y z; rewrite /meet; case: (leP y z) => yz; case: (leP x y) => xy //=. +- by rewrite (le_trans xy). +- by rewrite yz. +by rewrite !lt_geF // (lt_trans yz). +Qed. + +Fact joinA : associative join. +Proof. +move=> x y z; rewrite /join; case: (leP z y) => yz; case: (leP y x) => xy //=. +- by rewrite (le_trans yz). +- by rewrite yz. +by rewrite !lt_geF // (lt_trans xy). +Qed. + +Fact joinKI y x : meet x (join x y) = x. +Proof. by rewrite /meet /join; case: (leP y x) => yx; rewrite ?lexx ?ltW. Qed. + +Fact meetKU y x : join x (meet x y) = x. +Proof. by rewrite /meet /join; case: (leP x y) => yx; rewrite ?lexx ?ltW. Qed. + +Fact leEmeet x y : (x <= y) = (meet x y == x). +Proof. by rewrite /meet; case: leP => ?; rewrite ?eqxx ?lt_eqF. Qed. + +Fact meetUl : left_distributive meet join. +Proof. +move=> x y z; rewrite /meet /join. +case: (leP y z) => yz; case: (leP y x) => xy //=; first 1 last. +- by rewrite yz [x <= z](le_trans _ yz) ?[x <= y]ltW // lt_geF. +- by rewrite lt_geF ?lexx // (lt_le_trans yz). +- by rewrite lt_geF //; have [->|/lt_geF->|] := (ltgtP x z); rewrite ?lexx. +- by have [] := (leP x z); rewrite ?xy ?yz. +Qed. + +Definition latticeMixin := + LatticeMixin meetC joinC meetA joinA joinKI meetKU leEmeet meetUl. + +End TotalLatticeMixin. + +Module Exports. +Notation totalLatticeMixin := of_. +Coercion latticeMixin : totalLatticeMixin >-> Order.Lattice.mixin_of. +End Exports. + +End TotalLatticeMixin. +Import TotalLatticeMixin.Exports. + +Module LePOrderMixin. +Section LePOrderMixin. +Variable (T : eqType). + +Record of_ := Build { + le : rel T; + lt : rel T; + le_refl : reflexive le; + le_anti : antisymmetric le; + le_trans : transitive le; + lt_def : forall x y, lt x y = (y != x) && le x y; +}. + +Definition porderMixin (m : of_) : porderMixin T := + POrderMixin (@lt_def m) (@le_refl m) (@le_anti m) (@le_trans m). + +End LePOrderMixin. + +Module Exports. +Notation lePOrderMixin := of_. +Notation LePOrderMixin := Build. +Coercion porderMixin : lePOrderMixin >-> POrder.mixin_of. +End Exports. + +End LePOrderMixin. +Import LePOrderMixin.Exports. + +Module LtPOrderMixin. +Section LtPOrderMixin. +Variable (T : eqType). + +Record of_ := Build { + le : rel T; + lt : rel T; + lt_irr : irreflexive lt; + lt_trans : transitive lt; + le_def : forall x y, le x y = (x == y) || lt x y; +}. + +Variable (m : of_). + +Fact lt_asym x y : (lt m x y && lt m y x) = false. +Proof. +by apply/negP => /andP [] xy /(lt_trans xy); apply/negP; rewrite (lt_irr m x). +Qed. + +Fact lt_def x y : lt m x y = (y != x) && le m x y. +Proof. by rewrite le_def eq_sym; case: eqP => //= <-; rewrite lt_irr. Qed. + +Fact le_refl : reflexive (le m). +Proof. by move=> ?; rewrite le_def eqxx. Qed. + +Fact le_anti : antisymmetric (le m). +Proof. +by move=> ? ?; rewrite !le_def eq_sym -orb_andr lt_asym orbF => /eqP. +Qed. + +Fact le_trans : transitive (le m). +Proof. +by move=> y x z; rewrite !le_def => /predU1P [-> //|ltxy] /predU1P [<-|ltyz]; + rewrite ?ltxy ?(lt_trans ltxy ltyz) // ?orbT. +Qed. + +Definition porderMixin : porderMixin T := + @POrderMixin _ (le m) (lt m) lt_def le_refl le_anti le_trans. + +End LtPOrderMixin. + +Module Exports. +Notation ltPOrderMixin := of_. +Notation LtPOrderMixin := Build. +Coercion porderMixin : ltPOrderMixin >-> POrder.mixin_of. +End Exports. + +End LtPOrderMixin. +Import LtPOrderMixin.Exports. + +Module MeetJoinMixin. +Section MeetJoinMixin. + +Variable (disp : unit) (T : choiceType). + +Record of_ (disp : unit) (T : choiceType) := Build { + le : rel T; + lt : rel T; + meet : T -> T -> T; + join : T -> T -> T; + meetC : commutative meet; + joinC : commutative join; + meetA : associative meet; + joinA : associative join; + joinKI : forall y x : T, meet x (join x y) = x; + meetKU : forall y x : T, join x (meet x y) = x; + meetUl : left_distributive meet join; + meetxx : idempotent meet; + le_def : forall x y : T, le x y = (meet x y == x); + lt_def : forall x y : T, lt x y = (y != x) && le x y; +}. + + +Variable (m : of_ disp T). + +Fact le_refl : reflexive (le m). +Proof. by move=> x; rewrite le_def meetxx. Qed. + +Fact le_anti : antisymmetric (le m). +Proof. by move=> x y; rewrite !le_def meetC => /andP [] /eqP {2}<- /eqP ->. Qed. + +Fact le_trans : transitive (le m). +Proof. +move=> y x z; rewrite !le_def => /eqP lexy /eqP leyz; apply/eqP. +by rewrite -[in LHS]lexy -meetA leyz lexy. +Qed. + +Definition porderMixin : lePOrderMixin T := + LePOrderMixin le_refl le_anti le_trans (lt_def m). + +Definition latticeMixin : latticeMixin (POrderType disp T porderMixin) := + @LatticeMixin disp (POrderType disp T porderMixin) (meet m) (join m) + (meetC m) (joinC m) (meetA m) (joinA m) + (joinKI m) (meetKU m) (le_def m) (meetUl m). + +End MeetJoinMixin. + +Module Exports. +Notation meetJoinMixin := of_. +Notation MeetJoinMixin := Build. +Coercion porderMixin : meetJoinMixin >-> lePOrderMixin. +Coercion latticeMixin : meetJoinMixin >-> Lattice.mixin_of. +End Exports. + +End MeetJoinMixin. +Import MeetJoinMixin.Exports. + +Module LeOrderMixin. +Section LeOrderMixin. + +Record of_ (disp : unit) (T : choiceType) := Build { + le : rel T; + lt : rel T; + meet : T -> T -> T; + join : T -> T -> T; + le_anti : antisymmetric le; + le_trans : transitive le; + le_total : total le; + lt_def : forall x y, lt x y = (y != x) && le x y; + meet_def : forall x y, meet x y = if le x y then x else y; + join_def : forall x y, join x y = if le y x then x else y; +}. + +Variable (disp : unit) (T : choiceType) (m : of_ disp T). + +Fact le_refl : reflexive (le m). +Proof. by move=> x; case: (le m x x) (le_total m x x). Qed. + +Definition T_porderType : porderType disp := + POrderType + disp T + (LePOrderMixin le_refl (@le_anti _ _ m) (@le_trans _ _ m) (lt_def m)). +Definition T_latticeType : latticeType disp := + LatticeType T_porderType (le_total m : totalLatticeMixin T_porderType). + +Implicit Types (x y z : T_latticeType). + +Fact meetE x y : meet m x y = x `&` y. Proof. by rewrite meet_def. Qed. +Fact joinE x y : join m x y = x `|` y. Proof. by rewrite join_def. Qed. +Fact meetC : commutative (meet m). +Proof. by move=> *; rewrite !meetE meetC. Qed. +Fact joinC : commutative (join m). +Proof. by move=> *; rewrite !joinE joinC. Qed. +Fact meetA : associative (meet m). +Proof. by move=> *; rewrite !meetE meetA. Qed. +Fact joinA : associative (join m). +Proof. by move=> *; rewrite !joinE joinA. Qed. +Fact joinKI y x : meet m x (join m x y) = x. +Proof. by rewrite meetE joinE joinKI. Qed. +Fact meetKU y x : join m x (meet m x y) = x. +Proof. by rewrite meetE joinE meetKU. Qed. +Fact meetUl : left_distributive (meet m) (join m). +Proof. by move=> *; rewrite !meetE !joinE meetUl. Qed. +Fact meetxx : idempotent (meet m). +Proof. by move=> *; rewrite meetE meetxx. Qed. +Fact le_def x y : x <= y = (meet m x y == x). +Proof. by rewrite meetE (eq_meetl x y). Qed. + +Definition latticeMixin : meetJoinMixin disp T := + @MeetJoinMixin + _ _ (le m) (lt m) (meet m) (join m) + meetC joinC meetA joinA joinKI meetKU meetUl meetxx le_def (lt_def m). + +Definition totalMixin : + Total.mixin_of (LatticeType (POrderType disp T latticeMixin) latticeMixin) + := le_total m. + +End LeOrderMixin. + +Module Exports. +Notation leOrderMixin := of_. +Notation LeOrderMixin := Build. +Coercion latticeMixin : leOrderMixin >-> meetJoinMixin. +Coercion totalMixin : leOrderMixin >-> Total.mixin_of. +End Exports. + +End LeOrderMixin. +Import LeOrderMixin.Exports. + +Module LtOrderMixin. + +Record of_ (disp : unit) (T : choiceType) := Build { + le : rel T; + lt : rel T; + meet : T -> T -> T; + join : T -> T -> T; + lt_irr : irreflexive lt; + lt_trans : transitive lt; + lt_total : forall x y, x != y -> lt x y || lt y x; + le_def : forall x y, le x y = (x == y) || lt x y; + meet_def : forall x y, meet x y = if lt x y then x else y; + join_def : forall x y, join x y = if lt y x then x else y; +}. + +Section LtOrderMixin. + +Variable (disp : unit) (T : choiceType) (m : of_ disp T). + +Fact le_total : total (le m). +Proof. +by move=> x y; rewrite !le_def (eq_sym y); case: (altP eqP); [|apply: lt_total]. +Qed. + +Definition T_porderType : porderType disp := + POrderType disp T (LtPOrderMixin (lt_irr m) (@lt_trans _ _ m) (le_def m)). +Definition T_latticeType : latticeType disp := + LatticeType T_porderType (le_total : totalLatticeMixin T_porderType). + +Implicit Types (x y z : T_latticeType). + +Fact leP x y : + le_xor_gt x y (x <= y) (y < x) (y `&` x) (x `&` y) (y `|` x) (x `|` y). +Proof. by apply/lcomparable_leP/le_total. Qed. +Fact meetE x y : meet m x y = x `&` y. +Proof. by rewrite meet_def (_ : lt m x y = (x < y)) //; case: (leP y). Qed. +Fact joinE x y : join m x y = x `|` y. +Proof. by rewrite join_def (_ : lt m y x = (y < x)) //; case: leP. Qed. +Fact meetC : commutative (meet m). +Proof. by move=> *; rewrite !meetE meetC. Qed. +Fact joinC : commutative (join m). +Proof. by move=> *; rewrite !joinE joinC. Qed. +Fact meetA : associative (meet m). +Proof. by move=> *; rewrite !meetE meetA. Qed. +Fact joinA : associative (join m). +Proof. by move=> *; rewrite !joinE joinA. Qed. +Fact joinKI y x : meet m x (join m x y) = x. +Proof. by rewrite meetE joinE joinKI. Qed. +Fact meetKU y x : join m x (meet m x y) = x. +Proof. by rewrite meetE joinE meetKU. Qed. +Fact meetUl : left_distributive (meet m) (join m). +Proof. by move=> *; rewrite !meetE !joinE meetUl. Qed. +Fact meetxx : idempotent (meet m). +Proof. by move=> *; rewrite meetE meetxx. Qed. +Fact le_def' x y : x <= y = (meet m x y == x). +Proof. by rewrite meetE (eq_meetl x y). Qed. + +Definition latticeMixin : meetJoinMixin disp T := + @MeetJoinMixin + _ _ (le m) (lt m) (meet m) (join m) + meetC joinC meetA joinA joinKI meetKU meetUl meetxx + le_def' (@lt_def _ T_latticeType). + +Definition totalMixin : + Total.mixin_of (LatticeType (POrderType disp T latticeMixin) latticeMixin) + := le_total. + +End LtOrderMixin. + +Module Exports. +Notation ltOrderMixin := of_. +Notation LtOrderMixin := Build. +Coercion latticeMixin : ltOrderMixin >-> meetJoinMixin. +Coercion totalMixin : ltOrderMixin >-> Total.mixin_of. +End Exports. + +End LtOrderMixin. +Import LtOrderMixin.Exports. + (*************) (* INSTANCES *) (*************) -Module Import NatOrder. +Module NatOrder. Section NatOrder. -Fact nat_display : unit. Proof. exact: tt. Qed. -Program Definition natPOrderMixin := @POrderMixin _ leq ltn _ leqnn anti_leq leq_trans. -Next Obligation. by rewrite ltn_neqAle. Qed. -Canonical natPOrderType := POrderType nat_display nat natPOrderMixin. +Lemma minnE x y : minn x y = if (x <= y)%N then x else y. +Proof. by case: leqP => [/minn_idPl|/ltnW /minn_idPr]. Qed. + +Lemma maxnE x y : maxn x y = if (y <= x)%N then x else y. +Proof. by case: leqP => [/maxn_idPl|/ltnW/maxn_idPr]. Qed. -Lemma leEnat (n m : nat): (n <= m) = (n <= m)%N. +Lemma ltn_def x y : (x < y)%N = (y != x) && (x <= y)%N. +Proof. by rewrite ltn_neqAle eq_sym. Qed. + +Definition orderMixin := + LeOrderMixin total_display anti_leq leq_trans leq_total ltn_def minnE maxnE. + +Canonical porderType := POrderType total_display nat orderMixin. +Canonical latticeType := LatticeType nat orderMixin. +Canonical orderType := OrderType nat orderMixin. +Canonical blatticeType := BLatticeType nat (BLatticeMixin leq0n). + +Lemma leEnat: le = leq. Proof. by []. Qed. Lemma ltEnat (n m : nat): (n < m) = (n < m)%N. Proof. by []. Qed. -Definition natLatticeMixin := TotalLattice.Mixin leq_total. -Canonical natLatticeType := LatticeType nat natLatticeMixin. -Canonical natOrderType := OrderType nat leq_total. - -Definition natBLatticeMixin := BLatticeMixin leq0n. -Canonical natBLatticeType := BLatticeType nat natBLatticeMixin. +End NatOrder. +Module Exports. +Canonical porderType. +Canonical latticeType. +Canonical orderType. +Canonical blatticeType. +Definition leEnat := leEnat. +Definition ltEnat := ltEnat. +End Exports. End NatOrder. -Notation "@max" := (@join nat_display). -Notation max := (@join nat_display _). -Notation "@min" := (@meet nat_display). -Notation min := (@meet nat_display _). +Module ProductOrder. +Section ProductOrder. +Context {disp1 disp2 disp3 : unit}. -Notation "\max_ ( i <- r | P ) F" := - (\big[@join nat_display _/0%O]_(i <- r | P%B) F%O) : order_scope. -Notation "\max_ ( i <- r ) F" := - (\big[@join nat_display _/0%O]_(i <- r) F%O) : order_scope. -Notation "\max_ ( i | P ) F" := - (\big[@join nat_display _/0%O]_(i | P%B) F%O) : order_scope. -Notation "\max_ i F" := - (\big[@join nat_display _/0%O]_i F%O) : order_scope. -Notation "\max_ ( i : I | P ) F" := - (\big[@join nat_display _/0%O]_(i : I | P%B) F%O) (only parsing) : order_scope. -Notation "\max_ ( i : I ) F" := - (\big[@join nat_display _/0%O]_(i : I) F%O) (only parsing) : order_scope. -Notation "\max_ ( m <= i < n | P ) F" := - (\big[@join nat_display _/0%O]_(m <= i < n | P%B) F%O) : order_scope. -Notation "\max_ ( m <= i < n ) F" := - (\big[@join nat_display _/0%O]_(m <= i < n) F%O) : order_scope. -Notation "\max_ ( i < n | P ) F" := - (\big[@join nat_display _/0%O]_(i < n | P%B) F%O) : order_scope. -Notation "\max_ ( i < n ) F" := - (\big[@join nat_display _/0%O]_(i < n) F%O) : order_scope. -Notation "\max_ ( i 'in' A | P ) F" := - (\big[@join nat_display _/0%O]_(i in A | P%B) F%O) : order_scope. -Notation "\max_ ( i 'in' A ) F" := - (\big[@join nat_display _/0%O]_(i in A) F%O) : order_scope. +Section POrder. +Variable (T : porderType disp1) (T' : porderType disp2). -End NatOrder. +Definition le (x y : T * T') := (x.1 <= y.1) && (x.2 <= y.2). +Fact refl : reflexive le. +Proof. by move=> ?; rewrite /le !lexx. Qed. -Module SeqLexPOrder. -Section SeqLexPOrder. -Context {display : unit}. -Local Notation porderType := (porderType display). -Variable T : porderType. +Fact anti : antisymmetric le. +Proof. +case=> [? ?] [? ?]. +by rewrite andbAC andbA andbAC -andbA => /= /andP [] /le_anti -> /le_anti ->. +Qed. + +Fact trans : transitive le. +Proof. +rewrite /le => y x z /andP [] hxy ? /andP [] /(le_trans hxy) ->. +by apply: le_trans. +Qed. + +Definition porderMixin := LePOrderMixin refl anti trans (rrefl _). +Canonical porderType := POrderType disp3 (T * T') porderMixin. + +End POrder. + +Section Lattice. +Variable (T : latticeType disp1) (T' : latticeType disp2). +Implicit Types (x y : T * T'). + +Definition meet x y := (x.1 `&` y.1, x.2 `&` y.2). +Definition join x y := (x.1 `|` y.1, x.2 `|` y.2). + +Fact meetC : commutative meet. +Proof. by move=> ? ?; congr pair; rewrite meetC. Qed. + +Fact joinC : commutative join. +Proof. by move=> ? ?; congr pair; rewrite joinC. Qed. + +Fact meetA : associative meet. +Proof. by move=> ? ? ?; congr pair; rewrite meetA. Qed. + +Fact joinA : associative join. +Proof. by move=> ? ? ?; congr pair; rewrite joinA. Qed. + +Fact joinKI y x : meet x (join x y) = x. +Proof. by case: x => ? ?; congr pair; rewrite joinKI. Qed. + +Fact meetKU y x : join x (meet x y) = x. +Proof. by case: x => ? ?; congr pair; rewrite meetKU. Qed. + +Fact leEmeet x y : (x <= y) = (meet x y == x). +Proof. by rewrite /POrderDef.le /= /le /meet eqE /= -!leEmeet. Qed. + +Fact meetUl : left_distributive meet join. +Proof. by move=> ? ? ?; congr pair; rewrite meetUl. Qed. + +Definition latticeMixin := + Lattice.Mixin meetC joinC meetA joinA joinKI meetKU leEmeet meetUl. +Canonical latticeType := LatticeType (T * T') latticeMixin. + +End Lattice. + +Section BLattice. +Variable (T : blatticeType disp1) (T' : blatticeType disp2). + +Fact le0x (x : T * T') : (0, 0) <= x. +Proof. by rewrite /POrderDef.le /= /le !le0x. Qed. + +Canonical blatticeType := BLatticeType (T * T') (BLattice.Mixin le0x). +End BLattice. + +Section TBLattice. +Variable (T : tblatticeType disp1) (T' : tblatticeType disp2). + +Fact lex1 (x : T * T') : x <= (top, top). +Proof. by rewrite /POrderDef.le /= /le !lex1. Qed. + +Canonical tblatticeType := TBLatticeType (T * T') (TBLattice.Mixin lex1). + +End TBLattice. + +Section CBLattice. +Variable (T : cblatticeType disp1) (T' : cblatticeType disp2). +Implicit Types (x y : T * T'). + +Definition sub x y := (x.1 `\` y.1, x.2 `\` y.2). + +Lemma subKI x y : y `&` (sub x y) = 0. +Proof. by congr pair; rewrite subKI. Qed. + +Lemma joinIB x y : (x `&` y) `|` (sub x y) = x. +Proof. by case: x => ? ?; congr pair; rewrite joinIB. Qed. + +Definition cblatticeMixin := CBLattice.Mixin subKI joinIB. +Canonical cblatticeType := CBLatticeType (T * T') cblatticeMixin. + +End CBLattice. + +Section CTBLattice. +Variable (T : ctblatticeType disp1) (T' : ctblatticeType disp2). +Implicit Types (x y : T * T'). + +Definition compl x := (~` x.1, ~` x.2). + +Lemma complE x : compl x = sub 1 x. +Proof. by congr pair; rewrite complE. Qed. + +Definition ctblatticeMixin := CTBLattice.Mixin complE. +Canonical ctblatticeType := CTBLatticeType (T * T') ctblatticeMixin. +(* Let default_ctblatticeType := [default_ctblatticeType of T * T']. *) + +End CTBLattice. + +Canonical finPOrderType (T : finPOrderType disp1) (T' : finPOrderType disp2) := + [finPOrderType of T * T']. + +Canonical finLatticeType + (T : finLatticeType disp1) (T' : finLatticeType disp2) := + [finLatticeType of T * T']. + +Canonical finClatticeType + (T : finCLatticeType disp1) (T' : finCLatticeType disp2) := + [finCLatticeType of T * T']. + +End ProductOrder. + +Module Exports. +Canonical porderType. +Canonical latticeType. +Canonical blatticeType. +Canonical tblatticeType. +Canonical cblatticeType. +Canonical ctblatticeType. +Canonical finPOrderType. +Canonical finLatticeType. +Canonical finClatticeType. +End Exports. +End ProductOrder. + +Module ProdLexOrder. +Section ProdLexOrder. +Context {disp1 disp2 disp3 : unit}. + +Section POrder. +Variable (T : porderType disp1) (T' : porderType disp2). +Implicit Types (x y : T * T'). + +Definition le x y := (x.1 <= y.1) && ((x.1 >= y.1) ==> (x.2 <= y.2)). + +Fact refl : reflexive le. +Proof. by move=> ?; by rewrite /le !lexx. Qed. + +Fact anti : antisymmetric le. +Proof. +rewrite /le => -[x x'] [y y'] /=; case_eq (y <= x); case_eq (x <= y) => //. +by move=> //= hxy hyx /le_anti ->; move/andP/le_anti: (conj hxy hyx) => ->. +Qed. + +Fact trans : transitive le. +Proof. +move=> y x z /andP [hxy /implyP hxy'] /andP [hyz /implyP hyz']. +rewrite /le (le_trans hxy) //=; apply/implyP => hzx. +by apply/le_trans/hxy'/(le_trans hyz): (hyz' (le_trans hzx hxy)). +Qed. + +Definition porderMixin := LePOrderMixin refl anti trans (rrefl _). +Canonical porderType := POrderType disp3 (T * T') porderMixin. + +End POrder. + +Section Total. +Variable (T : orderType disp1) (T' : orderType disp2). +Implicit Types (x y : T * T'). + +Fact total : totalLatticeMixin [porderType of T * T']. +Proof. +move=> x y; rewrite /POrderDef.le /= /le; case: (ltgtP x.1 y.1) => _ //=. +by apply: le_total. +Qed. + +Canonical latticeType := LatticeType (T * T') total. +Canonical totalType := LatticeType (T * T') total. + +End Total. + +End ProdLexOrder. + +Module Exports. +Canonical porderType. +Canonical latticeType. +Canonical totalType. +End Exports. +End ProdLexOrder. + +Module SeqProdOrder. +Section SeqProdOrder. +Context {disp disp' : unit}. + +Section POrder. +Variable T : porderType disp. +Implicit Types s : seq T. + +Fixpoint le s1 s2 := + if s1 is x1 :: s1' then + if s2 is x2 :: s2' then (x1 <= x2) && le s1' s2' else false + else + true. + +Fact refl : reflexive le. +Proof. by elim=> //= ? ? ?; rewrite !lexx. Qed. + +Fact anti : antisymmetric le. +Proof. +elim=> [|? ? ih] [|? ?] //=. +by rewrite andbAC andbA andbAC -andbA => /andP [] /le_anti -> /ih ->. +Qed. + +Fact trans : transitive le. +Proof. +elim=> [|y ys ih] [|x xs] [|z zs] //=. +by case/andP => [] xy xys /andP [] /(le_trans xy) -> /(ih _ _ xys). +Qed. + +Definition porderMixin := LePOrderMixin refl anti trans (rrefl _). +Canonical porderType := POrderType disp' (seq T) porderMixin. + +End POrder. + +Section BLattice. +Variable T : latticeType disp. +Implicit Types s : seq T. + +Fixpoint meet s1 s2 := + match s1, s2 with + | x1 :: s1', x2 :: s2' => (x1 `&` x2) :: meet s1' s2' + | _, _ => [::] + end. + +Fixpoint join s1 s2 := + match s1, s2 with + | [::], _ => s2 + | _, [::] => s1 + | x1 :: s1', x2 :: s2' => (x1 `|` x2) :: join s1' s2' + end. + +Fact meetC : commutative meet. +Proof. by elim=> [|? ? ih] [|? ?] //=; rewrite meetC ih. Qed. + +Fact joinC : commutative join. +Proof. by elim=> [|? ? ih] [|? ?] //=; rewrite joinC ih. Qed. + +Fact meetA : associative meet. +Proof. by elim=> [|? ? ih] [|? ?] [|? ?] //=; rewrite meetA ih. Qed. + +Fact joinA : associative join. +Proof. by elim=> [|? ? ih] [|? ?] [|? ?] //=; rewrite joinA ih. Qed. + +Fact meetss s : meet s s = s. +Proof. by elim: s => [|? ? ih] //=; rewrite meetxx ih. Qed. + +Fact joinKI y x : meet x (join x y) = x. +Proof. +elim: x y => [|? ? ih] [|? ?] //=; rewrite (meetxx, joinKI) ?ih //. +by congr cons; rewrite meetss. +Qed. + +Fact meetKU y x : join x (meet x y) = x. +Proof. by elim: x y => [|? ? ih] [|? ?] //=; rewrite meetKU ih. Qed. + +Fact leEmeet x y : (x <= y) = (meet x y == x). +Proof. +rewrite /POrderDef.le /=. +by elim: x y => [|? ? ih] [|? ?] //=; rewrite /eq_op /= leEmeet ih. +Qed. + +Fact meetUl : left_distributive meet join. +Proof. by elim=> [|? ? ih] [|? ?] [|? ?] //=; rewrite meetUl ih. Qed. + +Fact le0x s : [::] <= s. +Proof. by []. Qed. + +Definition latticeMixin := + Lattice.Mixin meetC joinC meetA joinA joinKI meetKU leEmeet meetUl. +Canonical latticeType := LatticeType (seq T) latticeMixin. +Canonical blatticeType := BLatticeType (seq T) (BLattice.Mixin le0x). + +End BLattice. + +End SeqProdOrder. + +Module Exports. +Canonical porderType. +Canonical latticeType. +Canonical blatticeType. +End Exports. +End SeqProdOrder. + +Module SeqLexOrder. +Section SeqLexOrder. +Context {disp : unit}. + +Section POrder. +Variable T : porderType disp. Implicit Types s : seq T. -Fixpoint lexi s1 s2 := +Fixpoint le s1 s2 := if s1 is x1 :: s1' then if s2 is x2 :: s2' then - (x1 < x2) || ((x1 == x2) && lexi s1' s2') + (x1 < x2) || (x1 == x2) && le s1' s2' else false else true. -Fact lexi_le_head x sx y sy: - lexi (x :: sx) (y :: sy) -> x <= y. -Proof. by case/orP => [/ltW|/andP [/eqP-> _]]. Qed. - -Fact lexi_refl: reflexive lexi. +Fact refl: reflexive le. Proof. by elim => [|x s ih] //=; rewrite eqxx ih orbT. Qed. -Fact lexi_anti: antisymmetric lexi. +Fact anti: antisymmetric le. Proof. move=> x y /andP []; elim: x y => [|x sx ih] [|y sy] //=. by case: comparableP => //= -> lesxsy /(ih _ lesxsy) ->. Qed. -Fact lexi_trans: transitive lexi. +Fact trans: transitive le. Proof. elim=> [|y sy ih] [|x sx] [|z sz] //=. case: (comparableP x y) => //=; case: (comparableP y z) => //=. @@ -2798,17 +3630,49 @@ case: (comparableP x y) => //=; case: (comparableP y z) => //=. - by move=> ltyz /lt_trans - /(_ _ ltyz) ->. Qed. -Definition lexi_porderMixin := LePOrderMixin lexi_refl lexi_anti lexi_trans. -Canonical lexi_porderType := POrderType display (seq T) lexi_porderMixin. +Definition porderMixin := LePOrderMixin refl anti trans (rrefl _). +Canonical porderType := POrderType disp (seq T) porderMixin. + +Fact lexi_le_head x sx y sy: x :: sx <= y :: sy -> x <= y. +Proof. by case/orP => [/ltW|/andP [/eqP-> _]]. Qed. + +End POrder. -End SeqLexPOrder. -End SeqLexPOrder. +Section Total. +Variable T : orderType disp. +Implicit Types s : seq T. -Canonical SeqLexPOrder.lexi_porderType. +Fact total : totalLatticeMixin [porderType of seq T]. +Proof. +rewrite /totalLatticeMixin /= /POrderDef.le /=. +by elim=> [|? ? ih] [|? ?] //=;case: ltgtP => //=. +Qed. + +Fact le0x s : [::] <= s. +Proof. by []. Qed. + +Canonical latticeType := LatticeType (seq T) total. +Canonical blatticeType := BLatticeType (seq T) (BLattice.Mixin le0x). +Canonical totalType := LatticeType (seq T) total. + +End Total. + +End SeqLexOrder. + +Module Exports. +Canonical porderType. +Canonical latticeType. +Canonical blatticeType. +Canonical totalType. +Definition lexi_le_head := @lexi_le_head. +Arguments lexi_le_head {disp}. +End Exports. +End SeqLexOrder. Module Def. Export POrderDef. Export LatticeDef. +Export TotalDef. Export BLatticeDef. Export TBLatticeDef. Export CBLatticeDef. @@ -2817,43 +3681,58 @@ End Def. Module Syntax. Export POSyntax. +Export TotalSyntax. Export LatticeSyntax. Export BLatticeSyntax. Export TBLatticeSyntax. Export CBLatticeSyntax. Export CTBLatticeSyntax. -Export ReverseSyntax. +Export ConverseSyntax. End Syntax. -Module Theory. -Export ReversePOrder. +Module LTheory. +Export POCoercions. +Export ConversePOrder. Export POrderTheory. -Export TotalTheory. -Export ReverseLattice. + +Export ConverseLattice. Export LatticeTheoryMeet. Export LatticeTheoryJoin. Export BLatticeTheory. -Export CBLatticeTheory. -Export ReverseTBLattice. +Export ConverseTBLattice. Export TBLatticeTheory. -Export CTBLatticeTheory. -Export NatOrder. -Export SeqLexPOrder. +End LTheory. -Export POrder.Exports. -Export Total.Exports. -Export Lattice.Exports. -Export BLattice.Exports. -Export CBLattice.Exports. -Export TBLattice.Exports. -Export CTBLattice.Exports. -Export FinPOrder.Exports. -Export FinTotal.Exports. -Export FinLattice.Exports. -Export FinBLattice.Exports. -Export FinCBLattice.Exports. -Export FinTBLattice.Exports. -Export FinCTBLattice.Exports. +Module CTheory. +Export LTheory CBLatticeTheory CTBLatticeTheory. +End CTheory. + +Module TTheory. +Export LTheory TotalTheory. +End TTheory. + +Module Theory. +Export CTheory TotalTheory. End Theory. End Order. + +Export Order.POrder.Exports. +Export Order.FinPOrder.Exports. +Export Order.Lattice.Exports. +Export Order.BLattice.Exports. +Export Order.TBLattice.Exports. +Export Order.FinLattice.Exports. +Export Order.CBLattice.Exports. +Export Order.CTBLattice.Exports. +Export Order.FinCLattice.Exports. +Export Order.Total.Exports. +Export Order.FinTotal.Exports. + +Export Order.TotalLatticeMixin.Exports. +Export Order.LePOrderMixin.Exports. +Export Order.LtPOrderMixin.Exports. +Export Order.MeetJoinMixin.Exports. +Export Order.LeOrderMixin.Exports. +Export Order.LtOrderMixin.Exports. +Export Order.NatOrder.Exports. -- cgit v1.2.3